Coloring ggplot x axis faceted
I am trying to highlight the x-axis value in my chart, which I can do based on this example , however I run into problems when I try to decorate things, Borders have different sizes and orders along the x-axis. This ultimately complicates the situation. I also suspect that the x-axis for each of the facets should be the same, however I hope someone can prove to me that they are different.
My example is pure sample data, and my datasets are a little larger, so I apologize if, when I test it on a real dataset, this 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 sort items by x-axis based on this SO question.
roles <- function(x) sub("[^_]*\\.","",x )
Diagram
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 "red" is assigned to sophie, the formatting is applied to john. Some of them are related to the ordering of the dataset.
chart2
If I add in setkey
, I get closer to the correct result
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 can see that in the second aspect the x-axis element is highlighted in red. I think this is because it takes the formatting from the first chart and applies it in the same order on the 2nd chart.
Any ideas on how to apply formatting to work when the same person exists in different activities, or where a person only exists in one activity, is appreciated.
source to share
If you can live with a rather dirty hack, I can share what I do in these cases. I mostly get around with the basic grid structure, which is basically a lot of calls browser
and str
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 need to extract the base object grob
representing the x-axis in order 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]
now contains two x-axes. Now you need to dive even deeper 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 "everything" we need to do to build the mesh object:
grid.draw(bp)
This is admittedly more of a crude hack, but it provides what is needed:
Update
This does not work for later versions ggplot2
as the internal structure changes grob
. So you need a little adaptation to get it working again. Basically, the corresponding slot has grob
moved one slot further down and can now be 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)
source to share
