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

Question

0

原谅我的笨蛋又来打扰你了

@teunbrand 昨天回答了我的问题，我在真实数据中使用了它，但它不起作用。

这是我在stackoverfow:Can中的问题我在使用ggh4x包时调整了不同标签区域的填充（颜色）

@teunbrand 创建了一个函数：assign_strip_colours <- function(gt, index, colours){…}

不知道我的真实数据和代码哪里出了问题。有42个区域需要用不同的颜色填充。

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. ) ?

如果在 assign_strip_colours <- function(gt, index, colours){…} 中有某事需要调整？

请原谅我是 ggplotGrob 的新手。我需要你的 help.Thanks.

示例数据和代码：

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"), 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" “ ), 平均值 =..., 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

不好意思，我想我之前忘记的mapply()函数应该有一个SIMPLIFY = FALSE。


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)

^{由 reprex package (v1.0.0)}

于 2021 年 4 月 11 日创建

数据/情节构建：

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

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

Adjust the multiple fills(color) of different label regions

r

ggplot2

grob