tests/testthat/test-recode_into.R

In easystats/datawizard: Easy Data Wrangling and Statistical Transformations

test_that("recode_into", {
  x <- 1:10
  out <- recode_into(
    x > 5 ~ "a",
    x > 2 & x <= 5 ~ "b",
    default = "c"
  )
  expect_identical(out, c("c", "c", "b", "b", "b", "a", "a", "a", "a", "a"))
})

test_that("recode_into, overwrite", {
  x <- 1:30
  expect_warning(
    recode_into(
      x > 1 ~ "a",
      x > 10 & x <= 15 ~ "b",
      default = "c",
      overwrite = TRUE
    ),
    regex = "overwritten"
  )
  # validate results
  x <- 1:10
  expect_silent({
    out <- recode_into(
      x >= 3 & x <= 7 ~ 1,
      x > 5 ~ 2,
      default = 0,
      verbose = FALSE
    )
  })
  expect_identical(out, c(0, 0, 1, 1, 1, 2, 2, 2, 2, 2))
  expect_warning(
    recode_into(
      x >= 3 & x <= 7 ~ 1,
      x > 5 ~ 2,
      default = 0
    ),
    regex = "case 6"
  )

  x <- 1:10
  expect_silent({
    out <- recode_into(
      x >= 3 & x <= 7 ~ 1,
      x > 5 ~ 2,
      default = 0,
      overwrite = FALSE,
      verbose = FALSE
    )
  })
  expect_identical(out, c(0, 0, 1, 1, 1, 1, 1, 2, 2, 2))
  expect_warning(
    recode_into(
      x >= 3 & x <= 7 ~ 1,
      x > 5 ~ 2,
      default = 0,
      overwrite = FALSE
    ),
    regex = "case 6"
  )
})

test_that("recode_into, don't overwrite", {
  x <- 1:30
  expect_warning(
    recode_into(
      x > 1 ~ "a",
      x > 10 & x <= 15 ~ "b",
      default = "c",
      overwrite = FALSE
    ),
    regex = "altered"
  )
})

test_that("recode_into, check mixed types", {
  x <- 1:10
  expect_error(
    {
      out <- recode_into(
        x > 5 ~ 1,
        x > 2 & x <= 5 ~ "b"
      )
    },
    regexp = "Recoding not carried out"
  )
})

test_that("recode_into, complain about default = NULL", {
  x <- 1:10
  expect_warning(
    {
      out <- recode_into(
        x > 5 ~ "c",
        x > 2 & x <= 5 ~ "b",
        default = NULL
      )
    },
    regexp = "Default value"
  )
  expect_identical(out, c(NA, NA, "b", "b", "b", "c", "c", "c", "c", "c"))
})

test_that("recode_into, data frame", {
  data(mtcars)
  out <- recode_into(
    mtcars$mpg > 20 & mtcars$cyl == 6 ~ 1,
    mtcars$mpg <= 20 ~ 2,
    default = 0
  )
  expect_identical(
    out,
    c(
      1, 1, 0, 1, 2, 2, 2, 0, 0, 2, 2, 2, 2, 2, 2, 2, 2, 0, 0, 0,
      0, 2, 2, 2, 2, 0, 0, 0, 2, 2, 2, 0
    )
  )
  d <- mtcars
  out <- recode_into(
    mpg > 20 & cyl == 6 ~ 1,
    mpg <= 20 ~ 2,
    default = 0,
    data = d
  )
  expect_identical(
    out,
    c(
      1, 1, 0, 1, 2, 2, 2, 0, 0, 2, 2, 2, 2, 2, 2, 2, 2, 0, 0, 0,
      0, 2, 2, 2, 2, 0, 0, 0, 2, 2, 2, 0
    )
  )
})

test_that("recode_into, works inside functions", {
  test <- function() {
    set.seed(123)
    d <- data.frame(
      x = sample.int(5, 30, TRUE),
      y = sample(letters[1:5], 30, TRUE),
      stringsAsFactors = FALSE
    )
    recode_into(
      x %in% 1:3 & y %in% c("a", "b") ~ 1,
      x > 3 ~ 2,
      data = d,
      default = 0
    )
  }
  expect_identical(
    test(),
    c(
      1, 1, 1, 0, 0, 2, 2, 0, 1, 1, 2, 0, 0, 0, 2, 1, 1, 2, 1, 0,
      1, 1, 0, 2, 0, 1, 2, 2, 1, 2
    )
  )
})

test_that("recode_into, check differen input length", {
  x <- 1:10
  y <- 10:30
  expect_error(
    {
      out <- recode_into(
        x > 5 ~ 1,
        y > 10 ~ 2
      )
    },
    regexp = "matching conditions"
  )
})

test_that("recode_into, check different input length", {
  x <- 1:5
  y <- c(5, 2, 3, 1, 4)
  expect_warning(
    {
      out <- recode_into(
        x == 2 ~ 1,
        y == 2 & x == 2 ~ 2,
        default = 0
      )
    },
    regexp = "Several recode patterns"
  )
})

test_that("recode_into, make sure recode works with missing in original variable", {
  data(mtcars)
  mtcars$mpg[c(3, 10, 12, 15, 16)] <- NA
  mtcars$cyl[c(2, 15, 16)] <- NA
  d_recode_na <<- as.data.frame(mtcars)
  out1_recoded_na <- recode_into(
    d_recode_na$mpg > 20 & d_recode_na$cyl == 6 ~ 1,
    d_recode_na$mpg <= 20 ~ 2,
    d_recode_na$cyl == 4 ~ 3,
    default = 0,
    preserve_na = TRUE
  )
  out2_recoded_na <- recode_into(
    d_recode_na$mpg > 20 & d_recode_na$cyl == 6 ~ 1,
    d_recode_na$mpg <= 20 ~ 2,
    default = 0,
    preserve_na = TRUE
  )
  expect_message(
    {
      out3_recoded_na <- recode_into(
        d_recode_na$mpg > 20 & d_recode_na$cyl == 6 ~ 1,
        d_recode_na$mpg <= 20 ~ 2,
        d_recode_na$cyl == 4 ~ 3,
        default = 0,
        preserve_na = FALSE
      )
    },
    regex = "Missing values in original variable"
  )
  expect_message(
    {
      out4_recoded_na <- recode_into(
        d_recode_na$mpg > 20 & d_recode_na$cyl == 6 ~ 1,
        d_recode_na$mpg <= 20 ~ 2,
        default = 0,
        preserve_na = FALSE
      )
    },
    regex = "Missing values in original variable"
  )
  # one NA in mpg is overwritten by valid value from cyl, total 5 NA
  expect_identical(
    out1_recoded_na,
    c(
      1, NA, 3, 1, 2, 2, 2, 3, 3, NA, 2, NA, 2, 2, NA, NA, 2, 3,
      3, 3, 3, 2, 2, 2, 2, 3, 3, 3, 2, 2, 2, 3
    )
  )
  # total 6 NA
  expect_identical(
    out2_recoded_na,
    c(
      1, NA, NA, 1, 2, 2, 2, 0, 0, NA, 2, NA, 2, 2, NA, NA, 2, 0,
      0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 2, 2, 2, 0
    )
  )
  # NA is preserved, set to default if not overwritten by other recodes
  expect_identical(
    out3_recoded_na,
    c(
      1, 0, 3, 1, 2, 2, 2, 3, 3, 0, 2, 0, 2, 2, 0, 0, 2, 3, 3, 3,
      3, 2, 2, 2, 2, 3, 3, 3, 2, 2, 2, 3
    )
  )
  expect_identical(
    out4_recoded_na,
    c(
      1, 0, 0, 1, 2, 2, 2, 0, 0, 0, 2, 0, 2, 2, 0, 0, 2, 0, 0, 0,
      0, 2, 2, 2, 2, 0, 0, 0, 2, 2, 2, 0
    )
  )
})

test_that("recode_into, NA doesn't need to be of exact type", {
  data(mtcars)
  x1 <- recode_into(
    mpg > 10 ~ 1,
    gear == 5 ~ NA_real_,
    data = mtcars,
    verbose = FALSE
  )
  x2 <- recode_into(
    mpg > 10 ~ 1,
    gear == 5 ~ NA,
    data = mtcars,
    verbose = FALSE
  )
  expect_identical(x1, x2)
})