Colouring ggplot x axis in facets

Question

I am trying to highlight an x-axis value on my chart which I can do based on this example, however I run into issues when I try to facet things. The facets have varying sizes and orders along the x-axis. This is ultimately what complicates things. I also suspect that the x-axis for each of the facets has to be the same, however I am hoping someone can prove me different.

My example is pure sample data, and the size of my sets is a bit larger, so I'll apologise now if when I test it on the real data set it leads to more questions.

Data

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)

Function to help with the sorting of the items in the x axis based on this SO question.

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

Chart

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)

You can see that even though the "red" is assigned to sophie the formatting is applied to john. Some of this has to do with the ordering of the dataset.

Chart2

If I add in the setkey i get close to the right outcome

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)

Unfortunately we see that the 2nd facet has the x-axis item highlighted red. I think this is because it takes the formatting from the first chart and applies it in the same order in the 2nd chart.

Any ideas on how to apply the formatting to work where the same person exists across activities or where a person exists in only one activity would be greatly appreciated.

Answer 1

If you can live with a rather dirty hack, I can share what I do in these cases. Basically I mess around with the underlying grid structure, which is basically a lot of browser and str calls in the beginning :)

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)

grid

Now you have to extract the underlying grob object representing the x-axis to be able to change the color.

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

bp$grobs[wh] contains now the two x-axis. Now you have to dive even further into the object to change the color.

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
})

So, now 'all' we have to do is to plot the grid object:

grid.draw(bp)

Admittedly, that's rather a rough hack, but it delivers what is needed:

Update

This does not work for more recent versions of ggplot2 as the internal structure of the grob changed. Thus, you need a little adaptation to make it work again. In principle the relevant grob slot moved one slot further down and can be now found in .$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)