3232# ' Below follows an overview of the three stages of evaluation and how aesthetic
3333# ' evaluation can be controlled.
3434# '
35- # ' ## Stage 1: direct input
35+ # ' ## Stage 1: direct input at the start
3636# ' The default is to map at the beginning, using the layer data provided by
3737# ' the user. If you want to map directly from the layer data you should not do
3838# ' anything special. This is the only stage where the original layer data can
8787# ' ```
8888# '
8989# ' ## Complex staging
90- # ' If you want to map the same aesthetic multiple times, e.g. map `x` to a
91- # ' data column for the stat, but remap it for the geom, you can use the
92- # ' `stage()` function to collect multiple mappings.
90+ # ' Sometimes, you may want to map the same aesthetic multiple times, e.g. map
91+ # ' `x` to a data column at the start for the layer stat, but remap it later to
92+ # ' a variable from the stat transformation for the layer geom. The `stage()`
93+ # ' function allows you to control multiple mappings for the same aesthetic
94+ # ' across all three stages of evaluation.
9395# '
9496# ' ```r
9597# ' # Use stage to modify the scaled fill
9698# ' ggplot(mpg, aes(class, hwy)) +
9799# ' geom_boxplot(aes(fill = stage(class, after_scale = alpha(fill, 0.4))))
98100# '
99101# ' # Using data for computing summary, but placing label elsewhere.
100- # ' # Also, we're making our own computed variable to use for the label.
102+ # ' # Also, we're making our own computed variables to use for the label.
101103# ' ggplot(mpg, aes(class, displ)) +
102104# ' geom_violin() +
103105# ' stat_summary(
110112# ' )
111113# ' ```
112114# '
115+ # ' Conceptually, `aes(x)` is equivalent to `aes(stage(start = x))`, and
116+ # ' `aes(after_stat(count))` is equivalent to `aes(stage(after_stat = count))`,
117+ # ' and so on. `stage()` is most useful when at least two of its arguments are
118+ # ' specified.
119+ # '
113120# ' ## Theme access
114121# ' The `from_theme()` function can be used to acces the [`element_geom()`]
115122# ' fields of the `theme(geom)` argument. Using `aes(colour = from_theme(ink))`
@@ -219,12 +226,10 @@ stage_scaled <- function(start = NULL, after_stat = NULL, after_scale = NULL) {
219226}
220227
221228# Regex to determine if an identifier refers to a calculated aesthetic
229+ # The pattern includes ye olde '...var...' syntax, which was
230+ # deprecated in 3.4.0 in favour of `after_stat()`
222231match_calculated_aes <- " ^\\ .\\ .([a-zA-Z._]+)\\ .\\ .$"
223232
224- is_dotted_var <- function (x ) {
225- grepl(match_calculated_aes , x )
226- }
227-
228233# Determine if aesthetic is calculated
229234is_calculated_aes <- function (aesthetics , warn = FALSE ) {
230235 vapply(aesthetics , is_calculated , warn = warn , logical (1 ), USE.NAMES = FALSE )
@@ -246,7 +251,8 @@ is_calculated <- function(x, warn = FALSE) {
246251 if (is.null(x ) || is.atomic(x )) {
247252 FALSE
248253 } else if (is.symbol(x )) {
249- res <- is_dotted_var(as.character(x ))
254+ # Test if x is a dotted variable
255+ res <- grepl(match_calculated_aes , as.character(x ))
250256 if (res && warn ) {
251257 what <- I(paste0(" The dot-dot notation (`" x , " `)"
252258 var <- gsub(match_calculated_aes , " \\ 1" x ))
@@ -333,7 +339,7 @@ strip_stage <- function(expr) {
333339 } else if (is_call(uq_expr , " stage"
334340 uq_expr <- call_match(uq_expr , stage )
335341 # Prefer stat mapping if present, otherwise original mapping (fallback to
336- # scale mapping) but there should always be two arguments to stage()
342+ # scale mapping)
337343 uq_expr $ after_stat %|| % uq_expr $ start %|| % uq_expr $ after_scale
338344 } else {
339345 expr
@@ -359,3 +365,39 @@ make_labels <- function(mapping) {
359365 }
360366 Map(default_label , names(mapping ), mapping )
361367}
368+
369+ eval_aesthetics <- function (aesthetics , data , mask = NULL ) {
370+
371+ env <- child_env(base_env())
372+
373+ # Here we mask functions, often to replace `stage()` with context appropriate
374+ # functions `stage_calculated()`/`stage_scaled()`.
375+ if (length(mask ) > 0 ) {
376+ aesthetics <- substitute_aes(aesthetics , mask_function , mask = mask )
377+ }
378+
379+ evaled <- lapply(aesthetics , eval_tidy , data = data , env = env )
380+ names(evaled ) <- names(aesthetics )
381+ compact(rename_aes(evaled ))
382+ }
383+
384+ # `mask` is a list of functions where `names(mask)` indicate names of functions
385+ # that need to be replaced, and `mask[[i]]` is the function to replace it
386+ # with.
387+ mask_function <- function (x , mask ) {
388+ if (! is.call(x )) {
389+ return (x )
390+ }
391+ nms <- names(mask )
392+ x [- 1 ] <- lapply(x [- 1 ], mask_function , mask = mask )
393+ if (! is_call(x , nms )) {
394+ return (x )
395+ }
396+ for (nm in nms ) {
397+ if (is_call(x , nm )) {
398+ x [[1 ]] <- mask [[nm ]]
399+ return (x )
400+ }
401+ }
402+ }
403+
0 commit comments