Skip to content

Adopt S7 in most places #6364

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

Open
wants to merge 32 commits into
base: main
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
32 commits
Select commit Hold shift + click to select a range
0154671
import S7
teunbrand Mar 10, 2025
b4163e0
convert theme to S7
teunbrand Mar 10, 2025
7fce100
Reimplement S3 <uneval> into S7 <mapping>
teunbrand Mar 10, 2025
32ccdb2
convert labels to S7
teunbrand Mar 11, 2025
032ca6a
make S7 class_ggplot
teunbrand Mar 12, 2025
c37317b
Use `@` as accessor
teunbrand Mar 12, 2025
90d644f
double dispatch for `ggplot_add()`
teunbrand Mar 13, 2025
0310be8
Write methods for external generics as S7
teunbrand Mar 13, 2025
2607597
backward compatibility for ggplot class
teunbrand Mar 13, 2025
30b1118
Implement <ggplot_built> as S7
teunbrand Mar 14, 2025
ef5db54
implement `as.gtable` methods
teunbrand Mar 14, 2025
206c394
rename mapping to class_mapping
teunbrand Mar 14, 2025
53504c3
refine class_ggplot_built and related functions
teunbrand Mar 14, 2025
bbdc7a5
also access ggplot_built slots with normal extractors
teunbrand Mar 14, 2025
2f06dd5
resolve gnarlyness in S3/S7 method conflicts
teunbrand Mar 14, 2025
39765cd
fix esoteric 'promise already under evaluation' error
teunbrand Mar 17, 2025
07ebce6
fix series of minor issues
teunbrand Mar 17, 2025
fece790
export theme as class
teunbrand Mar 17, 2025
f8ed252
export labels class
teunbrand Mar 17, 2025
8fde6e8
collect classes in one place
teunbrand Mar 17, 2025
5453b28
revert @include decisions
teunbrand Mar 17, 2025
9736300
Make S7 generic of `get_alt_text()`
teunbrand Mar 17, 2025
028068f
backport `@`
teunbrand Mar 17, 2025
c754551
exempt classes from pkgdown
teunbrand Mar 17, 2025
9acc1ee
lol at my incompetence
teunbrand Mar 17, 2025
edda7e4
resolve merge conflict
teunbrand Mar 28, 2025
5d41f0e
allow variant error messages
teunbrand Mar 31, 2025
77cb52d
workaround for old R versions
teunbrand Mar 31, 2025
8177f06
update pkgdown index
teunbrand Mar 31, 2025
c8a0683
resolve merge conflict
teunbrand Apr 16, 2025
69ae934
use `is_theme()`
teunbrand Apr 16, 2025
67dae2d
sprinkle notes
teunbrand Apr 16, 2025
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: 2 additions & 0 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -39,6 +39,7 @@ Imports:
isoband,
lifecycle (> 1.0.1),
rlang (>= 1.1.0),
S7,
scales (>= 1.3.0),
stats,
vctrs (>= 0.6.0),
Expand Down Expand Up @@ -93,6 +94,7 @@ Collate:
'compat-plyr.R'
'utilities.R'
'aes.R'
'all-classes.R'
'utilities-checks.R'
'legend-draw.R'
'geom-.R'
Expand Down
56 changes: 20 additions & 36 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,20 +1,23 @@
# Generated by roxygen2: do not edit by hand

S3method("$","ggplot2::gg")
S3method("$","ggplot2::theme")
S3method("$",ggproto)
S3method("$",ggproto_parent)
S3method("$",theme)
S3method("$<-",uneval)
S3method("+",gg)
S3method("$<-","ggplot2::gg")
S3method("$<-","ggplot2::mapping")
S3method("[","ggplot2::gg")
S3method("[","ggplot2::mapping")
S3method("[",mapped_discrete)
S3method("[",uneval)
S3method("[<-","ggplot2::gg")
S3method("[<-","ggplot2::mapping")
S3method("[<-",mapped_discrete)
S3method("[<-",uneval)
S3method("[[","ggplot2::gg")
S3method("[[",ggproto)
S3method("[[<-",uneval)
S3method("[[<-","ggplot2::gg")
S3method("[[<-","ggplot2::mapping")
S3method(.DollarNames,ggproto)
S3method(as.data.frame,mapped_discrete)
S3method(as.gtable,ggplot)
S3method(as.gtable,ggplot_built)
S3method(as.list,ggproto)
S3method(autolayer,default)
S3method(autoplot,default)
Expand Down Expand Up @@ -51,30 +54,7 @@ S3method(fortify,sfg)
S3method(fortify,summary.glht)
S3method(fortify,tbl)
S3method(fortify,tbl_df)
S3method(get_alt_text,ggplot)
S3method(get_alt_text,ggplot_built)
S3method(get_alt_text,gtable)
S3method(ggplot,"function")
S3method(ggplot,default)
S3method(ggplot_add,"NULL")
S3method(ggplot_add,"function")
S3method(ggplot_add,Coord)
S3method(ggplot_add,Facet)
S3method(ggplot_add,Guides)
S3method(ggplot_add,Layer)
S3method(ggplot_add,Scale)
S3method(ggplot_add,by)
S3method(ggplot_add,data.frame)
S3method(ggplot_add,default)
S3method(ggplot_add,labels)
S3method(ggplot_add,list)
S3method(ggplot_add,theme)
S3method(ggplot_add,uneval)
S3method(ggplot_build,ggplot)
S3method(ggplot_build,ggplot_built)
S3method(ggplot_gtable,ggplot_built)
S3method(grid.draw,absoluteGrob)
S3method(grid.draw,ggplot)
S3method(grobHeight,absoluteGrob)
S3method(grobHeight,zeroGrob)
S3method(grobWidth,absoluteGrob)
Expand Down Expand Up @@ -103,19 +83,18 @@ S3method(pattern_alpha,GridPattern)
S3method(pattern_alpha,GridTilingPattern)
S3method(pattern_alpha,default)
S3method(pattern_alpha,list)
S3method(plot,ggplot)
S3method(predictdf,default)
S3method(predictdf,glm)
S3method(predictdf,locfit)
S3method(predictdf,loess)
S3method(print,"ggplot2::ggplot")
S3method(print,"ggplot2::mapping")
S3method(print,"ggplot2::theme")
S3method(print,element)
S3method(print,ggplot)
S3method(print,ggplot2_bins)
S3method(print,ggproto)
S3method(print,ggproto_method)
S3method(print,rel)
S3method(print,theme)
S3method(print,uneval)
S3method(scale_type,Date)
S3method(scale_type,POSIXt)
S3method(scale_type,character)
Expand All @@ -129,7 +108,6 @@ S3method(scale_type,logical)
S3method(scale_type,numeric)
S3method(scale_type,ordered)
S3method(scale_type,sfc)
S3method(summary,ggplot)
S3method(vec_cast,character.mapped_discrete)
S3method(vec_cast,double.mapped_discrete)
S3method(vec_cast,factor.mapped_discrete)
Expand Down Expand Up @@ -308,6 +286,11 @@ export(binned_scale)
export(borders)
export(calc_element)
export(check_device)
export(class_ggplot)
export(class_ggplot_built)
export(class_labels)
export(class_mapping)
export(class_theme)
export(combine_vars)
export(complete_theme)
export(continuous_scale)
Expand Down Expand Up @@ -766,6 +749,7 @@ export(xlim)
export(ylab)
export(ylim)
export(zeroGrob)
if (getRversion() < "4.3.0") importFrom("S7", "@")
import(grid)
import(gtable)
import(rlang)
Expand Down
51 changes: 21 additions & 30 deletions R/aes.R
Original file line number Diff line number Diff line change
Expand Up @@ -46,8 +46,8 @@ NULL
#' 'AsIs' variables.
#'
#' @family aesthetics documentation
#' @return A list with class `uneval`. Components of the list are either
#' quosures or constants.
#' @return An S7 object representing a list with class `mapping`. Components of
#' the list are either quosures or constants.
#' @export
#' @examples
#' aes(x = mpg, y = wt)
Expand Down Expand Up @@ -105,13 +105,12 @@ aes <- function(x, y, ...) {
inject(aes(!!!args))
})

aes <- new_aes(args, env = parent.frame())
rename_aes(aes)
class_mapping(rename_aes(args), env = parent.frame())
}

#' @export
#' @rdname is_tests
is_mapping <- function(x) inherits(x, "uneval")
is_mapping <- function(x) S7::S7_inherits(x, class_mapping)

# Wrap symbolic objects in quosures but pull out constants out of
# quosures for backward-compatibility
Expand All @@ -130,14 +129,10 @@ new_aesthetic <- function(x, env = globalenv()) {

x
}
new_aes <- function(x, env = globalenv()) {
check_object(x, is.list, "a {.cls list}")
x <- lapply(x, new_aesthetic, env = env)
structure(x, class = "uneval")
}

#' @export
print.uneval <- function(x, ...) {
# TODO: should convert to proper S7 method once bug in S7 is resolved
`print.ggplot2::mapping` <- function(x, ...) {
Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

When we have an S3 generic we need for both S3 and S7 objects, we need to implement methods for the S7 objects in the S3 fashion, because using S7::method() will invalidate the S3 methods.

cat("Aesthetic mapping: \n")

if (length(x) == 0) {
Expand All @@ -152,26 +147,24 @@ print.uneval <- function(x, ...) {
invisible(x)
}

# TODO: should convert to proper S7 method once bug in S7 is resolved
#' @export
"[.uneval" <- function(x, i, ...) {
new_aes(NextMethod())
"[.ggplot2::mapping" <- function(x, i, ...) {
class_mapping(NextMethod())
}

# If necessary coerce replacements to quosures for compatibility
#' @export
"[[<-.uneval" <- function(x, i, value) {
new_aes(NextMethod())
"[[<-.ggplot2::mapping" <- function(x, i, value) {
class_mapping(NextMethod())
}
#' @export
"$<-.uneval" <- function(x, i, value) {
# Can't use NextMethod() because of a bug in R 3.1
x <- unclass(x)
x[[i]] <- value
new_aes(x)
"$<-.ggplot2::mapping" <- function(x, i, value) {
class_mapping(NextMethod())
}
#' @export
"[<-.uneval" <- function(x, i, value) {
new_aes(NextMethod())
"[<-.ggplot2::mapping" <- function(x, i, value) {
class_mapping(NextMethod())
}

#' Standardise aesthetic names
Expand Down Expand Up @@ -212,8 +205,7 @@ substitute_aes <- function(x, fun = standardise_aes_symbols, ...) {
x <- lapply(x, function(aesthetic) {
as_quosure(fun(quo_get_expr(aesthetic), ...), env = environment(aesthetic))
})
class(x) <- "uneval"
x
class_mapping(x)
}
# x is a quoted expression from inside aes()
standardise_aes_symbols <- function(x) {
Expand Down Expand Up @@ -311,7 +303,7 @@ aes_ <- function(x, y, ...) {
}
}
mapping <- lapply(mapping, as_quosure_aes)
structure(rename_aes(mapping), class = "uneval")
class_mapping(rename_aes(mapping))
}

#' @rdname aes_
Expand All @@ -337,7 +329,7 @@ aes_string <- function(x, y, ...) {
new_aesthetic(x, env = caller_env)
})

structure(rename_aes(mapping), class = "uneval")
class_mapping(rename_aes(mapping))
}

#' @export
Expand All @@ -358,10 +350,9 @@ aes_all <- function(vars) {

# Quosure the symbols in the empty environment because they can only
# refer to the data mask
structure(
lapply(vars, function(x) new_quosure(as.name(x), emptyenv())),
class = c("unlabelled_uneval", "uneval")
)
x <- class_mapping(lapply(vars, function(x) new_quosure(as.name(x), emptyenv())))
class(x) <- union("unlabelled", class(x))
x
}

#' Automatic aesthetic mapping
Expand Down
Loading