jolars / eulerr

Area-Proportional Euler and Venn Diagrams with Ellipses
https://jolars.github.io/eulerr/
GNU General Public License v3.0
129 stars 18 forks source link

Fix for Mismatched Strips in Euler Diagram Facets #108

Closed altairwei closed 3 months ago

altairwei commented 9 months ago

I encountered a problem with mismatched strips when using the eulerr package installed from CRAN. Here's the generated diagram:

image

Upon examining the source code of eulerr, I noticed an issue in the plot.euler method. The pos variable has the same data type as the groups variable. This means that the first column of groups is interpreted as layout.pos.row and the second column as layout.pos.col. The relevant code that calculates the position of the grob object is as follows:

  ...

  if (do_groups) {
    ...
    pos  <-  vapply(groups, as.numeric, numeric(NROW(groups)), USE.NAMES  =  FALSE)
    layout  <-  lengths(lapply(groups, unique))
    ...
  } else {
    ...
  }

  ...

  for (i in seq_along(euler_grob$children)) {
    if (NCOL(pos) == 2L) {
      j <- pos[i, 1L]
      k <- pos[i, 2L]
    } else {
      j <- 1L
      k <- pos[i]
    }
    euler_grob$children[[i]]$vp <- grid::viewport(
      layout.pos.row = j,
      layout.pos.col = k,
      xscale = if (xlim[1] == -Inf) c(-1, 1) else xlim,
      yscale = if (ylim[1] == -Inf) c(-1, 1) else ylim,
      name = paste0("panel.vp.", j, ".", k)
    )
  }

While the plotting of strips used the layout correctly, strips$groups was not used properly. Another observation is that the grob layout fills row by row, but strips start plotting from the bottom left. Hence, it's important to reverse the sequence of the left strips.

  ...

  if  (do_strips)  {
    strips  <-  list(gp  =  setup_gpar(opar$strips,  strips,  n_levels),
                   groups  =  groups)
  }  else  {
    strips  <-  NULL
  }

  ...

  # draw strips
  if  (do_strip_top)  {
    strip_top_vp  <-
      grid::viewport(layout.pos.row  =  strip_top_row,
                     layout.pos.col  =  strip_top_col,
                     name  =  "strip.top.vp",
                     layout  = grid::grid.layout(nrow  =  1,  ncol  =  layout[2]))

    lvls  <-  levels(strips$groups[[1]])
    ...
  }

  if  (do_strip_left)  {
    strip_left_vp  <-
      grid::viewport(layout.pos.row  =  strip_left_row,
                     layout.pos.col  =  strip_left_col,
                     name  =  "strip.left.vp",
                     layout  = grid::grid.layout(nrow  =  layout[1],  ncol  =  1))

    lvls  <-  levels(strips$groups[[2]])
    ...
  }

Here's the final euler diagram with the fixed strips:

image

jolars commented 7 months ago

Thanks! (And sorry for the belated reply). Yes, this definitely seems like a bug. Thanks for the investigation and proposed fix. I, however, see some errors running the tests now:

11.   ├─base::levels(strips$groups[[2]]) at eulerr/R/plot.euler.R|549| 5
12.   ├─strips$groups[[2]] at eulerr/R/plot.euler.R|549| 5
13.   └─base::`[[.data.frame`(strips$groups, 2) at eulerr/R/plot.euler.R|549| 5
||  14.     └─(function(x, i, exact) if (is.matrix(i)) as.matrix(x)[[i]] else .subset2(x, ...
altairwei commented 3 months ago

@jolars I apologize for the late reply. Recently, when I tried to split the data.frame using only one variable and then call eulerr::euler, I realized and understood the error you encountered in the tests. The latest commit fixes this case, but it requires the groups to have column names; otherwise, we would need to write more code for logical operation.

jolars commented 3 months ago

Great, thanks a lot for the PR!