Use lengths() where appropriate (tidyverse#5210)

Author: teunbrand

R/annotation.r

@@ -56,7 +56,7 @@ annotate <- function(geom, x = NULL, y = NULL, xmin = NULL, xmax = NULL,
   aesthetics <- c(position, list(...))
 
   # Check that all aesthetic have compatible lengths
-  lengths <- vapply(aesthetics, length, integer(1))
+  lengths <- lengths(aesthetics)
   n <- unique0(lengths)
 
   # if there is more than one unique length, ignore constants

R/compat-plyr.R

@@ -91,7 +91,7 @@ id <- function(.variables, drop = FALSE) {
     nrows <- nrow(.variables)
     .variables <- unclass(.variables)
   }
-  lengths <- vapply(.variables, length, integer(1))
+  lengths <- lengths(.variables)
   .variables <- .variables[lengths != 0]
   if (length(.variables) == 0) {
     n <- nrows %||% 0L

R/geom-.r

@@ -230,7 +230,7 @@ NULL
 .stroke <- 96 / 25.4
 
 check_aesthetics <- function(x, n) {
-  ns <- vapply(x, length, integer(1))
+  ns <- lengths(x)
   good <- ns == 1L | ns == n
 
   if (all(good)) {

R/guide-bins.R

@@ -240,7 +240,7 @@ guide_geom.bins <- function(guide, layers, default_mapping) {
 
     if (length(matched) > 0) {
       # Filter out set aesthetics that can't be applied to the legend
-      n <- vapply(layer$aes_params, length, integer(1))
+      n <- lengths(layer$aes_params)
       params <- layer$aes_params[n == 1]
 
       aesthetics <- layer$computed_mapping

R/guide-legend.r

@@ -259,7 +259,7 @@ guide_geom.legend <- function(guide, layers, default_mapping) {
 
     if (length(matched) > 0) {
       # Filter out set aesthetics that can't be applied to the legend
-      n <- vapply(layer$aes_params, length, integer(1))
+      n <- lengths(layer$aes_params)
       params <- layer$aes_params[n == 1]
 
       aesthetics <- layer$computed_mapping

R/layer.r

@@ -297,7 +297,7 @@ Layer <- ggproto("Layer", NULL,
       if (length(evaled) == 0) {
         n <- 0
       } else {
-        aes_n <- vapply(evaled, length, integer(1))
+        aes_n <- lengths(evaled)
         n <- if (min(aes_n) == 0) 0L else max(aes_n)
       }
     }

R/limits.r

@@ -189,7 +189,7 @@ expand_limits <- function(...) {
   data <- unlist(c(list(data[!data_dfs]), data[data_dfs]), recursive = FALSE)
 
   # Repeat vectors up to max length and collect to data frame
-  n_rows <- max(vapply(data, length, integer(1)))
+  n_rows <- max(lengths(data))
   data <- lapply(data, rep, length.out = n_rows)
   data <- data_frame0(!!!data)
 

R/scale-.r

@@ -747,7 +747,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale,
     }
     if (is.list(labels)) {
       # Guard against list with empty elements
-      labels[vapply(labels, length, integer(1)) == 0] <- ""
+      labels[lengths(labels) == 0] <- ""
       # Make sure each element is scalar
       labels <- lapply(labels, `[`, 1)
 

R/scale-hue.r

@@ -176,7 +176,7 @@ qualitative_pal <- function(type, h, c, l, h.start, direction) {
     if (!all(vapply(type_list, is.character, logical(1)))) {
       cli::cli_abort("{.arg type} must be a character vector or a list of character vectors")
     }
-    type_lengths <- vapply(type_list, length, integer(1))
+    type_lengths <- lengths(type_list)
     # If there are more levels than color codes default to hue_pal()
     if (max(type_lengths) < n) {
       return(scales::hue_pal(h, c, l, h.start, direction)(n))

R/stat-summary-2d.r

@@ -134,7 +134,7 @@ tapply_df <- function(x, index, fun, ..., drop = TRUE) {
   out$value <- unlist(lapply(grps, fun, ...))
 
   if (drop) {
-    n <- vapply(grps, length, integer(1))
+    n <- lengths(grps)
     out <- out[n > 0, , drop = FALSE]
   }
 

R/utilities.r

@@ -27,7 +27,7 @@ check_required_aesthetics <- function(required, present, name, call = caller_env
   if (is.null(required)) return()
 
   required <- strsplit(required, "|", fixed = TRUE)
-  if (any(vapply(required, length, integer(1)) > 1)) {
+  if (any(lengths(required) > 1)) {
     required <- lapply(required, rep_len, 2)
     required <- list(
       vapply(required, `[`, character(1), 1),
@@ -37,7 +37,7 @@ check_required_aesthetics <- function(required, present, name, call = caller_env
     required <- list(unlist(required))
   }
   missing_aes <- lapply(required, setdiff, present)
-  if (any(vapply(missing_aes, length, integer(1)) == 0)) return()
+  if (any(lengths(missing_aes) == 0)) return()
   message <- "{.fn {name}} requires the following missing aesthetics: {.field {missing_aes[[1]]}}"
   if (length(missing_aes) > 1) {
     message <- paste0(message, " {.strong or} {.field {missing_aes[[2]]}}")