问题描述
0
原谅我的笨蛋再次打扰你。
@teunbrand 昨天回答了我的问题,我在我的真实数据中使用了它,但它不起作用。
这是我在 stackoverfow 中的问题:我可以在使用 ggh4x 包时调整不同标签区域的填充(颜色)
并且@teunbrand 创建了一个函数:assign_strip_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有什么需要调整的
请原谅我对 ggplotGrob 真的很陌生。我需要你的帮助。谢谢。
示例数据和代码:
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"),fill = c("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,rainbow(42))
grid::grid.newpage(); grid::grid.draw(gt)
解决方法
糟糕,我认为 SIMPLIFY = FALSE
函数中应该有一个 mapply()
,但我之前忘记了。
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")