使一个条上的边框比其他条更暗答案

【问题标题】：Make the border on one bar darker than the others使一个条上的边框比其他条更暗
【发布时间】：2013-12-18 13:21:33
【问题描述】：

我在 ggplot2 中创建了一个条形图，其中 3 个条表示做出 3 个选择中的 1 个的概率。

我想在显示正确响应的栏周围添加一个粗体边框。

我还没有找到方法来做到这一点。我可以更改所有条的颜色，但不仅仅是一个。

所附图片显示了我生成的图表网格。在 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

。 . .

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

使用下面 Troy 提出的代码，我对其进行了一些改动，并提出了一个解决 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 种模式的示例：How to add texture to fill colors in ggplot2?

【问题讨论】：

你能重新调整颜色的用途吗？条形上的灰度颜色看起来并没有添加任何信息。也许您可以使用它来显示正确答案。另外，代码会很好。
不幸的是，我需要坚持使用灰色条。颜色本来是一个很好的简单解决方案。干杯。

标签： r graph colors ggplot2 border

【解决方案1】：

我没有得到你的数据，所以我使用了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)))

【讨论】：

【解决方案2】：

与 Troy 的回答类似，但您可以使用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)

这会产生以下情节：

【讨论】：