Skip to content
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.

Sign up for GitHub

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

Jump to bottom

Avoid theme partial string matching #5335

Closed
wants to merge 3 commits into from
Closed

Avoid theme partial string matching #5335

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
3f93cbd
Replace `theme$element` by `calc_element(element, theme)`
teunbrand Jun 25, 2023
3b2f6b7
Correct defaults
teunbrand Jun 25, 2023
741bc85
Fix indentation
teunbrand Aug 9, 2023
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
21 changes: 13 additions & 8 deletions R/facet-grid-.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -319,7 +319,7 @@ FacetGrid <- ggproto("FacetGrid", Facet,
attr(row_vars, "facet") <- "grid"
strips <- render_strips(col_vars, row_vars, params$labeller, theme)

aspect_ratio <- theme$aspect.ratio
aspect_ratio <- calc_element("aspect.ratio", theme)
if (!is.null(aspect_ratio) && (params$space_free$x || params$space_free$y)) {
cli::cli_abort("Free scales cannot be mixed with a fixed aspect ratio")
}
Expand Down Expand Up @@ -361,10 +361,14 @@ FacetGrid <- ggproto("FacetGrid", Facet,
panel_widths, panel_heights, respect = respect, clip = coord$clip, z = matrix(1, ncol = ncol, nrow = nrow))
panel_table$layout$name <- paste0('panel-', rep(seq_len(nrow), ncol), '-', rep(seq_len(ncol), each = nrow))

panel_table <- gtable_add_col_space(panel_table,
theme$panel.spacing.x %||% theme$panel.spacing)
panel_table <- gtable_add_row_space(panel_table,
theme$panel.spacing.y %||% theme$panel.spacing)
panel_table <- gtable_add_col_space(
panel_table,
calc_element("panel.spacing.x", theme)
)
panel_table <- gtable_add_row_space(
panel_table,
calc_element("panel.spacing.y", theme)
)

# Add axes
panel_table <- gtable_add_rows(panel_table, max_height(axes$x$top), 0)
Expand All @@ -382,9 +386,10 @@ FacetGrid <- ggproto("FacetGrid", Facet,
# Add strips
switch_x <- !is.null(params$switch) && params$switch %in% c("both", "x")
switch_y <- !is.null(params$switch) && params$switch %in% c("both", "y")
inside_x <- (theme$strip.placement.x %||% theme$strip.placement %||% "inside") == "inside"
inside_y <- (theme$strip.placement.y %||% theme$strip.placement %||% "inside") == "inside"
strip_padding <- convertUnit(theme$strip.switch.pad.grid, "cm")
inside_x <- (calc_element("strip.placement.x", theme) %||% "inside") == "inside"
inside_y <- (calc_element("strip.placement.y", theme) %||% "inside") == "inside"
strip_padding <- calc_element("strip.switch.pad.grid", theme)
strip_padding <- convertUnit(strip_padding, "cm")
panel_pos_col <- panel_cols(panel_table)
if (switch_x) {
if (!is.null(strips$x$bottom)) {
Expand Down
2 changes: 1 addition & 1 deletion R/facet-null.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,7 @@ FacetNull <- ggproto("FacetNull", Facet,
range <- ranges[[1]]

# Figure out aspect ratio
aspect_ratio <- theme$aspect.ratio %||% coord$aspect(range)
aspect_ratio <- calc_element("aspect.ratio", theme) %||% coord$aspect(range)
if (is.null(aspect_ratio)) {
aspect_ratio <- 1
respect <- FALSE
Expand Down
23 changes: 14 additions & 9 deletions R/facet-wrap.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -257,7 +257,7 @@ FacetWrap <- ggproto("FacetWrap", Facet,

# If user hasn't set aspect ratio, and we have fixed scales, then
# ask the coordinate system if it wants to specify one
aspect_ratio <- theme$aspect.ratio
aspect_ratio <- calc_element("aspect.ratio", theme)
if (is.null(aspect_ratio) && !params$free$x && !params$free$y) {
aspect_ratio <- coord$aspect(ranges[[1]])
}
Expand All @@ -278,10 +278,14 @@ FacetWrap <- ggproto("FacetWrap", Facet,
heights = unit(rep(abs(aspect_ratio), nrow), "null"), respect = respect, clip = coord$clip, z = matrix(1, ncol = ncol, nrow = nrow))
panel_table$layout$name <- paste0('panel-', rep(seq_len(ncol), nrow), '-', rep(seq_len(nrow), each = ncol))

panel_table <- gtable_add_col_space(panel_table,
theme$panel.spacing.x %||% theme$panel.spacing)
panel_table <- gtable_add_row_space(panel_table,
theme$panel.spacing.y %||% theme$panel.spacing)
panel_table <- gtable_add_col_space(
panel_table,
calc_element("panel.spacing.x", theme)
)
panel_table <- gtable_add_row_space(
panel_table,
calc_element("panel.spacing.y", theme)
)

# Add axes
axis_mat_x_top <- empty_table
Expand Down Expand Up @@ -320,7 +324,7 @@ FacetWrap <- ggproto("FacetWrap", Facet,
if (any(empties)) {
row_ind <- row(empties)
col_ind <- col(empties)
inside <- (theme$strip.placement %||% "inside") == "inside"
inside <- (calc_element("strip.placement", theme) %||% "inside") == "inside"
empty_bottom <- apply(empties, 2, function(x) c(diff(x) == 1, FALSE))
if (any(empty_bottom)) {
pos <- which(empty_bottom)
Expand Down Expand Up @@ -403,12 +407,13 @@ FacetWrap <- ggproto("FacetWrap", Facet,
panel_table <- weave_tables_col(panel_table, axis_mat_y_left, -1, axis_width_left, "axis-l", 3)
panel_table <- weave_tables_col(panel_table, axis_mat_y_right, 0, axis_width_right, "axis-r", 3)

strip_padding <- convertUnit(theme$strip.switch.pad.wrap, "cm")
strip_padding <- calc_element("strip.switch.pad.wrap", theme)
strip_padding <- convertUnit(strip_padding, "cm")
strip_name <- paste0("strip-", substr(params$strip.position, 1, 1))
strip_mat <- empty_table
strip_mat[panel_pos] <- unlist(unname(strips), recursive = FALSE)[[params$strip.position]]
if (params$strip.position %in% c("top", "bottom")) {
inside_x <- (theme$strip.placement.x %||% theme$strip.placement %||% "inside") == "inside"
inside_x <- (calc_element("strip.placement.x", theme) %||% "inside") == "inside"
if (params$strip.position == "top") {
placement <- if (inside_x) -1 else -2
strip_pad <- axis_height_top
Expand All @@ -423,7 +428,7 @@ FacetWrap <- ggproto("FacetWrap", Facet,
panel_table <- weave_tables_row(panel_table, row_shift = placement, row_height = strip_pad)
}
} else {
inside_y <- (theme$strip.placement.y %||% theme$strip.placement %||% "inside") == "inside"
inside_y <- (calc_element("strip.placement.y", theme) %||% "inside") == "inside"
if (params$strip.position == "left") {
placement <- if (inside_y) -1 else -2
strip_pad <- axis_width_left
Expand Down
5 changes: 3 additions & 2 deletions R/guide-bins.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -334,8 +334,9 @@ GuideBins <- ggproto(
},

override_elements = function(params, elements, theme) {
elements$ticks <- combine_elements(elements$ticks, theme$line)
elements$line <- combine_elements(elements$line, theme$line)
line <- calc_element("line", theme)
elements$ticks <- combine_elements(elements$ticks, line)
elements$line <- combine_elements(elements$line, line)
GuideLegend$override_elements(params, elements, theme)
},

Expand Down
4 changes: 2 additions & 2 deletions R/guide-colorbar.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -410,8 +410,8 @@ GuideColourbar <- ggproto(
} else {
elements$key.height <- elements$key.height * 5
}
elements$ticks <- combine_elements(elements$ticks, theme$line)
elements$frame <- combine_elements(elements$frame, theme$rect)
elements$ticks <- combine_elements(elements$ticks, calc_element("line", theme))
elements$frame <- combine_elements(elements$frame, calc_element("rect", theme))
GuideLegend$override_elements(params, elements, theme)
},

Expand Down
8 changes: 4 additions & 4 deletions R/guide-legend.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -414,11 +414,11 @@ GuideLegend <- ggproto(
}
# Breaking justification inheritance for intuition purposes.
if (is.null(params$label.theme$hjust) &&
is.null(theme$legend.text$hjust)) {
is.null(theme[["legend.text"]]$hjust)) {
label$hjust <- NULL
}
if (is.null(params$label.theme$vjust) &&
is.null(theme$legend.text$vjust)) {
is.null(theme[["legend.text"]]$vjust)) {
label$vjust <- NULL
}
label$hjust <- params$label.hjust %||% elements$text.align %||%
Expand All @@ -439,8 +439,8 @@ GuideLegend <- ggproto(
elements$text$size %||% 11
gap <- unit(gap * 0.5, "pt")
# Should maybe be elements$spacing.{x/y} instead of the theme's spacing?
elements$hgap <- width_cm( theme$legend.spacing.x %||% gap)
elements$vgap <- height_cm(theme$legend.spacing.y %||% gap)
elements$hgap <- width_cm( theme[["legend.spacing.x"]] %||% gap)
elements$vgap <- height_cm(theme[["legend.spacing.y"]] %||% gap)
elements$padding <- convertUnit(
elements$margin %||% margin(),
"cm", valueOnly = TRUE
Expand Down
30 changes: 15 additions & 15 deletions R/guides-.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -252,14 +252,14 @@ Guides <- ggproto(
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
theme[["legend.key.width"]] <- calc_element("legend.key.width", theme)
theme[["legend.key.height"]] <- calc_element("legend.key.height", theme)


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(
theme[["legend.box"]] <- calc_element("legend.box", theme) %||% default_direction
theme[["legend.direction"]] <- calc_element("legend.direction", theme) %||% default_direction
theme[["legend.box.just"]] <- calc_element("legend.box.just", theme) %||% switch(
position,
inside = c("center", "center"),
vertical = c("left", "top"),
Expand All @@ -272,7 +272,7 @@ Guides <- ggproto(
return(no_guides)
}
guides <- self$setup(scales)
guides$train(scales, theme$legend.direction, labels)
guides$train(scales, calc_element("legend.direction", theme), labels)
if (length(guides$guides) == 0) {
return(no_guides)
}
Expand Down Expand Up @@ -461,9 +461,9 @@ Guides <- ggproto(
# Combining multiple guides in a guide box
assemble = function(grobs, theme) {
# Set spacing
theme$legend.spacing <- theme$legend.spacing %||% unit(0.5, "lines")
theme$legend.spacing.y <- theme$legend.spacing.y %||% theme$legend.spacing
theme$legend.spacing.x <- theme$legend.spacing.x %||% theme$legend.spacing
theme[["legend.spacing"]] <- calc_element("legend.spacing", theme) %||% unit(0.5, "lines")
theme[["legend.spacing.y"]] <- calc_element("legend.spacing.y", theme)
theme[["legend.spacing.x"]] <- calc_element("legend.spacing.x", theme)

# Measure guides
widths <- lapply(grobs, function(g) sum(g$widths))
Expand All @@ -473,12 +473,12 @@ Guides <- ggproto(

# Set the justification of each legend within the legend box
# First value is xjust, second value is yjust
just <- valid.just(theme$legend.box.just)
just <- valid.just(calc_element("legend.box.just", theme))
xjust <- just[1]
yjust <- just[2]

# setting that is different for vertical and horizontal guide-boxes.
if (identical(theme$legend.box, "horizontal")) {
if (identical(calc_element("legend.box", theme), "horizontal")) {
# Set justification for each legend
for (i in seq_along(grobs)) {
grobs[[i]] <- editGrob(
Expand All @@ -493,7 +493,7 @@ Guides <- ggproto(
widths = widths, height = max(heights))

# add space between the guide-boxes
guides <- gtable_add_col_space(guides, theme$legend.spacing.x)
guides <- gtable_add_col_space(guides, calc_element("legend.spacing.x", theme))

} else { # theme$legend.box == "vertical"
# Set justification for each legend
Expand All @@ -510,18 +510,18 @@ Guides <- ggproto(
width = max(widths), heights = heights)

# add space between the guide-boxes
guides <- gtable_add_row_space(guides, theme$legend.spacing.y)
guides <- gtable_add_row_space(guides, calc_element("legend.spacing.y", theme))
}

# Add margins around the guide-boxes.
margin <- theme$legend.box.margin %||% margin()
margin <- calc_element("legend.box.margin", theme) %||% margin()
guides <- gtable_add_cols(guides, margin[4], pos = 0)
guides <- gtable_add_cols(guides, margin[2], pos = ncol(guides))
guides <- gtable_add_rows(guides, margin[1], pos = 0)
guides <- gtable_add_rows(guides, margin[3], pos = nrow(guides))

# Add legend box background
background <- element_grob(theme$legend.box.background %||% element_blank())
background <- element_render(theme, "legend.box.background")

guides <- gtable_add_grob(
guides, background,
Expand Down
2 changes: 1 addition & 1 deletion R/layout.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -80,7 +80,7 @@ Layout <- ggproto("Layout", NULL,

coord_fg <- self$coord$render_fg(self$panel_params[[i]], theme)
coord_bg <- self$coord$render_bg(self$panel_params[[i]], theme)
if (isTRUE(theme$panel.ontop)) {
if (isTRUE(calc_element("panel.ontop", theme))) {
panel <- c(panel, list(coord_bg), list(coord_fg))
} else {
panel <- c(list(coord_bg), panel, list(coord_fg))
Expand Down
34 changes: 18 additions & 16 deletions R/plot-build.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -172,7 +172,7 @@ ggplot_gtable.ggplot_built <- function(data) {
plot_table <- layout$render(geom_grobs, data, theme, plot$labels)

# Legends
position <- theme$legend.position %||% "right"
position <- calc_element("legend.position", theme) %||% "right"
if (length(position) == 2) {
position <- "manual"
}
Expand All @@ -190,13 +190,14 @@ ggplot_gtable.ggplot_built <- function(data) {

# Set the justification of the legend box
# First value is xjust, second value is yjust
just <- valid.just(theme$legend.justification)
just <- valid.just(calc_element("legend.justification", theme))
xjust <- just[1]
yjust <- just[2]

if (position == "manual") {
xpos <- theme$legend.position[1]
ypos <- theme$legend.position[2]
pos <- calc_element("legend.position", theme)
xpos <- pos[1]
ypos <- pos[2]

# x and y are specified via theme$legend.position (i.e., coords)
legend_box <- editGrob(
Expand Down Expand Up @@ -232,24 +233,24 @@ ggplot_gtable.ggplot_built <- function(data) {
# for align-to-device, use this:
# panel_dim <- summarise(plot_table$layout, t = min(t), r = max(r), b = max(b), l = min(l))

theme$legend.box.spacing <- theme$legend.box.spacing %||% unit(0.2, 'cm')
legend.box.spacing <- calc_element("legend.box.spacing", theme) %||% unit(0.2, "cm")
if (position == "left") {
plot_table <- gtable_add_cols(plot_table, theme$legend.box.spacing, pos = 0)
plot_table <- gtable_add_cols(plot_table, legend.box.spacing, pos = 0)
plot_table <- gtable_add_cols(plot_table, legend_width, pos = 0)
plot_table <- gtable_add_grob(plot_table, legend_box, clip = "off",
t = panel_dim$t, b = panel_dim$b, l = 1, r = 1, name = "guide-box")
} else if (position == "right") {
plot_table <- gtable_add_cols(plot_table, theme$legend.box.spacing, pos = -1)
plot_table <- gtable_add_cols(plot_table, legend.box.spacing, pos = -1)
plot_table <- gtable_add_cols(plot_table, legend_width, pos = -1)
plot_table <- gtable_add_grob(plot_table, legend_box, clip = "off",
t = panel_dim$t, b = panel_dim$b, l = -1, r = -1, name = "guide-box")
} else if (position == "bottom") {
plot_table <- gtable_add_rows(plot_table, theme$legend.box.spacing, pos = -1)
plot_table <- gtable_add_rows(plot_table, legend.box.spacing, pos = -1)
plot_table <- gtable_add_rows(plot_table, legend_height, pos = -1)
plot_table <- gtable_add_grob(plot_table, legend_box, clip = "off",
t = -1, b = -1, l = panel_dim$l, r = panel_dim$r, name = "guide-box")
} else if (position == "top") {
plot_table <- gtable_add_rows(plot_table, theme$legend.box.spacing, pos = 0)
plot_table <- gtable_add_rows(plot_table, legend.box.spacing, pos = 0)
plot_table <- gtable_add_rows(plot_table, legend_height, pos = 0)
plot_table <- gtable_add_grob(plot_table, legend_box, clip = "off",
t = 1, b = 1, l = panel_dim$l, r = panel_dim$r, name = "guide-box")
Expand Down Expand Up @@ -277,14 +278,14 @@ ggplot_gtable.ggplot_built <- function(data) {
# "panel" means align to the panel(s)
# "plot" means align to the entire plot (except margins and tag)
title_pos <- arg_match0(
theme$plot.title.position %||% "panel",
calc_element("plot.title.position", theme) %||% "panel",
c("panel", "plot"),
arg_nm = "plot.title.position",
error_call = expr(theme())
)

caption_pos <- arg_match0(
theme$plot.caption.position %||% "panel",
calc_element("plot.caption.position", theme) %||% "panel",
values = c("panel", "plot"),
arg_nm = "plot.caption.position",
error_call = expr(theme())
Expand Down Expand Up @@ -321,12 +322,13 @@ ggplot_gtable.ggplot_built <- function(data) {
plot_table <- table_add_tag(plot_table, plot$labels$tag, theme)

# Margins
plot_table <- gtable_add_rows(plot_table, theme$plot.margin[1], pos = 0)
plot_table <- gtable_add_cols(plot_table, theme$plot.margin[2])
plot_table <- gtable_add_rows(plot_table, theme$plot.margin[3])
plot_table <- gtable_add_cols(plot_table, theme$plot.margin[4], pos = 0)
plot.margin <- calc_element("plot.margin", theme)
plot_table <- gtable_add_rows(plot_table, plot.margin[1], pos = 0)
plot_table <- gtable_add_cols(plot_table, plot.margin[2])
plot_table <- gtable_add_rows(plot_table, plot.margin[3])
plot_table <- gtable_add_cols(plot_table, plot.margin[4], pos = 0)

if (inherits(theme$plot.background, "element")) {
if (inherits(calc_element("plot.background", theme), "element")) {
plot_table <- gtable_add_grob(plot_table,
element_render(theme, "plot.background"),
t = 1, l = 1, b = -1, r = -1, name = "background", z = -Inf)
Expand Down
3 changes: 2 additions & 1 deletion R/theme-defaults.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -481,6 +481,7 @@ theme_void <- function(base_size = 11, base_family = "",
axis.ticks.length.y.left = NULL,
axis.ticks.length.y.right = NULL,
legend.box = NULL,
legend.box.background = element_blank(),
legend.key.size = unit(1.2, "lines"),
legend.position = "right",
legend.text = element_text(size = rel(0.8)),
Expand All @@ -491,7 +492,7 @@ theme_void <- function(base_size = 11, base_family = "",
strip.switch.pad.wrap = unit(half_line / 2, "pt"),
panel.ontop = FALSE,
panel.spacing = unit(half_line, "pt"),
plot.margin = unit(c(0, 0, 0, 0), "lines"),
plot.margin = margin(unit = "lines"),
plot.title = element_text(
size = rel(1.2),
hjust = 0, vjust = 1,
Expand Down
Loading
Loading