Окраска ggplot x axis в фасетках

Question

Я пытаюсь выделить значение оси x на моей диаграмме, которое я могу сделать на основе этого example, однако я сталкиваюсь с проблемами, когда я пытаюсь украсить вещи. Границы имеют разные размеры и порядки вдоль оси х. В конечном итоге это усложняет ситуацию. Я также подозреваю, что ось х для каждого из фасетов должна быть одинаковой, однако я надеюсь, что кто-то может доказать мне, что я другой.

Мой пример - чистые данные образца, а размер моих наборов немного больше, поэтому я приношу извинения, если, когда я проверю его на реальном наборе данных, это приведет к появлению большего количества вопросов.

данных

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 вопрос.

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 форматирование применяется к сортире. Некоторые из них связаны с упорядочением набора данных.

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) 

К сожалению, мы видим, что второй аспект имеет элемент оси х выделено красным цветом. Я думаю, это связано с тем, что он принимает форматирование с первого графика и применяет его в том же порядке на втором графике.

Любые идеи о том, как применять форматирование для работы там, где существует одно и то же лицо в рамках деятельности или где человек существует только в одном мероприятии, будут очень признательны.

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) 

сетки

Теперь вы должны извлеките базовый объект grob, представляющий ось x, чтобы иметь возможность изменять цвет.

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

bp$grobs[wh] содержит теперь две оси х.Теперь вам нужно еще больше погрузиться в объект, чтобы изменить цвет.

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) 

Правда, это довольно грубый хак, но он обеспечивает то, что нужно:

Update

Это не работает для более поздних версий 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

Try:

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