Adjust the multiple fills(color) of different label regions - r

Question

0
Forgive my stupid to disturb you again.
#teunbrand answered my question yesterday and I used it in my real data but it doesn’t work .
Here is my question in stackoverfow:Can I adjust the fill(color) of different label regions when using ggh4x package
And # teunbrand created a function : assign_strip_colours <- function(gt, index, colours){…}
I don’t know where is wrong with my real data and code. There are 42 regions need to be filled with different colors.
gt <- assign_strip_colours(gt, 1:42,rainbow(42)) Warning message: In gt$grobs[is_strips] <- strips : 被替换的项目不是替换值长度的倍数(The item being replaced is not a multiple of the length of the replacement value. ) ?
If there is sth need to be adjust in assign_strip_colours <- function(gt, index, colours){…} ?
Forgive me I’m really new to ggplotGrob. I need your help.Thanks.
sample data and code:
structure(list(Name = 1:71, Disease = 72:142, Organ = c("A",
"A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A",
"A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A",
"A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A",
"A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A",
"A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A",
"A", "A", "A", "A", "A"), fill = c("a", "a", "a", "a", "a", "a",
"a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a",
"a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a",
"a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a",
"a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a",
"a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a"
), mean =..., row.names = c(NA, 71L), class = "data.frame")
p1<-ggplot(data = data, aes(Name,mean, label = Name, fill=Organ)) +
geom_bar(position="dodge2", stat="identity",width = 0.85,color="black") +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd),position = position_dodge(0.95), width = .2) +
# scale_alpha_manual(values = datamean_sd$Alpha) +
# scale_color_manual(name = "Organ", values = c("A"="#f15a24", "B"="#00FF00","C"="#7570B3","D"="#FF00FF","E"="#FFFF33","F"="#00F5FF","G"="#666666","H"="#7FC97F","I"="#BEAED4","J"="#A6D854"))+
# guides(
# colour = guide_legend(title.position = "right")
# )+
facet_nested(.~Organ+Disease, scales = "free_x", space = "free_x",switch = "x")+
## facet_wrap(strip.position="bottom") +
labs(title = "123", x = NULL, y = "value") +
rotate_x_text(angle = 45)+
scale_fill_manual(name = "Organ",values = unique(datamean_sd$Organ_fill))
p1
####
gt <- ggplotGrob(p1)
###############
assign_strip_colours <- function(gt, index, colours) {
if (length(index) != length(colours))
stop()
# Decide which strips to recolour, here: the first 3
is_strips <- which(startsWith(gt$layout$name, "strip-b"))[index]
# Extract strips
strips <- gt$grobs[is_strips]
# Loop over strips
strips <- mapply(function(strip, colour) {
# Find actual strip
is_strip <- strip$layout$name == "strip"
grob <- strip$grobs[is_strip][[1]]
# Find rectangle
is_rect <- which(vapply(grob$children, inherits, logical(1), "rect"))
# Change colour
grob$children[[is_rect]]$gp$fill <- colour
# Put back into strip
strip$grobs[is_strip][[1]] <- grob
return(strip)
}, strip = strips, colour = colours)
# Put strips back into gtable
gt$grobs[is_strips] <- strips
return(gt)
}
gt <- assign_strip_colours(gt, 1:42,rainbow(42))
grid::grid.newpage(); grid::grid.draw(gt)

Answer 1

My bad, I think there should have been a SIMPLIFY = FALSE at the mapply() function which I forgot earlier.
gt <- ggplotGrob(p1)
assign_strip_colours <- function(gt, index, colours) {
if (length(index) != length(colours))
stop()
# Decide which strips to recolour, here: the first 3
is_strips <- which(startsWith(gt$layout$name, "strip-b"))[index]
# Extract strips
strips <- gt$grobs[is_strips]
# Loop over strips
strips <- mapply(function(strip, colour) {
# Find actual strip
is_strip <- strip$layout$name == "strip"
grob <- strip$grobs[is_strip][[1]]
# Find rectangle
is_rect <- which(vapply(grob$children, inherits, logical(1), "rect"))
# Change colour
grob$children[[is_rect]]$gp$fill <- colour
# Put back into strip
strip$grobs[is_strip][[1]] <- grob
return(strip)
}, strip = strips, colour = colours, SIMPLIFY = FALSE)
# Put strips back into gtable
gt$grobs[is_strips] <- strips
return(gt)
}
gt <- assign_strip_colours(gt, 1:42,rainbow(42))
grid::grid.newpage(); grid::grid.draw(gt)
Created on 2021-04-11 by the reprex package (v1.0.0)
Data / plot construction:
library(ggplot2)
library(ggh4x)
data <- [Censored upon request]
p1<-ggplot(data = data, aes(Name,mean, label = Name, fill=Organ)) +
geom_bar(position="dodge2", stat="identity",width = 0.85,color="black") +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd),position = position_dodge(0.95), width = .2) +
facet_nested(.~Organ+Disease, scales = "free_x", space = "free_x",switch = "x")+
theme_classic() +
theme(legend.position = "bottom",
legend.box = "horizontal",
plot.title = element_text(hjust = 0.5),
plot.margin = unit(c(5, 10, 20, 7), "mm"),
strip.background = element_rect(colour="black", fill="white"),
strip.text.x = element_text(size = 6, angle=0),
axis.text.x=element_text(size=8),
strip.placement = "outside"
) +
labs(title = "123", x = NULL, y = "value")