Skip to content

Commit

Permalink
test: Greatly improve testing of mutate()
Browse files Browse the repository at this point in the history
  • Loading branch information
nathaneastwood committed Oct 25, 2020
1 parent e9bb116 commit b0318e8
Show file tree
Hide file tree
Showing 4 changed files with 25 additions and 6 deletions.
2 changes: 1 addition & 1 deletion R/context.R
Original file line number Diff line number Diff line change
Expand Up @@ -97,7 +97,7 @@ cur_group_id <- function() {
details <- get_group_details(data)
details[, ".group_id"] <- seq_len(nrow(details))
res <- suppressMessages(semi_join(details, res))
res[, ".group_id", drop = FALSE]
res[, ".group_id"]
}

#' @description
Expand Down
15 changes: 13 additions & 2 deletions R/mutate.R
Original file line number Diff line number Diff line change
Expand Up @@ -32,14 +32,25 @@ mutate <- function(.data, ...) {
#' @export
mutate.default <- function(.data, ...) {
conditions <- dotdotdot(..., .impute_names = TRUE)
cond_nms <- names(dotdotdot(..., .impute_names = FALSE))
if (length(conditions) == 0L) return(.data)
context$setup(.data)
on.exit(context$clean(), add = TRUE)
for (i in seq_along(conditions)) {
not_named <- (is.null(cond_nms) || cond_nms[i] == "")
res <- eval(conditions[[i]], envir = context$.data)
if (!is.list(res)) res <- list(res)
if (is.null(names(res))) names(res) <- names(conditions)[[i]]
context$.data[, names(res)] <- res
res_nms <- names(res)
if (is.data.frame(res)) {
if (not_named) {
context$.data[, res_nms] <- res
} else {
context$.data[[cond_nms[i]]] <- res
}
} else {
if (is.null(res_nms)) names(res) <- names(conditions)[[i]]
context$.data[, names(res)] <- res
}
}
context$.data
}
Expand Down
2 changes: 1 addition & 1 deletion inst/tinytest/test_across.R
Original file line number Diff line number Diff line change
Expand Up @@ -95,7 +95,7 @@ expect_equal(
)

expect_named(
mutate(data.frame(a = 1, b = 2), a = 2, x = across()),
mutate(data.frame(a = 1, b = 2), a = 2, x = across())$x,
c("a", "b"),
info = "across() retains original ordering"
)
Expand Down
12 changes: 10 additions & 2 deletions inst/tinytest/test_mutate.R
Original file line number Diff line number Diff line change
Expand Up @@ -76,7 +76,7 @@ expect_equal(
{
res <- mtcars
res <- do.call(rbind, unname(lapply(
split(res, list(res$am , res$cyl)),
split(res, list(res$am, res$cyl)),
function(x) {
x[, "mpg2"] <- x$mpg * 2
x
Expand Down Expand Up @@ -137,7 +137,15 @@ expect_identical(

df <- data.frame(x = 1)
out <- df %>% mutate(y = data.frame(a = x))
expect_equal(out, data.frame(x = 1, y = data.frame(a = 1)), info = "named data frames are packed")
expect_equal(
out,
{
res <- data.frame(x = 1)
res[["y"]] <- data.frame(a = 1)
res
},
info = "named data frames are packed"
)

gf <- group_by(data.frame(x = 1:2, y = 2), x)
out <- mutate(gf, x = 1)
Expand Down

0 comments on commit b0318e8

Please sign in to comment.