tests/testthat/test-fNobs-fNdistinct.R

In collapse: Advanced and Fast Data Transformation

context("fnobs and fndistinct")

if(!is.null(attributes(identical(FALSE, TRUE)))) stop("OECD label issue")
# rm(list = ls())
set.seed(101)
x <- rnorm(100)
xNA <- x
xNA[sample.int(100,20)] <- NA
f <- as.factor(sample.int(10, 100, TRUE))
data <- fsubset(wlddev, iso3c %in% c("BLZ","IND","USA","SRB","GRL"))
g <- GRP.default(data$iso3c) # rev(), droplevels()
dataNA <- na_insert(data)
m <- as.matrix(data)
mNA <- as.matrix(dataNA)
data$LC <- as.list(data$PCGDP)
dataNA$LC <- lapply(na_insert(data["LC"])[[1]], function(x) if(is.na(x)) NULL else x)

bsum <- base::sum
Nobs <- function(x) if(is.list(x)) bsum(lengths(x) > 0L) else bsum(!is.na(x))
Ndistinct <- function(x, na.rm = FALSE) {
  if(na.rm) return(length(unique(x[!is.na(x)])))
  return(length(unique(x)))
}

# fnobs

test_that("fnobs performs like Nobs (defined above)", {
  expect_equal(fnobs(NA), as.double(Nobs(NA)))
  expect_equal(fnobs(1), Nobs(1))
  expect_equal(fnobs(1:3), Nobs(1:3))
  expect_equal(fnobs(-1:1), Nobs(-1:1))
  expect_equal(fnobs(x), Nobs(x))
  expect_equal(fnobs(xNA), Nobs(xNA))
  expect_equal(fnobs(data[-length(data)]), fnobs(m))
  expect_equal(fnobs(m), dapply(m, Nobs))
  expect_equal(fnobs(mNA), dapply(mNA, Nobs))
  expect_equal(fnobs(x, f), BY(x, f, Nobs))
  expect_equal(fnobs(xNA, f), BY(xNA, f, Nobs))
  expect_equal(fnobs(m, g), BY(m, g, Nobs))
  expect_equal(fnobs(mNA, g), BY(mNA, g, Nobs))
  expect_equal(fnobs(data, g), BY(data, g, Nobs))
  expect_equal(fnobs(dataNA, g), BY(dataNA, g, Nobs))
})

test_that("fnobs performs numerically stable", {
  expect_true(all_obj_equal(replicate(50, fnobs(1), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fnobs(NA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fnobs(x), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fnobs(xNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fnobs(m), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fnobs(mNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fnobs(data), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fnobs(dataNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fnobs(x, f), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fnobs(xNA, f), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fnobs(m, g), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fnobs(mNA, g), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fnobs(data, g), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fnobs(dataNA, g), simplify = FALSE)))
})

test_that("fnobs handles special values in the right way", {
  expect_equal(fnobs(NA), 0)
  expect_equal(fnobs(NaN), 0)
  expect_equal(fnobs(Inf), 1)
  expect_equal(fnobs(-Inf), 1)
  expect_equal(fnobs(TRUE), 1)
  expect_equal(fnobs(FALSE), 1)
})

test_that("fnobs produces errors for wrong input", {
  expect_visible(fnobs("a"))
  expect_visible(fnobs(NA_character_))
  expect_visible(fnobs(mNA))
  expect_visible(fnobs(mNA, g))
  expect_error(fnobs(1:2,1:3))
  expect_error(fnobs(m,1:31))
  expect_error(fnobs(m, 1))
  expect_error(fnobs(data,1:31))
  expect_visible(fnobs(wlddev))
  expect_visible(fnobs(wlddev, wlddev$iso3c))
})

data$LC <- NULL
dataNA$LC <- NULL

# fndistinct

for (nth in 1:2) {

  if(nth == 2L) {
    if(Sys.getenv("OMP") == "TRUE") {
      fndistinct <- function(x, ...) collapse::fndistinct(x, ..., nthreads = 2L)
    } else break
  }

test_that("fndistinct performs like Ndistinct (defined above)", {
  expect_equal(fndistinct(NA), 0)
  expect_equal(fndistinct(NA, na.rm = FALSE), 1)
  expect_equal(fndistinct(1), Ndistinct(1, na.rm = TRUE))
  expect_equal(fndistinct(1:3), Ndistinct(1:3, na.rm = TRUE))
  expect_equal(fndistinct(-1:1), Ndistinct(-1:1, na.rm = TRUE))
  expect_equal(fndistinct(1, na.rm = FALSE), Ndistinct(1))
  expect_equal(fndistinct(1:3, na.rm = FALSE), Ndistinct(1:3))
  expect_equal(fndistinct(-1:1, na.rm = FALSE), Ndistinct(-1:1))
  expect_equal(fndistinct(x), Ndistinct(x, na.rm = TRUE))
  expect_equal(fndistinct(x, na.rm = FALSE), Ndistinct(x))
  expect_equal(fndistinct(xNA, na.rm = FALSE), Ndistinct(xNA))
  expect_equal(fndistinct(xNA), Ndistinct(xNA, na.rm = TRUE))
  expect_equal(fndistinct(data), fndistinct(m))
  expect_equal(fndistinct(m), dapply(m, Ndistinct, na.rm = TRUE))
  expect_equal(fndistinct(m, na.rm = FALSE), dapply(m, Ndistinct))
  expect_equal(fndistinct(mNA, na.rm = FALSE), dapply(mNA, Ndistinct))
  expect_equal(fndistinct(mNA), dapply(mNA, Ndistinct, na.rm = TRUE))
  expect_equal(fndistinct(x, f), BY(x, f, Ndistinct, na.rm = TRUE))
  expect_equal(fndistinct(x, f, na.rm = FALSE), BY(x, f, Ndistinct))
  expect_equal(fndistinct(xNA, f, na.rm = FALSE), BY(xNA, f, Ndistinct))
  expect_equal(fndistinct(xNA, f), BY(xNA, f, Ndistinct, na.rm = TRUE))
  expect_equal(fndistinct(m, g), BY(m, g, Ndistinct, na.rm = TRUE))
  expect_equal(fndistinct(m, g, na.rm = FALSE), BY(m, g, Ndistinct))
  expect_equal(fndistinct(mNA, g, na.rm = FALSE), BY(mNA, g, Ndistinct))
  expect_equal(fndistinct(mNA, g), BY(mNA, g, Ndistinct, na.rm = TRUE))
  expect_equal(fndistinct(data, g), BY(data, g, Ndistinct, na.rm = TRUE))
  expect_equal(fndistinct(data, g, na.rm = FALSE), BY(data, g, Ndistinct))
  expect_equal(fndistinct(dataNA, g, na.rm = FALSE), BY(dataNA, g, Ndistinct))
  expect_equal(fndistinct(dataNA, g), BY(dataNA, g, Ndistinct, na.rm = TRUE))

  fg = as_factor_GRP(g)
  expect_equal(fndistinct(m, fg), BY(m, g, Ndistinct, na.rm = TRUE))
  expect_equal(fndistinct(m, fg, na.rm = FALSE), BY(m, g, Ndistinct))
  expect_equal(fndistinct(mNA, fg, na.rm = FALSE), BY(mNA, g, Ndistinct))
  expect_equal(fndistinct(mNA, fg), BY(mNA, g, Ndistinct, na.rm = TRUE))
  expect_equal(fndistinct(data, fg), BY(data, g, Ndistinct, na.rm = TRUE))
  expect_equal(fndistinct(data, fg, na.rm = FALSE), BY(data, g, Ndistinct))
  expect_equal(fndistinct(dataNA, fg, na.rm = FALSE), BY(dataNA, g, Ndistinct))
  expect_equal(fndistinct(dataNA, fg), BY(dataNA, g, Ndistinct, na.rm = TRUE))
})

test_that("fndistinct performs numerically stable", {
  expect_true(all_obj_equal(replicate(50, fndistinct(1), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(NA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(NA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(x), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(x, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(xNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(xNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(m), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(m, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(mNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(mNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(data), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(data, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(dataNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(dataNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(x, f), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(x, f, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(xNA, f, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(xNA, f), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(m, g), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(m, g, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(mNA, g, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(mNA, g), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(data, g), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(data, g, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(dataNA, g, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fndistinct(dataNA, g), simplify = FALSE)))
})

test_that("fndistinct handles special values in the right way", {
  expect_equal(fndistinct(NA), 0)
  expect_equal(fndistinct(NaN), 0)
  expect_equal(fndistinct(Inf), 1)
  expect_equal(fndistinct(-Inf), 1)
  expect_equal(fndistinct(TRUE), 1)
  expect_equal(fndistinct(FALSE), 1)
  expect_equal(fndistinct(c(TRUE,TRUE)), 1)
  expect_equal(fndistinct(c(TRUE,FALSE)), 2)
  expect_equal(fndistinct(c(FALSE,TRUE)), 2)
  expect_equal(fndistinct(c(FALSE,FALSE)), 1)
  expect_equal(fndistinct(c(NA,TRUE,TRUE,NA)), 1)
  expect_equal(fndistinct(c(NA,TRUE,FALSE,NA)), 2)
  expect_equal(fndistinct(c(NA,FALSE,TRUE,NA)), 2)
  expect_equal(fndistinct(c(NA,FALSE,FALSE,NA)), 1)
  # expect_equal(max(fndistinct(mNA > 10)), 1) # These tests are insecure to random number generation
  # expect_equal(max(fndistinct(mNA > 10, g)), 1)
  expect_equal(fndistinct(NA, na.rm = FALSE), 1)
  expect_equal(fndistinct(NaN, na.rm = FALSE), 1)
  expect_equal(fndistinct(Inf, na.rm = FALSE), 1)
  expect_equal(fndistinct(-Inf, na.rm = FALSE), 1)
  expect_equal(fndistinct(TRUE, na.rm = FALSE), 1)
  expect_equal(fndistinct(FALSE, na.rm = FALSE), 1)
  expect_equal(fndistinct(c(TRUE,TRUE), na.rm = FALSE), 1)
  expect_equal(fndistinct(c(TRUE,FALSE), na.rm = FALSE), 2)
  expect_equal(fndistinct(c(FALSE,TRUE), na.rm = FALSE), 2)
  expect_equal(fndistinct(c(FALSE,FALSE), na.rm = FALSE), 1)
  expect_equal(fndistinct(c(NA,TRUE,TRUE,NA), na.rm = FALSE), 2)
  expect_equal(fndistinct(c(NA,TRUE,FALSE,NA), na.rm = FALSE), 3)
  expect_equal(fndistinct(c(NA,FALSE,TRUE,NA), na.rm = FALSE), 3)
  expect_equal(fndistinct(c(NA,FALSE,FALSE,NA), na.rm = FALSE), 2)
  # expect_equal(max(fndistinct(mNA > 10, na.rm = FALSE)), 2)
  # expect_equal(max(fndistinct(mNA > 10, g, na.rm = FALSE)), 2)
})

test_that("fndistinct produces errors for wrong input", {
  expect_visible(fndistinct("a"))
  expect_visible(fndistinct(NA_character_))
  expect_visible(fndistinct(mNA))
  expect_visible(fndistinct(mNA, g))
  expect_error(fndistinct(1:2,1:3))
  expect_error(fndistinct(m,1:31))
  expect_error(fndistinct(m, 1))
  expect_error(fndistinct(data,1:31))
  expect_visible(fndistinct(wlddev))
  expect_visible(fndistinct(wlddev, wlddev$iso3c))
})

}

test_that("Singleton group optimization works properly", {
  g <- GRP(as.character(seq_row(mtcars)))
  xNA <- na_insert(mtcars$mpg)
  expect_equal(unattrib(fndistinct(xNA, g)), as.integer(!is.na(xNA[g$order])))
  g <- GRP(seq_row(mtcars))
  xNA <- na_insert(mtcars$mpg)
  expect_equal(unattrib(fndistinct(xNA, g)), as.integer(!is.na(xNA[g$order])))
  g <- GRP(sample.int(100, 32))
  xNA <- na_insert(mtcars$mpg)
  expect_equal(unattrib(fndistinct(xNA, g)), as.integer(!is.na(xNA[g$order])))
})