Make the border on one bar darker than the others

Question

I created a histogram in ggplot2, where 3 bars represent the probability of making one of 3 options.

I want to add a bolded frame around a panel that shows the correct answer.

I did not find a way to do this. I can change the color of ALL bars, but not just one.

The attached image shows the grid of graphs that I generated. In the leftCust column, I want all bars with a “left” below them to have a bold border.

In the rightCust column, I want to add a bold border to all the bars directly below them.

And finally, in the SIMCust column, I want all bars with a SIM card below them to have a bold border.

This basically emphasizes the correct answer and simplifies the explanation of what the graphs show.

CODE:

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 ie 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))) 

This is what AggBar looks like after manipulation just before plotting:

  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

Using the code presented by Troy below, I twisted it a bit and came up with a small solution for the lack of templates in ggplot2 for histograms.

Here's the code I used to add vertical lines to the columns to get a basic pattern for the correct response bars. I'm sure that you smart people could adapt this for your own needs taking into account textures / patterns, albeit basic ones:

 ######### 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))) 

This is the result. Clearly, the lines can be made with any color you want and a combination of colors. Just make sure you start with the widest width and work in the 0.0 direction so that the layers don't overwrite. Hope someone finds this helpful. (It should also be possible to create horizontal lines inside the bars, if you need to create several layers with different y-axis heights, i.e. the vertex of each different bar heights will look like a horizontal line. I haven’t checked it myself, but it might be worth looking into those which require more than one bar template. Combining both into one bar should lead to a mesh pattern and forget that you cannot use different colors. In short, I think this approach is a worthy fix for the lack of a template in ggplot2.)

I created an example of the three types of patterns mentioned here: How to add texture to fill colors in ggplot2?

Answer 1

I have no data, so I used the diamonds dataset for demonstration.

Basically, you need to “rewrite” the second call to geom_bar() , in which you filter the data= attribute only to draw the strokes you want to highlight. Just filter the source data to exclude anything you don't want. for example below, we select a subset of 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 , obviously your filter will be more complex, like

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

OK updated by your details. I had to compose confidence intervals because they are not available in AggBar2 data:

 ######### 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))) 

Answer 2

Similar to the Triple answer, but instead of creating a layer of invisible bars, you can use size aesthetics and 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) 

Which gives the following graph: