在 R 条形图中设置可变条形宽度

Question

我希望能够通过针对两个因素绘制连续变量的条形图来改变条形图的宽度。并非所有的因子组合都有值，我希望它们要么不被绘制，要么具有更小的条形宽度。这是为了避免在图中浪费空间。 This is the kind of chart I am making 它的点叠加在透明条上。

我已经将基本 R 用于一系列条形图，如果可能的话，我宁愿不转向 ggplot2。

我尝试了不同的“宽度”和“空间”，但无法使其正常工作。宽度向量在前两项之后被回收。

示例代码

mydata=data.frame(y=rnorm(50,1,1))

group1=c(rep(1, times=30), rep(rep(c(1,2), each = 5), times=2))

group2=rep(c(c("A", "B", "C", "D", "E")), each=10)

cbind(mydata, group1, group2)


xbar=with(mydata, tapply(y, list(group1, group2), mean, na.rm=TRUE))    


barplot(xbar, beside = TRUE)

legend("topleft", legend=c("Group 1", "Group 2"),
       text.col=c("black", "gray50"))

谁能建议一种方法来删除没有条形的空格，因为该因素组合中没有数据？非常感谢。

Barplot showing empty space for empty factor combination

这些是我尝试过的宽度 `宽度=0.5

xlim=c(0,width*11)

w=c(width, 0, width, 0, width, 0, width, width, width, width)  

barplot(xbar, beside=TRUE, width=w, xlim=xlim)`

我认为这仅使用向量的前两个值。 Trying to vary width as a vector

我也尝试将它作为数据框（即使文档要求提供向量） - 这与上面的向量尝试给出相同的结果

single=c(width, 0)

double=c(width, width)

w=cbind(single, single, single, double, double)

barplot(xbar, beside=TRUE, width=w, xlim=xlim)

Answer 1

你可以在ggplot中试试

library(tidyverse)
cbind(mydata, group1, group2) %>% 
  ggplot(aes(group2, y, fill=factor(group1))) + 
    stat_summary(geom = "bar", fun.y = "mean", position = position_dodge(0.9)) +
    stat_summary(fun.data = mean_cl_normal, geom = "errorbar",position = position_dodge(0.9)) + 
    geom_point(aes(shape=factor(group1)),position = position_dodge(0.9))

在base R中你可以试试这个

# data
df <- cbind(mydata, group1, group2)
xbar=with(df, tapply(y, list(group1, group2), mean, na.rm=TRUE))    

# barplot
d <- xbar
d[2,1:3] <- d[1,1:3]
h <- barplot(d, beside=T, col=c(rep("darkgrey",7),"lightgrey","darkgrey","lightgrey"), border = NA, ylim = c(-3,3))

# get x positions
xpos <- h[2,]-diff(h)/2
xpos[4:5] <- h[,4]
xpos <- c(xpos, h[,5])
xpos
[1]  2.0  5.0  8.0 10.5 11.5 13.5 14.5

# add points
df$xpos <- NA
df$xpos[df$group2 == "A"] <- xpos[1]
df$xpos[df$group2 == "B"] <- xpos[2]
df$xpos[df$group2 == "C"] <- xpos[3]
df$xpos[df$group2 == "D" & df$group1 == 1 ] <- xpos[4]
df$xpos[df$group2 == "D" & df$group1 == 2 ] <- xpos[5]
df$xpos[df$group2 == "E" & df$group1 == 1 ] <- xpos[6]
df$xpos[df$group2 == "E" & df$group1 == 2 ] <- xpos[7]

points(df$xpos, df$y, pch=df$group1)

# add sd bars 
xsd=with(mydata, tapply(y, list(group1, group2), sd, na.rm=TRUE))   
xsd <- c(xsd[1,], xsd[2,4:5])
xsd <- xsd[order(names(xsd))]

arrows(x0 = xpos, x1 = xpos, y0 = c(xbar)[!is.na(c(xbar))]-xsd, y1 = c(xbar)[!is.na(c(xbar))]+xsd,angle=90,code=3,length=0.1)