关于 r：在构面中为 ggplot x 轴着色


Colouring ggplot x axis in facets

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

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

数据

1
2
3
4
5
6
7
8
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)

根据此 SO 问题帮助对 x 轴上的项目进行排序的功能。

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

图表

1
2
3
4
5
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)

enter

图表2

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

1
2
3
4
5
6
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)

enter

1
2
3
4
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 对象才能更改颜色。

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

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
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
})

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

1
grid.draw(bp)

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

enter

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
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)
相关讨论

试试：

1
2
3
4
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"))

enter

相关讨论