Example for using scales #57

teunbrand · 2024-09-19T15:34:02Z

Apologies for ignoring your checklist; this is just a proof-of-concept PR. Feel free to take and/or ignore as you please.
This PR follows discussion in https://github.com/teunbrand/ggplot-extension-club/discussions/38.
It shows how using a scale might simplify your code, most of it in comments.

As a demonstration; here is what your example will look like without adding a scale.

devtools::load_all("~/packages/test/ggswim")
#> ℹ Loading ggswim
library(ggplot2)
library(dplyr)

all_events <- dplyr::bind_rows(
  ggswim::infusion_events %>% 
    mutate(marker_glyph = "⬤") %>% 
    rename(Marker = infusion_type),
  ggswim::end_study_events %>% 
    rename(marker_glyph = end_study_label, Marker = end_study_name)
) %>% 
  mutate(Marker = factor(Marker))

# Add color info to data
all_events <- all_events %>% 
  mutate(
    marker_color = case_match(
      Marker,
      "Initial Infusion" ~ "blue",
      "Reinfusion" ~ "red",
      .default = "black"
    )
  )

p <- ggplot() +
  geom_swim_lane(
    data = patient_data,
    aes(x = start_time, xend = end_time, y = pt_id, colour = disease_assessment)
  ) +
  geom_swim_marker(
    data = all_events,
    aes(x = time_from_initial_infusion, y = pt_id, marker = Marker),
    size = 4,
  )

p

Adding a scale will override the default symbols.

p + with(all_events, scale_marker_discrete(marker_glyph, marker_color, Marker))

^{Created on 2024-09-19 with reprex v2.1.1}

teunbrand · 2024-09-19T15:34:45Z

DESCRIPTION

-    tidyselect
-RoxygenNote: 7.3.1
+    tidyselect,
+    vctrs


{vctrs} is already a dependency of ggplot2, so it is 'free'

teunbrand · 2024-09-19T15:35:21Z

R/geom_swim_marker.R

-  # Copied from ggplot2::geom_text
-  if (!missing(nudge_x) || !missing(nudge_y)) {
-    if (!missing(position)) {
-      cli::cli_abort(c(
-        "Both {.arg position} and {.arg nudge_x}/{.arg nudge_y} are supplied.",
-        "i" = "Only use one approach to alter the position."
-      ))
-    }
-
-    position <- position_nudge(nudge_x, nudge_y)
-  }


No need for all this nudging setup. Users can just use position_nudge() if they want.

teunbrand · 2024-09-19T15:35:36Z

R/geom_swim_marker.R

-  marker_labels <- rlang::eval_tidy(data = data, expr = mapping$label)
-
-  marker_key <- data.frame(
-    marker_labels = marker_labels,
-    marker_glyphs = glyph,
-    marker_colors = color
-  ) |> distinct()


Moved to scale

teunbrand · 2024-09-19T15:35:51Z

R/geom_swim_marker.R

-  # Reclass the layer to trigger ggplot_add and apply manual scale/guide
-  class(layer_obj) <- c("swim_marker", class(layer_obj))
-  layer_obj$marker_key <- marker_key
-  layer_obj


No need for reclassing here

teunbrand · 2024-09-19T15:36:13Z

R/geom_swim_marker.R

-StatMarker <- ggplot2::ggproto(
-  `_class` = "StatMarker",
-  `_inherit` = ggplot2::Stat,
-  required_aes = c("x", "y", "label"),
-  compute_group = function(data, scales, marker_key, ...) {
-    compute_marker_group(data = data, scales = scales, marker_key = marker_key)
-  }
-)
+GeomSwimMarker <- ggproto(
+  "GeomSwimMarker", GeomText,
+  default_aes = GeomText$default_aes[names(GeomText$default_aes) != "colour"],
+  required_aes = c("x", "y", "marker"),

-#' @rdname geom_swim_marker
-#' @keywords internal
-compute_marker_group <- function(data, scales, marker_key) {
-  data <- left_join(data, marker_key, by = c("label" = "marker_labels"))
-  data
-}


Handled by scale mapping now

teunbrand · 2024-09-19T15:36:46Z

R/geom_swim_marker.R

-ggplot_add.swim_marker <- function(object, plot, object_name) {
-  marker_key <- object$marker_key |>
-    arrange(marker_labels)
+  draw_panel = function(self, data, panel_params, coord, size.unit = "mm",
+                        check_overlap = FALSE, na.rm = FALSE) {

-  plot$layers <- append(plot$layers, object)
+    data$colour <- vctrs::field(data$marker, "colour")
+    data$label  <- vctrs::field(data$marker, "glyphs")
+    data$marker <- NULL

-  # Add manual color/guide changes to the scale
-  plot +
-    scale_color_manual(
-      aesthetics = "label",
-      name = plot$layers[[length(plot$layers)]]$mapping$label |> rlang::as_label(),
-      values = setNames(marker_key$marker_glyphs, marker_key$marker_labels),
-      guide = guide_legend(
-        override.aes = list(
-          color = marker_key$marker_colors
-        )
-      )
+    GeomText$draw_panel(
+      data, panel_params, coord,
+      check_overlap = check_overlap,
+      size.unit = size.unit, na.rm = na.rm
    )
-}


No need to add this ad hoc scale that can clash with other layer's scales

teunbrand · 2024-09-19T15:37:17Z

R/geom_swim_marker.R

+    data$colour <- vctrs::field(data$marker, "colour")
+    data$label  <- vctrs::field(data$marker, "glyphs")
+    data$marker <- NULL


Just unpacking the marker column and forwarding to text geom

teunbrand · 2024-09-19T15:37:37Z

R/geom_swim_marker.R

+  default_aes = GeomText$default_aes[names(GeomText$default_aes) != "colour"],
+  required_aes = c("x", "y", "marker"),


We don't want colour as an aesthetic, we have marker that catches this.

teunbrand · 2024-09-19T15:37:59Z

R/geom_swim_marker.R

@@ -13,122 +13,57 @@
 geom_swim_marker <- function(mapping = NULL, data = NULL,
                             stat = "identity", position = "identity",
                             ...,
-                             color = NULL,
-                             glyph = NULL,
-                             parse = FALSE,


We're not allowing expressions as markers, so no need to parse anything

teunbrand · 2024-09-19T15:38:40Z

R/scale_marker.R

+  markers <- data.frame(glyphs = glyphs, colors = colors, labels = limits) |>
+    distinct()


Was previously handled in geom_swim_marker() constructor

teunbrand · 2024-09-19T15:39:22Z

R/scale_marker.R

+  )
+
+  discrete_scale("marker", rlang::missing_arg(), palette = palette,
+                 limits = markers$labels, ..., na.translate = FALSE)


na.translate is needed here because the <vctr_rcrd> doesn't work well with an ifelse() statement somewhere in the scale mapping.

teunbrand · 2024-09-19T15:39:32Z

R/scale_marker.R

+.default_glyphs <- c("⛔", "✔", "✖", "☀", "☢", "☠", "☮", "⚛", "♥",
+                     "✀")


Feel free to change to whatever

teunbrand · 2024-09-19T15:40:17Z

R/scale_marker.R

+  markers <- vctrs::new_rcrd(
+    list(
+      colour = rep(colors %||% "black", length.out = n_values),
+      glyphs = rep(glyphs %||% .default_glyphs, length.out = n_values)
+    ),
+    class = "marker"
+  )


We're essentially making a 2-column data frame act like a vector, so that it works well with ggplot2's internals.
We unpack this in the drawing method.

@teunbrand I've been working through this example to wrap my head around {vctrs} and how scale_marker_discrete() is triggered during the call to geom_swim_marker().

I think I have a shallow handle of {vctrs} here, but wanted to test it by converting the code above to something I could more easily inspect:

markers <- structure( list( colour = rep(colors %||% "black", length.out = n_values), glyphs = rep(glyphs %||% .default_glyphs, length.out = n_values) ), class = "marker" )

I believe this should work the same, but on stepping through a geom_swim_marker() call it seems this set up triggers draw_panel before it triggers draw_key and winds up failing. Any insight as to what I'm missing here in how this behaves?

Is it also correct to assume that the definition of "marker" in required_aes triggers ggplot to look for scale_*_discrete() (in this case scale_marker_discrete())?

Yeah so vctrs::new_rcrd() invokes the <vctrs_rcrd> class that has all sorts of niceties that makes the data-frame like structure behave as if it was a vector (by treating each row as element). It avoids some type unsafeties in the internals of ggplot2 that would mangle the structure otherwise.

Very cool to learn. Thanks!

teunbrand added 3 commits September 19, 2024 17:25

add scale_marker_discrete()

4aa2396

simplify geom_swim_marker()

b800d46

redocument

46fe2bf

teunbrand commented Sep 19, 2024

View reviewed changes

rsh52 self-assigned this Sep 19, 2024

rsh52 added the enhancement New feature or request label Sep 19, 2024

rsh52 merged commit d1fdcd7 into CHOP-CGTInformatics:redev Sep 19, 2024

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

Example for using scales #57

Example for using scales #57

teunbrand commented Sep 19, 2024 •

edited

Loading

teunbrand Sep 19, 2024

teunbrand Sep 19, 2024

teunbrand Sep 19, 2024

teunbrand Sep 19, 2024 •

edited

Loading

teunbrand Sep 19, 2024

teunbrand Sep 19, 2024

teunbrand Sep 19, 2024

teunbrand Sep 19, 2024

teunbrand Sep 19, 2024

teunbrand Sep 19, 2024

teunbrand Sep 19, 2024

teunbrand Sep 19, 2024

teunbrand Sep 19, 2024

rsh52 Sep 26, 2024

teunbrand Sep 26, 2024

rsh52 Sep 26, 2024

		default_aes = GeomText$default_aes[names(GeomText$default_aes) != "colour"],
		required_aes = c("x", "y", "marker"),

		markers <- data.frame(glyphs = glyphs, colors = colors, labels = limits) \|>
		distinct()

		.default_glyphs <- c("⛔", "✔", "✖", "☀", "☢", "☠", "☮", "⚛", "♥",
		"✀")

Example for using scales #57

Example for using scales #57

Conversation

teunbrand commented Sep 19, 2024 • edited Loading

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

teunbrand Sep 19, 2024 • edited Loading

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

teunbrand commented Sep 19, 2024 •

edited

Loading

teunbrand Sep 19, 2024 •

edited

Loading