Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix for Mismatched Strips in Euler Diagram Facets #108

Merged
merged 3 commits into from
Mar 27, 2024

Conversation

altairwei
Copy link
Contributor

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
Copy link
Owner

jolars commented Dec 16, 2023

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
Copy link
Contributor Author

@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
Copy link
Owner

jolars commented Mar 27, 2024

Great, thanks a lot for the PR!

@jolars jolars merged commit 9b94486 into jolars:main Mar 27, 2024
6 checks passed
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

Successfully merging this pull request may close these issues.

None yet

2 participants