Skip to content

Commit 836d820

Browse files
authored
Forward compatibility: is_*() functions (#6388)
1 parent 7960366 commit 836d820

34 files changed

+235
-117
lines changed

NAMESPACE

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -458,6 +458,21 @@ export(is.facet)
458458
export(is.ggplot)
459459
export(is.ggproto)
460460
export(is.theme)
461+
export(is_coord)
462+
export(is_element)
463+
export(is_facet)
464+
export(is_geom)
465+
export(is_ggplot)
466+
export(is_ggproto)
467+
export(is_guide)
468+
export(is_guides)
469+
export(is_layer)
470+
export(is_mapping)
471+
export(is_margin)
472+
export(is_position)
473+
export(is_scale)
474+
export(is_stat)
475+
export(is_theme)
461476
export(label_both)
462477
export(label_bquote)
463478
export(label_context)

NEWS.md

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,9 @@
11
# ggplot2 (development version)
22

3+
* Standardised test functions for important classes: `is_ggproto()`,
4+
`is_ggplot()`, `is_mapping()`, `is_layer()`, `is_geom()`, `is_stat()`,
5+
`is_position()`, `is_coord()`, `is_facet()`, `is_scale()`, `is_guide()`,
6+
`is_guides()`, `is_margin()`, `is_element()` and `is_theme()`.
37
* New `get_labs()` function for retrieving completed plot labels
48
(@teunbrand, #6008).
59
* New `get_geom_defaults()` for retrieving resolved default aesthetics.

R/aes.R

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -102,6 +102,10 @@ aes <- function(x, y, ...) {
102102
rename_aes(aes)
103103
}
104104

105+
#' @export
106+
#' @rdname is_tests
107+
is_mapping <- function(x) inherits(x, "uneval")
108+
105109
# Wrap symbolic objects in quosures but pull out constants out of
106110
# quosures for backward-compatibility
107111
new_aesthetic <- function(x, env = globalenv()) {

R/coord-.R

Lines changed: 11 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -204,11 +204,17 @@ Coord <- ggproto("Coord",
204204
}
205205
)
206206

207-
#' Is this object a coordinate system?
208-
#'
209-
#' @export is.Coord
210-
#' @keywords internal
211-
is.Coord <- function(x) inherits(x, "Coord")
207+
#' @export
208+
#' @rdname is_tests
209+
is_coord <- function(x) inheritS(x, "Coord")
210+
211+
#' @export
212+
#' @rdname is_tests
213+
#' @usage is.Coord(x) # Deprecated
214+
is.Coord <- function(x) {
215+
deprecate_soft0("3.5.2", "is.Coord()", "is_coord()")
216+
is_coord(x)
217+
}
212218

213219
# Renders an axis with the correct orientation or zeroGrob if no axis should be
214220
# generated

R/coord-cartesian-.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -159,7 +159,7 @@ view_scales_from_scale <- function(scale, coord_limits = NULL, expand = TRUE) {
159159
}
160160

161161
panel_guides_grob <- function(guides, position, theme, labels = NULL) {
162-
if (!inherits(guides, "Guides")) {
162+
if (!is_guides(guides)) {
163163
return(zeroGrob())
164164
}
165165
pair <- guides$get_position(position)

R/facet-.R

Lines changed: 10 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -239,13 +239,17 @@ vars <- function(...) {
239239
quos(...)
240240
}
241241

242+
#' @export
243+
#' @rdname is_tests
244+
is_facet <- function(x) inherits(x, "Facet")
242245

243-
#' Is this object a faceting specification?
244-
#'
245-
#' @param x object to test
246-
#' @keywords internal
247246
#' @export
248-
is.facet <- function(x) inherits(x, "Facet")
247+
#' @rdname is_tests
248+
#' @usage is.facet(x) # Deprecated
249+
is.facet <- function(x) {
250+
deprecate_soft0("3.5.2", "is.facet()", "is_facet()")
251+
is_facet(x)
252+
}
249253

250254
# A "special" value, currently not used but could be used to determine
251255
# if faceting is active
@@ -324,7 +328,7 @@ as_facets_list <- function(x) {
324328
}
325329

326330
validate_facets <- function(x) {
327-
if (inherits(x, "uneval")) {
331+
if (is_mapping(x)) {
328332
cli::cli_abort("Please use {.fn vars} to supply facet variables.")
329333
}
330334
# Native pipe have higher precedence than + so any type of gg object can be

R/fortify.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -82,7 +82,7 @@ fortify.default <- function(model, data, ...) {
8282
"or an object coercible by {{.fn fortify}}, or a valid ",
8383
"{{.cls data.frame}}-like object coercible by {{.fn as.data.frame}}"
8484
)
85-
if (inherits(model, "uneval")) {
85+
if (is_mapping(model)) {
8686
msg <- c(
8787
glue(msg0, ", not {obj_type_friendly(model)}."),
8888
"i" = "Did you accidentally pass {.fn aes} to the {.arg data} argument?"

R/geom-.R

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -222,6 +222,9 @@ Geom <- ggproto("Geom",
222222

223223
)
224224

225+
#' @export
226+
#' @rdname is_tests
227+
is_geom <- function(x) inherits(x, "Geom")
225228

226229
#' Graphical units
227230
#'

R/ggproto.R

Lines changed: 13 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -52,7 +52,7 @@
5252
#' self$x
5353
#' }
5454
#' )
55-
#' is.ggproto(Adder)
55+
#' is_ggproto(Adder)
5656
#'
5757
#' Adder$add(10)
5858
#' Adder$add(10)
@@ -88,7 +88,7 @@ ggproto <- function(`_class` = NULL, `_inherit` = NULL, ...) {
8888

8989
super <- find_super()
9090
if (!is.null(super)) {
91-
check_object(super, is.ggproto, "a {.cls ggproto} object", arg = "_inherit")
91+
check_object(super, is_ggproto, "a {.cls ggproto} object", arg = "_inherit")
9292
e$super <- find_super
9393
class(e) <- c(`_class`, class(super))
9494
} else {
@@ -106,10 +106,17 @@ ggproto_parent <- function(parent, self) {
106106
structure(list(parent = parent, self = self), class = "ggproto_parent")
107107
}
108108

109-
#' @param x An object to test.
110109
#' @export
111-
#' @rdname ggproto
112-
is.ggproto <- function(x) inherits(x, "ggproto")
110+
#' @rdname is_tests
111+
is_ggproto <- function(x) inherits(x, "ggproto")
112+
113+
#' @export
114+
#' @rdname is_tests
115+
#' @usage is.ggproto(x) # Deprecated
116+
is.ggproto <- function(x) {
117+
deprecate_soft0("3.5.2", "is.ggproto()", "is_ggproto()")
118+
is_ggproto(x)
119+
}
113120

114121
fetch_ggproto <- function(x, name) {
115122
res <- NULL
@@ -305,7 +312,7 @@ object_summaries <- function(x, exclude = NULL, flat = TRUE) {
305312
values <- vapply(obj_names, function(name) {
306313
obj <- x[[name]]
307314
if (is.function(obj)) "function"
308-
else if (is.ggproto(obj)) format(obj, flat = flat)
315+
else if (is_ggproto(obj)) format(obj, flat = flat)
309316
else if (is.environment(obj)) "environment"
310317
else if (is.null(obj)) "NULL"
311318
else if (is.atomic(obj)) trim(paste(as.character(obj), collapse = " "))

R/guide-.R

Lines changed: 7 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -50,7 +50,7 @@ new_guide <- function(..., available_aes = "any", super) {
5050

5151
# Validate theme settings
5252
if (!is.null(params$theme)) {
53-
check_object(params$theme, is.theme, what = "a {.cls theme} object")
53+
check_object(params$theme, is_theme, what = "a {.cls theme} object")
5454
validate_theme(params$theme, call = caller_env())
5555
params$direction <- params$direction %||% params$theme$legend.direction
5656
}
@@ -66,6 +66,10 @@ new_guide <- function(..., available_aes = "any", super) {
6666
)
6767
}
6868

69+
#' @export
70+
#' @rdname is_tests
71+
is_guide <- function(x) inherits(x, "Guide")
72+
6973
#' @section Guides:
7074
#'
7175
#' The `guide_*()` functions, such as `guide_legend()` return an object that
@@ -377,10 +381,10 @@ Guide <- ggproto(
377381
# Renders tickmarks
378382
build_ticks = function(key, elements, params, position = params$position,
379383
length = elements$ticks_length) {
380-
if (!inherits(elements, "element")) {
384+
if (!is_element(elements)) {
381385
elements <- elements$ticks
382386
}
383-
if (!inherits(elements, "element_line")) {
387+
if (!is_element(elements, "line")) {
384388
return(zeroGrob())
385389
}
386390

0 commit comments

Comments
 (0)