Merge pull request #125 from teunbrand/ggplot2_3.5.0

Remove `ScalesListQuiet`

R/StatsandGeoms.R

@@ -184,55 +184,27 @@ GeomDAGEdgePath <- ggplot2::ggproto("GeomDAGEdgePath", ggraph::GeomEdgePath,
 )
 
 
-
-
-scales_list_quiet <- function() {
-  ggplot2::ggproto(NULL, ScalesListQuiet)
+silence_scales <- function(plot) {
+  old_scales <- plot$scales
+  plot$scales <- ggproto(
+    "ScalesListQuiet", old_scales,
+    add = silent_add
+  )
+  plot
 }
 
-ScalesListQuiet <- ggplot2::ggproto("ScalesListQuiet", NULL,
-  scales = NULL,
-  find = function(self, aesthetic) {
-    vapply(self$scales, function(x) any(aesthetic %in% x$aesthetics), logical(1))
-  },
-  has_scale = function(self, aesthetic) {
-    any(self$find(aesthetic))
-  },
-  add = function(self, scale) {
-    if (is.null(scale)) {
-      return()
-    }
-
-    prev_aes <- self$find(scale$aesthetics)
-    if (any(prev_aes)) {
-      # Get only the first aesthetic name in the returned vector -- it can
-      # sometimes be c("x", "xmin", "xmax", ....)
-      scalename <- self$scales[prev_aes][[1]]$aesthetics[1]
-    }
-
-    # Remove old scale for this aesthetic (if it exists)
-    self$scales <- c(self$scales[!prev_aes], list(scale))
-  },
-  n = function(self) {
-    length(self$scales)
-  },
-  input = function(self) {
-    unlist(lapply(self$scales, "[[", "aesthetics"))
-  },
+silent_add <- function(self, scale) {
+  if (is.null(scale)) {
+    return()
+  }
 
-  # This actually makes a descendant of self, which is functionally the same
-  # as a actually clone for most purposes.
-  clone = function(self) {
-    ggproto(NULL, self, scales = lapply(self$scales, function(s) s$clone()))
-  },
-  non_position_scales = function(self) {
-    ggproto(NULL, self, scales = self$scales[!self$find("x") & !self$find("y")])
-  },
-  get_scales = function(self, output) {
-    scale <- self$scales[self$find(output)]
-    if (length(scale) == 0) {
-      return()
-    }
-    scale[[1]]
+  prev_aes <- self$find(scale$aesthetics)
+  if (any(prev_aes)) {
+    # Get only the first aesthetic name in the returned vector -- it can
+    # sometimes be c("x", "xmin", "xmax", ....)
+    scalename <- self$scales[prev_aes][[1]]$aesthetics[1]
   }
-)
+
+  # Remove old scale for this aesthetic (if it exists)
+  self$scales <- c(self$scales[!prev_aes], list(scale))
+}

R/geom_dag.R

@@ -786,7 +786,7 @@ geom_dag_collider_edges <- function(mapping = NULL, data = NULL,
 ggplot.tidy_dagitty <- function(data = NULL, mapping = aes(), ...) {
   p <- ggplot2::ggplot(fortify(data), mapping = mapping, ...)
 
-  p$scales <- scales_list_quiet()
+  p <- silence_scales(p)
 
   p + expand_plot(
     expand_x = expansion(c(.10, .10)),

tests/testthat/_snaps/StatsandGeoms.md

@@ -0,0 +1,18 @@
+# We do not need to update `silent_add()`.
+
+    Code
+      body
+    Output
+      {
+          if (is.null(scale)) {
+              return()
+          }
+          prev_aes <- self$find(scale$aesthetics)
+          if (any(prev_aes)) {
+              scalename <- self$scales[prev_aes][[1]]$aesthetics[1]
+              cli::cli_inform(c("Scale for {.field {scalename}} is already present.", 
+                  "Adding another scale for {.field {scalename}}, which will replace the existing scale."))
+          }
+          self$scales <- c(self$scales[!prev_aes], list(scale))
+      }
+

tests/testthat/test-StatsandGeoms.R

@@ -13,5 +13,13 @@ test_that("Geom and Stat ggprotos are in fact ggprotos", {
   expect_ggproto(StatEdgeDiagonal)
   expect_ggproto(StatEdgeFan)
   expect_ggproto(GeomDAGEdgePath)
-  expect_ggproto(ScalesListQuiet)
+})
+
+test_that("We do not need to update `silent_add()`.", {
+  # This is a sentinel test to see if upstream ggplot2 has made changes to
+  # the ggplot2:::Scales$add() method.
+  # If this test fails, the add method has likely changed and `silent_add()`
+  # may need to be updated in StatsandGeoms.R.
+  body <- body(environment(ggplot()$scales$add)$f)
+  expect_snapshot(body)
 })