将文本背景设置为ggplot轴文本

Question

我有一个ggplot graphich，它有一个长文本作为Y轴。

我试图找到一种方法来为Y轴设置背景颜色，使用两种不同的颜色＆＃34; zebra-theme＆＃34;喜欢这个

但似乎element_text()中没有ggplot功能。

是的，请有人帮帮我。

感谢

Tlopasha

Answer 1

如果你破解了主题系统，它可能是可能的，但它可能不是一个好主意。

library(grid)

element_custom <- function(...) {
  structure(list(...), class = c("element_custom", "element_blank"))
}

element_grob.element_custom <- function(element, label, x, y, ...)  {
  tg <- textGrob(label, y=y, gp=gpar(col=element$colour))
  padding <- unit(1,"line")
  rg <- rectGrob(y=y,width=grobWidth(tg)+padding, height=unit(1,"line")+padding, 
                 gp=gpar(fill = element$fill, col=NA, alpha=0.1))
  gTree(children=gList(rg, tg), width=grobWidth(tg) + padding, cl="custom_axis")
}

widthDetails.custom_axis <- function(x) x$width + unit(2,"mm") # fudge


qplot(1:3,1:3) +
  theme(axis.text.y = element_custom(colour = 1:2, fill=1:2))

Answer 2

谢谢baptiste的回答和解决方案。

我想我发现使用gtable和amp;可能是另一个好方法。格：

data <- structure(list(item = c("Lorem ipsum dolor sit amet, consectetuer adipiscing elit.",
"Integer vitae libero ac risus egestas placerat.", "Fusce lobortis lorem at ipsum semper sagittis.",
"Donec quis dui at dolor tempor interdum.", "Vivamus molestie gravida turpis.", 
"Nunc dignissim risus id metus.", "Praesent placerat risus quis eros.", 
"Vestibulum commodo felis quis tortor."), VG = c(5, 6, 5, 3, 
3, 5, 5, 5), MA = c(5.7, 5.9, 5.7, 5.7, 3.7, 5.7, 5.7, 5.7), 
KO = c(3.3, 4.3, 3.7, 2.3, 3.3, 3.3, 3.3, 3.3), KU = c(5.8,
3.8, 2.8, 2.8, 3.8, 5.8, 5.8, 5.8), SE = c(6, 4, 4, 3.5, 
3, 6, 6, 6), itemnummber = 1:8, prio = c("", "2X", "", "", 
"4X", "1X", "", "")), .Names = c("item", "VG", "MA", "KO", 
"KU", "SE", "itemnummber", "prio"), row.names = c(NA, -8L), spec = 
structure(list(cols = structure(list(item = structure(list(), class = c("collector_character","collector")), VG = structure(list(), class = c("collector_double", 
"collector")), MA = structure(list(), class = c("collector_double", 
"collector")), KO = structure(list(), class = c("collector_double", 
"collector")), KU = structure(list(), class = c("collector_double", 
"collector")), SE = structure(list(), class = c("collector_number", 
"collector"))), .Names = c("item", "VG", "MA", "KO", "KU", 
"SE")), default = structure(list(), class = c("collector_guess", 
"collector"))), .Names = c("cols", "default"), class = "col_spec"), class = 
c("tbl_df", 
"tbl", "data.frame")) 



library(tidyr)
data_long <- gather(data, perspective, value, VG:SE, factor_key=TRUE)

library(ggplot2)
library(stringr)
library(grid)
library(gridExtra)
library(gtable)

scale.text <- c("not satisfied", "little satisfied", "satisfied", "50% 
ok", "more than 50%", "sehr satisfied", " 100% satisfied")

diagram <- ggplot(data_long, aes(value, item, colour = perspective, fill = 
perspective, group = perspective)) +
  geom_point(size= 5,stroke = 0.1) +

  scale_y_discrete(labels = function(x) str_wrap(x, width = 60)) + 
  scale_x_continuous(breaks = c(1:7), labels = scale.text, limits=c(1, 
  7),sec.axis = sec_axis(~ ., breaks = c(1:7), labels = c(1:7))) +
  theme_minimal(base_size = 5) +
  theme(

    panel.grid.minor.x = element_blank(),
    panel.grid.major.x =element_line(linetype="dotted",colour = "#b4c2cb", 
    size = 0.2),
    legend.position="top",
    plot.title = element_blank(),
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    legend.title = element_blank(),
    axis.text.y = element_blank(),
    axis.text.x=element_text(color = "black", size=8, angle=60, vjust=.8, 
    hjust=0.8),
    axis.text.x.top = element_text(color = "black", size=8, angle=0, 
    vjust=.5, hjust=0.5)
   )


# ITEMS

tt3 <- ttheme_minimal(
  core=list(bg_params = list(fill = c("#DDDDDD", "#FFFFFF"), col=NA),
            fg_params=list(fontface=3)),
  base_size = 9,
  colhead=list(fg_params=list(col="navyblue", fontface=1)),
  rowhead=list(fg_params=list(col="orange", fontface=1)))

items <- tableGrob(str_wrap(data$item, width = 80),cols = " ", theme=tt3)
items$widths <- unit(rep(1, 1), "npc")
#items$heights <- unit(rep(1/nrow(data), nrow(data)), "null")
items$heights <- unit(c(0.03, rep(1/nrow(data)  , nrow(data))), "npc")


# stats
stats <- tableGrob(data[,2:4], rows=NULL, theme=tt3) 
stats$widths <- unit(rep(1/3,3), "npc")  
stats$heights <- unit(c(0.03, rep(1/nrow(data)  , nrow(data))), "npc")
separators <- replicate(ncol(stats), segmentsGrob(x1 = unit(0, "npc"), 
gp=gpar(lty=4, col = "#8c8c8c")), simplify=FALSE)

stats <- gtable_add_grob(stats, grobs = separators,t = 1, b = nrow(stats), l = seq_len(ncol(stats)))


# itemnummber
itemnummber <- tableGrob(data$itemnummber,cols = "Nr.", rows=NULL, 
theme=tt3)
itemnummber$widths <- unit(rep(1, 1), "npc")
itemnummber$heights <-  unit(c(0.03, rep(1/nrow(data)  , nrow(data))),"npc")





prioritaeten <- tableGrob(data$prio,cols = "Prio.", theme=tt3) 
prioritaeten$widths <- unit(rep(1, 1), "npc")
#items$heights <- unit(rep(1/nrow(data), nrow(data)), "null")
prioritaeten$heights <- unit(c(0.03, rep(1/nrow(data)  , nrow(data))),"npc")

separators <- replicate(ncol(prioritaeten),
segmentsGrob(x1 = unit(0, "npc"), gp=gpar(lty=4, col="#8c8c8c")),simplify=FALSE) 
prioritaeten <- gtable_add_grob(prioritaeten, grobs = separators,
                                t = 1, b = nrow(prioritaeten), l = seq_len(ncol(prioritaeten)))



new.grob <- ggplotGrob(diagram)


new.grob <- gtable_add_cols(new.grob, unit(1, "cm"), pos = 0) 
new.grob <- gtable_add_cols(new.grob, unit(12, "cm"), pos = 0)
new.grob <- gtable_add_cols(new.grob, unit(1, "cm"), pos = 0)
new.grob <- gtable_add_cols(new.grob, unit(2.5, "cm"), pos = -1)

new.grob <- gtable_add_grob(new.grob, itemnummber, t=8, l=1, b=8, r=1, name="itemnummber")
new.grob <- gtable_add_grob(new.grob, items, t=8, l=2, b=8, r=2, name="items")
new.grob <- gtable_add_grob(new.grob, prioritaeten, t=8, l=3, b=8, r=3, name="prioritaeten")
new.grob <- gtable_add_grob(new.grob, stats, t=8, l=11, b=8, r=11, name="stats")

separators <- replicate(ncol(new.grob),
                        segmentsGrob(x1 = unit(0, "npc"), gp=gpar(lty=4, col = "#8c8c8c")),
                        simplify=FALSE)

new.grob <- gtable_add_grob(new.grob, grobs = separators, t = 8, b = 8, l = 4)


grid.newpage()
grid.draw(new.grob)

但现在我的问题是我如何为相同高度的情节图形做同样的背景 - gtable？

如下例所示：optimal-efficient-plotting-of-survival-regression-analysis-results

感谢，

Answer 3

你可以将表格grobs添加到gtable，

library(gtable)
library(grid)
library(ggplot2)

tg <- tableGrob(iris[1:5,1:3], rows = NULL, cols=NULL)
tg$heights <- unit(rep(1,nrow(tg)), "null")

p <- qplot(1:5,1:5) + ggtitle("Title", subtitle = "another line") + theme_grey(12) +
  scale_y_continuous(expand=c(0,0.5))
g <- ggplotGrob(p)
g <- gtable::gtable_add_cols(g, widths = sum(tg$widths), pos = 0)
g <- gtable::gtable_add_cols(g, widths = sum(tg$widths), pos = -1)
g <- gtable::gtable_add_grob(g, list(tg, tg), t = 6, l=c(1,ncol(g)), r=c(1, ncol(g)))
grid.newpage()
grid.draw(g)