ggplot，嵌套的X轴用于条形图中的交互（）因子变量

Question

如何格式化多面，多分组的箱形图x轴，以便我得到一些看起来像这样的东西（狡猾的油漆，但显示了这个想法）......

到目前为止，这是代码。

# Make the dataset
data<-data.frame(cbind(runif(10,1,10), 
                       sample(1:5, 10, replace=TRUE), 
                       sample(1:5, 10, replace=TRUE),
                       sample(1:2, 10, replace=TRUE),
                       sample(1:2, 10, replace=TRUE)))

names(data)<-c("DV","Grouping_1", "Grouping_2", "Grouping_3", "Grouping_4")

data$Grouping_1<-as.factor(data$Grouping_1)
data$Grouping_2<-as.factor(data$Grouping_2)
data$Grouping_3<-as.factor(data$Grouping_3)
data$Grouping_4<-as.factor(data$Grouping_4)

# grab the interaction
data$groups<-interaction(data$Grouping_1,data$Grouping_2)

# Sort it (to make things neat)
data$groups<-factor(data$groups, levels = sort(levels(data$group)))

# Plot it
ggplot(data = data, aes(x =groups, y = DV, fill = Grouping_3)) + 
  geom_bar(stat = "identity", position = position_dodge())  + facet_grid(Grouping_4 ~ .)

这给了......

Answer 1

这在ggplot2中确实运作良好。您可以尝试类似下面的代码。它真的不漂亮，但它有点工作。

gr <- as.numeric(as.character(data$groups))
# additional data for annotation
df_a <- data.frame(y=-Inf, 
                   xmin = factor(sapply(1:5, function(x) min(gr[gr > x]))), 
                   xmax = factor(sapply(2:6, function(x) max(gr[gr < x]))), 
                   nr = -(sapply(1:5, function(x) sum(gr > x & gr < x+1))-1)*2.5+0.5, # change here to get horizontal adjustment right...
                   Grouping_4 = 2, 
                   text = 1:5)

# Plot it
p <- ggplot(data = data, aes(x =groups, y = DV, fill = Grouping_3)) + 
  geom_bar(stat = "identity", position = position_dodge())  + facet_grid(Grouping_4 ~ .) +
  geom_segment(data = df_a, aes(x=xmin, xend=xmax, y=y, yend=y, fill=NULL)) +
  geom_text(data = df_a, aes(x=xmin, y=y+2, label=text, fill=NULL, hjust=nr), vjust = 1.5) + 
  theme(plot.margin = unit(c(1,1,2,1), "lines")) + 
  scale_x_discrete(name = "\ngroups", labels=paste0("\n\n", round(10 * (sort(gr)-round(sort(gr), 0)), 0)))

require(gridExtra)
# turns clipping off
gt <- ggplot_gtable(ggplot_build(p))
gt$layout$clip[gt$layout$name == "panel"] <- "off"
grid.draw(gt)

另一个选项可能是ggvis，一个类似于ggplot2的包，支持多个轴。或者您可以直接手动添加grob grid。