Skip to content

Commit 5184f5e

Browse files
authored
Clean up orphan functions and tiny one-off helpers (#6022)
* replace single use internal functions * move helper to location where it is used * remove orphan functions * replace and remove redundant `adjust_breaks()` function * replace `df_rows()` with `vec_slice()` * inline `f_as_facets_list()` * inline `find_origin()` * inline `firstUpper()` * replace `has_name()` * replace `interleave()` with `vec_interleave()` * remove `cunion()` * inline `is_dotted_var()` * inline `is_facets()` * inline `is_labeller()` * inline `is_missing_arg()` * replace `is_npc()` (we partially backport `unitType()`) * inline `is_scalar_numeric()` * inline `is.margin()` * inline `is.sec_axis()` * inline `is.subclass()` * inline `is_triple_bang()` * remove `justify_grobs()` * inline `label_variable()` * more responsibility for `parse_axes_labeling()`, so that it is less distracting * remove `resolve_guide()` * inline revalue * simplify `scale_flip_position()` * remove `as.quoted()` (note there is still `as_quoted()`) * replace `simplify_formula()` with `simplify()` * inline `single_value()` * inline `update_guides()` * inline `is_column_vec()` and better name for `validate_column_vec()` * remove/replace `wrap_as_facets_list()` (by `compact_facets()` * finishing touches * `parse_axes_labeling` uses parent call * elaborate on regex pattern * Revert "inline `is_labeller()`" This reverts commit 9976913. * Revert "inline `is.sec_axis()`" This reverts commit 1bdc20d. * Revert "replace single use internal functions" This reverts commit 20fa50f. * Collection of test functions for user-facing components * apply tests when applicable * redocument * abolish `uniquecols()`'s rownames * move `is.*()` functions to class definitions
1 parent 171664b commit 5184f5e

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

59 files changed

+281
-660
lines changed

DESCRIPTION

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -276,7 +276,6 @@ Collate:
276276
'utilities-break.R'
277277
'utilities-grid.R'
278278
'utilities-help.R'
279-
'utilities-matrix.R'
280279
'utilities-patterns.R'
281280
'utilities-resolution.R'
282281
'utilities-tidy-eval.R'

NAMESPACE

Lines changed: 11 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -84,8 +84,6 @@ S3method(guide_train,default)
8484
S3method(guide_transform,default)
8585
S3method(heightDetails,titleGrob)
8686
S3method(heightDetails,zeroGrob)
87-
S3method(interleave,default)
88-
S3method(interleave,unit)
8987
S3method(limits,Date)
9088
S3method(limits,POSIXct)
9189
S3method(limits,POSIXlt)
@@ -126,8 +124,6 @@ S3method(scale_type,logical)
126124
S3method(scale_type,numeric)
127125
S3method(scale_type,ordered)
128126
S3method(scale_type,sfc)
129-
S3method(single_value,default)
130-
S3method(single_value,factor)
131127
S3method(summary,ggplot)
132128
S3method(vec_cast,character.mapped_discrete)
133129
S3method(vec_cast,double.mapped_discrete)
@@ -464,9 +460,20 @@ export(guide_transform)
464460
export(guides)
465461
export(has_flipped_aes)
466462
export(is.Coord)
463+
export(is.coord)
464+
export(is.element)
467465
export(is.facet)
466+
export(is.geom)
468467
export(is.ggplot)
469468
export(is.ggproto)
469+
export(is.guide)
470+
export(is.guides)
471+
export(is.layer)
472+
export(is.mapping)
473+
export(is.margin)
474+
export(is.position)
475+
export(is.scale)
476+
export(is.stat)
470477
export(is.theme)
471478
export(label_both)
472479
export(label_bquote)

R/aes-evaluation.R

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -219,12 +219,10 @@ stage_scaled <- function(start = NULL, after_stat = NULL, after_scale = NULL) {
219219
}
220220

221221
# Regex to determine if an identifier refers to a calculated aesthetic
222+
# The pattern includes ye olde '...var...' syntax, which was
223+
# deprecated in 3.4.0 in favour of `after_stat()`
222224
match_calculated_aes <- "^\\.\\.([a-zA-Z._]+)\\.\\.$"
223225

224-
is_dotted_var <- function(x) {
225-
grepl(match_calculated_aes, x)
226-
}
227-
228226
# Determine if aesthetic is calculated
229227
is_calculated_aes <- function(aesthetics, warn = FALSE) {
230228
vapply(aesthetics, is_calculated, warn = warn, logical(1), USE.NAMES = FALSE)
@@ -246,7 +244,8 @@ is_calculated <- function(x, warn = FALSE) {
246244
if (is.null(x) || is.atomic(x)) {
247245
FALSE
248246
} else if (is.symbol(x)) {
249-
res <- is_dotted_var(as.character(x))
247+
# Test if x is a dotted variable
248+
res <- grepl(match_calculated_aes, as.character(x))
250249
if (res && warn) {
251250
what <- I(paste0("The dot-dot notation (`", x, "`)"))
252251
var <- gsub(match_calculated_aes, "\\1", as.character(x))

R/aes.R

Lines changed: 13 additions & 2 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()) {
@@ -177,7 +181,12 @@ standardise_aes_names <- function(x) {
177181
x <- sub("color", "colour", x, fixed = TRUE)
178182

179183
# convert old-style aesthetics names to ggplot version
180-
revalue(x, ggplot_global$base_to_ggplot)
184+
convert <- ggplot_global$base_to_ggplot
185+
convert <- convert[names(convert) %in% x]
186+
if (length(convert) > 0) {
187+
x[match(names(convert), x)] <- convert
188+
}
189+
x
181190
}
182191

183192
# x is a list of aesthetic mappings, as generated by aes()
@@ -448,7 +457,9 @@ arg_enquos <- function(name, frame = caller_env()) {
448457
quo <- inject(enquo0(!!sym(name)), frame)
449458
expr <- quo_get_expr(quo)
450459

451-
if (!is_missing(expr) && is_triple_bang(expr)) {
460+
is_triple_bang <- !is_missing(expr) &&
461+
is_bang(expr) && is_bang(expr[[2]]) && is_bang(expr[[c(2, 2)]])
462+
if (is_triple_bang) {
452463
# Evaluate `!!!` operand and create a list of quosures
453464
env <- quo_get_env(quo)
454465
xs <- eval_bare(expr[[2]][[2]][[2]], env)

R/compat-plyr.R

Lines changed: 8 additions & 94 deletions
Original file line numberDiff line numberDiff line change
@@ -166,84 +166,7 @@ join_keys <- function(x, y, by) {
166166
list(x = keys[seq_len(n_x)], y = keys[n_x + seq_len(n_y)],
167167
n = attr(keys, "n"))
168168
}
169-
#' Replace specified values with new values, in a factor or character vector
170-
#'
171-
#' An easy to use substitution of elements in a string-like vector (character or
172-
#' factor). If `x` is a character vector the matching elements will be replaced
173-
#' directly and if `x` is a factor the matching levels will be replaced
174-
#'
175-
#' @param x A character or factor vector
176-
#' @param replace A named character vector with the names corresponding to the
177-
#' elements to replace and the values giving the replacement.
178-
#'
179-
#' @return A vector of the same class as `x` with the given values replaced
180-
#'
181-
#' @keywords internal
182-
#' @noRd
183-
#'
184-
revalue <- function(x, replace) {
185-
if (is.character(x)) {
186-
replace <- replace[names(replace) %in% x]
187-
if (length(replace) == 0) return(x)
188-
x[match(names(replace), x)] <- replace
189-
} else if (is.factor(x)) {
190-
lev <- levels(x)
191-
replace <- replace[names(replace) %in% lev]
192-
if (length(replace) == 0) return(x)
193-
lev[match(names(replace), lev)] <- replace
194-
levels(x) <- lev
195-
} else if (!is.null(x)) {
196-
stop_input_type(x, "a factor or character vector")
197-
}
198-
x
199-
}
200-
# Iterate through a formula and return a quoted version
201-
simplify_formula <- function(x) {
202-
if (length(x) == 2 && x[[1]] == as.name("~")) {
203-
return(simplify(x[[2]]))
204-
}
205-
if (length(x) < 3)
206-
return(list(x))
207-
op <- x[[1]]
208-
a <- x[[2]]
209-
b <- x[[3]]
210-
if (op == as.name("+") || op == as.name("*") || op ==
211-
as.name("~")) {
212-
c(simplify(a), simplify(b))
213-
}
214-
else if (op == as.name("-")) {
215-
c(simplify(a), bquote(-.(x), list(x = simplify(b))))
216-
}
217-
else {
218-
list(x)
219-
}
220-
}
221-
#' Create a quoted version of x
222-
#'
223-
#' This function captures the special meaning of formulas in the context of
224-
#' facets in ggplot2, where `+` have special meaning. It works as
225-
#' `plyr::as.quoted` but only for the special cases of `character`, `call`, and
226-
#' `formula` input as these are the only situations relevant for ggplot2.
227-
#'
228-
#' @param x A formula, string, or call to be quoted
229-
#' @param env The environment to a attach to the quoted expression.
230-
#'
231-
#' @keywords internal
232-
#' @noRd
233-
#'
234-
as.quoted <- function(x, env = parent.frame()) {
235-
x <- if (is.character(x)) {
236-
lapply(x, function(x) parse(text = x)[[1]])
237-
} else if (is.formula(x)) {
238-
simplify_formula(x)
239-
} else if (is.call(x)) {
240-
as.list(x)[-1]
241-
} else {
242-
cli::cli_abort("Must be a character vector, call, or formula.")
243-
}
244-
attributes(x) <- list(env = env, class = 'quoted')
245-
x
246-
}
169+
247170
# round a number to a given precision
248171
round_any <- function(x, accuracy, f = round) {
249172
check_numeric(x)
@@ -286,29 +209,20 @@ dapply <- function(df, by, fun, ..., drop = TRUE) {
286209
}
287210

288211
# Shortcut when only one group
289-
if (all(vapply(grouping_cols, single_value, logical(1)))) {
212+
has_single_group <- all(vapply(
213+
grouping_cols,
214+
function(x) identical(as.character(levels(x) %||% attr(x, "n")), "1"),
215+
logical(1)
216+
))
217+
if (has_single_group) {
290218
return(apply_fun(df))
291219
}
292220

293221
ids <- id(grouping_cols, drop = drop)
294222
group_rows <- split_with_index(seq_len(nrow(df)), ids)
295223
result <- lapply(seq_along(group_rows), function(i) {
296-
cur_data <- df_rows(df, group_rows[[i]])
224+
cur_data <- vec_slice(df, group_rows[[i]])
297225
apply_fun(cur_data)
298226
})
299227
vec_rbind0(!!!result)
300228
}
301-
302-
single_value <- function(x, ...) {
303-
UseMethod("single_value")
304-
}
305-
#' @export
306-
single_value.default <- function(x, ...) {
307-
# This is set by id() used in creating the grouping var
308-
identical(attr(x, "n"), 1L)
309-
}
310-
#' @export
311-
single_value.factor <- function(x, ...) {
312-
# Panels are encoded as factor numbers and can never be missing (NA)
313-
identical(levels(x), "1")
314-
}

R/coord-.R

Lines changed: 12 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -226,11 +226,18 @@ Coord <- ggproto("Coord",
226226
}
227227
)
228228

229-
#' Is this object a coordinate system?
230-
#'
231-
#' @export is.Coord
232-
#' @keywords internal
233-
is.Coord <- function(x) inherits(x, "Coord")
229+
230+
#' @export
231+
#' @rdname is_tests
232+
is.coord <- function(x) inherits(x, "Coord")
233+
234+
#' @export
235+
#' @rdname is_tests
236+
#' @usage is.Coord(x) # Deprecated
237+
is.Coord <- function(x) {
238+
deprecate_soft0("3.5.2", "is.Coord()", "is.coord()")
239+
is.coord(x)
240+
}
234241

235242
# Renders an axis with the correct orientation or zeroGrob if no axis should be
236243
# generated

R/coord-cartesian-.R

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

165165
panel_guides_grob <- function(guides, position, theme, labels = NULL) {
166-
if (!inherits(guides, "Guides")) {
166+
if (!is.guides(guides)) {
167167
return(zeroGrob())
168168
}
169169
pair <- guides$get_position(position)

R/coord-map.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -157,7 +157,7 @@ CoordMap <- ggproto("CoordMap", Coord,
157157

158158
transform = function(self, data, panel_params) {
159159
trans <- mproject(self, data$x, data$y, panel_params$orientation)
160-
out <- cunion(trans[c("x", "y")], data)
160+
out <- data_frame0(!!!defaults(trans[c("x", "y")], data))
161161

162162
out$x <- rescale(out$x, 0:1, panel_params$x.proj)
163163
out$y <- rescale(out$y, 0:1, panel_params$y.proj)

R/coord-sf.R

Lines changed: 9 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -545,11 +545,7 @@ coord_sf <- function(xlim = NULL, ylim = NULL, expand = TRUE,
545545
label_axes <- label_axes %|W|% ""
546546
}
547547

548-
if (is.character(label_axes)) {
549-
label_axes <- parse_axes_labeling(label_axes)
550-
} else if (!is.list(label_axes)) {
551-
cli::cli_abort("Panel labeling format not recognized.")
552-
}
548+
label_axes <- parse_axes_labeling(label_axes)
553549

554550
if (is.character(label_graticule)) {
555551
label_graticule <- unlist(strsplit(label_graticule, ""))
@@ -582,9 +578,14 @@ coord_sf <- function(xlim = NULL, ylim = NULL, expand = TRUE,
582578
)
583579
}
584580

585-
parse_axes_labeling <- function(x) {
586-
labs <- unlist(strsplit(x, ""))
587-
list(top = labs[1], right = labs[2], bottom = labs[3], left = labs[4])
581+
parse_axes_labeling <- function(x, call = caller_env()) {
582+
if (is.character(x)) {
583+
x <- unlist(strsplit(x, ""))
584+
x <- list(top = x[1], right = x[2], bottom = x[3], left = x[4])
585+
} else if (!is.list(x)) {
586+
cli::cli_abort("Panel labeling format not recognized.", call = call)
587+
}
588+
x
588589
}
589590

590591
# This function does two things differently from standard breaks:

0 commit comments

Comments
 (0)