调整不同 label 区域的多重填充（颜色）

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