在facet中着色ggplot x軸

Question

我試圖在我的圖表上突出顯示我可以根據這個例子做的x軸值，但是當我嘗試面對事情時遇到問題。 小平面沿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)

有助於根據此 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)

你可以看到，即使將“紅色”分配給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"))