diff --git a/R/expand.R b/R/expand.R index 1aa217541..4cb032cf2 100644 --- a/R/expand.R +++ b/R/expand.R @@ -138,7 +138,6 @@ crossing <- function(...) { "Each element must be either an atomic vector or a data frame. Problems: {problems}." )) - } # turn each atomic vector into single column data frame diff --git a/R/extract.R b/R/extract.R index ffa6744bb..92f8e7928 100644 --- a/R/extract.R +++ b/R/extract.R @@ -84,7 +84,7 @@ extract.data.frame <- function(data, col, into, regex = "([[:alnum:]]+)", #' @inheritParams extract #' @export extract_ <- function(data, col, into, regex = "([[:alnum:]]+)", remove = TRUE, - convert = FALSE, ...) { + convert = FALSE, ...) { UseMethod("extract_") } #' @export diff --git a/R/gather.R b/R/gather.R index 3f461e1a9..6eef4ee4c 100644 --- a/R/gather.R +++ b/R/gather.R @@ -132,7 +132,8 @@ gather.data.frame <- function(data, key = "key", value = "value", ..., args <- normalize_melt_arguments(data, gather_idx, factorsAsStrings = TRUE) valueAsFactor <- "factor" %in% class(args$attr_template) - out <- melt_dataframe(data, + out <- melt_dataframe( + data, id_idx - 1L, gather_idx - 1L, as.character(key_var), @@ -159,7 +160,6 @@ gather.data.frame <- function(data, key = "key", value = "value", ..., ## Get the attributes if common, NULL if not. normalize_melt_arguments <- function(data, measure.ind, factorsAsStrings) { - measure.attributes <- map(measure.ind, function(i) { attributes(data[[i]]) }) @@ -172,7 +172,8 @@ normalize_melt_arguments <- function(data, measure.ind, factorsAsStrings) { } else { warn(glue( "attributes are not identical across measure variables; - they will be dropped")) + they will be dropped" + )) attr_template <- NULL } diff --git a/R/replace_na.R b/R/replace_na.R index c1b701399..184e51a3d 100644 --- a/R/replace_na.R +++ b/R/replace_na.R @@ -43,8 +43,9 @@ replace_na.data.frame <- function(data, replace = list(), ...) { check_replacement <- function(x, var) { n <- length(x) - if (n == 1) + if (n == 1) { return() + } abort(glue("Replacement for `{var}` is length {n}, not length 1")) } diff --git a/R/unnest.R b/R/unnest.R index 944089dfc..c4ae047c1 100644 --- a/R/unnest.R +++ b/R/unnest.R @@ -84,7 +84,6 @@ unnest.default <- function(data, ..., .drop = NA, .id = NULL, .sep = NULL, .pres #' @export unnest.data.frame <- function(data, ..., .drop = NA, .id = NULL, .sep = NULL, .preserve = NULL) { - preserve <- tidyselect::vars_select(names(data), !!! enquo(.preserve)) quos <- quos(...) if (is_empty(quos)) { @@ -122,13 +121,16 @@ unnest.data.frame <- function(data, ..., .drop = NA, .id = NULL, unnested_dataframe <- map(nest_types$dataframe %||% list(), dplyr::bind_rows, .id = .id) if (!is_null(.sep)) { - unnested_dataframe <- imap(unnested_dataframe, + unnested_dataframe <- imap( + unnested_dataframe, function(df, name) { set_names(df, paste(name, names(df), sep = .sep)) - }) + } + ) } - if (length(unnested_dataframe) > 0) + if (length(unnested_dataframe) > 0) { unnested_dataframe <- dplyr::bind_cols(unnested_dataframe) + } # Keep list columns by default, only if the rows aren't expanded if (identical(.drop, NA)) { diff --git a/R/utils.R b/R/utils.R index 0449aa3e4..19669397a 100644 --- a/R/utils.R +++ b/R/utils.R @@ -58,8 +58,9 @@ extract_numeric <- function(x) { NULL list_indices <- function(x, max = 20) { - if (length(x) > max) + if (length(x) > max) { x <- c(x[seq_len(max)], "...") + } paste(x, collapse = ", ") } diff --git a/tests/testthat/test-fill.R b/tests/testthat/test-fill.R index 95f504298..728e66622 100644 --- a/tests/testthat/test-fill.R +++ b/tests/testthat/test-fill.R @@ -34,7 +34,6 @@ test_that("missings filled down for each atomic vector", { dbl = c(1, NA), chr = c("a", NA), lst = list(1:5, NULL) - ) out <- fill(df, tidyselect::everything()) diff --git a/tests/testthat/test-gather.R b/tests/testthat/test-gather.R index 57c82aaed..0bf0dadeb 100644 --- a/tests/testthat/test-gather.R +++ b/tests/testthat/test-gather.R @@ -46,7 +46,7 @@ test_that("key preserves column ordering when factor_key = TRUE", { test_that("preserve class of input", { dat <- data.frame(x = 1:2) - dat %>% as_tibble %>% gather %>% expect_is("tbl_df") + dat %>% as_tibble() %>% gather() %>% expect_is("tbl_df") }) test_that("additional inputs control which columns to gather", { @@ -95,8 +95,10 @@ test_that("factors coerced to characters, not integers", { v2 = factor(letters[1:3]) ) - expect_warning(out <- gather(df, k, v), - "attributes are not identical across measure variables") + expect_warning( + out <- gather(df, k, v), + "attributes are not identical across measure variables" + ) expect_equal(out$v, c(1:3, letters[1:3])) }) @@ -121,8 +123,10 @@ test_that("varying attributes are dropped with a warning", { date1 = as.POSIXct(Sys.Date()), date2 = Sys.Date() + 10 ) - expect_warning(gather(df, k, v), - "attributes are not identical across measure variables") + expect_warning( + gather(df, k, v), + "attributes are not identical across measure variables" + ) }) test_that("gather preserves OBJECT bit on e.g. POSIXct", { diff --git a/tests/testthat/test-spread.R b/tests/testthat/test-spread.R index dbd2864ac..d6c62c158 100644 --- a/tests/testthat/test-spread.R +++ b/tests/testthat/test-spread.R @@ -74,7 +74,8 @@ test_that("drop = FALSE spread all levels including NA (#254)", { df <- data.frame( x = factor(c("a", "b", "c", NA), levels = l), y = c("a", "b", "c", "d"), - z = c("a", "b", "a", "b")) + z = c("a", "b", "a", "b") + ) out <- df %>% spread(x, y, drop = FALSE) expect_equal(nrow(out), 2) expect_equal(ncol(out), 6) @@ -92,10 +93,12 @@ test_that("preserve class of input", { }) test_that("dates are spread into columns (#62)", { - df <- data.frame(id = c("a", "a", "b", "b"), - key = c("begin", "end", "begin", "end"), - date = Sys.Date() + 0:3, - stringsAsFactors = FALSE) + df <- data.frame( + id = c("a", "a", "b", "b"), + key = c("begin", "end", "begin", "end"), + date = Sys.Date() + 0:3, + stringsAsFactors = FALSE + ) out <- spread(df, key, date) expect_identical(names(out), c("id", "begin", "end")) expect_is(out$begin, "Date") @@ -106,21 +109,27 @@ test_that("spread can produce mixed variable types (#118)", { df <- data.frame( row = rep(1:2, 3), column = rep(1:3, each = 2), - cell_contents = as.character(c(rep("Argentina", 2), - 62.485, 64.399, - 1952, 1957)), + cell_contents = as.character(c( + rep("Argentina", 2), + 62.485, 64.399, + 1952, 1957 + )), stringsAsFactors = FALSE ) out <- spread(df, column, cell_contents, convert = TRUE) - expect_equivalent(vapply(out, class, ""), - c("integer", "character", "numeric", "integer")) + expect_equivalent( + vapply(out, class, ""), + c("integer", "character", "numeric", "integer") + ) }) test_that("factors can be used with convert = TRUE to produce mixed types", { - df <- data.frame(row = c(1, 2, 1, 2, 1, 2), - column = c("f", "f", "g", "g", "h", "h"), - contents = c("aa", "bb", "1", "2", "TRUE", "FALSE"), - stringsAsFactors = FALSE) + df <- data.frame( + row = c(1, 2, 1, 2, 1, 2), + column = c("f", "f", "g", "g", "h", "h"), + contents = c("aa", "bb", "1", "2", "TRUE", "FALSE"), + stringsAsFactors = FALSE + ) out <- df %>% spread(column, contents, convert = TRUE) expect_is(out$f, "character") expect_is(out$g, "integer") @@ -128,18 +137,22 @@ test_that("factors can be used with convert = TRUE to produce mixed types", { }) test_that("dates can be used with convert = TRUE", { - df <- data.frame(id = c("a", "a", "b", "b"), - key = c("begin", "end", "begin", "end"), - date = Sys.Date() + 0:3, - stringsAsFactors = FALSE) + df <- data.frame( + id = c("a", "a", "b", "b"), + key = c("begin", "end", "begin", "end"), + date = Sys.Date() + 0:3, + stringsAsFactors = FALSE + ) out <- spread(df, key, date, convert = TRUE) expect_is(out$begin, "character") expect_is(out$end, "character") }) test_that("vars that are all NA are logical if convert = TRUE (#118)", { - df <- data.frame(row = c(1, 2, 1, 2), column = c("f", "f", "g", "g"), - contents = c("aa", "bb", NA, NA), stringsAsFactors = FALSE) + df <- data.frame( + row = c(1, 2, 1, 2), column = c("f", "f", "g", "g"), + contents = c("aa", "bb", NA, NA), stringsAsFactors = FALSE + ) out <- df %>% spread(column, contents, convert = TRUE) expect_is(out$g, "logical") }) diff --git a/tests/testthat/test-unnest.R b/tests/testthat/test-unnest.R index 3d49b4d42..d0282bcc5 100644 --- a/tests/testthat/test-unnest.R +++ b/tests/testthat/test-unnest.R @@ -152,7 +152,6 @@ test_that("unnest respects .drop_lists", { expect_equal(df %>% unnest(y, .drop = TRUE) %>% names(), c("x", "y")) expect_equal(df %>% unnest(z, .drop = FALSE) %>% names(), c("x", "y", "z")) - }) test_that("grouping is preserved", {