grobs를 목록에 저장하고 grobTree()에 전달하려면 어떻게해야합니까?

Question

그래서 grobs 목록을 작성한 다음 grobTree()에 전달하려고 시도하지만 내 목록 항목이 do.call()에 의해 grobs로 읽히지 않습니다. 내 목록 요소가 grobs과 같이되지 않기 때문에,

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) 

나는 do.call() 문에 도착하면 오류가 발생합니다 :

여기 내 코드입니다.

이 코드를 시도하면 true로 평가됩니다. 나는이 비트를하려고하면

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

, 그것은 거짓

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

편집 :이 내가 pmap의 기능을 달성하기 위해 노력하고있어입니다 평가.

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

서면으로 질문에 답변하려고 시도해 보겠습니다. 질문 나는 다음과 같이 간다 읽을 때 :

이 코드는 작동합니다

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

그러나, 이전 코드의 계산 레크리에이션으로 의미가이 코드는,하지 않습니다

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 

무슨 일 이니? 대답은 문제가 처음 두 줄에 달려 있다는 것입니다 :

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

할당 grobs[1] <- 목록 요소에 대한 gp = ...의 이름을 제거, 따라서 기능 grobTree() 첫 번째 인수가 GROB 아니라는 것을 이해하지 않는다 . 수정은 간단합니다. 이 두 줄을 다음으로 바꿉니다.

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

이제는 일을합니다. do.call() 행은 더 이상 오류를 발생시키지 않습니다. 그러나 pmap() 호출이 첫 번째부터 n 번째까지의 모든 grob 너비의 합계를 생성하지 않기 때문에 단어 간격이 여전히 올바르지 않습니다. 대신 이전 grob의 grob 너비 만 사용합니다. 이 문제는 가장 재귀 함수로 해결된다 생각 : 규정이 기능

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

가 전체 재생 가능한 예해진다 :

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)