test_that("empty mutate returns input", {
df <- tibble(x = 1)
gf <- group_by(df, x)
expect_equal(mutate(df), df)
expect_equal(mutate(gf), gf)
expect_equal(mutate(df, !!!list()), df)
expect_equal(mutate(gf, !!!list()), gf)
})
test_that("rownames preserved", {
df <- data.frame(x = c(1, 2), row.names = c("a", "b"))
df <- mutate(df, y = 2)
expect_equal(row.names(df), c("a", "b"))
})
test_that("mutations applied progressively", {
df <- tibble(x = 1)
expect_equal(df %>% mutate(y = x + 1, z = y + 1), tibble(x = 1, y = 2, z = 3))
expect_equal(df %>% mutate(x = x + 1, x = x + 1), tibble(x = 3))
expect_equal(df %>% mutate(x = 2, y = x), tibble(x = 2, y = 2))
df <- data.frame(x = 1, y = 2)
expect_equal(
df %>% mutate(x2 = x, x3 = x2 + 1),
df %>% mutate(x2 = x + 0, x3 = x2 + 1)
)
})
test_that("length-1 vectors are recycled (#152)", {
df <- tibble(x = 1:4)
expect_equal(mutate(df, y = 1)$y, rep(1, 4))
expect_error(mutate(df, y = 1:2))
})
test_that("can remove variables with NULL (#462)", {
df <- tibble(x = 1:3, y = 1:3)
gf <- group_by(df, x)
expect_equal(df %>% mutate(y = NULL), df[1])
expect_equal(gf %>% mutate(y = NULL), gf[1])
# even if it doesn't exist
expect_equal(df %>% mutate(z = NULL), df)
# or was just created
expect_equal(df %>% mutate(z = 1, z = NULL), df)
# regression test for https://github.com/tidyverse/dplyr/issues/4974
expect_equal(
mutate(data.frame(x = 1, y = 1), z = 1, x = NULL, y = NULL),
data.frame(z = 1)
)
})
test_that("mutate() names pronouns correctly (#2686)", {
expect_named(mutate(tibble(x = 1), .data$x), "x")
expect_named(mutate(tibble(x = 1), .data[["x"]]), "x")
})
test_that("mutate() supports unquoted values", {
df <- tibble(g = c(1, 1, 2, 2, 2), x = 1:5)
expect_identical(mutate(df, out = !!1), mutate(df, out = 1))
expect_identical(mutate(df, out = !!(1:5)), mutate(df, out = 1:5))
expect_identical(mutate(df, out = !!quote(1:5)), mutate(df, out = 1:5))
gdf <- group_by(df, g)
expect_identical(mutate(gdf, out = !!1), mutate(gdf, out = 1))
})
test_that("assignments don't overwrite variables (#315)", {
df <- tibble(x = 1, y = 2)
out <- df %>% mutate(z = {x <- 10; x})
expect_equal(out, tibble(x = 1, y = 2, z = 10))
})
test_that("can mutate a data frame with zero columns and `NULL` column names", {
df <- new_data_frame(n = 2L)
colnames(df) <- NULL
expect_equal(mutate(df, x = 1), data.frame(x = c(1, 1)))
})
test_that("mutate() handles symbol expressions", {
df <- tibble(x = structure(1, class = "alien"))
res <- mutate(df, y = x)
expect_identical(df$x, res$y)
gf <- group_by(df, x)
res <- mutate(df, y = x)
expect_identical(df$x, res$y)
})
test_that("mutate() supports constants (#6056)", {
df <- data.frame(x = 1:10, g = rep(1:2, each = 5))
y <- 1:10
z <- 1:2
expect_error(df %>% mutate(y = !!y), NA)
expect_error(df %>% group_by(g) %>% mutate(y = !!y), NA)
expect_error(df %>% rowwise() %>% mutate(y = !!y), NA)
expect_error(df %>% mutate(z = !!z))
expect_error(df %>% group_by(g) %>% mutate(z = !!z))
expect_error(df %>% rowwise() %>% mutate(z = !!z))
})
# column types ------------------------------------------------------------
test_that("glue() is supported", {
expect_equal(
tibble(x = 1) %>% mutate(y = glue("")),
tibble(x = 1, y = glue(""))
)
})
test_that("mutate disambiguates NA and NaN (#1448)", {
df <- tibble(x = c(1, NA, NaN))
out <- mutate(df, y = x * 1)
expect_equal(out$y, df$x)
})
test_that("mutate preserves names (#1689, #2675)", {
df <- tibble(a = 1:3)
out1 <- df %>% mutate(b = setNames(1:3, letters[1:3]))
out2 <- df %>% mutate(b = setNames(as.list(1:3), letters[1:3]))
expect_named(out1$b, letters[1:3])
expect_named(out2$b, letters[1:3])
})
test_that("mutate handles data frame columns", {
df <- data.frame("a" = c(1, 2, 3), "b" = c(2, 3, 4), "base_col" = c(3, 4, 5))
res <- mutate(df, new_col = data.frame(x = 1:3))
expect_equal(res$new_col, data.frame(x = 1:3))
res <- mutate(group_by(df, a), new_col = data.frame(x = a))
expect_equal(res$new_col, data.frame(x = 1:3))
res <- mutate(rowwise(df), new_col = data.frame(x = a))
expect_equal(res$new_col, data.frame(x = 1:3))
})
test_that("unnamed data frames are automatically unspliced (#2326, #3630)", {
expect_identical(
tibble(a = 1) %>% mutate(tibble(b = 2)),
tibble(a = 1, b = 2)
)
expect_identical(
tibble(a = 1) %>% mutate(tibble(b = 2), tibble(b = 3)),
tibble(a = 1, b = 3)
)
expect_identical(
tibble(a = 1) %>% mutate(tibble(b = 2), c = b),
tibble(a = 1, b = 2, c = 2)
)
})
test_that("named data frames are packed (#2326, #3630)", {
df <- tibble(x = 1)
out <- df %>% mutate(y = tibble(a = x))
expect_equal(out, tibble(x = 1, y = tibble(a = 1)))
})
test_that("unchop only called for when multiple groups", {
df <- data.frame(g = 1, x = 1:5)
out <- mutate(df, x = ts(x, start = c(1971, 1), frequency = 52))
expect_s3_class(out$x, "ts")
gdf <- group_by(df, g)
out <- mutate(gdf, x = ts(x, start = c(1971, 1), frequency = 52))
expect_s3_class(out$x, "ts")
})
# output types ------------------------------------------------------------
test_that("mutate preserves grouping", {
gf <- group_by(tibble(x = 1:2, y = 2), x)
i <- count_regroups(out <- mutate(gf, x = 1))
expect_equal(i, 1L)
expect_equal(group_vars(out), "x")
expect_equal(nrow(group_data(out)), 1)
i <- count_regroups(out <- mutate(gf, z = 1))
expect_equal(i, 0)
expect_equal(group_data(out), group_data(gf))
})
test_that("mutate works on zero-row grouped data frame (#596)", {
dat <- data.frame(a = numeric(0), b = character(0), stringsAsFactors = TRUE)
res <- dat %>% group_by(b, .drop = FALSE) %>% mutate(a2 = a * 2)
expect_type(res$a2, "double")
expect_s3_class(res, "grouped_df")
expect_equal(res$a2, numeric(0))
expect_type(group_rows(res), "list")
expect_equal(attr(group_rows(res), "ptype"), integer())
expect_equal(group_data(res)$b, factor(character(0)))
})
test_that("mutate works on zero-row rowwise data frame (#4224)", {
dat <- data.frame(a = numeric(0))
res <- dat %>% rowwise() %>% mutate(a2 = a * 2)
expect_type(res$a2, "double")
expect_s3_class(res, "rowwise_df")
expect_equal(res$a2, numeric(0))
})
test_that("mutate works on empty data frames (#1142)", {
df <- data.frame()
res <- df %>% mutate()
expect_equal(nrow(res), 0L)
expect_equal(length(res), 0L)
res <- df %>% mutate(x = numeric())
expect_equal(names(res), "x")
expect_equal(nrow(res), 0L)
expect_equal(length(res), 1L)
})
test_that("mutate handles 0 rows rowwise (#1300)", {
res <- tibble(y = character()) %>% rowwise() %>% mutate(z = 1)
expect_equal(nrow(res), 0L)
})
test_that("rowwise mutate gives expected results (#1381)", {
f <- function(x) ifelse(x < 2, NA_real_, x)
res <- tibble(x = 1:3) %>% rowwise() %>% mutate(y = f(x))
expect_equal(res$y, c(NA, 2, 3))
})
test_that("grouped mutate does not drop grouping attributes (#1020)", {
d <- data.frame(subject = c("Jack", "Jill"), id = c(2, 1)) %>% group_by(subject)
a1 <- names(attributes(d))
a2 <- names(attributes(d %>% mutate(foo = 1)))
expect_equal(setdiff(a1, a2), character(0))
})
test_that("mutate() hands list columns with rowwise magic to follow up expressions (#4845)", {
test <- rowwise(tibble(x = 1:2))
expect_identical(
test %>%
mutate(a = list(1)) %>%
mutate(b = list(a + 1)),
test %>%
mutate(a = list(1), b = list(a + 1))
)
})
# other -------------------------------------------------------------------
test_that("no utf8 invasion (#722)", {
skip_if_not(l10n_info()$"UTF-8")
source("utf-8.txt", local = TRUE, encoding = "UTF-8")
})
test_that("mutate() to UTF-8 column names", {
df <- tibble(a = 1) %>% mutate("\u5e78" := a)
expect_equal(colnames(df), c("a", "\u5e78"))
})
test_that("Non-ascii column names in version 0.3 are not duplicated (#636)", {
local_non_utf8_encoding()
df <- tibble(a = "1", b = "2")
names(df) <- c("a", enc2native("\u4e2d"))
res <- df %>% mutate_all(as.numeric)
expect_equal(names(res), as_utf8_character(names(df)))
})
test_that("mutate coerces results from one group with all NA values (#1463) ", {
df <- tibble(x = c(1, 2), y = c(1, NA))
res <- df %>% group_by(x) %>% mutate(z = ifelse(y > 1, 1, 2))
expect_true(is.na(res$z[2]))
expect_type(res$z, "double")
})
test_that("grouped subsets are not lazy (#3360)", {
make_call <- function(x) {
quo(!!x)
}
res <- tibble(name = 1:2, value = letters[1:2]) %>%
rowwise() %>%
mutate(call = list(make_call(value))) %>%
pull()
expect_identical(res, list(make_call("a"), make_call("b")))
res <- tibble(name = 1:2, value = letters[1:2]) %>%
group_by(name) %>%
mutate(call = list(make_call(value))) %>%
pull()
expect_identical(res, list(make_call("a"), make_call("b")))
})
test_that("mutate() evaluates expression for empty groups", {
df <- tibble(f = factor(c("a", "b"), levels = c("a", "b", "c")))
gf <- group_by(df, f, .drop = FALSE)
count <- 0
mutate(gf, x = {count <<- count + 1})
expect_equal(count, 3L)
})
test_that("DataMask$add() forces chunks (#4677)", {
df <- tibble(bf10 = 0.244) %>%
mutate(
bf01 = 1 / bf10,
log_e_bf10 = log(bf10),
log_e_bf01 = log(bf01)
)
expect_equal(df$log_e_bf01, log(1 / 0.244))
})
# .before, .after, .keep ------------------------------------------------------
test_that(".keep = 'unused' keeps variables explicitly mentioned", {
df <- tibble(x = 1, y = 2)
out <- mutate(df, x1 = x + 1, y = y, .keep = "unused")
expect_named(out, c("y", "x1"))
})
test_that(".keep = 'used' not affected by across()", {
df <- tibble(x = 1, y = 2, z = 3, a = "a", b = "b", c = "c")
# This must evaluate every column in order to figure out if should
# be included in the set or not, but that shouldn't be counted for
# the purposes of "used" variables
out <- mutate(df, across(where(is.numeric), identity), .keep = "unused")
expect_named(out, names(df))
})
test_that(".keep = 'used' keeps variables used in expressions", {
df <- tibble(a = 1, b = 2, c = 3, x = 1, y = 2)
out <- mutate(df, xy = x + y, .keep = "used")
expect_named(out, c("x", "y", "xy"))
})
test_that(".keep = 'none' only keeps grouping variables", {
df <- tibble(x = 1, y = 2)
gf <- group_by(df, x)
expect_named(mutate(df, z = 1, .keep = "none"), "z")
expect_named(mutate(gf, z = 1, .keep = "none"), c("x", "z"))
})
test_that(".keep = 'none' retains original ordering (#5967)", {
df <- tibble(x = 1, y = 2)
expect_named(df %>% mutate(y = 1, x = 2, .keep = "none"), c("x", "y"))
# even when grouped
gf <- group_by(df, x)
expect_named(gf %>% mutate(y = 1, x = 2, .keep = "none"), c("x", "y"))
})
test_that("can use .before and .after to control column position", {
df <- tibble(x = 1, y = 2)
expect_named(mutate(df, z = 1), c("x", "y", "z"))
expect_named(mutate(df, z = 1, .before = 1), c("z", "x", "y"))
expect_named(mutate(df, z = 1, .after = 1), c("x", "z", "y"))
# but doesn't affect order of existing columns
df <- tibble(x = 1, y = 2)
expect_named(mutate(df, x = 1, .after = y), c("x", "y"))
})
test_that(".keep and .before/.after interact correctly", {
df <- tibble(x = 1, y = 1, z = 1, a = 1, b = 2, c = 3) %>%
group_by(a, b)
expect_named(mutate(df, d = 1, x = 2, .keep = "none"), c("x", "a", "b", "d"))
expect_named(mutate(df, d = 1, x = 2, .keep = "none", .before = "a"), c("x", "d", "a", "b"))
expect_named(mutate(df, d = 1, x = 2, .keep = "none", .after = "a"), c("x", "a", "d", "b"))
})
test_that("dropping column with `NULL` then readding it retains original location", {
df <- tibble(x = 1, y = 2, z = 3, a = 4)
df <- group_by(df, z)
expect_named(mutate(df, y = NULL, y = 3, .keep = "all"), c("x", "y", "z", "a"))
expect_named(mutate(df, b = a, y = NULL, y = 3, .keep = "used"), c("y", "z", "a", "b"))
expect_named(mutate(df, b = a, y = NULL, y = 3, .keep = "unused"), c("x", "y", "z", "b"))
# It isn't treated as a "new" column
expect_named(mutate(df, y = NULL, y = 3, .keep = "all", .before = x), c("x", "y", "z", "a"))
})
test_that(".keep= always retains grouping variables (#5582)", {
df <- tibble(x = 1, y = 2, z = 3) %>% group_by(z)
expect_equal(
df %>% mutate(a = x + 1, .keep = "none"),
tibble(z = 3, a = 2) %>% group_by(z)
)
expect_equal(
df %>% mutate(a = x + 1, .keep = "all"),
tibble(x = 1, y = 2, z = 3, a = 2) %>% group_by(z)
)
expect_equal(
df %>% mutate(a = x + 1, .keep = "used"),
tibble(x = 1, z = 3, a = 2) %>% group_by(z)
)
expect_equal(
df %>% mutate(a = x + 1, .keep = "unused"),
tibble(y = 2, z = 3, a = 2) %>% group_by(z)
)
})
test_that("mutate() preserves the call stack on error (#5308)", {
foobar <- function() stop("foo")
stack <- NULL
expect_error(
withCallingHandlers(
error = function(...) stack <<- sys.calls(),
mutate(mtcars, foobar())
)
)
expect_true(some(stack, is_call, "foobar"))
})
test_that("dplyr data mask can become obsolete", {
lazy <- function(x) {
list(enquo(x))
}
df <- tibble(
x = 1:2
)
res <- df %>%
rowwise() %>%
mutate(y = lazy(x), .keep = "unused")
expect_equal(names(res), c("x", "y"))
expect_error(eval_tidy(res$y[[1]]))
})
test_that("mutate() deals with 0 groups (#5534)", {
df <- data.frame(x = numeric()) %>%
group_by(x)
expect_equal(
mutate(df, y = x + 1),
data.frame(x = numeric(), y = numeric()) %>% group_by(x)
)
expect_warning(
mutate(df, y = max(x)),
"Inf"
)
})
test_that("mutate(=NULL) preserves correct all_vars", {
df <- data.frame(x = 1, y = 2) %>% mutate(x = NULL, vars = cur_data_all()) %>% pull()
expect_equal(df, tibble(y = 2))
})
test_that("functions are not skipped in data pronoun (#5608)", {
f <- function(i) i + 1
df <- tibble(a = list(f), b = 1)
two <- df %>%
rowwise() %>%
mutate(res = .data$a(.data$b)) %>%
pull(res)
expect_equal(two, 2)
})
test_that("mutate() casts data frame results to common type (#5646)", {
df <- data.frame(x = 1:2, g = 1:2) %>% group_by(g)
res <- df %>%
mutate(if (g == 1) data.frame(y = 1) else data.frame(y = 1, z = 2))
expect_equal(res$z, c(NA, 2))
})
test_that("can suppress or catch warnings from the outside (#5675)", {
# Check that basic warning handling still works
expect_no_warning(
suppressWarnings(mutate(tibble(), warning("foo")))
)
f <- function() warn("foo", "dplyr:::foo")
x <- tryCatch(warning = identity, mutate(mtcars, f()))
msg <- conditionMessage(x)
expect_match(msg, "foo")
# Check that caught warnings are instrumented. Requires
# <https://github.com/wch/r-source/commit/688eaebf>.
if (can_return_from_exit) {
expect_match(msg, "Problem while")
}
})
test_that("mutate() supports empty list columns in rowwise data frames (#5804", {
res <- tibble(a = list()) %>%
rowwise() %>%
mutate(n = lengths(a))
expect_equal(res$n, integer())
})
test_that("mutate() propagates caller env", {
expect_caller_env(mutate(mtcars, sig_caller_env()))
})
test_that("rowwise() + mutate(across()) correctly handles list columns (#5951)", {
tib <- tibble(a=list(1:2,3:4),c=list(NULL,NULL)) %>% rowwise()
expect_identical(
mutate(tib, sum = across(everything(),sum)),
mutate(tib, sum = across(where(is.list),sum))
)
})
test_that("mutate() fails on named empty arguments (#5925)", {
expect_error(
mutate(tibble(), bogus = )
)
})
# Error messages ----------------------------------------------------------
test_that("mutate() give meaningful errors", {
expect_snapshot({
tbl <- tibble(x = 1:2, y = 1:2)
# setting column to NULL makes it unavailable
(expect_error(tbl %>% mutate(y = NULL, a = sum(y))))
(expect_error(tbl %>%
group_by(x) %>%
mutate(y = NULL, a = sum(y))
))
# incompatible column type
(expect_error(tibble(x = 1) %>% mutate(y = mean)))
# Unsupported type"
df <- tibble(g = c(1, 1, 2, 2, 2), x = 1:5)
(expect_error(df %>% mutate(out = env(a = 1))))
(expect_error(df %>%
group_by(g) %>%
mutate(out = env(a = 1))
))
(expect_error(df %>%
rowwise() %>%
mutate(out = rnorm)
))
# incompatible types across groups
(expect_error(
data.frame(x = rep(1:5, each = 3)) %>%
group_by(x) %>%
mutate(val = ifelse(x < 3, "foo", 2))
))
(expect_error(
tibble(a = 1:3, b=4:6) %>%
group_by(a) %>%
mutate(if(a==1) NULL else "foo")
))
# incompatible size
(expect_error(
data.frame(x = c(2, 2, 3, 3)) %>% mutate(int = 1:5)
))
(expect_error(
data.frame(x = c(2, 2, 3, 3)) %>%
group_by(x) %>%
mutate(int = 1:5)
))
(expect_error(
data.frame(x = c(2, 3, 3)) %>%
group_by(x) %>%
mutate(int = 1:5)
))
(expect_error(
data.frame(x = c(2, 2, 3, 3)) %>%
rowwise() %>%
mutate(int = 1:5)
))
(expect_error(
tibble(y = list(1:3, "a")) %>%
rowwise() %>%
mutate(y2 = y)
))
(expect_error(
data.frame(x = 1:10) %>% mutate(y = 11:20, y = 1:2)
))
# .data pronoun
(expect_error(
tibble(a = 1) %>% mutate(c = .data$b)
))
(expect_error(
tibble(a = 1:3) %>%
group_by(a) %>%
mutate(c = .data$b)
))
# obsolete data mask
lazy <- function(x) list(enquo(x))
res <- tbl %>%
rowwise() %>%
mutate(z = lazy(x), .keep = "unused")
(expect_error(
eval_tidy(res$z[[1]])
))
# Error that contains {
(expect_error(
tibble() %>% mutate(stop("{"))
))
})
})
Generated by dwww version 1.15 on Sun Jun 16 15:21:04 CEST 2024.