Allow to both position_stack and position_nudge

[krassowski]

Summary

I was trying to achieve something similar as in this question: Is there a possibility to combine position_stack and nudge_x in a stacked bar chart in ggplot2?, but with ggrepel. I think I succeeded.

Minimal code example

Intent

Having the following plot, I would like to move the names out of the bars and point to them with arrows:

df <- tibble::tribble(
  ~y, ~x, ~grp,
  "a", 1,  "some long name",
  "a", 2,  "other name",
  "b", 1,  "some name",
  "b", 3,  "another name",
  "b", -1, "some long name"
)

ggplot(data = df, aes(x, y, group = grp)) +
  geom_col(aes(fill = grp), width=0.5) +
  geom_vline(xintercept = 0) +
  geom_text(aes(label = grp), position = position_stack(vjust = 0.5))

Problem

ggplot(data = df, aes(x, y, group = grp)) +
  geom_col(aes(fill = grp), width=0.5) +
  geom_vline(xintercept = 0) +
  geom_text_repel(
      aes(label = grp),
      position = position_stack(vjust = 0.5),
      nudge_y = 0.4,
      direction = 'x'
  )

Will raise:

Error: Specify either `position` or `nudge_x`/`nudge_y`

Suggestions

Surprisingly, this turned out easy to implement with:

ggplot(data = df, aes(x, y, group = grp)) +
  geom_col(aes(fill = grp), width=0.5) +
  geom_vline(xintercept = 0) +
  geom_text_repel(
      aes(label = grp),
      position = position_stack_and_nudge(vjust = 0.5, y = 0.4),
      direction = 'x'
  )

Where position_stack_and_nudge() is a combination of ggrepel::position_nudge2 and ggplot::position_stack():

position_stack_and_nudge <- function(x = 0, y = 0, vjust = 1, reverse = FALSE) {
  ggproto(NULL, PositionStackAndNudge,
    x = x,
    y = y,
    vjust = vjust,
    reverse = reverse
  )
}

#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @noRd
PositionStackAndNudge <- ggproto("PositionStackAndNudge", PositionStack,
  x = 0,
  y = 0,

  setup_params = function(self, data) {
    c(
        list(x = self$x, y = self$y),
        ggproto_parent(PositionStack, self)$setup_params(data)
    )
  },

  compute_layer = function(self, data, params, panel) {
    # operate on the stacked positions (updated in August 2020)
    data = ggproto_parent(PositionStack, self)$compute_layer(data, params, panel)

    x_orig <- data$x
    y_orig <- data$y
    # transform only the dimensions for which non-zero nudging is requested
    if (any(params$x != 0)) {
      if (any(params$y != 0)) {
        data <- transform_position(data, function(x) x + params$x, function(y) y + params$y)
      } else {
        data <- transform_position(data, function(x) x + params$x, NULL)
      }
    } else if (any(params$y != 0)) {
      data <- transform_position(data, function(x) x, function(y) y + params$y)
    }
    data$nudge_x <- data$x
    data$nudge_y <- data$y
    data$x <- x_orig
    data$y <- y_orig

    data
  },

  compute_panel = function(self, data, params, scales) {
      ggproto_parent(PositionStack, self)$compute_panel(data, params, scales)
  }
)

This is my first attempt at modifying ggproto, and I am not confident in the quality of the code above, but it seems to work. Does ggproto allow multi-inheritance? This would have reduced the code much more!

My gut feeling is that it might be a bit specific use-case, so it might be just good enough to keep it in an issue, but if there is more users interested I could make it into a PR.

Version information

Here is the output from sessionInfo() in my R session:

R version 3.6.3 (2020-02-29)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 20.04 LTS

Matrix products: default
BLAS:   /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0
LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.0

locale:
 [1] LC_CTYPE=en_GB.UTF-8       LC_NUMERIC=C              
 [3] LC_TIME=en_GB.UTF-8        LC_COLLATE=en_GB.UTF-8    
 [5] LC_MONETARY=en_GB.UTF-8    LC_MESSAGES=en_GB.UTF-8   
 [7] LC_PAPER=en_GB.UTF-8       LC_NAME=C                 
 [9] LC_ADDRESS=C               LC_TELEPHONE=C            
[11] LC_MEASUREMENT=en_GB.UTF-8 LC_IDENTIFICATION=C       

attached base packages:
[1] tools     stats     graphics  grDevices utils     datasets  methods  
[8] base     

other attached packages:
[1] ggrepel_0.9.0        ComplexUpset_0.5.7   patchwork_1.0.0.9000
[4] ggplot2_3.3.0       

loaded via a namespace (and not attached):
 [1] Rcpp_1.0.4.6       magrittr_1.5       tidyselect_1.0.0   munsell_0.5.0     
 [5] colorspace_1.4-1   R6_2.4.1           rlang_0.4.5        dplyr_0.8.4       
 [9] grid_3.6.3         gtable_0.3.0       withr_2.2.0        ellipsis_0.3.0    
[13] assertthat_0.2.1   digest_0.6.25      tibble_3.0.1       lifecycle_0.2.0   
[17] crayon_1.3.4       purrr_0.3.3        RColorBrewer_1.1-2 farver_2.0.3      
[21] vctrs_0.2.4        glue_1.4.0         labeling_0.3       compiler_3.6.3    
[25] pillar_1.4.3       scales_1.1.0       pkgconfig_2.0.3   

[slowkow]

Thanks for sharing this! Very cool. I agree with you that we might want to distribute this in some package if there is interest.

[choc2000]

I would be very much interested in such a feature. Specifically, I'd need a combination of position_dodge/position_jitter and position_nudge. Use case: I have geom_point that is dedged/jittered. I want to label the points but with an additional offset (nudge).

Would this be possible as well?

[krassowski]

I guess it would need to be similar in principle to the code above, but using PositionJitterdodge rather than PositionStack.

[slowkow]

@krassowski Hey Michał, if you're still interested, I would like to invite you to make a pull request with your new code. I might also add an example to show off this cool new feature.

[nikostr]

Hey, I'm interested in this feature :) is a PR coming? :)

[aphalo]

@krassowski @slowkow Are you both o.k. with me adding position_stack_and_nudge() to package 'ggpp'? If yes, Michel, could you please send me your ORCID or directly add yourself as a contributor at https://github.com/aphalo/ggpp ?

I provisionally added the code to 'ggpp' and will do some testing, but it seems to work nicely. If you disagree, I will remove it.

Thanks!

[slowkow]

I think ggpp is an OK place for position_stack_and_nudge().

[krassowski]

Fine by me. AFK but my ORCID is https://orcid.org/0000-0002-9638-7785

[aphalo]

@krassowski @slowkow Many thanks! I also implemented position_dodge_and_nudge() in 'ggpp'.