From 979b4da64296017aa655df7e8dc7e27c7c01212c Mon Sep 17 00:00:00 2001 From: Claus Wilke Date: Sat, 7 Jul 2018 23:54:13 -0500 Subject: [PATCH] Move global variables into an environment. --- DESCRIPTION | 1 + R/aaa-.r | 1 + R/aes.r | 29 ++++----------------------- R/ggplot-global.R | 38 ++++++++++++++++++++++++++++++++++++ R/quick-plot.r | 2 +- R/stat-sum.r | 2 +- R/theme-current.R | 9 ++++----- R/theme-elements.r | 4 ++-- R/theme.r | 6 +++--- tests/testthat/test-guides.R | 6 ++++-- 10 files changed, 59 insertions(+), 39 deletions(-) create mode 100644 R/ggplot-global.R diff --git a/DESCRIPTION b/DESCRIPTION index 75d34d2512..d62c0389bf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -61,6 +61,7 @@ BugReports: https://github.com/tidyverse/ggplot2/issues LazyData: true Collate: 'ggproto.r' + 'ggplot-global.R' 'aaa-.r' 'aes-calculated.r' 'aes-colour-fill-alpha.r' diff --git a/R/aaa-.r b/R/aaa-.r index 8aa8b79cd7..3bb6c93110 100644 --- a/R/aaa-.r +++ b/R/aaa-.r @@ -1,3 +1,4 @@ +#' @include ggplot-global.R #' @include ggproto.r NULL diff --git a/R/aes.r b/R/aes.r index c783c318cb..fc5f0aedf7 100644 --- a/R/aes.r +++ b/R/aes.r @@ -1,27 +1,6 @@ #' @include utilities.r NULL -.all_aesthetics <- c("adj", "alpha", "angle", "bg", "cex", "col", "color", - "colour", "fg", "fill", "group", "hjust", "label", "linetype", "lower", - "lty", "lwd", "max", "middle", "min", "pch", "radius", "sample", "shape", - "size", "srt", "upper", "vjust", "weight", "width", "x", "xend", "xmax", - "xmin", "xintercept", "y", "yend", "ymax", "ymin", "yintercept", "z") - -.base_to_ggplot <- c( - "col" = "colour", - "color" = "colour", - "pch" = "shape", - "cex" = "size", - "lty" = "linetype", - "lwd" = "size", - "srt" = "angle", - "adj" = "hjust", - "bg" = "fill", - "fg" = "colour", - "min" = "ymin", - "max" = "ymax" -) - #' Construct aesthetic mappings #' #' Aesthetic mappings describe how variables in the data are mapped to visual @@ -167,10 +146,10 @@ print.uneval <- function(x, ...) { # Rename American or old-style aesthetics name rename_aes <- function(x) { # Convert prefixes to full names - full <- match(names(x), .all_aesthetics) - names(x)[!is.na(full)] <- .all_aesthetics[full[!is.na(full)]] + full <- match(names(x), ggplot_global$all_aesthetics) + names(x)[!is.na(full)] <- ggplot_global$all_aesthetics[full[!is.na(full)]] - plyr::rename(x, .base_to_ggplot, warn_missing = FALSE) + plyr::rename(x, ggplot_global$base_to_ggplot, warn_missing = FALSE) } # Look up the scale that should be used for a given aesthetic @@ -315,7 +294,7 @@ aes_auto <- function(data = NULL, ...) { } # automatically detected aes - vars <- intersect(.all_aesthetics, vars) + vars <- intersect(ggplot_global$all_aesthetics, vars) names(vars) <- vars aes <- lapply(vars, function(x) parse(text = x)[[1]]) diff --git a/R/ggplot-global.R b/R/ggplot-global.R new file mode 100644 index 0000000000..62c9eec6d4 --- /dev/null +++ b/R/ggplot-global.R @@ -0,0 +1,38 @@ +# Environment that holds various global variables and settings for ggplot, +# such as the current theme. It is not exported and should not be directly +# manipulated by other packages. +ggplot_global <- new.env(parent = emptyenv()) + +# The current theme. Defined here only as placeholder, and defined properly +# in file "theme-current.R". This setup avoids circular dependencies among +# the various source files. +ggplot_global$theme_current <- list() + +# Element tree for the theme elements. Defined here only as placeholder, and +# defined properly in file "theme-elements.r". +ggplot_global$element_tree <- list() + +# List of all aesthetics known to ggplot +ggplot_global$all_aesthetics <- c( + "adj", "alpha", "angle", "bg", "cex", "col", "color", + "colour", "fg", "fill", "group", "hjust", "label", "linetype", "lower", + "lty", "lwd", "max", "middle", "min", "pch", "radius", "sample", "shape", + "size", "srt", "upper", "vjust", "weight", "width", "x", "xend", "xmax", + "xmin", "xintercept", "y", "yend", "ymax", "ymin", "yintercept", "z" +) + +# Aesthetic aliases +ggplot_global$base_to_ggplot <- c( + "col" = "colour", + "color" = "colour", + "pch" = "shape", + "cex" = "size", + "lty" = "linetype", + "lwd" = "size", + "srt" = "angle", + "adj" = "hjust", + "bg" = "fill", + "fg" = "colour", + "min" = "ymin", + "max" = "ymax" +) diff --git a/R/quick-plot.r b/R/quick-plot.r index 57f5ebb495..d3aef44357 100644 --- a/R/quick-plot.r +++ b/R/quick-plot.r @@ -75,7 +75,7 @@ qplot <- function(x, y, ..., data, facets = NULL, margins = FALSE, is_missing <- vapply(exprs, rlang::quo_is_missing, logical(1)) # treat arguments as regular parameters if they are wrapped into I() or # if they don't have a name that is in the list of all aesthetics - is_constant <- (!names(exprs) %in% .all_aesthetics) | + is_constant <- (!names(exprs) %in% ggplot_global$all_aesthetics) | vapply(exprs, rlang::quo_is_call, logical(1), name = "I") mapping <- new_aes(exprs[!is_missing & !is_constant], env = parent.frame()) diff --git a/R/stat-sum.r b/R/stat-sum.r index 7113c240f6..b03274a4a2 100644 --- a/R/stat-sum.r +++ b/R/stat-sum.r @@ -40,7 +40,7 @@ StatSum <- ggproto("StatSum", Stat, compute_panel = function(data, scales) { if (is.null(data$weight)) data$weight <- 1 - group_by <- setdiff(intersect(names(data), .all_aesthetics), "weight") + group_by <- setdiff(intersect(names(data), ggplot_global$all_aesthetics), "weight") counts <- plyr::count(data, group_by, wt_var = "weight") counts <- plyr::rename(counts, c(freq = "n"), warn_missing = FALSE) diff --git a/R/theme-current.R b/R/theme-current.R index 916270b262..7879d2ccd3 100644 --- a/R/theme-current.R +++ b/R/theme-current.R @@ -1,7 +1,6 @@ #' @include theme-defaults.r #' @include theme-elements.r -theme_env <- new.env(parent = emptyenv()) -theme_env$current <- theme_gray() +ggplot_global$theme_current <- theme_gray() #' Get, set, and modify the active theme #' @@ -66,7 +65,7 @@ theme_env$current <- theme_gray() #' # theme_update() and theme_replace() are similar except they #' # apply directly to the current/active theme. theme_get <- function() { - theme_env$current + ggplot_global$theme_current } #' @rdname theme_get @@ -79,8 +78,8 @@ theme_set <- function(new) { paste(missing, collapse = ", "), call. = FALSE) } - old <- theme_env$current - theme_env$current <- new + old <- ggplot_global$theme_current + ggplot_global$theme_current <- new invisible(old) } diff --git a/R/theme-elements.r b/R/theme-elements.r index 50b01f98ee..3af3875fb1 100644 --- a/R/theme-elements.r +++ b/R/theme-elements.r @@ -257,7 +257,7 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { # This data structure represents the theme elements and the inheritance # among them. -.element_tree <- list( +ggplot_global$element_tree <- list( line = el_def("element_line"), rect = el_def("element_rect"), text = el_def("element_text"), @@ -364,7 +364,7 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { # @param el an element # @param elname the name of the element validate_element <- function(el, elname) { - eldef <- .element_tree[[elname]] + eldef <- ggplot_global$element_tree[[elname]] if (is.null(eldef)) { stop('"', elname, '" is not a valid theme element name.') diff --git a/R/theme.r b/R/theme.r index 1442fd74b4..b5d1c695b8 100644 --- a/R/theme.r +++ b/R/theme.r @@ -561,12 +561,12 @@ calc_element <- function(element, theme, verbose = FALSE) { # If the element is defined (and not just inherited), check that # it is of the class specified in .element_tree if (!is.null(theme[[element]]) && - !inherits(theme[[element]], .element_tree[[element]]$class)) { - stop(element, " should have class ", .element_tree[[element]]$class) + !inherits(theme[[element]], ggplot_global$element_tree[[element]]$class)) { + stop(element, " should have class ", ggplot_global$element_tree[[element]]$class) } # Get the names of parents from the inheritance tree - pnames <- .element_tree[[element]]$inherit + pnames <- ggplot_global$element_tree[[element]]$inherit # If no parents, this is a "root" node. Just return this element. if (is.null(pnames)) { diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index b77f31c6df..b1002431cd 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -191,7 +191,8 @@ test_that("guides title and text are positioned correctly", { name = "value", guide = guide_colorbar( title.theme = element_text(size = 11, angle = 0, hjust = 0.5, vjust = 1), - label.theme = element_text(size = 0.8*11, angle = 270, hjust = 0.5, vjust = 1) + label.theme = element_text(size = 0.8*11, angle = 270, hjust = 0.5, vjust = 1), + order = 2 # set guide order to keep visual test stable ) ) + scale_fill_continuous( @@ -204,7 +205,8 @@ test_that("guides title and text are positioned correctly", { title.position = "top", label.position = "bottom", title.theme = element_text(size = 11, angle = 180, hjust = 0, vjust = 1), - label.theme = element_text(size = 0.8*11, angle = 90, hjust = 1, vjust = 0.5) + label.theme = element_text(size = 0.8*11, angle = 90, hjust = 1, vjust = 0.5), + order = 1 ) )