将文本背景设置为ggplot axis Text

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

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

感谢巴普蒂斯特的回答和解决方案。

我想我找到了另一种使用gtable&网格:

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)

optimal-efficient-plotting-of-survival-regression-analysis-results

谢谢

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)