Skip to content

Move guide building to ggplot_build() #5483

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

Merged
merged 10 commits into from
Oct 30, 2023
Merged
Show file tree
Hide file tree
Changes from 7 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
2 changes: 1 addition & 1 deletion R/coord-cartesian-.R
Original file line number Diff line number Diff line change
Expand Up @@ -151,5 +151,5 @@ panel_guides_grob <- function(guides, position, theme) {
return(zeroGrob())
}
pair <- guides$get_position(position)
pair$guide$draw(theme, pair$params)
pair$guide$draw(theme, params = pair$params)
}
5 changes: 4 additions & 1 deletion R/guide-.R
Original file line number Diff line number Diff line change
Expand Up @@ -280,11 +280,14 @@ Guide <- ggproto(

# Main drawing function that organises more specialised aspects of guide
# drawing.
draw = function(self, theme, params = self$params) {
draw = function(self, theme, position = NULL, direction = NULL,
params = self$params) {

key <- params$key

# Setup parameters and theme
params$position <- params$position %||% position
params$direction <- params$direction %||% direction
params <- self$setup_params(params)
elems <- self$setup_elements(params, self$elements, theme)
elems <- self$override_elements(params, elems, theme)
Expand Down
2 changes: 1 addition & 1 deletion R/guide-axis.R
Original file line number Diff line number Diff line change
Expand Up @@ -429,7 +429,7 @@ draw_axis <- function(break_positions, break_labels, axis_position, theme,
!!aes := c(0, 1),
!!opp := opp_value
)
guide$draw(theme, params)
guide$draw(theme, params = params)
}

draw_axis_labels <- function(break_positions, break_labels, label_element, is_vertical,
Expand Down
32 changes: 18 additions & 14 deletions R/guide-bins.R
Original file line number Diff line number Diff line change
Expand Up @@ -298,15 +298,15 @@ GuideBins <- ggproto(
params$title <- scale$make_title(
params$title %|W|% scale$name %|W|% title
)
params$key <- key
params
},

setup_params = function(params) {
params$direction <- arg_match0(
params$direction %||% direction,
params$direction,
c("horizontal", "vertical"), arg_nm = "direction"
)
if (params$direction == "vertical") {
key$.value <- 1 - key$.value
}

params$key <- key
valid_label_pos <- switch(
params$direction,
"horizontal" = c("bottom", "top"),
Expand All @@ -320,10 +320,6 @@ GuideBins <- ggproto(
"not {.val {params$label.position}}."
))
}
params
},

setup_params = function(params) {
params <- GuideLegend$setup_params(params)
params$byrow <- FALSE
params$rejust_labels <- FALSE
Expand All @@ -345,10 +341,15 @@ GuideBins <- ggproto(
}
key$.label[c(1, n_labels)[!params$show.limits]] <- ""

just <- if (params$direction == "horizontal") {
elements$text$vjust
} else {
elements$text$hjust
just <- switch(
params$direction,
horizontal = elements$text$vjust,
vertical = elements$text$hjust,
0.5
)

if (params$direction == "vertical") {
key$.value <- 1 - key$.value
}

list(labels = flip_element_grob(
Expand All @@ -363,6 +364,9 @@ GuideBins <- ggproto(
},

build_ticks = function(key, elements, params, position = params$position) {
if (params$direction == "vertical") {
key$.value <- 1 - key$.value
}
key$.value[c(1, nrow(key))[!params$show.limits]] <- NA
Guide$build_ticks(key$.value, elements, params, params$label.position)
},
Expand Down
36 changes: 18 additions & 18 deletions R/guide-colorbar.R
Original file line number Diff line number Diff line change
Expand Up @@ -344,27 +344,10 @@ GuideColourbar <- ggproto(
},

extract_params = function(scale, params,
title = waiver(), direction = "vertical", ...) {
title = waiver(), ...) {
params$title <- scale$make_title(
params$title %|W|% scale$name %|W|% title
)
params$direction <- arg_match0(
params$direction %||% direction,
c("horizontal", "vertical"), arg_nm = "direction"
)
valid_label_pos <- switch(
params$direction,
"horizontal" = c("bottom", "top"),
"vertical" = c("right", "left")
)
params$label.position <- params$label.position %||% valid_label_pos[1]
if (!params$label.position %in% valid_label_pos) {
cli::cli_abort(paste0(
"When {.arg direction} is {.val {params$direction}}, ",
"{.arg label.position} must be one of {.or {.val {valid_label_pos}}}, ",
"not {.val {params$label.position}}."
))
}

limits <- c(params$decor$value[1], params$decor$value[nrow(params$decor)])
params$key$.value <- rescale(
Expand Down Expand Up @@ -402,6 +385,23 @@ GuideColourbar <- ggproto(
},

setup_params = function(params) {
params$direction <- arg_match0(
params$direction,
c("horizontal", "vertical"), arg_nm = "direction"
)
valid_label_pos <- switch(
params$direction,
"horizontal" = c("bottom", "top"),
"vertical" = c("right", "left")
)
params$label.position <- params$label.position %||% valid_label_pos[1]
if (!params$label.position %in% valid_label_pos) {
cli::cli_abort(paste0(
"When {.arg direction} is {.val {params$direction}}, ",
"{.arg label.position} must be one of {.or {.val {valid_label_pos}}}, ",
"not {.val {params$label.position}}."
))
}
params$title.position <- arg_match0(
params$title.position %||%
switch(params$direction, vertical = "top", horizontal = "left"),
Expand Down
13 changes: 7 additions & 6 deletions R/guide-legend.R
Original file line number Diff line number Diff line change
Expand Up @@ -244,7 +244,7 @@ GuideLegend <- ggproto(

available_aes = "any",

hashables = exprs(title, key$.label, direction, name),
hashables = exprs(title, key$.label, name),

elements = list(
background = "legend.background",
Expand All @@ -260,14 +260,10 @@ GuideLegend <- ggproto(
),

extract_params = function(scale, params,
title = waiver(), direction = NULL, ...) {
title = waiver(), ...) {
params$title <- scale$make_title(
params$title %|W|% scale$name %|W|% title
)
params$direction <- arg_match0(
params$direction %||% direction,
c("horizontal", "vertical"), arg_nm = "direction"
)
if (isTRUE(params$reverse %||% FALSE)) {
params$key <- params$key[nrow(params$key):1, , drop = FALSE]
}
Expand Down Expand Up @@ -346,6 +342,11 @@ GuideLegend <- ggproto(
},

setup_params = function(params) {
params$direction <- arg_match0(
params$direction %||% direction,
c("horizontal", "vertical"), arg_nm = "direction"
)

if ("title.position" %in% names(params)) {
params$title.position <- arg_match0(
params$title.position %||%
Expand Down
2 changes: 1 addition & 1 deletion R/guide-none.R
Original file line number Diff line number Diff line change
Expand Up @@ -35,7 +35,7 @@ GuideNone <- ggproto(
},

# Draw nothing
draw = function(self, params, theme) {
draw = function(self, ...) {
zeroGrob()
}
)
7 changes: 4 additions & 3 deletions R/guide-old.R
Original file line number Diff line number Diff line change
Expand Up @@ -90,7 +90,7 @@ GuideOld <- ggproto(
train = function(self, params, scale, aesthetic = NULL,
title = waiver(), direction = NULL) {
params$title <- scale$make_title(params$title %|W|% scale$name %|W|% title)
params$direction <- params$direction %||% direction
params$direction <- params$direction %||% direction %||% "vertical"
params <- guide_train(params, scale, aesthetic)
params
},
Expand All @@ -107,9 +107,10 @@ GuideOld <- ggproto(
guide_geom(params, layers, default_mapping = NULL)
},

draw = function(self, theme, params) {
draw = function(self, theme, position = NULL, direction = NULL, params) {
params$direction <- params$direction %||% direction %||% "placeholder"
params$title.position <- params$title.position %||% switch(
params$direction %||% "placeholder",
params$direction,
vertical = "top", horizontal = "left",
NULL
)
Expand Down
70 changes: 38 additions & 32 deletions R/guides-.R
Original file line number Diff line number Diff line change
Expand Up @@ -278,28 +278,10 @@ Guides <- ggproto(
# 5. Guides$assemble()
# arrange all guide grobs

build = function(self, scales, layers, default_mapping,
position, theme, labels) {
build = function(self, scales, layers, labels) {

position <- legend_position(position)
no_guides <- zeroGrob()
if (position == "none") {
return(no_guides)
}

theme$legend.key.width <- theme$legend.key.width %||% theme$legend.key.size
theme$legend.key.height <- theme$legend.key.height %||% theme$legend.key.size


default_direction <- if (position == "inside") "vertical" else position
theme$legend.box <- theme$legend.box %||% default_direction
theme$legend.direction <- theme$legend.direction %||% default_direction
theme$legend.box.just <- theme$legend.box.just %||% switch(
position,
inside = c("center", "center"),
vertical = c("left", "top"),
horizontal = c("center", "top")
)
# Empty guides list
no_guides <- guides_list()

# Extract the non-position scales
scales <- scales$non_position_scales()$scales
Expand All @@ -314,7 +296,8 @@ Guides <- ggproto(

# Setup and train scales
guides <- self$setup(scales, aesthetics = aesthetics)
guides$train(scales, theme$legend.direction, labels)
guides$train(scales, labels)

if (length(guides$guides) == 0) {
return(no_guides)
}
Expand All @@ -325,10 +308,7 @@ Guides <- ggproto(
if (length(guides$guides) == 0) {
return(no_guides)
}

# Draw and assemble
grobs <- guides$draw(theme)
guides$assemble(grobs, theme)
guides
},

# Setup routine for resolving and validating guides based on paired scales.
Expand Down Expand Up @@ -409,14 +389,13 @@ Guides <- ggproto(

# Loop over every guide-scale combination to perform training
# A strong assumption here is that `scales` is parallel to the guides
train = function(self, scales, direction, labels) {
train = function(self, scales, labels) {

params <- Map(
function(guide, param, scale, aes) {
guide$train(
param, scale, aes,
title = labels[[aes]],
direction = direction
title = labels[[aes]]
)
},
guide = self$guides,
Expand Down Expand Up @@ -480,16 +459,43 @@ Guides <- ggproto(
},

# Loop over every guide, let them draw their grobs
draw = function(self, theme) {
draw = function(self, theme, position, direction) {
Map(
function(guide, params) guide$draw(theme, params),
function(guide, params) guide$draw(theme, position, direction, params),
guide = self$guides,
params = self$params
)
},

# Combining multiple guides in a guide box
assemble = function(grobs, theme) {
assemble = function(self, theme, position) {

if (length(self$guides) < 1) {
return(zeroGrob())
}

position <- legend_position(position)
if (position == "none") {
return(zeroGrob())
}
default_direction <- if (position == "inside") "vertical" else position

theme$legend.key.width <- theme$legend.key.width %||% theme$legend.key.size
theme$legend.key.height <- theme$legend.key.height %||% theme$legend.key.size
theme$legend.box <- theme$legend.box %||% default_direction
theme$legend.direction <- theme$legend.direction %||% default_direction
theme$legend.box.just <- theme$legend.box.just %||% switch(
position,
inside = c("center", "center"),
vertical = c("left", "top"),
horizontal = c("center", "top")
)

grobs <- self$draw(theme, position, default_direction)
if (length(grobs) < 1) {
return(zeroGrob())
}

# Set spacing
theme$legend.spacing <- theme$legend.spacing %||% unit(0.5, "lines")
theme$legend.spacing.y <- theme$legend.spacing.y %||% theme$legend.spacing
Expand Down
14 changes: 9 additions & 5 deletions R/plot-build.R
Original file line number Diff line number Diff line change
Expand Up @@ -84,11 +84,18 @@ ggplot_build.ggplot <- function(plot) {
layout$setup_panel_params()
data <- layout$map_position(data)

# Train and map non-position scales
# Hand off position guides to layout
layout$setup_panel_guides(plot$guides, plot$layers)

# Train and map non-position scales and guides
npscales <- scales$non_position_scales()
if (npscales$n() > 0) {
lapply(data, npscales$train_df)
plot$guides <- plot$guides$build(npscales, plot$layers, plot$labels)
data <- lapply(data, npscales$map_df)
} else {
# Assign empty guides if there are no non-position scales
plot$guides <- guides_list()
}

# Fill in defaults etc.
Expand Down Expand Up @@ -168,7 +175,6 @@ ggplot_gtable.ggplot_built <- function(data) {

geom_grobs <- by_layer(function(l, d) l$draw_geom(d, layout), plot$layers, data, "converting geom to grob")

layout$setup_panel_guides(plot$guides, plot$layers)
plot_table <- layout$render(geom_grobs, data, theme, plot$labels)

# Legends
Expand All @@ -177,9 +183,7 @@ ggplot_gtable.ggplot_built <- function(data) {
position <- "manual"
}

legend_box <- plot$guides$build(
plot$scales, plot$layers, plot$mapping, position, theme, plot$labels
)
legend_box <- plot$guides$assemble(theme, position)

if (is.zero(legend_box)) {
position <- "none"
Expand Down
Loading