Skip to content

POC: ignore() for aesthetic evaluation. #5418

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
wants to merge 9 commits into from
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
13 changes: 13 additions & 0 deletions R/aes-evaluation.R
Original file line number Diff line number Diff line change
Expand Up @@ -204,6 +204,12 @@ stage_scaled <- function(start = NULL, after_stat = NULL, after_scale = NULL) {
after_scale
}

#' @rdname aes_eval
#' @export
ignore <- function(x) {
x
}

# Regex to determine if an identifier refers to a calculated aesthetic
match_calculated_aes <- "^\\.\\.([a-zA-Z._]+)\\.\\.$"

Expand All @@ -221,6 +227,10 @@ is_scaled_aes <- function(aesthetics) {
is_staged_aes <- function(aesthetics) {
vapply(aesthetics, is_staged, logical(1), USE.NAMES = FALSE)
}
is_ignored_aes <- function(aesthetics) {
vapply(aesthetics, is_ignored, logical(1), USE.NAMES = FALSE)
}

is_calculated <- function(x, warn = FALSE) {
if (is_call(get_expr(x), "after_stat")) {
return(TRUE)
Expand Down Expand Up @@ -263,6 +273,9 @@ is_scaled <- function(x) {
is_staged <- function(x) {
is_call(get_expr(x), "stage")
}
is_ignored <- function(x) {
is_call(get_expr(x), "ignore")
}

# Strip dots from expressions
strip_dots <- function(expr, env, strip_pronoun = FALSE) {
Expand Down
13 changes: 11 additions & 2 deletions R/annotation.R
Original file line number Diff line number Diff line change
Expand Up @@ -70,8 +70,17 @@ annotate <- function(geom, x = NULL, y = NULL, xmin = NULL, xmax = NULL,
details <- paste0(names(aesthetics)[bad], " (", lengths[bad], ")")
cli::cli_abort("Unequal parameter lengths: {details}")
}

data <- data_frame0(!!!position, .size = n)

# Re-inject potential `ignore()` expressions
mapping <- aes_all(names(data))
call <- call_match(fn = annotate)
aesthetics <- intersect(names(call), names(mapping))
for (aes in aesthetics[is_ignored_aes(call[aesthetics])]) {
expr <- quo_get_expr(mapping[[aes]])
mapping[[aes]] <- quo(ignore(!!expr))
}

layer(
geom = geom,
params = list(
Expand All @@ -81,7 +90,7 @@ annotate <- function(geom, x = NULL, y = NULL, xmin = NULL, xmax = NULL,
stat = StatIdentity,
position = PositionIdentity,
data = data,
mapping = aes_all(names(data)),
mapping = mapping,
inherit.aes = FALSE,
show.legend = FALSE
)
Expand Down
34 changes: 33 additions & 1 deletion R/layer.R
Original file line number Diff line number Diff line change
Expand Up @@ -344,7 +344,8 @@ Layer <- ggproto("Layer", NULL,
aesthetics <- defaults(aesthetics, self$stat$default_aes)
aesthetics <- compact(aesthetics)

new <- strip_dots(aesthetics[is_calculated_aes(aesthetics) | is_staged_aes(aesthetics)])
new <- aesthetics[!is_ignored_aes(aesthetics)]
new <- strip_dots(new[is_calculated_aes(new) | is_staged_aes(new)])
if (length(new) == 0) return(data)

# data needs to be non-scaled
Expand Down Expand Up @@ -428,7 +429,38 @@ Layer <- ggproto("Layer", NULL,
}

data <- self$geom$handle_na(data, self$computed_geom_params)

ignored <- self$ignored_aesthetics()
if (any(ignored %in% c(ggplot_global$x_aes, ggplot_global$y_aes))) {
# We temporarily redefine x/y aesthetics to have coords skip
# transformation of ignored aesthetics
local_bindings(
x_aes = setdiff(ggplot_global$x_aes, ignored),
y_aes = setdiff(ggplot_global$y_aes, ignored),
.env = ggplot_global
)
}

self$geom$draw_layer(data, self$computed_geom_params, layout, layout$coord)
},

ignored_aesthetics = function(self) {
aesthetics <- self$computed_mapping
names(aesthetics)[is_ignored_aes(aesthetics)]
},

apply_ignore = function(self, data) {
ignored <- self$ignored_aesthetics()
ignored <- names(data) %in% ignored
names(data)[ignored] <- paste0(".ignored_", names(data)[ignored])
data
},

undo_ignore = function(self, data) {
ignored <- self$ignored_aesthetics()
ignored <- names(data) %in% paste0(".ignored_", ignored)
names(data)[ignored] <- gsub("^\\.ignored_", "", names(data)[ignored])
data
}
)

Expand Down
4 changes: 4 additions & 0 deletions R/plot-build.R
Original file line number Diff line number Diff line change
Expand Up @@ -51,6 +51,7 @@ ggplot_build.ggplot <- function(plot) {

# Compute aesthetics to produce data with generalised variable names
data <- by_layer(function(l, d) l$compute_aesthetics(d, plot), layers, data, "computing aesthetics")
data <- by_layer(function(l, d) l$apply_ignore(d), layers, data, "ignoring aesthetics")

# Transform all scales
data <- lapply(data, scales$transform_df)
Expand All @@ -62,6 +63,7 @@ ggplot_build.ggplot <- function(plot) {

layout$train_position(data, scale_x(), scale_y())
data <- layout$map_position(data)
data <- by_layer(function(l, d) l$undo_ignore(d), layers, data, "unignoring aesthetics")

# Apply and map statistics
data <- by_layer(function(l, d) l$compute_statistic(d, layout), layers, data, "computing stat")
Expand All @@ -79,6 +81,7 @@ ggplot_build.ggplot <- function(plot) {
# Reset position scales, then re-train and map. This ensures that facets
# have control over the range of a plot: is it generated from what is
# displayed, or does it include the range of underlying data
data <- by_layer(function(l, d) l$apply_ignore(d), layers, data, "ignoring aesthetics")
layout$reset_scales()
layout$train_position(data, scale_x(), scale_y())
layout$setup_panel_params()
Expand All @@ -90,6 +93,7 @@ ggplot_build.ggplot <- function(plot) {
lapply(data, npscales$train_df)
data <- lapply(data, npscales$map_df)
}
data <- by_layer(function(l, d) l$undo_ignore(d), layers, data, "unignoring aesthetics")

# Fill in defaults etc.
data <- by_layer(function(l, d) l$compute_geom_2(d), layers, data, "setting up geom aesthetics")
Expand Down
7 changes: 4 additions & 3 deletions R/position-.R
Original file line number Diff line number Diff line change
Expand Up @@ -78,13 +78,14 @@ transform_position <- function(df, trans_x = NULL, trans_y = NULL, ...) {
# Treat df as list during transformation for faster set/get
oldclass <- class(df)
df <- unclass(df)
scales <- aes_to_scale(names(df))

if (!is.null(trans_x)) {
df[scales == "x"] <- lapply(df[scales == "x"], trans_x, ...)
is_x <- names(df) %in% ggplot_global$x_aes
df[is_x] <- lapply(df[is_x], trans_x, ...)
}
if (!is.null(trans_y)) {
df[scales == "y"] <- lapply(df[scales == "y"], trans_y, ...)
is_y <- names(df) %in% ggplot_global$y_aes
df[is_y] <- lapply(df[is_y], trans_y, ...)
}

class(df) <- oldclass
Expand Down
1 change: 1 addition & 0 deletions R/scales-.R
Original file line number Diff line number Diff line change
Expand Up @@ -145,6 +145,7 @@ ScalesList <- ggproto("ScalesList", NULL,
if (is.null(aesthetics)) {
return()
}
aesthetics <- aesthetics[!is_ignored_aes(aesthetics)]
names(aesthetics) <- unlist(lapply(names(aesthetics), aes_to_scale))

new_aesthetics <- setdiff(names(aesthetics), self$input())
Expand Down