diff --git a/R/layer.R b/R/layer.R index 737fbff7bd..973b358460 100644 --- a/R/layer.R +++ b/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) @@ -348,7 +348,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) @@ -376,11 +376,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) diff --git a/R/plot-build.R b/R/plot-build.R index 1b6d89ef1d..5aca9e4a82 100644 --- a/R/plot-build.R +++ b/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. diff --git a/R/scales-.R b/R/scales-.R index cb1e784670..73c490c8a2 100644 --- a/R/scales-.R +++ b/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")()) + } } -} - +)