在构面中着色ggplot x轴

Question

我试图在我的图表上突出显示一个 x 轴值，我可以根据这个 example 执行此操作，但是当我尝试解决问题时遇到了问题。刻面沿 x 轴具有不同的大小和顺序。这最终使事情变得复杂。我还怀疑每个方面的 x 轴必须相同，但是我希望有人可以证明我的不同。

我的例子是纯样本数据，我的集合的大小有点大，所以如果我在真实数据集上测试它会导致更多问题，我现在很抱歉。

数据

library(data.table)
dt1 <- data.table(name=as.factor(c("steve","john","mary","sophie","steve","sophie")),
                  activity=c("a","a","a","a","b","b"),
                  value=c(22,32,12,11,25,32),
                  colour=c("black","black","black","red","black","red"))

dt1[,myx := paste(activity, name,sep=".")]
dt1$myx <- reorder(dt1$myx, dt1$value,sum)

根据this SO question 帮助在 x 轴上对项目进行排序的函数。

roles <- function(x) sub("[^_]*\\.","",x ) 

图表

ggplot() +
  geom_bar(data=dt1,aes(x=myx, y=value), stat="identity") +
  facet_grid( ~ activity, scales = "free_x",space = "free_x") + 
  theme(axis.text.x = element_text(colour=dt1[,colour[1],by=myx][,V1])) +
  scale_x_discrete(labels=roles)

您可以看到，即使“红色”分配给了 sophie，格式也应用于 john。其中一些与数据集的排序有关。

图表2

如果我添加setkey，我会接近正确的结果

setkey(dt1,myx)
ggplot() +
  geom_bar(data=dt1,aes(x=myx, y=value), stat="identity") +
  facet_grid( ~ activity, scales = "free_x",space = "free_x") + 
  theme(axis.text.x = element_text(colour=dt1[,colour[1],by=myx][,V1])) +
  scale_x_discrete(labels=roles)

不幸的是，我们看到第二个方面的 x 轴项目以​​红色突出显示。我认为这是因为它从第一个图表中获取格式并在第二个图表中以相同的顺序应用它。

任何关于如何将格式应用到同一个人存在于活动中或一个人只存在于一项活动中的工作的想法将不胜感激。

Answer 1

如果你能忍受一个相当肮脏的黑客，我可以分享我在这些情况下所做的事情。基本上我搞乱了底层的网格结构，基本上是很多browser和str开头的调用:)

ggplot

p <- ggplot() +
   geom_bar(data=dt1,aes(x=myx, y=value), stat="identity") +
   facet_grid( ~ activity, scales = "free_x",space = "free_x") + 
   scale_x_discrete(labels=roles)

网格

现在您必须提取代表 x 轴的底层 grob 对象才能更改颜色。

library(grid)
bp <- ggplotGrob(p)
wh <- which(grepl("axis-b", bp$layout$name)) # get the x-axis grob

bp$grobs[wh] 现在包含两个 x 轴。现在您必须更深入地了解对象才能更改颜色。

bp$grobs[wh] <- lapply(bp$grobs[wh], function(gg) {
   ## we need to extract the right element
   ## this is not that straight forward, but in principle I used 'str' to scan through
   ## the objects to find out which element I would need
   kids <- gg$children 
   wh <- which(sapply(kids$axis$grobs, function(.) grepl("axis\\.text", .$name)))
   axis.text <- kids$axis$grobs[[wh]]
   ## Now that we found the right element, we have to replicate the colour and change 
   ## the element corresponding to 'sophie'
   axis.text$gp$col <- rep(axis.text$gp$col, length(axis.text$label))
   axis.text$gp$col[grepl("sophie", axis.text$label)] <- "red"
   ## write the changed object back to the respective slot
   kids$axis$grobs[[wh]] <- axis.text
   gg$children <- kids
   gg
})

所以，现在我们要做的就是绘制网格对象：

grid.draw(bp)

诚然，这是一个相当粗略的 hack，但它提供了所需的内容：

更新

这不适用于ggplot2 的更新版本，因为grob 的内部结构发生了变化。因此，您需要进行一些调整才能使其再次工作。原则上，相关的grob 插槽向下移动了一个插槽，现在可以在.$children[[1]] 中找到

bp$grobs[wh] <- lapply(bp$grobs[wh], function(gg) {
   ## we need to extract the right element
   ## this is not that straight forward, but in principle I used 'str' to scan through
   ## the objects to find out which element I would need
   kids <- gg$children 
   wh <- which(sapply(kids$axis$grobs, function(.) grepl("axis\\.text", .$name)))
   axis.text <- kids$axis$grobs[[wh]]$children[[1]]
   ## Now that we found the right element, we have to replicate the colour and change 
   ## the element corresponding to 'sophie'
   axis.text$gp$col <- rep(axis.text$gp$col, length(axis.text$label))
   axis.text$gp$col[grepl("sophie", axis.text$label)] <- "red"
   ## write the changed object back to the respective slot
   kids$axis$grobs[[wh]]$children[[1]] <- axis.text
   gg$children <- kids
   gg
})
grid.draw(bp) 

Answer 2

试试：

ggplot() +

      geom_bar(data=dt1,aes(x=name, y=value, fill = name), stat="identity") +
      facet_grid( ~ activity) + scale_fill_manual(values = c("black","black","red", "black"))