ggplot2: сделать границу на одной полосе темнее, чем другие, используя R

Question

ggplot2: сделать границу на одной полосе темнее, чем другие, используя R

Я создал гистограмму в ggplot2, где 3 столбца представляют вероятность выбора 1 из 3 вариантов.

Я хочу добавить рамку, выделенную жирным шрифтом вокруг бара, которая показывает правильный ответ.

Я не нашел способ сделать это. Я могу изменить цвет ВСЕХ баров, но не только одного.

Прикрепленное изображение показывает сетку графиков, которые я сгенерировал. В столбце leftCust я хочу, чтобы все столбцы с 'left' под ними имели жирную рамку.

В столбце rightCust я хочу добавить жирную границу ко всем столбцам, расположенным прямо под ними.

И, наконец, в столбце SIMCust я хочу, чтобы все столбцы с SIM-картами под ними имели жирную рамку.

Это в основном для того, чтобы выделить правильный ответ и облегчить объяснение того, что показывают графики.

введите описание изображения здесь

КОД:

    dataRarrangeExpD <- read.csv("EXP2D.csv", header =TRUE);



library(ggplot2)
library("matrixStats")
library("lattice")
library("gdata")
library(plyr)
library(doBy)
library(Epi)
library(reshape2)
library(graphics)


#Create DataFrame with only Left-to-Right Visual Presentation
DataRearrangeD <- dataRarrangeExpD[, c("correct","Circle1", "Beep1","correct_response", "response", "subject_nr")]
#data_exp1$target_coh > 0



# Add new columns to hold choices made
DataRearrangeD[c("RightChoice", "LeftChoice", "SimChoice")] <- 0

DataRearrangeD$RightChoice <- ifelse(DataRearrangeD$response == "l", 1, 0)
DataRearrangeD$LeftChoice <- ifelse(DataRearrangeD$response == "a", 1, 0)
DataRearrangeD$SimChoice <- ifelse(DataRearrangeD$response == "space", 1, 0)


Exp2D.data = DataRearrangeD

# Construct data frames of report probability
SIM.vis.aud.df = aggregate(SimChoice ~ Circle1 + Beep1 + subject_nr, data = Exp2D.data, mean)
RightFirst.vis.aud.df = aggregate(RightChoice ~ Circle1 + Beep1 + subject_nr, data = Exp2D.data, mean)
LeftFirst.vis.aud.df = aggregate(LeftChoice ~ Circle1 + Beep1 + subject_nr, data = Exp2D.data, mean)


# combine data frames
mean.vis.aud.df = data.frame(SIM.vis.aud.df, RightFirst.vis.aud.df$RightChoice, LeftFirst.vis.aud.df$LeftChoice)
colnames(mean.vis.aud.df)[5:5] = c("Right")
colnames(mean.vis.aud.df)[6:6] = c("Left")
colnames(mean.vis.aud.df)[4:4] = c("SIM")
colnames(mean.vis.aud.df)[1:2] = c("Visual", "Audio")


# using reshape 2, we change the data frame to long format## measure.var column 3 up to column 5 i.e. 3,4,5
mean.vis.aud.long = melt(mean.vis.aud.df, measure.vars = 4:6, variable.name = "Report", value.name = "Prob")
# re-order levels of Report for presentation purposes
mean.vis.aud.long$Report = Relevel(mean.vis.aud.long$Report, ref = c("Left", "SIM", "Right"))
mean.vis.aud.long$Visual = Relevel(mean.vis.aud.long$Visual, ref = c("LeftCust","SIMCust","RightCust"))

#write.table(mean.vis.aud.long, "C:/Documents and Settings/psundere/My Documents/Analysis/Exp2_Pilot/reshape.txt",row.names=F) 


##############################################################################################
##############################################################################################
# Calculate SD, SE Means etc.
##############################################################################################
##############################################################################################

CalSD <- mean.vis.aud.long[, c("Prob", "Report", "Visual", "Audio", "subject_nr")]


# Get the average effect size by Prob
CalSD.means <- aggregate(CalSD[c("Prob")], 
                         by = CalSD[c("subject_nr", "Report", "Visual", "Audio")], FUN=mean)

#"correct","Circle1", "Beep1","correct_response", "response", "subject_nr"

# multiply by 100
CalSD.means$Prob <- CalSD.means$Prob*100

# Get the sample (n-1) standard deviation for "Probability"
CalSD.sd <- aggregate(CalSD.means["Prob"],
                      by = CalSD.means[c("Report","Visual", "Audio")], FUN=sd)


# Calculate SE --> SD / sqrt(N)
CalSD.se <- CalSD.sd$Prob / sqrt(25)
SE <- CalSD.se



# Confidence Interval @ 95% --> Standard Error * qt(0.975, N-1) SEE help(qt)
#.975 instead of .95 becasuse the 5% is 2.5% either side of the distribution
ci <- SE*qt(0.975,24)


##############################################################################################
##############################################################################################
###################################################
# Bar Graph

#mean.vis.aud.long$Audio <- factor (mean.vis.aud.long$Audio, levels = c("left", "2centre","NoBeep", "single","right"))


AggBar <- aggregate(mean.vis.aud.long$Prob*100,
                    by=list(mean.vis.aud.long$Report,mean.vis.aud.long$Visual, mean.vis.aud.long$Audio),FUN="mean")

#Change column names
colnames(AggBar) <- c("Report", "Visual", "Audio","Prob")


# Change the order of presentation
#CondPerRow$AuditoryCondition <- factor (CondPerRow$AuditoryCondition, levels = c("NoBeep", "left", "right"))



prob.bar = ggplot(AggBar, aes(x = Report, y = Prob, fill = Report)) + theme_bw() + facet_grid(Audio~Visual)
prob.bar + geom_bar(position=position_dodge(.9), stat="identity", colour="black") + theme(legend.position = "none") + labs(x="Report", y="Probability of Report") + scale_fill_grey() +
  labs(title = expression("Visual Condition")) +
  theme(plot.title = element_text(size = rel(1)))+
  geom_errorbar(aes(ymin=Prob-ci, ymax=Prob+ci),
                width=.2, # Width of the error bars
                position=position_dodge(.9))+
  theme(plot.title = element_text(size = rel(1.5)))+
  scale_y_continuous(limits = c(0, 100), breaks = (seq(0,100,by = 10)))

Вот как выглядит AggBar после манипулирования непосредственно перед генерацией графика:

        Report  Visual  Audio   Prob
1   Left    LeftCust    2centre 81.84
2   SIM LeftCust    2centre 13.52
3   Right   LeftCust    2centre 4.64
4   Left    SIMCust 2centre 17.36
5   SIM SIMCust 2centre 69.76
6   Right   SIMCust 2centre 12.88
7   Left    RightCust   2centre 8.88
8   SIM RightCust   2centre 13.12
9   Right   RightCust   2centre 78.00
10  Left    LeftCust    left    94.48
11  SIM LeftCust    left    2.16
12  Right   LeftCust    left    3.36
13  Left    SIMCust left    65.20
14  SIM SIMCust left    21.76
15  Right   SIMCust left    13.04
16  Left    RightCust   left    31.12
17  SIM RightCust   left    4.40
18  Right   RightCust   left    64.48
19  Left    LeftCust    NoBeep  66.00
20  SIM LeftCust    NoBeep  26.08
21  Right   LeftCust    NoBeep  7.92
22  Left    SIMCust NoBeep  10.96
23  SIM SIMCust NoBeep  78.88
24  Right   SIMCust NoBeep  10.16
25  Left    RightCust   NoBeep  8.48
26  SIM RightCust   NoBeep  26.24
27  Right   RightCust   NoBeep  65.28
28  Left    LeftCust    right   62.32
29  SIM LeftCust    right   6.08
30  Right   LeftCust    right   31.60
31  Left    SIMCust right   17.76
32  SIM SIMCust right   22.16
33  Right   SIMCust right   60.08
34  Left    RightCust   right   5.76
35  SIM RightCust   right   3.60
36  Right   RightCust   right   90.64
37  Left    LeftCust    single  49.92
38  SIM LeftCust    single  47.84
39  Right   LeftCust    single  2.24
40  Left    SIMCust single  6.56
41  SIM SIMCust single  87.52
42  Right   SIMCust single  5.92
43  Left    RightCust   single  3.20
44  SIM RightCust   single  52.40
45  Right   RightCust   single  44.40

,,,

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Используя код, предложенный Троем ниже, я немного изменил его и нашел крошечное решение об отсутствии шаблонов в ggplot2 для гистограмм.

Вот код, который я использовал для добавления вертикальных линий к столбцам, чтобы получить базовый шаблон для правильных столбцов ответа. Я уверен, что вы умные люди могли бы адаптировать это для ваших собственных потребностей в отношении текстуры / моделей, хотя и основных:

######### ADD THIS LINE TO CREATE THE HIGHLIGHT SUBSET
HighlightDataCust <-AggBar[AggBar$Report==gsub("Cust", "", AggBar$Visual),]
#####################################################


prob.bar = ggplot(AggBar, aes(x = Report, y = Prob, fill = Report)) + theme_bw() + facet_grid(Audio~Visual)
prob.bar + geom_bar(position=position_dodge(.9), stat="identity", colour="black") + theme(legend.position = "none") + labs(x="Response", y="Probability of Report") + scale_fill_grey() +

######### ADD THIS LINE TO CREATE THE HIGHLIGHT SUBSET

geom_bar(data=HighlightDataCust, position=position_dodge(.9), stat="identity", colour="black", size=2)+
  geom_bar(data=HighlightDataCust, position=position_dodge(.9), stat="identity", colour="black", size=0.5, width=0.85)+
  geom_bar(data=HighlightDataCust, position=position_dodge(.9), stat="identity", colour="black", size=0.5, width=0.65)+
  geom_bar(data=HighlightDataCust, position=position_dodge(.9), stat="identity", colour="black", size=0.5, width=0.45)+
  geom_bar(data=HighlightDataCust, position=position_dodge(.9), stat="identity", colour="black", size=0.5, width=0.25)+
  geom_bar(data=HighlightDataCust, position=position_dodge(.9), stat="identity", colour="black", width=0.0) +
  ######################################################

labs(title = expression("Visual Condition")) +
  theme(text=element_text(size=18))+
  theme(axis.title.x=element_text(size=18))+
  theme(axis.title.y=element_text(size=18))+
  theme(axis.text.x=element_text(size=12))+
  geom_errorbar(aes(ymin=Prob-ci, ymax=Prob+ci),
                width=.2, # Width of the error bars
                position=position_dodge(.9))+
  theme(plot.title = element_text(size = 18))+
  scale_y_continuous(limits = c(0, 100), breaks = (seq(0,100,by = 10)))

Это выход. Очевидно, что линии могут быть сделаны в любом цвете, который вы хотите, и сочетание цветов. Просто убедитесь, что вы начинаете с самой широкой ширины и работаете в направлении 0,0, чтобы слои не перезаписывались. Надеюсь, кто-то найдет это полезным. (Также должно быть возможно создать горизонтальные линии внутри стержней, если создать несколько слоев с разными высотами по оси Y, то есть верх каждой разной высоты стержня будет выглядеть как горизонтальная линия. Сам не проверял, но это может быть Стоит обратить внимание на те из них, которым требуется более одного рисунка столбцов. Объединение обоих в один столбец должно привести к получению сетчатого рисунка и не забывать, что можно использовать разные цвета. Короче говоря, я думаю, что этот подход является хорошим решением проблемы отсутствия рисунка. в ggplot2.)

Я создал пример 3 типов шаблонов, которые я упомянул здесь: Как добавить текстуру для заливки цветов в ggplot2?

введите описание изображения здесь

12

r ggplot2 graph colors border

Источник

user2653210 02 дек '13 в 18:12

2 ответа

Решение

Подобно ответу Троя, но вместо создания слоя невидимых баров, вы можете использовать size эстетическое и scale_size_manual:

require(ggplot2)
data(diamonds)

diamonds$choose = factor(diamonds$clarity == "SI1")

ggplot(diamonds) + 
  geom_bar(aes(x = clarity, fill=clarity, size=choose), color="black") +
  scale_size_manual(values=c(0.5, 1), guide = "none") +
  facet_wrap(~ cut)

Который производит следующий сюжет:

18

Источник

user2497424 02 дек '13 в 19:24

Другие вопросы по тегам r ggplot2 graph colors border

user2967665 02 дек '13 в 18:58 2013-12-02 18:58 · Accepted Answer · 2013-12-02 18:58

У меня нет ваших данных, поэтому я использовал diamonds набор данных для демонстрации.

В основном вам нужно "перепланировать" секунду geom_bar() звоните, где вы фильтруете data= атрибут для рисования только тех полос, которые вы хотите выделить. Просто отфильтруйте исходные данные, чтобы исключить все, что вам не нужно. например, ниже мы реплотируем подмножество diamonds[(diamonds$clarity=="SI2"),]

d <- ggplot(diamonds) +  geom_bar(aes(clarity, fill=color))    # first plot
d + geom_bar(data=diamonds[(diamonds$clarity=="SI2"),],        # filter
aes(clarity), alpha=0, size=1, color="black") +                # plot outline only
  facet_wrap(~ cut)

NB очевидно, что ваш фильтр будет более сложным, например,

data=yourdata[(yourdata$visualcondition=="LeftCust" & yourdata$report=="Left" |
                 yourdata$visualcondition=="SIMCust" & yourdata$report=="SIM" |
                yourdata$visualcondition=="RightCust" & yourdata$report=="Right"),]

ОК обновлен с вашими данными. Я должен был установить доверительные интервалы, потому что они не были доступны в данных AggBar2:

######### ADD THIS LINE TO CREATE THE HIGHLIGHT SUBSET
HighlightData<-AggBar2[AggBar2$Report==gsub("Cust","",AggBar2$Visual),]
#####################################################

prob.bar = ggplot(AggBar2, aes(x = Report, y = Prob, fill = Report)) + theme_bw() + facet_grid(Audio~Visual)
prob.bar + geom_bar(position=position_dodge(.9), stat="identity", colour="black") + theme(legend.position = "none") + labs(x="Report", y="Probability of Report") + scale_fill_grey() +

######### ADD THIS LINE TO CREATE THE HIGHLIGHT SUBSET
  geom_bar(data=HighlightData, position=position_dodge(.9), stat="identity", colour="pink",size=1) +
######################################################

  labs(title = expression("Visual Condition")) +
  theme(plot.title = element_text(size = rel(1)))+
  geom_errorbar(aes(ymin=Prob-ci, ymax=Prob+ci),
                width=.2, # Width of the error bars
                position=position_dodge(.9))+
  theme(plot.title = element_text(size = rel(1.5)))+
  scale_y_continuous(limits = c(0, 100), breaks = (seq(0,100,by = 10)))