set Text-background to ggplot axis-text

Question

I have a ggplot graphich and it has a long text as Y-axis .

I'm trying to find a way to set background-color for the Y-axis with tow different colors "zebra-theme" like this one

but it seems that there is no ggplot feature in element_text() for this .

Can someone help me please.

thanks

Tlopasha

Answer 1

it's probably possible if you hack the theme system, but it's probably not a good idea.

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

you can add the table grobs to the 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)

Answer 3

thank you baptiste for your answer and solution.

I think i found maybe another good way to do that with gtable & grid:

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)

but now my question is how i can do the same background for the plot graphic with the same height from items - gtable ?

like this Example : optimal-efficient-plotting-of-survival-regression-analysis-results

thanks,