Skip to content

Commit 8b285a5

Browse files
teunbrandteunbrand
authored
Merge pull request #16 from teunbrand/S7_elements
S7 elements
2 parents 38ae287 + 4b7a189 commit 8b285a5

32 files changed

+824
-608
lines changed

‎DESCRIPTION

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -177,6 +177,8 @@ Collate:
177177
'grob-dotstack.R'
178178
'grob-null.R'
179179
'grouping.R'
180+
'properties.R'
181+
'margins.R'
180182
'theme-elements.R'
181183
'guide-.R'
182184
'guide-axis.R'
@@ -201,7 +203,6 @@ Collate:
201203
'layer-sf.R'
202204
'layout.R'
203205
'limits.R'
204-
'margins.R'
205206
'performance.R'
206207
'plot-build.R'
207208
'plot-construction.R'

‎NAMESPACE

Lines changed: 7 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,19 +1,25 @@
11
# Generated by roxygen2: do not edit by hand
22

3+
S3method("$","ggplot2::element")
34
S3method("$","ggplot2::gg")
45
S3method("$","ggplot2::theme")
56
S3method("$",ggproto)
67
S3method("$",ggproto_parent)
8+
S3method("$<-","ggplot2::element")
79
S3method("$<-","ggplot2::gg")
810
S3method("$<-","ggplot2::mapping")
11+
S3method("[","ggplot2::element")
912
S3method("[","ggplot2::gg")
1013
S3method("[","ggplot2::mapping")
1114
S3method("[",mapped_discrete)
15+
S3method("[<-","ggplot2::element")
1216
S3method("[<-","ggplot2::gg")
1317
S3method("[<-","ggplot2::mapping")
1418
S3method("[<-",mapped_discrete)
19+
S3method("[[","ggplot2::element")
1520
S3method("[[","ggplot2::gg")
1621
S3method("[[",ggproto)
22+
S3method("[[<-","ggplot2::element")
1723
S3method("[[<-","ggplot2::gg")
1824
S3method("[[<-","ggplot2::mapping")
1925
S3method(.DollarNames,ggproto)
@@ -23,12 +29,6 @@ S3method(autolayer,default)
2329
S3method(autoplot,default)
2430
S3method(c,mapped_discrete)
2531
S3method(drawDetails,zeroGrob)
26-
S3method(element_grob,element_blank)
27-
S3method(element_grob,element_line)
28-
S3method(element_grob,element_point)
29-
S3method(element_grob,element_polygon)
30-
S3method(element_grob,element_rect)
31-
S3method(element_grob,element_text)
3232
S3method(format,ggproto)
3333
S3method(format,ggproto_method)
3434
S3method(fortify,"NULL")
@@ -75,10 +75,6 @@ S3method(limits,character)
7575
S3method(limits,factor)
7676
S3method(limits,numeric)
7777
S3method(makeContext,dotstackGrob)
78-
S3method(merge_element,default)
79-
S3method(merge_element,element)
80-
S3method(merge_element,element_blank)
81-
S3method(merge_element,margin)
8278
S3method(pattern_alpha,GridPattern)
8379
S3method(pattern_alpha,GridTilingPattern)
8480
S3method(pattern_alpha,default)
@@ -330,6 +326,7 @@ export(draw_key_vline)
330326
export(draw_key_vpath)
331327
export(dup_axis)
332328
export(el_def)
329+
export(element)
333330
export(element_blank)
334331
export(element_geom)
335332
export(element_grob)

‎R/coord-sf.R

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -334,13 +334,13 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
334334

335335
# we don't draw the graticules if the major panel grid is
336336
# turned off
337-
if (inherits(el, "element_blank")) {
337+
if (is_theme_element(el, "blank")) {
338338
grobs <- list(element_render(theme, "panel.background"))
339339
} else {
340340
line_gp <- gg_par(
341-
col = el$colour,
342-
lwd = el$linewidth,
343-
lty = el$linetype
341+
col = el@colour,
342+
lwd = el@linewidth,
343+
lty = el@linetype
344344
)
345345
grobs <- c(
346346
list(element_render(theme, "panel.background")),

‎R/geom-.R

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -245,7 +245,7 @@ eval_from_theme <- function(aesthetics, theme, class = NULL) {
245245
return(aesthetics)
246246
}
247247

248-
element <- calc_element("geom", theme) %||% .default_geom_element
248+
el <- calc_element("geom", theme) %||% .default_geom_element
249249
class <- setdiff(class, c("Geom", "ggproto", "gg"))
250250

251251
if (length(class) > 0) {
@@ -260,12 +260,12 @@ eval_from_theme <- function(aesthetics, theme, class = NULL) {
260260
# Inherit up to parent geom class
261261
if (length(class) > 0) {
262262
for (cls in rev(class)) {
263-
element <- combine_elements(theme[[cls]], element)
263+
el <- combine_elements(theme[[cls]], el)
264264
}
265265
}
266266
}
267267

268-
lapply(aesthetics[themed], eval_tidy, data = element)
268+
lapply(aesthetics[themed], eval_tidy, data = S7::props(el))
269269
}
270270

271271
#' Graphical units

‎R/geom-label.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -88,7 +88,7 @@ GeomLabel <- ggproto("GeomLabel", Geom,
8888
data <- coord$transform(data, panel_params)
8989
data$vjust <- compute_just(data$vjust, data$y, data$x, data$angle)
9090
data$hjust <- compute_just(data$hjust, data$x, data$y, data$angle)
91-
if (!is_margin("margin")) {
91+
if (!is_margin(label.padding)) {
9292
label.padding <- rep(label.padding, length.out = 4)
9393
}
9494

‎R/guide-.R

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -376,6 +376,7 @@ Guide <- ggproto(
376376
# Renders tickmarks
377377
build_ticks = function(key, elements, params, position = params$position,
378378
length = elements$ticks_length) {
379+
force(length)
379380
if (!is_theme_element(elements)) {
380381
elements <- elements$ticks
381382
}

‎R/guide-axis-logticks.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -119,7 +119,7 @@ guide_axis_logticks <- function(
119119
allow_null = TRUE
120120
)
121121
check_bool(expanded)
122-
check_inherits(short.theme, c("element_blank", "element_line"))
122+
check_inherits(short.theme, c("ggplot2::element_blank", "ggplot2::element_line"))
123123

124124
new_guide(
125125
available_aes = c("x", "y"),

‎R/guide-axis-theta.R

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -154,7 +154,7 @@ GuideAxisTheta <- ggproto(
154154
}
155155

156156
offset <- max(unit(0, "pt"), elements$major_length, elements$minor_length)
157-
elements$offset <- offset + max(elements$text$margin %||% unit(0, "pt"))
157+
elements$offset <- offset + max(elements$text@margin %||% unit(0, "pt"))
158158
elements
159159
},
160160

@@ -184,7 +184,7 @@ GuideAxisTheta <- ggproto(
184184

185185
build_labels = function(key, elements, params) {
186186

187-
if (inherits(elements$text, "element_blank")) {
187+
if (is_theme_element(elements$text, "blank")) {
188188
return(zeroGrob())
189189
}
190190

@@ -198,7 +198,7 @@ GuideAxisTheta <- ggproto(
198198

199199
# Resolve text angle
200200
if (is.waiver(params$angle) || is.null(params$angle)) {
201-
angle <- elements$text$angle
201+
angle <- elements$text@angle
202202
} else {
203203
angle <- flip_text_angle(params$angle - rad2deg(key$theta))
204204
}
@@ -268,20 +268,20 @@ GuideAxisTheta <- ggproto(
268268
key <- params$key
269269
key <- vec_slice(key, !is.na(key$.label) & nzchar(key$.label))
270270
labels <- validate_labels(key$.label)
271-
if (length(labels) == 0 || inherits(elements$text, "element_blank")) {
271+
if (length(labels) == 0 || is_theme_element(elements$text, "blank")) {
272272
return(list(offset = offset))
273273
}
274274

275275
# Resolve text angle
276276
if (is.waiver(params$angle %||% waiver())) {
277-
angle <- elements$text$angle
277+
angle <- elements$text@angle
278278
} else {
279279
angle <- flip_text_angle(params$angle - rad2deg(key$theta))
280280
}
281281
angle <- key$theta + deg2rad(angle)
282282

283283
# Set margin
284-
margin <- rep(max(elements$text$margin), length.out = 4)
284+
margin <- rep(max(elements$text@margin), length.out = 4)
285285

286286
# Measure size of each individual label
287287
single_labels <- lapply(labels, function(lab) {
@@ -365,7 +365,7 @@ GuideAxisTheta <- ggproto(
365365

366366
theta_tickmarks <- function(key, element, length, offset = NULL) {
367367
n_breaks <- nrow(key)
368-
if (n_breaks < 1 || inherits(element, "element_blank")) {
368+
if (n_breaks < 1 || is_theme_element(element, "blank")) {
369369
return(zeroGrob())
370370
}
371371

‎R/guide-axis.R

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -259,10 +259,10 @@ GuideAxis <- ggproto(
259259
override_elements = function(params, elements, theme) {
260260
elements$text <-
261261
label_angle_heuristic(elements$text, params$position, params$angle)
262-
if (inherits(elements$ticks, "element_blank")) {
262+
if (is_theme_element(elements$ticks, "blank")) {
263263
elements$major_length <- unit(0, "cm")
264264
}
265-
if (inherits(elements$minor, "element_blank") || isFALSE(params$minor.ticks)) {
265+
if (is_theme_element(elements$minor, "blank") || isFALSE(params$minor.ticks)) {
266266
elements$minor_length <- unit(0, "cm")
267267
}
268268
return(elements)
@@ -379,7 +379,7 @@ GuideAxis <- ggproto(
379379
# Ticks
380380
major_cm <- convertUnit(elements$major_length, "cm", valueOnly = TRUE)
381381
range <- range(0, major_cm)
382-
if (params$minor.ticks && !inherits(elements$minor, "element_blank")) {
382+
if (params$minor.ticks && !is_theme_element(elements$minor, "blank")) {
383383
minor_cm <- convertUnit(elements$minor_length, "cm", valueOnly = TRUE)
384384
range <- range(range, minor_cm)
385385
}
@@ -450,13 +450,13 @@ GuideAxis <- ggproto(
450450
# rather than dimensions of this axis alone.
451451
if (has_labels && params$position %in% c("left", "right")) {
452452
where <- layout$l[-c(1, length(layout$l))]
453-
just <- with(elements$text, rotate_just(angle, hjust, vjust))$hjust %||% 0.5
453+
just <- with(S7::props(elements$text), rotate_just(angle, hjust, vjust))$hjust %||% 0.5
454454
gt <- gtable_add_cols(gt, unit(just, "null"), pos = min(where) - 1)
455455
gt <- gtable_add_cols(gt, unit(1 - just, "null"), pos = max(where) + 1)
456456
}
457457
if (has_labels && params$position %in% c("top", "bottom")) {
458458
where <- layout$t[-c(1, length(layout$t))]
459-
just <- with(elements$text, rotate_just(angle, hjust, vjust))$vjust %||% 0.5
459+
just <- with(S7::props(elements$text), rotate_just(angle, hjust, vjust))$vjust %||% 0.5
460460
gt <- gtable_add_rows(gt, unit(1 - just, "null"), pos = min(where) - 1)
461461
gt <- gtable_add_rows(gt, unit(just, "null"), pos = max(where) + 1)
462462
}
@@ -590,7 +590,7 @@ axis_label_priority_between <- function(x, y) {
590590
#' overridden from the user- or theme-supplied element.
591591
#' @noRd
592592
label_angle_heuristic <- function(element, position, angle) {
593-
if (!inherits(element, "element_text")
593+
if (!is_theme_element(element, "text")
594594
|| is.null(position)
595595
|| is.null(angle %|W|% NULL)) {
596596
return(element)
@@ -612,8 +612,8 @@ label_angle_heuristic <- function(element, position, angle) {
612612
hjust <- switch(position, left = cosine, right = 1 - cosine, top = 1 - sine, sine)
613613
vjust <- switch(position, left = 1 - sine, right = sine, top = 1 - cosine, cosine)
614614

615-
element$angle <- angle %||% element$angle
616-
element$hjust <- hjust %||% element$hjust
617-
element$vjust <- vjust %||% element$vjust
615+
element@angle <- angle %||% element@angle
616+
element@hjust <- hjust %||% element@hjust
617+
element@vjust <- vjust %||% element@vjust
618618
element
619619
}

‎R/guide-custom.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -113,7 +113,7 @@ GuideCustom <- ggproto(
113113

114114
gt <- self$add_title(
115115
gt, title, title_position,
116-
with(elems$title, rotate_just(angle, hjust, vjust))
116+
with(S7::props(elems$title), rotate_just(angle, hjust, vjust))
117117
)
118118

119119
# Add padding and background

‎R/guide-legend.R

Lines changed: 7 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -325,7 +325,7 @@ GuideLegend <- ggproto(
325325
# Resolve title. The trick here is to override the main text element, so
326326
# that any settings declared in `legend.title` will be honoured but we have
327327
# custom defaults for the guide.
328-
margin <- calc_element("text", theme)$margin
328+
margin <- calc_element("text", theme)@margin
329329
title <- theme(text = element_text(
330330
hjust = 0, vjust = 0.5,
331331
margin = position_margin(title_position, margin, gap)
@@ -573,7 +573,7 @@ GuideLegend <- ggproto(
573573

574574
gt <- self$add_title(
575575
gt, grobs$title, elements$title_position,
576-
with(elements$title, rotate_just(angle, hjust, vjust))
576+
with(S7::props(elements$title), rotate_just(angle, hjust, vjust))
577577
)
578578

579579
gt <- gtable_add_padding(gt, unit(elements$padding, "cm"))
@@ -690,13 +690,17 @@ keep_key_data <- function(key, data, aes, show) {
690690

691691
position_margin <- function(position, margin = NULL, gap = unit(0, "pt")) {
692692
margin <- margin %||% margin()
693-
switch(
693+
margin <- switch(
694694
position,
695695
top = replace(margin, 3, margin[3] + gap),
696696
bottom = replace(margin, 1, margin[1] + gap),
697697
left = replace(margin, 2, margin[2] + gap),
698698
right = replace(margin, 4, margin[4] + gap)
699699
)
700+
# We have to manually reconstitute the class because the 'simpleUnit' class
701+
# might be dropped by the replacement operation.
702+
class(margin) <- c("ggplot2::margin", class(margin), "S7_object")
703+
margin
700704
}
701705

702706
# Function implementing backward compatibility with the old way of specifying

‎R/margins.R

Lines changed: 10 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,17 +1,21 @@
1+
#' @include properties.R
2+
13
#' @param t,r,b,l Dimensions of each margin. (To remember order, think trouble).
24
#' @param unit Default units of dimensions. Defaults to "pt" so it
35
#' can be most easily scaled with the text.
46
#' @rdname element
57
#' @export
6-
margin <- function(t = 0, r = 0, b = 0, l = 0, unit = "pt") {
7-
u <- unit(c(t, r, b, l), unit)
8-
class(u) <- c("margin", class(u))
9-
u
10-
}
8+
margin <- S7::new_class(
9+
"margin", parent = S7::new_S3_class(c("simpleUnit", "unit", "unit_v2")),
10+
constructor = function(t = 0, r = 0, b = 0, l = 0, unit = "pt") {
11+
u <- unit(c(t, r, b, l), unit)
12+
S7::new_object(u)
13+
}
14+
)
1115

1216
#' @export
1317
#' @rdname is_tests
14-
is_margin <- function(x) inherits(x, "margin")
18+
is_margin <- function(x) S7::S7_inherits(x, margin)
1519
is.margin <- function(x) lifecycle::deprecate_stop("3.5.2", "is.margin()", "is_margin()")
1620

1721
#' @rdname element

‎R/plot-build.R

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -337,7 +337,7 @@ table_add_tag <- function(table, label, theme) {
337337
return(table)
338338
}
339339
element <- calc_element("plot.tag", theme)
340-
if (inherits(element, "element_blank")) {
340+
if (is_theme_element(element, "blank")) {
341341
return(table)
342342
}
343343

@@ -382,20 +382,20 @@ table_add_tag <- function(table, label, theme) {
382382
if (location %in% c("plot", "panel")) {
383383
if (!is.numeric(position)) {
384384
if (right || left) {
385-
x <- (1 - element$hjust) * width
385+
x <- (1 - element@hjust) * width
386386
if (right) {
387387
x <- unit(1, "npc") - x
388388
}
389389
} else {
390-
x <- unit(element$hjust, "npc")
390+
x <- unit(element@hjust, "npc")
391391
}
392392
if (top || bottom) {
393-
y <- (1 - element$vjust) * height
393+
y <- (1 - element@vjust) * height
394394
if (top) {
395395
y <- unit(1, "npc") - y
396396
}
397397
} else {
398-
y <- unit(element$vjust, "npc")
398+
y <- unit(element@vjust, "npc")
399399
}
400400
} else {
401401
x <- unit(position[1], "npc")

‎R/plot-construction.R

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -96,7 +96,7 @@ add_ggplot <- function(p, object, objectname) {
9696
#' Add custom objects to ggplot
9797
#'
9898
#' This generic allows you to add your own methods for adding custom objects to
99-
#' a ggplot with [+.gg].
99+
#' a ggplot with [+.gg][add_gg].
100100
#'
101101
#' @param object An object to add to the plot
102102
#' @param plot The ggplot object to add `object` to
@@ -115,7 +115,9 @@ add_ggplot <- function(p, object, objectname) {
115115
#' @keywords internal
116116
#' @export
117117
#' @examples
118-
#' S7::method(ggplot_add, list(S7::new_S3_class("element_text"), class_ggplot)) <-
118+
#' # making a new method for the generic
119+
#' # in this example, we enable adding text elements
120+
#' S7::method(ggplot_add, list(element_text, class_ggplot)) <-
119121
#' function(object, plot, ...) {
120122
#' plot + theme(text = object)
121123
#' }
@@ -126,7 +128,6 @@ add_ggplot <- function(p, object, objectname) {
126128
#' element_text(colour = "red")
127129
#'
128130
#' # clean-up
129-
#' rm("element_text", envir = ggplot_add@methods)
130131
ggplot_add <- S7::new_generic("ggplot_add", c("object", "plot"))
131132

132133
S7::method(ggplot_add, list(S7::class_any, class_ggplot)) <-

0 commit comments

Comments
 (0)