Wie kann ich Grobs in einer Liste speichern und an grobTree() übergeben?

Question

Also ich versuche, eine Liste von groabs zu machen und dann übergebe sie in grobTree(), aber meine Liste Elemente werden nicht als grobs von do.call() eingelesen.

Hier ist mein Code:

library(purrr) 
library(grid) 
library(gridExtra) 
library(ggplot2) 
qplot(displ, year, data = mpg) 

title_segments <- c('Help ', 'me ', 'please', '!') 
colors <- c('red', 'orange', 'green', 'blue') 
nudge_x = 0 

grobs <- NULL 
grobs[1] <- list(gp = gpar(fontsize = 14, fontface = 'bold')) 
grobs[2] <- list(textGrob(label = title_segments[1], name = "title1", 
          x = unit(2.33 - nudge_x, "lines"), 
          y = unit(-.5, "lines"), 
          hjust = 0, vjust = 0, gp = gpar(col = colors[1]))) 

if(length(title_segments) > 1){ 
    x <- unit(2.24 - nudge_x, "lines") 
    more_grobs <- pmap(list(title_segments[-1], colors[-1], 
seq_along(title_segments)[-1]), function(segment, color, i){ 
    grob <- textGrob(label = segment, name = paste0('title', i, sep = ''), 
          x = x + grobWidth(paste0('title', i - 1, sep = '')),  
          y = unit(-.5, "lines"), 
          hjust = 0, vjust = 0, gp = gpar(col = color)) 
    }) 
} 
grobs <- c(grobs, more_grobs) 

grobs <- do.call(what = grobTree, args = grobs) ### ERROR HERE 

# Turn off clipping and draw plot 
gb <- ggplot_build(last_plot()) 
gt <- ggplot_gtable(gb) 
gt$layout$clip[gt$layout$name=="panel"] <- "off" 
gg <- arrangeGrob(gt, top = grobs, padding = unit(2.6, "line")) 
grid.newpage() 
grid.draw(gg) 

Der Fehler tritt auf, wenn ich auf die do.call() Anweisung bekommen, weil meine Listenelemente nicht als Grobs gelesen werden.

Wenn ich dieses Bit Code versuche, dann wird es als wahr ausgewertet.

var <- NULL 
is.grob(var <- textGrob(label = title_segments[1], name = "title1", 
         x = unit(2.33 - nudge_x, "lines"), 
         y = unit(-.5, "lines"), 
         hjust = 0, vjust = 0, gp = gpar(col = colors[1]))) 

Wenn ich dieses Bit versuchen, wertet sie auf false

var2 <-NULL 
var2[1] <- textGrob(label = title_segments[1], name = "title1", 
         x = unit(2.33 - nudge_x, "lines"), 
         y = unit(-.5, "lines"), 
         hjust = 0, vjust = 0, gp = gpar(col = colors[1]))) 
is.grob(var2[1]) 

EDIT :: Das ist, was ich versuche mit der pmap Funktion zu erreichen.

grobs <- grobTree(
gp = gpar(fontsize = 14, fontface = 'bold'), 

textGrob(label = title_segments[1], name = "title1", 
     x = unit(2.33 - nudge_x, "lines"), 
     y = unit(-.5, "lines"), 
     hjust = 0, vjust = 0, gp = gpar(col = colors[1])), 

    if(length(title_segments) > 1){ 
    textGrob(label = title_segments[2], name = "title2", 
      x = grobWidth("title1") + unit(2.24 - nudge_x, "lines"), 
      y = unit(-.5, "lines"), 
      hjust = 0, vjust = 0, gp = gpar(col = colors[2])) 
    }, 

    if(length(title_segments) > 2){ 
    textGrob(label = title_segments[3], name = "title3", 
      x = grobWidth("title1") + grobWidth("title2") + unit(2.24 - nudge_x, "lines"), 
      y = unit(-.5, "lines"), 
      hjust = 0, vjust = 0, gp = gpar(col = colors[3])) 
    }, 
    if(length(title_segments) > 3){ 
    textGrob(label = title_segments[4], name = "title4", 
      x = grobWidth("title1") + grobWidth("title2") + grobWidth("title3") + unit(2.24 - nudge_x, "lines"), 
      y = unit(-.5, "lines"), 
      hjust = 0, vjust = 0, gp = gpar(col = colors[4])) 
    }, 
    if(length(title_segments) > 4){ 
    textGrob(label = title_segments[5], name = "title5", 
      x = grobWidth("title1") + grobWidth("title2") + grobWidth("title3") + grobWidth("title4") + unit(2.24 - nudge_x, "lines"), 
      y = unit(-.5, "lines"), 
      hjust = 0, vjust = 0, gp = gpar(col = colors[5])) 
    } 
) 

Answer 1

Lassen Sie uns versuchen, die Frage wie geschrieben zu beantworten. Die Frage, wie ich las es geht wie folgt:

Dieser Code funktioniert:

grobs <- grobTree(
    gp = gpar(fontsize = 14, fontface = 'bold'), 

    textGrob(label = title_segments[1], name = "title1", 
      x = unit(2.33 - nudge_x, "lines"), 
      y = unit(-.5, "lines"), 
      hjust = 0, vjust = 0, gp = gpar(col = colors[1])), 

    if(length(title_segments) > 1){ 
    textGrob(label = title_segments[2], name = "title2", 
      x = grobWidth("title1") + unit(2.24 - nudge_x, "lines"), 
      y = unit(-.5, "lines"), 
      hjust = 0, vjust = 0, gp = gpar(col = colors[2])) 
    }, 

    if(length(title_segments) > 2){ 
    textGrob(label = title_segments[3], name = "title3", 
      x = grobWidth("title1") + grobWidth("title2") + unit(2.24 - nudge_x, "lines"), 
      y = unit(-.5, "lines"), 
      hjust = 0, vjust = 0, gp = gpar(col = colors[3])) 
    }, 
    if(length(title_segments) > 3){ 
    textGrob(label = title_segments[4], name = "title4", 
      x = grobWidth("title1") + grobWidth("title2") + grobWidth("title3") + unit(2.24 - nudge_x, "lines"), 
      y = unit(-.5, "lines"), 
      hjust = 0, vjust = 0, gp = gpar(col = colors[4])) 
    }, 
    if(length(title_segments) > 4){ 
    textGrob(label = title_segments[5], name = "title5", 
      x = grobWidth("title1") + grobWidth("title2") + grobWidth("title3") + grobWidth("title4") + unit(2.24 - nudge_x, "lines"), 
      y = unit(-.5, "lines"), 
      hjust = 0, vjust = 0, gp = gpar(col = colors[5])) 
    } 
) 

jedoch dieser Code, der als Rechen Erholung des vorherigen Code gemeint ist, nicht:

grobs <- NULL 
grobs[1] <- list(gp = gpar(fontsize = 14, fontface = 'bold')) 
grobs[2] <- list(textGrob(label = title_segments[1], name = "title1", 
          x = unit(2.33 - nudge_x, "lines"), 
          y = unit(-.5, "lines"), 
          hjust = 0, vjust = 0, gp = gpar(col = colors[1]))) 

if(length(title_segments) > 1){ 
    x <- unit(2.24 - nudge_x, "lines") 
    more_grobs <- pmap(list(title_segments[-1], colors[-1], 
seq_along(title_segments)[-1]), function(segment, color, i){ 
    grob <- textGrob(label = segment, name = paste0('title', i, sep = ''), 
          x = x + grobWidth(paste0('title', i - 1, sep = '')),  
          y = unit(-.5, "lines"), 
          hjust = 0, vjust = 0, gp = gpar(col = color)) 
    }) 
} 
grobs <- c(grobs, more_grobs) 

grobs <- do.call(what = grobTree, args = grobs) ### ERROR HERE 

Was ist los? Die Antwort ist, dass das Problem in den ersten beiden Zeilen liegt:

grobs <- NULL 
grobs[1] <- list(gp = gpar(fontsize = 14, fontface = 'bold')) 

Die Zuordnung grobs[1] <- entfernt die Benennung von gp = ... für das Listenelement und damit die Funktion grobTree() versteht nicht, dass das erste Argument ist keine grob . Die Lösung ist einfach. Ersetzen Sie diese zwei Zeilen mit:

grobs <- list(gp = gpar(fontsize = 14, fontface = 'bold')) 

Jetzt läuft die Sache, irgendwie. Die Zeile do.call() verursacht keinen Fehler mehr. Der Abstand der Wörter ist jedoch immer noch nicht richtig, da der Aufruf pmap() nicht eine Summe aller Grobbreiten von der ersten bis zur n-ten erzeugt. Stattdessen verwendet es nur die Grob-Breite des vorherigen Grobs. Dieses Problem wird am besten mit einer rekursiven Funktion gelöst, denke ich:

make_grobs <- function(words, colors, x, y, hjust = 0, vjust = 0, i = 0) { 
    n <- length(words) 
    colors <- rep_len(colors, n) 
    name <- paste0('title', i) 
    grob <- textGrob(label = words[1], name = name, 
        x = x, y = y, hjust = hjust, vjust = vjust, 
        gp = gpar(col = colors[1])) 
    if (n == 1) { 
    list(grob) 
    } 
    else { 
    c(list(grob), 
     make_grobs(words[-1], colors[-1], 
       x + grobWidth(grob), y, hjust, vjust, i + 1)) 
    } 
} 

Mit dieser Funktion definiert, das gesamte reproduzierbare Beispiel wird:

library(purrr) 
library(grid) 
library(gridExtra) 
library(ggplot2) 

title_segments <- c('Help ', 'me ', 'please', '!') 
colors <- c('red', 'orange', 'green', 'blue') 
nudge_x = 0 

grobs <- do.call(what = grobTree, 
       args = c(make_grobs(title_segments, colors, 
            x = unit(2.33 - nudge_x, "lines"), 
            y = unit(-.5, "lines")), 
          list(gp = gpar(fontsize = 14, fontface = 'bold')))) 

qplot(displ, year, data = mpg) 
gb <- ggplot_build(last_plot()) 
gt <- ggplot_gtable(gb) 
gt$layout$clip[gt$layout$name=="panel"] <- "off" 
gg <- arrangeGrob(gt, top = grobs, padding = unit(2.6, "line")) 
grid.newpage() 
grid.draw(gg)