add vertical or horizontal lines to the side plot

[pedriniedoardo]

Hello,
is there a way to add geom_vline or geom_hline to the side plot?

[jtlandis]

I must have missed these functions in the package. I will see about adding them in the next update when I have more time.

For now, please see the reprex on how to create a geom that may be compatible with ggside. Note for geom_vline and geom_hline they probably cannot be used alone so it is better to use them along side another geom_x/yside* function.

library(ggside)
#> Loading required package: ggplot2
#> Registered S3 method overwritten by 'ggside':
#>   method from   
#>   +.gg   ggplot2

get_formals <- function(fn) {
  frml <- ggplot2:::ggproto_formals(fn)
  fnames <- names(frml)
  for (i in seq_along(fnames)) {
    frml[[i]] <- as.name(fnames[i])
  }
  frml
}

build_ggside_geom <- function(geom, class = NULL, side = c("x","y")) {
  force(geom)
  
  
  use_side_aes <- switch(side, x = ggside::use_xside_aes, y = ggside::use_yside_aes)
  new_aes <- ggside:::new_default_aes(aes(xcolour = NA, xfill = NA),
                                      geom$default_aes)
  
  fn_setup_data <- rlang::new_function(
    ggplot2:::ggproto_formals(geom$setup_data),
    body = expr({
      data <- ggside::parse_side_aes(data, params)
      geom$setup_data(!!!get_formals(geom$setup_data))
    })
  )
  
  fn_draw_panel <- rlang::new_function(
    ggplot2:::ggproto_formals(geom$draw_panel),
    body = expr({
      data <- use_side_aes(data)
      geom$draw_panel(!!!get_formals(geom$draw_panel))
    })
  )
  
  fn_draw_key = rlang::new_function(
    ggplot2:::ggproto_formals(geom$draw_key),
    body = expr({
      data <- use_side_aes(data)
      geom$draw_key(!!!get_formals(geom$draw_key))
    })
  )
  
  ggplot2::ggproto(
    class,
    geom,
    default_aes = new_aes,
    setup_data = fn_setup_data,
    draw_panel = fn_draw_panel,
    draw_key = fn_draw_key
  )
  
}

as_ggside_layer <- function(layer, side = c("x", "y")) {
  side <- match.arg(side, c("x", "y"))
  LayerClass <- switch(side, x = ggside:::XLayer, y = ggside:::YLayer)
  geom <- layer$geom
  geom <- build_ggside_geom(geom, side = side)
  names <- ls(layer)
  args <- lapply(names, function(n, x) x[[n]], x = layer)
  names(args) <- names
  args$geom <- geom
  do.call(ggproto, c(list(`_class` = "ggside_layer", `_inherit` = LayerClass),
                     args))
  
  
}

#fails because there is no data passed to the layer
# for it to train the scale on.
ggplot(iris, aes(Sepal.Width, Sepal.Length)) +
  geom_point() + 
  as_ggside_layer(
    geom_vline(xintercept = 3), 
    side = "x"
  )
#> Error in `scale_apply()`:
#> ! `scale_id` must not contain any "NA"
#> Backtrace:
#>      ▆
#>   1. ├─base::tryCatch(...)
#>   2. │ └─base (local) tryCatchList(expr, classes, parentenv, handlers)
#>   3. │   ├─base (local) tryCatchOne(...)
#>   4. │   │ └─base (local) doTryCatch(return(expr), name, parentenv, handler)
#>   5. │   └─base (local) tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
#>   6. │     └─base (local) tryCatchOne(expr, names, parentenv, handlers[[1L]])
#>   7. │       └─base (local) doTryCatch(return(expr), name, parentenv, handler)
#>   8. ├─base::withCallingHandlers(...)
#>   9. ├─base::saveRDS(...)
#>  10. ├─base::do.call(...)
#>  11. ├─base (local) `<fn>`(...)
#>  12. └─global `<fn>`(input = base::quote("flat-ram_reprex.R"))
#>  13.   └─rmarkdown::render(input, quiet = TRUE, envir = globalenv(), encoding = "UTF-8")
#>  14.     └─knitr::knit(knit_input, knit_output, envir = envir, quiet = quiet)
#>  15.       └─knitr:::process_file(text, output)
#>  16.         ├─base::withCallingHandlers(...)
#>  17.         ├─base::withCallingHandlers(...)
#>  18.         ├─knitr:::process_group(group)
#>  19.         └─knitr:::process_group.block(group)
#>  20.           └─knitr:::call_block(x)
#>  21.             └─knitr:::block_exec(params)
#>  22.               └─knitr:::eng_r(options)
#>  23.                 ├─knitr:::in_input_dir(...)
#>  24.                 │ └─knitr:::in_dir(input_dir(), expr)
#>  25.                 └─knitr (local) evaluate(...)
#>  26.                   └─evaluate::evaluate(...)
#>  27.                     └─evaluate:::evaluate_call(...)
#>  28.                       ├─evaluate (local) handle(...)
#>  29.                       │ └─base::try(f, silent = TRUE)
#>  30.                       │   └─base::tryCatch(...)
#>  31.                       │     └─base (local) tryCatchList(expr, classes, parentenv, handlers)
#>  32.                       │       └─base (local) tryCatchOne(expr, names, parentenv, handlers[[1L]])
#>  33.                       │         └─base (local) doTryCatch(return(expr), name, parentenv, handler)
#>  34.                       ├─base::withCallingHandlers(...)
#>  35.                       ├─base::withVisible(value_fun(ev$value, ev$visible))
#>  36.                       └─knitr (local) value_fun(ev$value, ev$visible)
#>  37.                         └─knitr (local) fun(x, options = options)
#>  38.                           ├─base::withVisible(knit_print(x, ...))
#>  39.                           ├─knitr::knit_print(x, ...)
#>  40.                           └─knitr:::knit_print.default(x, ...)
#>  41.                             └─evaluate (local) normal_print(x)
#>  42.                               ├─base::print(x)
#>  43.                               └─ggplot2:::print.ggplot(x)
#>  44.                                 ├─ggplot2::ggplot_build(x)
#>  45.                                 └─ggplot2:::ggplot_build.ggplot(x)
#>  46.                                   └─layout$train_position(data, scale_x(), scale_y())
#>  47.                                     └─ggplot2 (local) train_position(..., self = self)
#>  48.                                       └─self$facet$train_scales(...)
#>  49.                                         └─ggplot2 (local) train_scales(...)
#>  50.                                           └─ggplot2:::scale_apply(layer_data, x_vars, "train", SCALE_X, x_scales)
#>  51.                                             └─cli::cli_abort("{.arg scale_id} must not contain any {.val NA}")
#>  52.                                               └─rlang::abort(...)

ggplot(iris, aes(Sepal.Width, Sepal.Length)) +
  geom_point() + 
  geom_xsidehistogram(aes(fill = Species)) +
  as_ggside_layer(
    geom_vline(xintercept = 3), 
    side = "x"
  )
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

^{Created on 2023-09-21 with reprex v2.0.2}

[pedriniedoardo]

It is working great. Thank you very much!

[pedriniedoardo]

Hello, I have tried reproducing the plot after updating the package to v0.3.1. There seems to be some problem.

library(ggside)

ggplot(iris, aes(Sepal.Width, Sepal.Length)) +
  geom_point() + 
  geom_xsidehistogram(aes(fill = Species)) +
  as_ggside_layer(
    geom_vline(xintercept = 3), 
    side = "x"
  )

Error in new_ggside_layer(layer, side) : 
  argument "remap" is missing, with no default

there seems to be a remap parameter to set but I cannot find the reference.

sessionInfo()
R version 4.3.3 (2024-02-29)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 22.04.5 LTS

Matrix products: default
BLAS:   /usr/lib/x86_64-linux-gnu/openblas-pthread/libblas.so.3 
LAPACK: /usr/lib/x86_64-linux-gnu/openblas-pthread/libopenblasp-r0.3.20.so;  LAPACK version 3.10.0

locale:
 [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C               LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8     LC_MONETARY=en_US.UTF-8   
 [6] LC_MESSAGES=en_US.UTF-8    LC_PAPER=en_US.UTF-8       LC_NAME=C                  LC_ADDRESS=C               LC_TELEPHONE=C            
[11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       

time zone: Europe/Rome
tzcode source: system (glibc)

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

other attached packages:
[1] ggside_0.3.1  ggplot2_3.5.1

loaded via a namespace (and not attached):
 [1] utf8_1.2.4       R6_2.5.1         magrittr_2.0.3   gtable_0.3.6     glue_1.8.0       tibble_3.2.1     pkgconfig_2.0.3  lifecycle_1.0.4 
 [9] cli_3.6.3        fansi_1.0.6      scales_1.3.0     grid_4.3.3       vctrs_0.6.5      withr_3.0.2      renv_1.0.10      compiler_4.3.3  
[17] tools_4.3.3      munsell_0.5.1    pillar_1.9.0     colorspace_2.1-1 rlang_1.1.4     

On the older version 0.2.2, the workaround suggested still works.