ScalesList methods

R/layer.r

@@ -268,7 +268,7 @@ Layer <- ggproto("Layer", NULL,
       aesthetics[["group"]] <- self$aes_params$group
     }
 
-    scales_add_defaults(plot$scales, data, aesthetics, plot$plot_env)
+    plot$scales$add_defaults(data, aesthetics, plot$plot_env)
 
     # Evaluate aesthetics
     env <- child_env(baseenv(), stage = stage)
@@ -341,7 +341,7 @@ Layer <- ggproto("Layer", NULL,
     if (length(new) == 0) return(data)
 
     # data needs to be non-scaled
-    data_orig <- scales_backtransform_df(plot$scales, data)
+    data_orig <- plot$scales$backtransform_df(data)
 
     # Add map stat output to aesthetics
     env <- child_env(baseenv(), stat = stat, after_stat = after_stat)
@@ -369,11 +369,11 @@ Layer <- ggproto("Layer", NULL,
     stat_data <- data_frame0(!!!compact(stat_data))
 
     # Add any new scales, if needed
-    scales_add_defaults(plot$scales, data, new, plot$plot_env)
+    plot$scales$add_defaults(data, new, plot$plot_env)
     # Transform the values, if the scale say it's ok
     # (see stat_spoke for one exception)
     if (self$stat$retransform) {
-      stat_data <- scales_transform_df(plot$scales, stat_data)
+      stat_data <- plot$scales$transform_df(stat_data)
     }
 
     cunion(stat_data, data)

R/plot-build.r

@@ -53,7 +53,7 @@ ggplot_build.ggplot <- function(plot) {
   data <- by_layer(function(l, d) l$compute_aesthetics(d, plot), layers, data, "computing aesthetics")
 
   # Transform all scales
-  data <- lapply(data, scales_transform_df, scales = scales)
+  data <- lapply(data, scales$transform_df)
 
   # Map and train positions so that statistics have access to ranges
   # and all positions are numeric
@@ -68,7 +68,7 @@ ggplot_build.ggplot <- function(plot) {
   data <- by_layer(function(l, d) l$map_statistic(d, plot), layers, data, "mapping stat to aesthetics")
 
   # Make sure missing (but required) aesthetics are added
-  scales_add_missing(plot, c("x", "y"), plot$plot_env)
+  plot$scales$add_missing(c("x", "y"), plot$plot_env)
 
   # Reparameterise geoms from (e.g.) y and width to ymin and ymax
   data <- by_layer(function(l, d) l$compute_geom_1(d), layers, data, "setting up geom")
@@ -87,8 +87,8 @@ ggplot_build.ggplot <- function(plot) {
   # Train and map non-position scales
   npscales <- scales$non_position_scales()
   if (npscales$n() > 0) {
-    lapply(data, scales_train_df, scales = npscales)
-    data <- lapply(data, scales_map_df, scales = npscales)
+    lapply(data, npscales$train_df)
+    data <- lapply(data, npscales$map_df)
   }
 
   # Fill in defaults etc.

R/scales-.r

@@ -59,102 +59,117 @@ ScalesList <- ggproto("ScalesList", NULL,
     scale <- self$scales[self$find(output)]
     if (length(scale) == 0) return()
     scale[[1]]
-  }
-)
-
-# Train scale from a data frame
-scales_train_df <- function(scales, df, drop = FALSE) {
-  if (empty(df) || length(scales$scales) == 0) return()
-
-  lapply(scales$scales, function(scale) scale$train_df(df = df))
-}
-
-# Map values from a data.frame. Returns data.frame
-scales_map_df <- function(scales, df) {
-  if (empty(df) || length(scales$scales) == 0) return(df)
-
-  mapped <- unlist(lapply(scales$scales, function(scale) scale$map_df(df = df)), recursive = FALSE)
-
-  data_frame0(!!!mapped, df[setdiff(names(df), names(mapped))])
-}
-
-# Transform values to cardinal representation
-scales_transform_df <- function(scales, df) {
-  if (empty(df)) return(df)
+  },
 
-  # if the scale contains no trans or the trans is of identity, it doesn't need
-  # to be transformed.
-  idx_skip <- vapply(scales$scales, function(x) {
-    has_default_transform(x) &&
-    (is.null(x$trans) || identical(x$trans$transform, identity))
-  }, logical(1L))
-  scale_list <- scales$scales[!idx_skip]
+  train_df = function(self, df, drop = FALSE) {
+    if (empty(df) || length(self$scales) == 0) {
+      return()
+    }
+    lapply(self$scales, function(scale) scale$train_df(df = df))
+  },
 
-  if (length(scale_list) == 0L) return(df)
+  map_df = function(self, df) {
+    if (empty(df) || length(self$scales) == 0) {
+      return(df)
+    }
 
-  transformed <- unlist(lapply(scale_list, function(s) s$transform_df(df = df)),
-    recursive = FALSE)
-  untransformed <- df[setdiff(names(df), names(transformed))]
-  data_frame0(!!!transformed, untransformed)
-}
+    mapped <- unlist(lapply(
+      self$scales,
+      function(scale) scale$map_df(df = df)
+    ), recursive = FALSE)
 
-scales_backtransform_df <- function(scales, df) {
-  # NOTE: no need to check empty(data) because it should be already checked
-  # before this function is called.
+    data_frame0(!!!mapped, df[setdiff(names(df), names(mapped))])
+  },
 
-  # if the scale contains no trans or the trans is of identity, it doesn't need
-  # to be backtransformed.
-  idx_skip <- vapply(scales$scales, function(x) {
-    is.null(x$trans) ||
-      identical(x$trans$inverse, identity)
-  }, logical(1L))
-  scale_list <- scales$scales[!idx_skip]
+  transform_df = function(self, df) {
+    if (empty(df)) {
+      return(df)
+    }
 
-  if (length(scale_list) == 0L) return(df)
+    # If the scale contains to trans or trans is identity, there is no need
+    # to transform anything
+    idx_skip <- vapply(self$scales, function(x) {
+      has_default_transform(x) &&
+        (is.null(x$trans) || identical(x$trans$transform, identity))
+    }, logical(1L))
+    scales <- self$scales[!idx_skip]
 
-  backtransformed <- unlist(lapply(scale_list, function(scale) {
-    aesthetics <- intersect(scale$aesthetics, names(df))
+    if (length(scales) == 0) {
+      return(df)
+    }
 
-    if (length(aesthetics) == 0) return()
+    transformed <- unlist(lapply(
+      scales,
+      function(scale) scale$transform_df(df = df)
+    ), recursive = FALSE)
 
-    lapply(df[aesthetics], scale$trans$inverse)
-  }), recursive = FALSE)
+    data_frame0(!!!transformed, df[setdiff(names(df), names(transformed))])
+  },
 
-  new_data_frame(c(backtransformed, df[setdiff(names(df), names(backtransformed))]))
-}
+  backtransform_df = function(self, df) {
+    # NOTE: no need to check empty(df) because it should be already checked
+    # before this method is called.
 
-# @param aesthetics A list of aesthetic-variable mappings. The name of each
-#   item is the aesthetic, and the value of each item is the variable in data.
-scales_add_defaults <- function(scales, data, aesthetics, env) {
-  if (is.null(aesthetics)) return()
-  names(aesthetics) <- unlist(lapply(names(aesthetics), aes_to_scale))
+    # If the scale contains to trans or trans is identity, there is no need
+    # to transform anything
+    idx_skip <- vapply(self$scales, function(x) {
+      has_default_transform(x) &&
+        (is.null(x$trans) || identical(x$trans$transform, identity))
+    }, logical(1))
+    scales <- self$scales[!idx_skip]
 
-  new_aesthetics <- setdiff(names(aesthetics), scales$input())
-  # No new aesthetics, so no new scales to add
-  if (is.null(new_aesthetics)) return()
+    if (length(scales) == 0) {
+      return(df)
+    }
 
-  datacols <- lapply(aesthetics[new_aesthetics], eval_tidy, data = data)
-  datacols <- compact(datacols)
+    backtransformed <- unlist(lapply(
+      scales,
+      function(scale) {
+        aesthetics <- intersect(scale$aesthetics, names(df))
+        if (length(aesthetics) == 0) {
+          return()
+        }
+        lapply(df[aesthetics], scale$trans$inverse)
+      }
+    ), recursive = FALSE)
+
+    data_frame0(
+      !!!backtransformed,
+      df[setdiff(names(df), names(backtransformed))]
+    )
+  },
 
-  for (aes in names(datacols)) {
-    scales$add(find_scale(aes, datacols[[aes]], env))
-  }
+  # `aesthetics` is a list of aesthetic-variable mappings. The name of each
+  # item is the aesthetic, and the value of each item is the variable in data.
+  add_defaults = function(self, data, aesthetics, env) {
+    if (is.null(aesthetics)) {
+      return()
+    }
+    names(aesthetics) <- unlist(lapply(names(aesthetics), aes_to_scale))
 
-}
+    new_aesthetics <- setdiff(names(aesthetics), self$input())
+    # No new aesthetics, so no new scales to add
+    if (is.null(new_aesthetics)) {
+      return()
+    }
 
-# Add missing but required scales.
-# @param aesthetics A character vector of aesthetics. Typically c("x", "y").
-scales_add_missing <- function(plot, aesthetics, env) {
+    data_cols <- lapply(aesthetics[new_aesthetics], eval_tidy, data = data)
+    data_cols <- compact(data_cols)
 
-  # Keep only aesthetics that aren't already in plot$scales
-  aesthetics <- setdiff(aesthetics, plot$scales$input())
+    for (aes in names(data_cols)) {
+      self$add(find_scale(aes, data_cols[[aes]], env))
+    }
+  },
 
-  for (aes in aesthetics) {
-    scale_name <- paste("scale", aes, "continuous", sep = "_")
+  # Add missing but required scales
+  # `aesthetics` is a character vector of aesthetics. Typically c("x", "y")
+  add_missing = function(self, aesthetics, env) {
+    aesthetics <- setdiff(aesthetics, self$input())
 
-    scale_f <- find_global(scale_name, env, mode = "function")
-    plot$scales$add(scale_f())
+    for (aes in aesthetics) {
+      scale_name <- paste("scale", aes, "continuous", sep = "_")
+      self$add(find_global(scale_name, env, mode = "function")())
+    }
   }
-}
-
+)