Error in theme[[element]]: "Attempt to select more than one element in vectorIndex" when using guides = "collect"

[qxxxd]

Hi,

First thank you for developing such a fantastic package! I've enjoyed working with it, but I've encountered an issue in the latest version (v1.3.0) of patchwork when using guides = "collect".

Here's the code to replicate the bug:

library(tidyverse)
library(patchwork)
p1 <- ggplot(mtcars) + geom_point(aes(mpg, disp, color = cyl))
p2 <- ggplot(mtcars) + geom_boxplot(aes(gear, disp, color = as.character(cyl)))

wrap_plots(list(p1, p2))   # this works

wrap_plots(list(p1, p2), guides = "collect")  # this doesn't work
#> Error in theme[[element]] : 
#>   attempt to select more than one element in vectorIndex
 
packageVersion("ggplot2")
#> [1] '3.4.4'
packageVersion("patchwork")
#> [1] '1.3.0'

Upon examining the code, the issue might be related to the guides_build function around lines 67–68:

patchwork/R/guides.R

Lines 67 to 69 in 2695a9f

	legend.spacing.y <- calc_element(theme, "legend.spacing.y")
	legend.spacing.x <- calc_element(theme, "legend.spacing.x")
	legend.box.margin <- calc_element("legend.box.margin", theme) %||% margin()

It seems that while retrieving elements legend.spacing.x and legend.spacing.y with calc_element(), the arguments might be passed in the wrong order. For example, calc_element(theme, "legend.spacing.x") might need to be revised to calc_element("legend.spacing.x", theme), similar to the function call on line 98.

Would you please look into this? Thanks in advance for any helps!

[fplazaonate]

I have the same issue with patchwork 1.3.0
Everything works with patchwork 1.2.0

[qxxxd]

I have the same issue with patchwork 1.3.0 Everything works with patchwork 1.2.0

I'm currently using this quick fix:

guides_build_mod <- function (guides, theme){
  legend.spacing.y <- calc_element("legend.spacing.y", theme)  # modified by me
  legend.spacing.x <- calc_element("legend.spacing.x", theme)  # modified by me
  legend.box.margin <- calc_element("legend.box.margin", theme) %||% 
    margin()
  widths <- exec(unit.c, !!!lapply(guides, gtable_width))
  heights <- exec(unit.c, !!!lapply(guides, gtable_height))
  just <- valid.just(calc_element("legend.box.just", theme))
  xjust <- just[1]
  yjust <- just[2]
  vert <- identical(calc_element("legend.box", theme), "horizontal")
  guides <- lapply(guides, function(g) {
    editGrob(g, vp = viewport(x = xjust, y = yjust, just = c(xjust, 
                                                             yjust), height = if (vert) 
                                                               heightDetails(g)
                              else 1, width = if (!vert) 
                                widthDetails(g)
                              else 1))
  })
  guide_ind <- seq(by = 2, length.out = length(guides))
  sep_ind <- seq(2, by = 2, length.out = length(guides) - 1)
  if (vert) {
    heights <- max(heights)
    if (length(widths) != 1) {
      w <- unit(rep_len(0, length(widths) * 2 - 1), "mm")
      w[guide_ind] <- widths
      w[sep_ind] <- legend.spacing.x
      widths <- w
    }
  }
  else {
    widths <- max(widths)
    if (length(heights) != 1) {
      h <- unit(rep_len(0, length(heights) * 2 - 1), "mm")
      h[guide_ind] <- heights
      h[sep_ind] <- legend.spacing.y
      heights <- h
    }
  }
  widths <- unit.c(legend.box.margin[4], widths, legend.box.margin[2])
  heights <- unit.c(legend.box.margin[1], heights, legend.box.margin[3])
  guides <- gtable_add_grob(gtable(widths, heights, name = "guide-box"), 
                            guides, t = 1 + if (!vert) 
                              guide_ind
                            else 1, l = 1 + if (vert) 
                              guide_ind
                            else 1, name = "guides")
  gtable_add_grob(guides, element_render(theme, "legend.box.background"), 
                  t = 1, l = 1, b = -1, r = -1, z = -Inf, clip = "off", 
                  name = "legend.box.background")
}

environment(guides_build_mod) <- asNamespace('patchwork')
assignInNamespace("guides_build", guides_build_mod, ns = "patchwork")

Run this before running wrap_plots and hopefully it should temporarily resolve the issue.

[MLenaBleile]

I have the same issue with patchwork 1.3.0 Everything works with patchwork 1.2.0

I'm currently using this quick fix:

guides_build_mod <- function (guides, theme){
  legend.spacing.y <- calc_element("legend.spacing.y", theme)  # modified by me
  legend.spacing.x <- calc_element("legend.spacing.x", theme)  # modified by me
  legend.box.margin <- calc_element("legend.box.margin", theme) %||% 
    margin()
  widths <- exec(unit.c, !!!lapply(guides, gtable_width))
  heights <- exec(unit.c, !!!lapply(guides, gtable_height))
  just <- valid.just(calc_element("legend.box.just", theme))
  xjust <- just[1]
  yjust <- just[2]
  vert <- identical(calc_element("legend.box", theme), "horizontal")
  guides <- lapply(guides, function(g) {
    editGrob(g, vp = viewport(x = xjust, y = yjust, just = c(xjust, 
                                                             yjust), height = if (vert) 
                                                               heightDetails(g)
                              else 1, width = if (!vert) 
                                widthDetails(g)
                              else 1))
  })
  guide_ind <- seq(by = 2, length.out = length(guides))
  sep_ind <- seq(2, by = 2, length.out = length(guides) - 1)
  if (vert) {
    heights <- max(heights)
    if (length(widths) != 1) {
      w <- unit(rep_len(0, length(widths) * 2 - 1), "mm")
      w[guide_ind] <- widths
      w[sep_ind] <- legend.spacing.x
      widths <- w
    }
  }
  else {
    widths <- max(widths)
    if (length(heights) != 1) {
      h <- unit(rep_len(0, length(heights) * 2 - 1), "mm")
      h[guide_ind] <- heights
      h[sep_ind] <- legend.spacing.y
      heights <- h
    }
  }
  widths <- unit.c(legend.box.margin[4], widths, legend.box.margin[2])
  heights <- unit.c(legend.box.margin[1], heights, legend.box.margin[3])
  guides <- gtable_add_grob(gtable(widths, heights, name = "guide-box"), 
                            guides, t = 1 + if (!vert) 
                              guide_ind
                            else 1, l = 1 + if (vert) 
                              guide_ind
                            else 1, name = "guides")
  gtable_add_grob(guides, element_render(theme, "legend.box.background"), 
                  t = 1, l = 1, b = -1, r = -1, z = -Inf, clip = "off", 
                  name = "legend.box.background")
}

environment(guides_build_mod) <- asNamespace('patchwork')
assignInNamespace("guides_build", guides_build_mod, ns = "patchwork")

Run this before running wrap_plots and hopefully it should temporarily resolve the issue.

Bless you kind stranger, I was having the same issue with patchwork in a different context and this worked perfectly.