tests/testthat/test_mutate.R

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")
})
elbersb/tidylog documentation built on Oct. 14, 2023, 12:54 p.m.