在facet中着色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问题帮助排列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)

你可以看到，即使＆＃34;红色＆＃34;被分配给sophie的格式应用于john。其中一些与数据集的排序有关。

Chart2

如果我添加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)

不可否认，这是一个粗略的黑客行为，但它提供了所需要的东西：

<强>更新

这对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"))