tests/testthat/test-select-replace-vars.R

In collapse: Advanced and Fast Data Transformation

context("select, replace or add vars")

if(!is.null(attributes(identical(FALSE, TRUE)))) stop("OECD label issue")

# rm(list = ls())

test_that("selecting vars works well", {
  expect_identical(get_vars(wlddev, 4:8), wlddev[4:8])
  expect_identical(get_vars(wlddev, -(4:8)), wlddev[-(4:8)])
  expect_identical(get_vars(wlddev, sapply(wlddev, is.numeric)), wlddev[sapply(wlddev, is.numeric)])
  expect_identical(get_vars(wlddev, c("iso3c","PCGDP","ODA")), wlddev[c("iso3c","PCGDP","ODA")])
  expect_identical(get_vars(wlddev, "D", regex = TRUE), wlddev[c("OECD","PCGDP","ODA")])
  expect_identical(get_vars(wlddev, c("D","L"), regex = TRUE), wlddev[c("OECD","PCGDP","LIFEEX","ODA")])
  expect_identical(get_vars(wlddev, is.factor), wlddev[sapply(wlddev, is.factor)])

  expect_identical(num_vars(wlddev), wlddev[sapply(wlddev, is.numeric)])
  expect_identical(cat_vars(wlddev), wlddev[sapply(wlddev, is_categorical)])
  expect_identical(char_vars(wlddev), wlddev[sapply(wlddev, is.character)])
  expect_identical(fact_vars(wlddev), wlddev[sapply(wlddev, is.factor)])
  expect_identical(date_vars(wlddev), wlddev[sapply(wlddev, is_date)])
})

test_that("replacing vars works well", {
  wlddevold <- wlddev
  get_vars(wlddev, 4:8) <- get_vars(wlddev, 4:8)
  expect_identical(wlddevold, wlddev)

  wlddevold <- wlddev
  fselect(wlddev, PCGDP:GINI) <- fselect(wlddev, PCGDP:GINI)
  expect_identical(wlddevold, wlddev)

  wlddevold <- wlddev
  get_vars(wlddev, -(4:8)) <- get_vars(wlddev, -(4:8))
  expect_identical(wlddevold, wlddev)

  wlddevold <- wlddev
  fselect(wlddev, -(PCGDP:GINI)) <- fselect(wlddev, -(PCGDP:GINI))
  expect_identical(wlddevold, wlddev)

  wlddevold <- wlddev
  get_vars(wlddev, -(4:8)) <- as.list(get_vars(wlddev, -(4:8)))
  expect_identical(wlddevold, wlddev)

  wlddevold <- wlddev
  get_vars(wlddev, c("iso3c","PCGDP","ODA")) <- get_vars(wlddev, c("iso3c","PCGDP","ODA"))
  expect_identical(wlddevold, wlddev)

  wlddevold <- wlddev
  get_vars(wlddev, "D", regex = TRUE) <- get_vars(wlddev, "D", regex = TRUE)
  expect_identical(wlddevold, wlddev)

  wlddevold <- wlddev
  get_vars(wlddev, c("D","L"), regex = TRUE) <- get_vars(wlddev, c("D","L"), regex = TRUE)
  expect_identical(wlddevold, wlddev)

  wlddevold <- wlddev
  get_vars(wlddev, sapply(wlddev, is.numeric)) <- get_vars(wlddev, sapply(wlddev, is.numeric))
  expect_identical(wlddevold, wlddev)

  wlddevold <- wlddev
  get_vars(wlddev, is.factor) <- get_vars(wlddev, is.factor)
  expect_identical(wlddevold, wlddev)

  wlddevold <- wlddev
  num_vars(wlddev) <- num_vars(wlddev)
  expect_identical(wlddevold, wlddev)

  wlddevold <- wlddev
  cat_vars(wlddev) <- cat_vars(wlddev)
  expect_identical(wlddevold, wlddev)

  wlddevold <- wlddev
  char_vars(wlddev) <- char_vars(wlddev)
  expect_identical(wlddevold, wlddev)

  wlddevold <- wlddev
  fact_vars(wlddev) <- fact_vars(wlddev)
  expect_identical(wlddevold, wlddev)

  wlddevold <- wlddev
  logi_vars(wlddev) <- logi_vars(wlddev)
  expect_identical(wlddevold, wlddev)

  wlddevold <- wlddev
  date_vars(wlddev) <- date_vars(wlddev)
  expect_identical(wlddevold, wlddev)
})

test_that("adding vars works well", {
  wlddev1 <- wlddev2 <- wlddev
  temp <- STD(get_vars(wlddev, 9:12))
  add_vars(wlddev1) <- temp
  wlddev2[names(temp)] <- temp
  expect_identical(wlddev1, wlddev2)

  wlddev1 <- wlddev
  temp <- STD(get_vars(wlddev, 9:12))
  add_vars(wlddev1, "front") <- temp
  expect_identical(wlddev1, add_vars(temp, wlddev))

  wlddev1 <- wlddev
  temp <- STD(get_vars(wlddev, 9:13))
  add_vars(wlddev1, c(10,12,14,16,18)) <- temp
  expect_true(all_identical(wlddev1,  add_vars(wlddev, temp, pos = c(10,12,14,16,18)),
                            add_vars(gv(wlddev, 1:9), gv(temp, 1), gv(wlddev, 10), gv(temp, 2),
                                     gv(wlddev, 11), gv(temp, 3), gv(wlddev, 12), gv(temp, 4), gv(wlddev, 13), gv(temp, 5))))

})

test_that("replacing with or adding atomic elements works well", {
  wlddev1 <- wlddev2 <- wlddev
  get_vars(wlddev1, 9) <- wlddev$PCGDP
  expect_identical(wlddev1, wlddev)

  get_vars(wlddev1, 9) <- qM(wlddev[9:12])
  wlddev2[9] <- qM(wlddev[9:12])
  expect_identical(wlddev1, wlddev2)

  wlddev1 <- wlddev2 <- wlddev
  add_vars(wlddev1) <- wlddev$PCGDP
  expect_identical(wlddev1, cbind(wlddev2, wlddev["PCGDP"]))

  wlddev1 <- wlddev2 <- wlddev
  add_vars(wlddev1) <- qM(wlddev[9:12])
  wlddev2["wlddev[9:12]"] <- qM(wlddev[9:12]) # formerly wlddev2["qM(wlddev[9:12])"], but no longer using deparse..
  expect_identical(wlddev1, wlddev2)

  wlddev1 <- wlddev2 <- wlddev
  add_vars(wlddev1, "front") <- wlddev$PCGDP
  expect_identical(wlddev1, add_vars(wlddev, wlddev$PCGDP, pos = 1))

  wlddev1 <- wlddev2 <- wlddev
  add_vars(wlddev1, "front") <- qM(wlddev[9:12])
  expect_identical(wlddev1, add_vars(wlddev, qM(wlddev[9:12]), pos = 1))
})


test_that("empty selections work well", {
  expect_equal(cat_vars(mtcars), mtcars[0L])
  expect_equal(char_vars(mtcars), mtcars[0L])
  expect_equal(fact_vars(mtcars), mtcars[0L])
  expect_equal(logi_vars(mtcars), mtcars[0L])
  expect_equal(get_vars(mtcars, is.character), mtcars[0L])
  expect_equal(get_vars(mtcars, 0L), mtcars[0L])
  expect_error(get_vars(mtcars, NULL))
})


test_that("select vars errors for wrong input", {
  expect_error(get_vars(wlddev, 14))
  expect_error(get_vars(wlddev, 1:14))
  expect_error(get_vars(wlddev, -14))
  expect_error(get_vars(wlddev, c("PCGDP","ODA3")))
  # expect_warning(get_vars(wlddev, "bla", regex = TRUE)) # Better give error
  expect_error(get_vars(wlddev, c(sapply(wlddev, is.numeric), TRUE)))
  expect_error(get_vars(wlddev, sapply(wlddev, is.numeric)[-1]))
})

test_that("replace vars errors for wrong input", {
  expect_error(get_vars(wlddev, 14) <- wlddev[12])
  expect_error(get_vars(wlddev, "ODA3") <- wlddev[12])
  expect_error(get_vars(wlddev, "bla", regex = TRUE) <- wlddev[12])
  expect_error(get_vars(wlddev, -14) <- wlddev[12])
  expect_error(get_vars(wlddev, 11:12) <- wlddev[12])
  expect_error(get_vars(wlddev, 9:12) <- wlddev[8:12])
  expect_invisible(get_vars(wlddev, 12) <- wlddev$ODA)
  expect_error(get_vars(wlddev, 12) <- wlddev$ODA[-1])
  expect_error(get_vars(wlddev, 12) <- qM(wlddev[9:12])[-1, ])
  expect_error(get_vars(wlddev, c(sapply(wlddev, is.numeric), TRUE)) <- wlddev)
  expect_error(get_vars(wlddev, sapply(wlddev, is.numeric)[-1]) <- wlddev)
})

test_that("add_vars errors for wrong input", {
  expect_error(add_vars(wlddev, 15) <- wlddev[12])
  expect_error(add_vars(wlddev, "ODA3") <- wlddev[12])

  expect_error(add_vars(wlddev) <- qM(wlddev[9:12])[-1, ])
  expect_error(add_vars(wlddev, "front") <- qM(wlddev[9:12])[-1, ])
  expect_error(add_vars(wlddev, 8) <- qM(wlddev[9:12])[-1, ])

  expect_error(add_vars(wlddev) <- wlddev[-1, 9:12])
  expect_error(add_vars(wlddev, "front") <- wlddev[-1, 9:12])
  expect_error(add_vars(wlddev, 8) <- wlddev[-1, 9:12])

  expect_error(add_vars(wlddev, 12) <- wlddev[9:12])
  expect_error(add_vars(wlddev, 9:12) <- wlddev[9:10])
})

test_that("fselect errors for wrong input", {
    expect_visible(fselect(mtcars, 1))
    expect_error(fselect(mtcars, "bla"))
    expect_visible(fselect(mtcars, "mpg"))
    expect_error(fselect(mtcars, mpg:bla))
    expect_error(fselect(mtcars, mpg > cyl))
    expect_error(fselect(mtcars, ~mpg))
})


test_that("fselect works properly", {
  expect_equal(fselect(mtcars, mpg, 2), mtcars[1:2])
  expect_equal(fselect(mtcars, mpg:vs), mtcars[1:8])
  expect_equal(names(fselect(mtcars, bla = mpg, cyl:vs)), c("bla", names(mtcars)[2:8]))
  expect_invisible(fselect(wlddev, -PCGDP) <- fselect(wlddev, -PCGDP))
})


test_that("no problems with numeric values", {
  expect_equal(fselect(mtcars, 1), mtcars[1])
  expect_equal(get_vars(mtcars, 1), mtcars[1])
  expect_equal(gv(mtcars, 1), mtcars[1])

  expect_invisible(fselect(mtcars, 1) <- mtcars[1])
  expect_invisible(get_vars(mtcars, 1) <- mtcars[1])
  expect_invisible(gv(mtcars, 1) <- mtcars[1])
  expect_invisible(av(mtcars, pos = 1) <- mtcars[1])
})