From e05cdcac938e3238299e08c0ef240ae8ef3fbe96 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Sun, 6 Sep 2020 21:59:33 +0900 Subject: [PATCH 1/9] Backtransform data before mapping statistics --- R/layer.r | 5 ++++- R/scales-.r | 23 +++++++++++++++++++++++ 2 files changed, 27 insertions(+), 1 deletion(-) diff --git a/R/layer.r b/R/layer.r index 0db859978a..680a488b8f 100644 --- a/R/layer.r +++ b/R/layer.r @@ -287,6 +287,9 @@ Layer <- ggproto("Layer", NULL, # evaluation (since the evaluation symbols gets renamed) data <- rename_aes(data) + # data needs to be non-scaled + data_orig <- scales_backtransform_df(plot$scales, data) + # Assemble aesthetics from layer, plot and stat mappings aesthetics <- self$mapping if (self$inherit.aes) { @@ -301,7 +304,7 @@ Layer <- ggproto("Layer", NULL, # Add map stat output to aesthetics env <- child_env(baseenv(), stat = stat, after_stat = after_stat) stage_mask <- child_env(emptyenv(), stage = stage_calculated) - mask <- new_data_mask(as_environment(data, stage_mask), stage_mask) + mask <- new_data_mask(as_environment(data_orig, stage_mask), stage_mask) mask$.data <- as_data_pronoun(mask) new <- substitute_aes(new) diff --git a/R/scales-.r b/R/scales-.r index d56036e8cf..ef76f4b696 100644 --- a/R/scales-.r +++ b/R/scales-.r @@ -86,6 +86,29 @@ scales_transform_df <- function(scales, df) { new_data_frame(c(transformed, df[setdiff(names(df), names(transformed))])) } +scales_backtransform_df <- function(scales, df) { + backtransform_df <- function(scale) { + if (empty(df)) { + return() + } + + aesthetics <- intersect(scale$aesthetics, names(df)) + if (length(aesthetics) == 0) { + return() + } + # If the scale doesn't have trans, return df as it is + if (is.null(scale$trans)) { + return(df[aesthetics]) + } + + lapply(df[aesthetics], scale$trans$inverse) + } + + if (empty(df) || length(scales$scales) == 0) return(df) + backtransformed <- unlist(lapply(scales$scales, backtransform_df), recursive = FALSE) + new_data_frame(c(backtransformed, df[setdiff(names(df), names(backtransformed))])) +} + # @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) { From 4d9da99e97edfe65889193d276ef75f3115fe5ea Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Sun, 15 May 2022 22:17:04 +0900 Subject: [PATCH 2/9] Push scales_backtransform_df() to below --- R/layer.r | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/layer.r b/R/layer.r index ce5e5a4d04..b8d444fd04 100644 --- a/R/layer.r +++ b/R/layer.r @@ -299,9 +299,6 @@ Layer <- ggproto("Layer", NULL, # evaluation (since the evaluation symbols gets renamed) data <- rename_aes(data) - # data needs to be non-scaled - data_orig <- scales_backtransform_df(plot$scales, data) - # Assemble aesthetics from layer, plot and stat mappings aesthetics <- self$computed_mapping aesthetics <- defaults(aesthetics, self$stat$default_aes) @@ -310,6 +307,9 @@ Layer <- ggproto("Layer", NULL, new <- strip_dots(aesthetics[is_calculated_aes(aesthetics) | is_staged_aes(aesthetics)]) if (length(new) == 0) return(data) + # data needs to be non-scaled + data_orig <- scales_backtransform_df(plot$scales, data) + # Add map stat output to aesthetics env <- child_env(baseenv(), stat = stat, after_stat = after_stat) stage_mask <- child_env(emptyenv(), stage = stage_calculated) From 26c7456dd57f25ee14a03ba7ed22ff65052c0507 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Sun, 15 May 2022 23:04:39 +0900 Subject: [PATCH 3/9] Exit early when the scale doesn't have any trans --- R/scales-.r | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/R/scales-.r b/R/scales-.r index ef76f4b696..bc8a0eb251 100644 --- a/R/scales-.r +++ b/R/scales-.r @@ -87,7 +87,15 @@ scales_transform_df <- function(scales, df) { } scales_backtransform_df <- function(scales, df) { - backtransform_df <- function(scale) { + if (empty(df)) return(df) + + # if the scale doesn't contain any trans, it doesn't need to be backtransformed. + idx_skip <- vapply(scales$scales, function(x) identical(x$trans$inverse, identity), logical(1L)) + scale_list <- scales$scales[!idx_skip] + + if (length(scale_list) == 0L) return(df) + + backtransformed <- lapply(scales$scales, function(scale) { if (empty(df)) { return() } @@ -102,10 +110,10 @@ scales_backtransform_df <- function(scales, df) { } lapply(df[aesthetics], scale$trans$inverse) - } + }) + + backtransformed <- unlist(backtransformed, recursive = FALSE) - if (empty(df) || length(scales$scales) == 0) return(df) - backtransformed <- unlist(lapply(scales$scales, backtransform_df), recursive = FALSE) new_data_frame(c(backtransformed, df[setdiff(names(df), names(backtransformed))])) } From cc333d0f2f2423332171536d4d156bf7b0797c55 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Sun, 15 May 2022 23:43:29 +0900 Subject: [PATCH 4/9] Skip transformation when no trans or the trans is identity --- R/scales-.r | 47 ++++++++++++++++++++++++++--------------------- 1 file changed, 26 insertions(+), 21 deletions(-) diff --git a/R/scales-.r b/R/scales-.r index bc8a0eb251..cbe51c9f38 100644 --- a/R/scales-.r +++ b/R/scales-.r @@ -79,40 +79,45 @@ scales_map_df <- function(scales, df) { # Transform values to cardinal representation scales_transform_df <- function(scales, df) { - if (empty(df) || length(scales$scales) == 0) return(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) { + is.null(x$trans) || + identical(x$trans$transform, identity) + }, logical(1L)) + scale_list <- scales$scales[!idx_skip] - transformed <- unlist(lapply(scales$scales, function(s) s$transform_df(df = df)), + if (length(scale_list) == 0L) return(df) + + transformed <- unlist(lapply(scale_list, function(s) s$transform_df(df = df)), recursive = FALSE) new_data_frame(c(transformed, df[setdiff(names(df), names(transformed))])) } scales_backtransform_df <- function(scales, df) { - if (empty(df)) return(df) - - # if the scale doesn't contain any trans, it doesn't need to be backtransformed. - idx_skip <- vapply(scales$scales, function(x) identical(x$trans$inverse, identity), logical(1L)) + # NOTE: no need to check empty(data) because it should be already checked + # before this function is called. + + # 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] if (length(scale_list) == 0L) return(df) - backtransformed <- lapply(scales$scales, function(scale) { - if (empty(df)) { - return() - } - + backtransformed <- unlist(lapply(scale_list, function(scale) { aesthetics <- intersect(scale$aesthetics, names(df)) - if (length(aesthetics) == 0) { - return() - } - # If the scale doesn't have trans, return df as it is - if (is.null(scale$trans)) { - return(df[aesthetics]) - } - lapply(df[aesthetics], scale$trans$inverse) - }) + if (length(aesthetics) == 0) return() + browser() - backtransformed <- unlist(backtransformed, recursive = FALSE) + lapply(df[aesthetics], scale$trans$inverse) + }), recursive = FALSE) new_data_frame(c(backtransformed, df[setdiff(names(df), names(backtransformed))])) } From 656f33430e1734c0f8e3d3ab0363b6997eba1161 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Sun, 15 May 2022 23:47:22 +0900 Subject: [PATCH 5/9] Remove mistakenly added browser() --- R/scales-.r | 1 - 1 file changed, 1 deletion(-) diff --git a/R/scales-.r b/R/scales-.r index cbe51c9f38..1fb22058e1 100644 --- a/R/scales-.r +++ b/R/scales-.r @@ -114,7 +114,6 @@ scales_backtransform_df <- function(scales, df) { aesthetics <- intersect(scale$aesthetics, names(df)) if (length(aesthetics) == 0) return() - browser() lapply(df[aesthetics], scale$trans$inverse) }), recursive = FALSE) From d904bb3f7ebaf245c7b0d48a0078d3fb388fda9e Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Mon, 13 Jun 2022 23:14:53 +0900 Subject: [PATCH 6/9] Add a test --- tests/testthat/test-scales.r | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/tests/testthat/test-scales.r b/tests/testthat/test-scales.r index 40bb1e5c8a..0c2a30f13e 100644 --- a/tests/testthat/test-scales.r +++ b/tests/testthat/test-scales.r @@ -455,3 +455,12 @@ test_that("breaks and labels are correctly checked", { p <- ggplot(mtcars) + geom_bar(aes(mpg)) + scale_x_binned(labels = function(x) 1:2) expect_snapshot_error(ggplotGrob(p)) }) + +test_that("staged aesthetics are backtransformed properly (#4155)", { + p <- ggplot(data.frame(value = 16)) + + geom_point(aes(stage(value, after_stat = x / 2), 0)) + + scale_x_sqrt(limits = c(0, 16), breaks = c(2, 4, 8)) + + # x / 2 should be 16 / 2 = 8, thus the result should be sqrt(8) on scale_x_sqrt() + expect_equal(layer_data(p)$x, sqrt(8)) +}) From ee6b6dc989f1f71f14b4d139d6972240a4ec42ae Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Mon, 13 Jun 2022 23:39:47 +0900 Subject: [PATCH 7/9] Add a NEWS item --- NEWS.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/NEWS.md b/NEWS.md index 1b41029b17..1991c9b554 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,10 @@ # ggplot2 (development version) +* `stage()` now properly refers to the values without scale transformations for + the stage of `after_stat`. If your code requires the scaled version of the + values, you have to apply the same transformation by yourself, e.g. `sqrt()` + for `scale_{x,y}_sqrt()` (@yutannihilation and @teunbrand, #4155). + * `qplot()` is now formally deprecated (@yutannihilation, #3956). * Use `rlang::hash()` instead of `digest::digest()`. This update may lead to From 232e2057bf58f4f2ef607c726d0957e7935acfb5 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Thu, 16 Jun 2022 23:32:25 +0900 Subject: [PATCH 8/9] Tweak --- NEWS.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index af7d99c88c..63a7c9bd74 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,8 +2,9 @@ * `stage()` now properly refers to the values without scale transformations for the stage of `after_stat`. If your code requires the scaled version of the - values, you have to apply the same transformation by yourself, e.g. `sqrt()` - for `scale_{x,y}_sqrt()` (@yutannihilation and @teunbrand, #4155). + values for some reason, you have to apply the same transformation by yourself, + e.g. `sqrt()` for `scale_{x,y}_sqrt()` (@yutannihilation and @teunbrand, #4155). + * A `linewidth` aesthetic has been introduced and supersedes the `size` aesthetic for scaling the width of lines in line based geoms. `size` will remain functioning but deprecated for these geoms and it is recommended to From e450ddf1ca9d3f67d1b6f4aa3c6dedc4b1f7554e Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Fri, 17 Jun 2022 00:04:48 +0900 Subject: [PATCH 9/9] Try clearing cache --- .github/workflows/R-CMD-check.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index bc759804c1..72a4c40477 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -59,6 +59,7 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: + cache-version: 2 extra-packages: > any::rcmdcheck, maps=?ignore-before-r=3.5.0,