tests/testthat/test-quick-conversion.R

In collapse: Advanced and Fast Data Transformation

context("quick-conversion")

if(!is.null(attributes(identical(FALSE, TRUE)))) stop("OECD label issue")
NCRAN <- identical(Sys.getenv("NCRAN"), "TRUE")

# rm(list = ls())
set.seed(101)
x <- rnorm(10)
xNA <- x
xNA[c(3,10)] <- NA
f <- sample.int(3, 10, TRUE)
fNA <- f
fNA[c(3,10)] <- NA
l1 <- replicate(10, rnorm(10), simplify = FALSE)
l2 <- as.list(mtcars)
m <- as.matrix(mtcars)
m2 <- replicate(10, rnorm(10))

# Test this (plain matrix)
# X = sweep(d, 2L, colMeans(qM(d), na.rm = TRUE), "replace_fill")

setdfdt <- function(x) {
  attr(x, "row.names") <- .set_row_names(length(x[[1L]]))
  class(x) <- c("data.table","data.frame")
  alc(x)
}


test_that("conversions to factor run smoothly", {
  expect_identical(ordered(as.factor(x)), qF(x, ordered = TRUE))
  expect_identical(ordered(as.factor(f)), qF(f, ordered = TRUE))
  expect_identical(as.integer(as.factor(xNA)), as.integer(qF(xNA, ordered = TRUE)))
  expect_identical(as.integer(as.factor(fNA)), as.integer(qF(fNA, ordered = TRUE)))
  expect_identical(as.integer(as.factor(x)), as.integer(qG(x, ordered = TRUE)))
  expect_identical(as.integer(as.factor(f)), as.integer(qF(f, ordered = TRUE)))
  expect_identical(as.integer(as.factor(xNA)), as.integer(qG(xNA, ordered = TRUE)))
  expect_identical(as.integer(qF(fNA, ordered = TRUE)), as.integer(qG(fNA, ordered = TRUE)))
})

test_that("conversions to matrix run smoothly", {
  expect_identical(do.call(cbind, l1), qM(l1))
  expect_identical(do.call(cbind, l2), qM(l2))
  expect_identical(as.matrix(mtcars), qM(mtcars))
  expect_identical(`dimnames<-`(as.matrix(x), list(NULL, "x")), qM(x))
  expect_identical(qM(m), m)
  expect_identical(qM(m2), m2)
  expect_identical(mtcars, qDF(qM(qDF(mtcars, "car"), "car")))
  expect_identical(qM(mtcars), qM(qDF(mtcars, "car"), 1))
  expect_identical(mtcars, qDF(qM(qDF(mtcars, "car"), "car", keep.attr = TRUE)))
  expect_identical(qM(mtcars), qM(qDF(mtcars, "car"), 1, keep.attr = TRUE))
  expect_identical(setRownames(qM(GGDC10S, is.character), NULL), as.matrix(num_vars(GGDC10S)))
  expect_identical(setRownames(qM(GGDC10S, is.character, keep.attr = TRUE), NULL), as.matrix(num_vars(GGDC10S)))
})

test_that("conversions to data.frame / data.table run smoothly", {
  expect_identical(setNames(as.data.frame(l1), paste0("V",1:10)), qDF(l1))
  expect_identical(as.data.frame(l2), qDF(l2))
  expect_identical(as.data.frame(m), qDF(m))
  expect_identical(as.data.frame(m2), qDF(m2))
  expect_identical(as.data.frame(x), qDF(x))
  expect_identical(qDF(mtcars), mtcars)

  expect_identical(setdfdt(setNames(as.data.frame(l1), paste0("V",1:10))), qDT(l1))
  expect_identical(setdfdt(as.data.frame(l2)), qDT(l2))
  expect_identical(setdfdt(as.data.frame(m)), qDT(m))
  expect_identical(setdfdt(as.data.frame(m2)), qDT(m2))
  expect_identical(setdfdt(as.data.frame(x)), qDT(x))
  expect_identical(qDT(mtcars), setdfdt(mtcars))
})

test_that("double-conversions are ok", {
  expect_identical(qDF(qDT(mtcars)), setRownames(mtcars))
  expect_identical(qM(qDT(m)), setRownames(m, NULL))
  expect_identical(qM(qDF(m)), m)
})

test_that("mrtl and mctl work well", {
  expect_equal(mctl(m), lapply(seq_col(m), function(i) unattrib(m[, i])))
  expect_equal(mctl(m, TRUE), setNames(lapply(seq_col(m), function(i) unattrib(m[, i])), colnames(m)))
  expect_equal(mctl(m, TRUE, "data.frame"), mtcars)
  expect_equal(mctl(m, TRUE, "data.table"), qDT(mtcars))
  expect_equal(mctl(m, FALSE, "data.frame"), setRownames(setNames(mtcars, paste0("V", seq_col(mtcars)))))
  expect_equal(mctl(m, FALSE, "data.table"), qDT(setNames(mtcars, paste0("V", seq_col(mtcars)))))

  expect_equal(mrtl(m), lapply(seq_row(m), function(i) unattrib(m[i, ])))
  expect_equal(mrtl(m, TRUE), setNames(lapply(seq_row(m), function(i) unattrib(m[i, ])), rownames(m)))
  expect_equal(mrtl(m, TRUE, "data.frame"), as.data.frame(t(m)))
  expect_equal(mrtl(m, TRUE, "data.table"), qDT(as.data.frame(t(m))))
  expect_equal(mrtl(m, FALSE, "data.frame"), setRownames(setNames(as.data.frame(t(m)), paste0("V", seq_row(mtcars)))))
  expect_equal(mrtl(m, FALSE, "data.table"), qDT(setNames(as.data.frame(t(m)), paste0("V", seq_row(mtcars)))))
})

test_that("qM keep.attr and class options work as intended", {
  expect_identical(qM(m), m)
  expect_identical(qM(m, keep.attr = TRUE), m)
  expect_identical(qM(m, keep.attr = TRUE, class = "matrix"), `oldClass<-`(m, "matrix"))
  expect_identical(qM(m, class = "matrix"), `oldClass<-`(m, "matrix"))

  expect_identical(qM(mtcars), m)
  expect_identical(qM(mtcars, keep.attr = TRUE), m)
  expect_identical(qM(mtcars, keep.attr = TRUE, class = "matrix"), `oldClass<-`(m, "matrix"))
  expect_identical(qM(mtcars, class = "matrix"), `oldClass<-`(m, "matrix"))

  gmtcars <- `attr<-`(fgroup_by(mtcars, cyl, vs, am), "was.tibble", NULL)
  expect_identical(qM(gmtcars), m)
  expect_identical(qM(gmtcars, keep.attr = TRUE), `attr<-`(m, "groups", attr(gmtcars, "groups")))
  expect_identical(qM(gmtcars, keep.attr = TRUE, class = "matrix"), `oldClass<-`(`attr<-`(m, "groups", attr(gmtcars, "groups")), "matrix"))
  expect_identical(qM(gmtcars, class = "matrix"), `oldClass<-`(m, "matrix"))
  if(NCRAN) {
  expect_identical(qM(EuStockMarkets, keep.attr = TRUE), EuStockMarkets)
  expect_identical(qM(EuStockMarkets), unclass(`attr<-`(EuStockMarkets, "tsp", NULL)))
  expect_false(identical(qM(EuStockMarkets), EuStockMarkets))
  expect_false(identical(qM(EuStockMarkets, keep.attr = TRUE, class = "matrix"), EuStockMarkets))

  tsl <- list(a = AirPassengers, b = AirPassengers)
  expect_identical(qM(tsl, keep.attr = TRUE), do.call(cbind, tsl))
  expect_identical(qM(tsl), unclass(`attr<-`(do.call(cbind, tsl), "tsp", NULL)))
  expect_false(identical(qM(tsl), do.call(cbind, tsl)))
  expect_false(identical(qM(tsl, keep.attr = TRUE, class = "matrix"), do.call(cbind, tsl)))
  }
})