Skip to content

Commit 23fdf39

Browse files
dpseideldpseidel
committed
Update implementation given feedback
1 parent 58a677d commit 23fdf39

File tree

3 files changed

+87
-68
lines changed

3 files changed

+87
-68
lines changed

‎R/geom-.r

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -106,15 +106,15 @@ Geom <- ggproto("Geom",
106106

107107
setup_data = function(data, params) data,
108108

109-
# Combine data with defaults and set aesthetics from parameters
110-
use_defaults = function(self, data, params = list(), theme) {
111-
112-
# evaluates defaults given plot theme
109+
# evaluate defaults according to theme
110+
eval_defaults = function(self, theme) {
113111
if (length(theme) == 0) theme <- theme_grey()
114-
env <- new.env()
115-
env$theme <- theme
116-
defaults <- rlang::eval_tidy(self$default_aes, env)
117112

113+
lapply(self$default_aes, rlang::eval_tidy, data = list(theme = theme))
114+
},
115+
116+
# Combine data with defaults and set aesthetics from parameters
117+
use_defaults = function(self, data, defaults, params = list()) {
118118
# Fill in missing aesthetics with their defaults
119119
missing_aes <- setdiff(names(defaults), names(data))
120120

‎R/guide-legend.r

Lines changed: 76 additions & 60 deletions
Original file line numberDiff line numberDiff line change
@@ -121,7 +121,7 @@
121121
#' # reversed order legend
122122
#' p + guides(col = guide_legend(reverse = TRUE))
123123
#' }
124-
guide_legend <- function(# title
124+
guide_legend <- function( # title
125125
title = waiver(),
126126
title.position = NULL,
127127
title.theme = NULL,
@@ -149,7 +149,6 @@ guide_legend <- function(# title
149149
reverse = FALSE,
150150
order = 0,
151151
...) {
152-
153152
if (!is.null(keywidth) && !is.unit(keywidth)) {
154153
keywidth <- unit(keywidth, default.unit)
155154
}
@@ -264,7 +263,12 @@ guide_geom.legend <- function(guide, layers, default_mapping, theme) {
264263
n <- vapply(layer$aes_params, length, integer(1))
265264
params <- layer$aes_params[n == 1]
266265

267-
data <- layer$geom$use_defaults(guide$key[matched], params, theme)
266+
defaults <- layer$geom$eval_defaults(theme = theme)
267+
data <- layer$geom$use_defaults(
268+
data = guide$key[matched],
269+
defaults = defaults,
270+
params = params
271+
)
268272
} else {
269273
return(NULL)
270274
}
@@ -274,7 +278,12 @@ guide_geom.legend <- function(guide, layers, default_mapping, theme) {
274278
# Default is to exclude it
275279
return(NULL)
276280
} else {
277-
data <- layer$geom$use_defaults(NULL, layer$aes_params)[rep(1, nrow(guide$key)), ]
281+
defaults <- layer$geom$eval_defaults(theme = theme)
282+
data <- layer$geom$use_defaults(
283+
data = NULL,
284+
defaults = defaults,
285+
params = layer$aes_params
286+
)[rep(1, nrow(guide$key)), ]
278287
}
279288
}
280289

@@ -301,8 +310,9 @@ guide_gengrob.legend <- function(guide, theme) {
301310

302311
# default setting
303312
label.position <- guide$label.position %||% "right"
304-
if (!label.position %in% c("top", "bottom", "left", "right"))
313+
if (!label.position %in% c("top", "bottom", "left", "right")) {
305314
stop("label position \"", label.position, "\" is invalid")
315+
}
306316

307317
nbreak <- nrow(guide$key)
308318

@@ -313,7 +323,8 @@ guide_gengrob.legend <- function(guide, theme) {
313323
title.hjust <- guide$title.hjust %||% theme$legend.title.align %||% title.theme$hjust %||% 0
314324
title.vjust <- guide$title.vjust %||% title.theme$vjust %||% 0.5
315325

316-
grob.title <- ggname("guide.title",
326+
grob.title <- ggname(
327+
"guide.title",
317328
element_grob(
318329
title.theme,
319330
label = guide$title,
@@ -331,7 +342,7 @@ guide_gengrob.legend <- function(guide, theme) {
331342
# gap between keys etc
332343
# the default horizontal and vertical gap need to be the same to avoid strange
333344
# effects for certain guide layouts
334-
hgap <- width_cm(theme$legend.spacing.x %||% (0.5 * unit(title_fontsize, "pt")))
345+
hgap <- width_cm(theme$legend.spacing.x %||% (0.5 * unit(title_fontsize, "pt")))
335346
vgap <- height_cm(theme$legend.spacing.y %||% (0.5 * unit(title_fontsize, "pt")))
336347

337348
# Labels
@@ -391,7 +402,7 @@ guide_gengrob.legend <- function(guide, theme) {
391402
key_sizes <- apply(key_size_mat, 1, max)
392403

393404
if (!is.null(guide$nrow) && !is.null(guide$ncol) &&
394-
guide$nrow * guide$ncol < nbreak) {
405+
guide$nrow * guide$ncol < nbreak) {
395406
stop(
396407
"`nrow` * `ncol` needs to be larger than the number of breaks",
397408
call. = FALSE
@@ -515,7 +526,8 @@ guide_gengrob.legend <- function(guide, theme) {
515526
label.row = R * 2 - 1,
516527
label.col = C * 4 - 1
517528
)
518-
})
529+
}
530+
)
519531
} else {
520532
switch(
521533
label.position,
@@ -580,59 +592,65 @@ guide_gengrob.legend <- function(guide, theme) {
580592
label.row = R,
581593
label.col = C * 4 - 1
582594
)
583-
})
595+
}
596+
)
584597
}
585598

586599
# layout the title over key-label
587600
switch(guide$title.position,
588-
"top" = {
589-
widths <- c(kl_widths, max(0, title_width - sum(kl_widths)))
590-
heights <- c(title_height, vgap, kl_heights)
591-
vps <- transform(
592-
vps,
593-
key.row = key.row + 2,
594-
key.col = key.col,
595-
label.row = label.row + 2,
596-
label.col = label.col
597-
)
598-
vps.title.row = 1; vps.title.col = 1:length(widths)
599-
},
600-
"bottom" = {
601-
widths <- c(kl_widths, max(0, title_width - sum(kl_widths)))
602-
heights <- c(kl_heights, vgap, title_height)
603-
vps <- transform(
604-
vps,
605-
key.row = key.row,
606-
key.col = key.col,
607-
label.row = label.row,
608-
label.col = label.col
609-
)
610-
vps.title.row = length(heights); vps.title.col = 1:length(widths)
611-
},
612-
"left" = {
613-
widths <- c(title_width, hgap, kl_widths)
614-
heights <- c(kl_heights, max(0, title_height - sum(kl_heights)))
615-
vps <- transform(
616-
vps,
617-
key.row = key.row,
618-
key.col = key.col + 2,
619-
label.row = label.row,
620-
label.col = label.col + 2
621-
)
622-
vps.title.row = 1:length(heights); vps.title.col = 1
623-
},
624-
"right" = {
625-
widths <- c(kl_widths, hgap, title_width)
626-
heights <- c(kl_heights, max(0, title_height - sum(kl_heights)))
627-
vps <- transform(
628-
vps,
629-
key.row = key.row,
630-
key.col = key.col,
631-
label.row = label.row,
632-
label.col = label.col
633-
)
634-
vps.title.row = 1:length(heights); vps.title.col = length(widths)
635-
})
601+
"top" = {
602+
widths <- c(kl_widths, max(0, title_width - sum(kl_widths)))
603+
heights <- c(title_height, vgap, kl_heights)
604+
vps <- transform(
605+
vps,
606+
key.row = key.row + 2,
607+
key.col = key.col,
608+
label.row = label.row + 2,
609+
label.col = label.col
610+
)
611+
vps.title.row <- 1
612+
vps.title.col <- 1:length(widths)
613+
},
614+
"bottom" = {
615+
widths <- c(kl_widths, max(0, title_width - sum(kl_widths)))
616+
heights <- c(kl_heights, vgap, title_height)
617+
vps <- transform(
618+
vps,
619+
key.row = key.row,
620+
key.col = key.col,
621+
label.row = label.row,
622+
label.col = label.col
623+
)
624+
vps.title.row <- length(heights)
625+
vps.title.col <- 1:length(widths)
626+
},
627+
"left" = {
628+
widths <- c(title_width, hgap, kl_widths)
629+
heights <- c(kl_heights, max(0, title_height - sum(kl_heights)))
630+
vps <- transform(
631+
vps,
632+
key.row = key.row,
633+
key.col = key.col + 2,
634+
label.row = label.row,
635+
label.col = label.col + 2
636+
)
637+
vps.title.row <- 1:length(heights)
638+
vps.title.col <- 1
639+
},
640+
"right" = {
641+
widths <- c(kl_widths, hgap, title_width)
642+
heights <- c(kl_heights, max(0, title_height - sum(kl_heights)))
643+
vps <- transform(
644+
vps,
645+
key.row = key.row,
646+
key.col = key.col,
647+
label.row = label.row,
648+
label.col = label.col
649+
)
650+
vps.title.row <- 1:length(heights)
651+
vps.title.col <- length(widths)
652+
}
653+
)
636654

637655
# grob for key
638656
key_size <- c(key_width, key_height) * 10
@@ -738,9 +756,7 @@ label_just_defaults.legend <- function(direction, position) {
738756
"left" = list(hjust = 1, vjust = 0.5),
739757
list(hjust = 0, vjust = 0.5)
740758
)
741-
742759
}
743-
744760
}
745761

746762

‎R/layer.r

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -305,8 +305,11 @@ Layer <- ggproto("Layer", NULL,
305305
compute_geom_2 = function(self, data, plot) {
306306
if (empty(data)) return(data)
307307

308+
# evaluate defaults for theme
309+
defaults <- self$geom$eval_defaults(theme = plot$theme)
310+
308311
# Combine aesthetics, defaults, & params
309-
self$geom$use_defaults(data, self$aes_params, plot$theme)
312+
self$geom$use_defaults(data, defaults = defaults, params = self$aes_params)
310313
},
311314

312315
finish_statistics = function(self, data) {

0 commit comments

Comments
 (0)