context("test_mutate")
library("dplyr")
library("tidylog")
test_that("mutate", {
expect_message({
out <- tidylog::mutate(mtcars, test = TRUE)
})
expect_equal(all(out$test), TRUE)
# factor to factor
f <- function() tidylog::mutate(iris, Species = recode(Species, "virginica" = "v"))
expect_message(f(), "changed 50 values.*0 new NA")
# factor to factor, with missings
f <- function() tidylog::mutate(iris, Species = na_if(Species, "virginica"))
expect_message(f(), "changed 50 values.*50 new NA")
# numeric to numeric
f <- function() tidylog::mutate(iris, Sepal.Length = round(Sepal.Length))
expect_message(f(), "changed 133 values.*0 new NA")
# character to character
iris2 <- dplyr::mutate(iris, Species = as.character(Species))
f <- function() tidylog::mutate(iris2, Species = ifelse(Species == "virginica", "v", Species))
expect_message(f(), "changed 50 values.*0 new NA")
# factor to character
f <- function() tidylog::mutate(iris, Species = as.character(Species))
expect_message(f(), "from factor to character.*0 new NA")
# factor to 100% missing
f <- function() tidylog::mutate(iris, Species = NA)
expect_message(f(), "now 100% NA")
# double to character
f <- function() tidylog::mutate(iris, Sepal.Length = as.character(Sepal.Length))
expect_message(f(), "from double to character.*0 new NA")
# character to ordered factor
iris2 <- dplyr::mutate(iris, Species = as.character(Species))
f <- function() tidylog::mutate(iris2, Species = ordered(Species))
expect_message(f(), "from character to ordered factor.*0 new NA")
# ordered factor to character
iris2 <- dplyr::mutate(iris, Species = ordered(Species))
f <- function() tidylog::mutate(iris2, Species = as.character(Species))
expect_message(f(), "from ordered factor to character.*0 new NA")
# character to Date
iris2 <- dplyr::mutate(iris, date = "2016-01-01")
f <- function() tidylog::mutate(iris2, date = as.Date(date))
expect_message(f(), "from character to Date.*0 new NA")
})
test_that("missings", {
# same type, increase missings
f <- function() tidylog::mutate(iris, Sepal.Length = ifelse(Sepal.Length > 5, NA, Sepal.Length))
expect_message(f(), "changed.*(118 new NA)")
# same type, reduce missings
iris2 <- dplyr::mutate(iris, Sepal.Length = ifelse(Sepal.Length > 5, NA, Sepal.Length))
f <- function() tidylog::mutate(iris2, Sepal.Length = 1)
expect_message(f(), "changed.*(118 fewer NA)")
# same type, same missings
f <- function() tidylog::mutate(iris, Sepal.Length = sample(Sepal.Length))
expect_message(f(), "changed.*(0 new NA)")
# double to integer, increase missings
f <- function() tidylog::mutate(iris,
Sepal.Length = as.integer(ifelse(Sepal.Length > 5, NA, Sepal.Length)))
expect_message(f(), "converted.*to integer.*(118 new NA)")
# double to integer, reduce missings
iris2 <- dplyr::mutate(iris, Sepal.Length = ifelse(Sepal.Length > 5, NA, Sepal.Length))
f <- function() tidylog::mutate(iris2, Sepal.Length = as.integer(1))
expect_message(f(), "converted.*to integer.*(118 fewer NA)")
# double to integer, same missings
f <- function() tidylog::mutate(iris,
Sepal.Length = as.integer(sample(Sepal.Length)))
expect_message(f(), "converted.*to integer.*(0 new NA)")
})
test_that("transmute", {
expect_message({
out <- tidylog::transmute(mtcars, test = TRUE)
})
expect_equal(all(out$test), TRUE)
expect_equal(ncol(out), 1)
f <- function() tidylog::transmute(mtcars)
expect_message(f(), regexp = "dropped all variables")
})
test_that("percent function", {
iris2 <- bind_rows(iris, iris)
# 100% change
f <- function() tidylog::mutate(iris2, Sepal.Length = 1)
expect_message(f(), regexp = "100%")
# <1% change, but no 0%
f <- function() tidylog::mutate(iris2,
Sepal.Length = ifelse(row_number() == 1, 100, Sepal.Length))
expect_message(f(), regexp = "<1%")
# >99% change, but no 100%
f <- function() tidylog::mutate(iris2,
Sepal.Length = ifelse(row_number() != 1, 100, Sepal.Length))
expect_message(f(), regexp = ">99%")
# no changes
f <- function() tidylog::mutate(iris2, Sepal.Length = Sepal.Length)
expect_message(f(), regexp = "no changes")
# 0%
f <- function() tidylog::mutate(iris2, test = 1)
expect_message(f(), regexp = "0%")
})
test_that("add_tally", {
expect_message({
out <- mtcars %>%
tidylog::group_by(cyl) %>%
tidylog::add_tally()
})
expect_equal(nrow(out), nrow(mtcars))
expect_equal(ncol(out), ncol(mtcars) + 1)
})
test_that("add_count", {
expect_message({
out <- mtcars %>%
tidylog::group_by(gear) %>%
tidylog::add_count(carb)
})
expect_equal(nrow(out), nrow(mtcars))
expect_equal(ncol(out), ncol(mtcars) + 1)
})
test_that("mutate: scoped variants", {
expect_message({
out <- tidylog::mutate_all(mtcars, round)
})
expect_equal(out, dplyr::mutate_all(mtcars, round))
expect_message({
out <- tidylog::mutate_at(mtcars, vars(mpg:disp), scale)
})
expect_equal(out, dplyr::mutate_at(mtcars, vars(mpg:disp), scale))
expect_message({
out <- tidylog::mutate_if(iris, is.factor, as.character)
})
expect_equal(out, dplyr::mutate_if(iris, is.factor, as.character))
})
test_that("transmute: scoped variants", {
expect_message({
out <- tidylog::transmute_all(mtcars, round)
})
expect_equal(out, dplyr::transmute_all(mtcars, round))
expect_message({
out <- tidylog::transmute_at(mtcars, vars(mpg:disp), scale)
})
expect_equal(out, dplyr::transmute_at(mtcars, vars(mpg:disp), scale))
expect_message({
out <- tidylog::transmute_if(iris, is.factor, as.character)
})
expect_equal(out, dplyr::transmute_if(iris, is.factor, as.character))
})
test_that("mutate: argument order", {
expect_message({
out <- tidylog::mutate(test = TRUE, .data = mtcars)
})
expect_equal(all(out$test), TRUE)
})
test_that("transmute: argument order", {
expect_message({
out <- tidylog::transmute(test = TRUE, .data = mtcars)
})
expect_equal(all(out$test), TRUE)
expect_equal(ncol(out), 1)
})
test_that("mutate/transmute: partial matching", {
f <- function() tidylog::mutate(mtcars, f = 1)
expect_message(f(), "new variable 'f'")
f <- function() tidylog::transmute(mtcars, fun = 1)
expect_message(f(), "new variable 'fun'")
})
test_that("tidyr::replace_na", {
df <- tibble(x = c(1, 2, NA), y = c("a", NA, "b"))
expect_message({
out <- tidylog::replace_na(df, list(x = 0, y = "unknown"))
})
# with vector
expect_silent(dplyr::mutate(df, x = replace_na(x, 0)))
expect_equal(tidyr::replace_na(df, list(x = 0, y = "unknown")), out)
})
test_that("tidyr::fill", {
df <- data.frame(Month = 1:12, Year = c(2000, rep(NA, 11)))
expect_message({
out <- tidylog::fill(df, Year)
})
expect_equal(tidyr::fill(df, Year), out)
})
test_that("mutate: list columns", {
df <- tibble(x = list(1, 2))
# from list to scalar
expect_message({
out <- tidylog::mutate(df, x = 1)
}, "converted.*from list to")
# from list to identical list
expect_message({
out <- tidylog::mutate(df, x = list(1, 2))
}, "no changes")
# from list to different list
expect_message({
out <- tidylog::mutate(df, x = lapply(x, function(v) v * 100))
}, "changed 2 values")
# from scalar to list
df <- tibble(x = 1:2)
expect_message({
out <- tidylog::mutate(df, x = as.list(x))
}, "converted.*from integer to list")
})
test_that("mutate: ordered factors", {
df <- tibble(x = ordered(c("apple", "bear", "banana", "dear")))
rec <- forcats::fct_recode(df$x, fruit = "apple", fruit = "banana")
# new variable
expect_message({
new <- tidylog::mutate(df,
y = forcats::fct_recode(x, fruit = "apple", fruit = "banana"))
}, "new variable 'y' (ordered factor) with 3 unique values", fixed = TRUE)
expect_true(all(new$y == rec))
# overwriting
expect_message({
new <- tidylog::mutate(df,
x = forcats::fct_recode(x, fruit = "apple", fruit = "banana"))
}, "changed 2 values")
expect_true(all(new$x == rec))
})
test_that("mutate: variable type", {
expect_message({
tidylog::mutate(tibble(x = 1:10), y = 1)
}, "new variable 'y' (double)", fixed = TRUE)
expect_message({
tidylog::mutate(tibble(x = 1:10), y = "a")
}, "new variable 'y' (character)", fixed = TRUE)
expect_message({
tidylog::mutate(tibble(x = 1:10), y = as.factor("a"))
}, "new variable 'y' (factor)", fixed = TRUE)
})
test_that("mutate: units", {
expect_message({
mutate(tibble(a = 1:2), a = units::set_units(a, mg))
}, "mutate: converted 'a' from integer to units (0 new NA)", fixed = TRUE)
})
test_that("mutate: formatting", {
expect_message({
mutate(tibble(x = rep(NA_real_, 1000000)), x = 1)
}, "mutate: changed 1,000,000 values (100%) of 'x' (1,000,000 fewer NAs)", fixed = TRUE)
expect_message({
mutate(tibble(x = rep(NA_real_, 1000000)), x = ifelse(row_number() == 1, 1, x))
}, "mutate: changed one value (<1%) of 'x' (one fewer NA)", fixed = TRUE)
expect_message({
mutate(tibble(x = 1:10000), x = ifelse(row_number() == 1, NA, x))
}, "mutate: changed one value (<1%) of 'x' (one new NA)", fixed = TRUE)
expect_message({
mutate(tibble(x = 1:10000), x = ifelse(row_number() <= 2, NA, x))
}, "mutate: changed 2 values (<1%) of 'x' (2 new NAs)", fixed = TRUE)
})
test_that("mutate: drop column", {
d <- tibble(a = 1, b = 2, c = 3)
expect_message(mutate(d, a = NULL), "dropped")
expect_message(mutate(d, a = NULL, b = 10), "dropped")
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.