chore: Prefer map_*() over vapply()

R/expectations.R

@@ -13,7 +13,7 @@ expect_all_args_have_default_values <- function(object) {
   act <- quasi_label(enquo(object), arg = "object")
   act$args <- formals(act$val)
   act$args <- act$args[names(act$args) != "..."]
-  act$char_args <- vapply(act$args, as.character, character(1L))
+  act$char_args <- map_chr(act$args, as.character)
   expect(
     all(nzchar(act$char_args, keepNA = FALSE)),
     sprintf("%s has arguments without default values", act$lab)
@@ -47,13 +47,13 @@ expect_invisible_true <- function(code) {
 }
 
 expect_equal_df <- function(actual, expected) {
-  factor_cols <- vapply(expected, is.factor, logical(1L))
+  factor_cols <- map_lgl(expected, is.factor)
   expected[factor_cols] <- lapply(expected[factor_cols], as.character)
 
-  asis_cols <- vapply(expected, inherits, "AsIs", FUN.VALUE = logical(1L))
+  asis_cols <- map_lgl(expected, inherits, "AsIs")
   expected[asis_cols] <- lapply(expected[asis_cols], unclass)
 
-  list_cols <- vapply(expected, is.list, logical(1L))
+  list_cols <- map_lgl(expected, is.list)
 
   if (!any(list_cols)) {
     order_actual <- do.call(order, actual)

R/spec-arrow-append-table-arrow.R

@@ -425,7 +425,7 @@ spec_arrow_append_table_arrow <- list(
       use_append = TRUE,
       con, tbl_in,
       transform = function(out) {
-        dates <- vapply(out, inherits, "POSIXt", FUN.VALUE = logical(1L))
+        dates <- map_lgl(out, inherits, "POSIXt")
         tz <- toupper(names(out))
         tz[tz == "LOCAL"] <- ""
         out[dates] <- Map(lubridate::with_tz, out[dates], tz[dates])
@@ -468,7 +468,7 @@ spec_arrow_append_table_arrow <- list(
       use_append = TRUE,
       con, tbl_in,
       transform = function(out) {
-        dates <- vapply(out, inherits, "POSIXt", FUN.VALUE = logical(1L))
+        dates <- map_lgl(out, inherits, "POSIXt")
         tz <- toupper(names(out))
         tz[tz == "LOCAL"] <- ""
         out[dates] <- Map(lubridate::with_tz, out[dates], tz[dates])

R/spec-arrow-write-table-arrow.R

@@ -659,7 +659,7 @@ spec_arrow_write_table_arrow <- list(
     test_arrow_roundtrip(
       con, tbl_in,
       transform = function(out) {
-        dates <- vapply(out, inherits, "POSIXt", FUN.VALUE = logical(1L))
+        dates <- map_lgl(out, inherits, "POSIXt")
         tz <- toupper(names(out))
         tz[tz == "LOCAL"] <- ""
         out[dates] <- Map(lubridate::with_tz, out[dates], tz[dates])
@@ -701,7 +701,7 @@ spec_arrow_write_table_arrow <- list(
     test_arrow_roundtrip(
       con, tbl_in,
       transform = function(out) {
-        dates <- vapply(out, inherits, "POSIXt", FUN.VALUE = logical(1L))
+        dates <- map_lgl(out, inherits, "POSIXt")
         tz <- toupper(names(out))
         tz[tz == "LOCAL"] <- ""
         out[dates] <- Map(lubridate::with_tz, out[dates], tz[dates])

R/spec-result-roundtrip.R

@@ -268,7 +268,7 @@ test_select <- function(con, ..., .dots = NULL, .add_null = "none",
                         .ctx, .envir = parent.frame()) {
   values <- c(list(...), .dots)
 
-  value_is_formula <- vapply(values, is.call, logical(1L))
+  value_is_formula <- map_lgl(values, is.call)
   names(values)[value_is_formula] <- lapply(values[value_is_formula], "[[", 2L)
   values[value_is_formula] <- lapply(
     values[value_is_formula],
@@ -350,7 +350,7 @@ equals_minus_100 <- function(x) {
 }
 
 all_have_utf8_or_ascii_encoding <- function(x) {
-  all(vapply(x, has_utf8_or_ascii_encoding, logical(1L)))
+  all(map_lgl(x, has_utf8_or_ascii_encoding))
 }
 
 has_utf8_or_ascii_encoding <- function(x) {

R/spec-sql-append-table.R

@@ -416,7 +416,7 @@ spec_sql_append_table <- list(
       use_append = TRUE,
       con, tbl_in,
       transform = function(out) {
-        dates <- vapply(out, inherits, "POSIXt", FUN.VALUE = logical(1L))
+        dates <- map_lgl(out, inherits, "POSIXt")
         tz <- toupper(names(out))
         tz[tz == "LOCAL"] <- ""
         out[dates] <- Map(lubridate::with_tz, out[dates], tz[dates])
@@ -457,7 +457,7 @@ spec_sql_append_table <- list(
       use_append = TRUE,
       con, tbl_in,
       transform = function(out) {
-        dates <- vapply(out, inherits, "POSIXt", FUN.VALUE = logical(1L))
+        dates <- map_lgl(out, inherits, "POSIXt")
         tz <- toupper(names(out))
         tz[tz == "LOCAL"] <- ""
         out[dates] <- Map(lubridate::with_tz, out[dates], tz[dates])

R/spec-sql-list-objects.R

@@ -43,7 +43,7 @@ spec_sql_list_objects <- list(
 
     #' part of the data frame.
     objects <- dbListObjects(con)
-    quoted_tables <- vapply(objects$table, dbQuoteIdentifier, conn = con, character(1))
+    quoted_tables <- map_chr(objects$table, dbQuoteIdentifier, conn = con)
     expect_true(dbQuoteIdentifier(con, table_name) %in% quoted_tables)
   },
   # second stage
@@ -55,7 +55,7 @@ spec_sql_list_objects <- list(
     #' As soon a table is removed from the database,
     #' it is also removed from the data frame of database objects.
     objects <- dbListObjects(con)
-    quoted_tables <- vapply(objects$table, dbQuoteIdentifier, conn = con, character(1))
+    quoted_tables <- map_chr(objects$table, dbQuoteIdentifier, conn = con)
     expect_false(dbQuoteIdentifier(con, table_name) %in% quoted_tables)
   },
 
@@ -66,7 +66,7 @@ spec_sql_list_objects <- list(
       dbWriteTable(con, table_name, data.frame(a = 1L), temporary = TRUE)
 
       objects <- dbListObjects(con)
-      quoted_tables <- vapply(objects$table, dbQuoteIdentifier, conn = con, character(1))
+      quoted_tables <- map_chr(objects$table, dbQuoteIdentifier, conn = con)
       expect_true(dbQuoteIdentifier(con, table_name) %in% quoted_tables)
     }
   },
@@ -84,7 +84,7 @@ spec_sql_list_objects <- list(
       local_remove_test_table(con, table_name)
       dbWriteTable(con, dbQuoteIdentifier(con, table_name), data.frame(a = 2L))
       objects <- dbListObjects(con)
-      quoted_tables <- vapply(objects$table, dbQuoteIdentifier, conn = con, character(1))
+      quoted_tables <- map_chr(objects$table, dbQuoteIdentifier, conn = con)
       expect_true(dbQuoteIdentifier(con, table_name) %in% quoted_tables)
     }
   },

R/spec-sql-quote-literal.R

@@ -75,17 +75,17 @@ spec_sql_quote_literal <- list(
     #' @section Specification:
     do_test_literal <- function(x) {
       #' The returned expression can be used in a `SELECT ...` query,
-      literals <- vapply(x, dbQuoteLiteral, conn = con, character(1))
+      literals <- map_chr(x, dbQuoteLiteral, conn = con)
       query <- paste0("SELECT ", paste(literals, collapse = ", "))
       #' and the value of
       #' \code{dbGetQuery(paste0("SELECT ", dbQuoteLiteral(x)))[[1]]}
       #' must be equal to `x`
       x_out <- check_df(dbGetQuery(con, query))
       expect_equal(nrow(x_out), 1L)
 
-      is_logical <- vapply(x, is.logical, FUN.VALUE = logical(1))
+      is_logical <- map_lgl(x, is.logical)
       x_out[is_logical] <- lapply(x_out[is_logical], as.logical)
-      is_numeric <- vapply(x, is.numeric, FUN.VALUE = logical(1))
+      is_numeric <- map_lgl(x, is.numeric)
       x_out[is_numeric] <- lapply(x_out[is_numeric], as.numeric)
       expect_equal(as.list(unname(x_out)), x)
     }

R/spec-sql-write-table.R

@@ -623,7 +623,7 @@ spec_sql_write_table <- list(
     test_table_roundtrip(
       con, tbl_in,
       transform = function(out) {
-        dates <- vapply(out, inherits, "POSIXt", FUN.VALUE = logical(1L))
+        dates <- map_lgl(out, inherits, "POSIXt")
         tz <- toupper(names(out))
         tz[tz == "LOCAL"] <- ""
         out[dates] <- Map(lubridate::with_tz, out[dates], tz[dates])
@@ -663,7 +663,7 @@ spec_sql_write_table <- list(
     test_table_roundtrip(
       con, tbl_in,
       transform = function(out) {
-        dates <- vapply(out, inherits, "POSIXt", FUN.VALUE = logical(1L))
+        dates <- map_lgl(out, inherits, "POSIXt")
         tz <- toupper(names(out))
         tz[tz == "LOCAL"] <- ""
         out[dates] <- Map(lubridate::with_tz, out[dates], tz[dates])

R/spec-stress-connection.R

@@ -12,7 +12,7 @@ spec_stress_connection <- list(
     }
 
     inherit_from_connection <-
-      vapply(cons, is, class2 = "DBIConnection", logical(1))
+      map_lgl(cons, is, class2 = "DBIConnection")
     expect_true(all(inherit_from_connection))
   },
 

R/tweaks.R

@@ -145,7 +145,7 @@ make_tweaks <- function(envir = parent.frame()) {
         }
       }
       ret <- .(list_call)
-      ret <- ret[!vapply(ret, is.null, logical(1L))]
+      ret <- compact(ret)
       structure(ret, class = "DBItest_tweaks")
     },
     as.environment(list(list_call = list_call))

R/utils.R

@@ -68,11 +68,6 @@ random_table_name <- function(n = 10) {
   paste0("dbit", paste(sample(letters, n, replace = TRUE), collapse = ""))
 }
 
-compact <- function(x) {
-  x[!vapply(x, is.null, logical(1L))]
-}
-
-
 try_silent <- function(code) {
   tryCatch(
     code,
@@ -83,7 +78,7 @@ try_silent <- function(code) {
 check_df <- function(df) {
   expect_s3_class(df, "data.frame")
   if (length(df) >= 1L) {
-    lengths <- vapply(df, length, integer(1L), USE.NAMES = FALSE)
+    lengths <- unname(lengths(df))
     expect_equal(diff(lengths), rep(0L, length(lengths) - 1L))
     expect_equal(nrow(df), lengths[[1]])
   }

tests/testthat/test-consistency.R

@@ -1,5 +1,5 @@
 test_that("no unnamed specs", {
-  tests <- spec_all[!vapply(spec_all, is.null, logical(1L))]
+  tests <- compact(spec_all)
   vicinity <- NULL
   if (any(names(tests) == "")) {
     vicinity <- sort(unique(unlist(