tests/testthat/test-ffirst-flast.R

In collapse: Advanced and Fast Data Transformation

context("ffirst and flast")

if(!is.null(attributes(identical(FALSE, TRUE)))) stop("OECD label issue")
# TODO: Check matrix with list columns !!
# Benchmark with groups: Bettr to check missing x ???

# rm(list = ls())
set.seed(101)
x <- rnorm(100)
w <- abs(100 * rnorm(100))
xNA <- x
wNA <- w
xNA[sample.int(100, 20)] <- NA
wNA[sample.int(100, 20)] <- NA
f <- as.factor(sample.int(10, 100, TRUE))

data <- wlddev[wlddev$iso3c %in% c("BLZ","IND","USA","SRB","GRL"), ]
l <- nrow(data)
g <- GRP(droplevels(data$iso3c))
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)

basefirst <- function(x, na.rm = FALSE) {
  if(is.list(x)) return(if(na.rm) x[which(lengths(x) > 0L)[1L]] else x[1L])
  if(na.rm) x[which(!is.na(x))[1L]] else x[1L]
}
baselast <- function(x, na.rm = FALSE) {
  lst <- function(x) x[length(x)]
  if(is.list(x)) return(if(na.rm) x[lst(which(lengths(x) > 0L))] else lst(x))
  if(na.rm && !all(na <- is.na(x))) x[lst(which(!na))] else lst(x)
}

# ffirst

test_that("ffirst performs like basefirst (defined above)", {
  expect_equal(ffirst(NA), basefirst(NA))
  expect_equal(ffirst(NA, na.rm = FALSE), basefirst(NA))
  expect_equal(ffirst(1), basefirst(1, na.rm = TRUE))
  expect_equal(ffirst(1:3), basefirst(1:3, na.rm = TRUE))
  expect_equal(ffirst(-1:1), basefirst(-1:1, na.rm = TRUE))
  expect_equal(ffirst(1, na.rm = FALSE), basefirst(1))
  expect_equal(ffirst(1:3, na.rm = FALSE), basefirst(1:3))
  expect_equal(ffirst(-1:1, na.rm = FALSE), basefirst(-1:1))
  expect_equal(ffirst(x), basefirst(x, na.rm = TRUE))
  expect_equal(ffirst(x, na.rm = FALSE), basefirst(x))
  expect_equal(ffirst(m[, 1]), basefirst(m[, 1]))
  expect_equal(ffirst(xNA, na.rm = FALSE), basefirst(xNA))
  expect_equal(ffirst(xNA), basefirst(xNA, na.rm = TRUE))
  expect_equal(ffirst(mNA[, 1]), basefirst(mNA[, 1], na.rm = TRUE))
  expect_equal(ffirst(m), dapply(m, basefirst, na.rm = TRUE))
  expect_equal(ffirst(m, na.rm = FALSE), dapply(m, basefirst))
  expect_equal(ffirst(mNA, na.rm = FALSE), dapply(mNA, basefirst))
  expect_equal(ffirst(mNA), dapply(mNA, basefirst, na.rm = TRUE))
  expect_equal(ffirst(data, drop = FALSE), dapply(data, basefirst, na.rm = TRUE, drop = FALSE))
  expect_equal(ffirst(data, na.rm = FALSE, drop = FALSE), dapply(data, basefirst, drop = FALSE))
  expect_equal(ffirst(dataNA, na.rm = FALSE, drop = FALSE), dapply(dataNA, basefirst, drop = FALSE))
  expect_equal(ffirst(dataNA, drop = FALSE), dapply(dataNA, basefirst, na.rm = TRUE, drop = FALSE))
  expect_equal(ffirst(x, f), BY(x, f, basefirst, na.rm = TRUE))
  expect_equal(ffirst(x, f, na.rm = FALSE), BY(x, f, basefirst))
  expect_equal(ffirst(xNA, f, na.rm = FALSE), BY(xNA, f, basefirst))
  expect_equal(ffirst(xNA, f), BY(xNA, f, basefirst, na.rm = TRUE))
  expect_equal(ffirst(m, na.rm = FALSE), m[1L, ])
  expect_equal(ffirst(m, na.rm = FALSE, drop = FALSE), setRownames(m[1L, , drop = FALSE], NULL))
  expect_equal(ffirst(m, g), BY(setRownames(m, NULL), g, basefirst, na.rm = TRUE))
  expect_equal(ffirst(m, g, na.rm = FALSE), BY(setRownames(m, NULL), g, basefirst))
  expect_equal(ffirst(mNA, g, na.rm = FALSE), BY(setRownames(mNA, NULL), g, basefirst))
  expect_equal(ffirst(mNA, g), BY(setRownames(mNA, NULL), g, basefirst, na.rm = TRUE))
  expect_equal(ffirst(data, na.rm = FALSE, drop = FALSE), setRownames(data[1L, ]))
  expect_equal(ffirst(data, g, use.g.names = FALSE), BY(data, g, basefirst, na.rm = TRUE, use.g.names = FALSE))
  expect_equal(setRownames(ffirst(data, g, na.rm = FALSE)), BY(data, g, basefirst, use.g.names = FALSE))
  expect_equal(setRownames(ffirst(dataNA, g, na.rm = FALSE)), BY(dataNA, g, basefirst, use.g.names = FALSE))
  expect_equal(ffirst(dataNA, g, use.g.names = FALSE), BY(dataNA, g, basefirst, na.rm = TRUE, use.g.names = FALSE))
})

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

test_that("ffirst handles special values in the right way", {
  expect_equal(ffirst(NA), NA)
  expect_equal(ffirst(NaN), NaN)
  expect_equal(ffirst(Inf), Inf)
  expect_equal(ffirst(-Inf), -Inf)
  expect_equal(ffirst(TRUE), TRUE)
  expect_equal(ffirst(FALSE), FALSE)
  expect_equal(ffirst(NA, na.rm = FALSE), NA)
  expect_equal(ffirst(NaN, na.rm = FALSE), NaN)
  expect_equal(ffirst(Inf, na.rm = FALSE), Inf)
  expect_equal(ffirst(-Inf, na.rm = FALSE), -Inf)
  expect_equal(ffirst(TRUE, na.rm = FALSE), TRUE)
  expect_equal(ffirst(FALSE, na.rm = FALSE), FALSE)
  expect_equal(ffirst(c(1,NA)), 1)
  expect_equal(ffirst(c(1,NaN)), 1)
  expect_equal(ffirst(c(1,Inf)), 1)
  expect_equal(ffirst(c(1,-Inf)), 1)
  expect_equal(ffirst(c(FALSE,TRUE)), FALSE)
  expect_equal(ffirst(c(TRUE,FALSE)), TRUE)
  expect_equal(ffirst(c(1,Inf), na.rm = FALSE), 1)
  expect_equal(ffirst(c(1,-Inf), na.rm = FALSE), 1)
  expect_equal(ffirst(c(FALSE,TRUE), na.rm = FALSE), FALSE)
  expect_equal(ffirst(c(TRUE,FALSE), na.rm = FALSE), TRUE)
})

test_that("ffirst produces errors for wrong input", {
  expect_visible(ffirst("a"))
  expect_visible(ffirst(NA_character_))
  expect_visible(ffirst(mNA))
  expect_error(ffirst(mNA, f))
  expect_error(ffirst(1:2,1:3))
  expect_error(ffirst(m,1:31))
  expect_error(ffirst(data,1:31))
  expect_warning(ffirst("a", w = 1))
  expect_warning(ffirst(1:2, w = 1:3))
  expect_warning(ffirst(NA_character_, w = 1))
  expect_warning(ffirst(mNA, w = wdat))
  expect_error(ffirst(mNA, f, 2))
  expect_warning(ffirst(mNA, w = 1:33))
  expect_error(ffirst(1:2,1:2, 1:3))
  expect_error(ffirst(m,1:32,1:20))
  expect_error(ffirst(data,1:32,1:10))
  expect_warning(ffirst(1:2, w = c("a","b")))
  expect_visible(ffirst(wlddev))
  expect_warning(ffirst(wlddev, w = wlddev$year, drop = FALSE))
  expect_visible(ffirst(wlddev, wlddev$iso3c))
  expect_error(ffirst(wlddev, wlddev$iso3c, wlddev$year))
})


# flast

test_that("flast performs like baselast (defined above)", {
  expect_equal(flast(NA), baselast(NA))
  expect_equal(flast(NA, na.rm = FALSE), baselast(NA))
  expect_equal(flast(1), baselast(1, na.rm = TRUE))
  expect_equal(flast(1:3), baselast(1:3, na.rm = TRUE))
  expect_equal(flast(-1:1), baselast(-1:1, na.rm = TRUE))
  expect_equal(flast(1, na.rm = FALSE), baselast(1))
  expect_equal(flast(1:3, na.rm = FALSE), baselast(1:3))
  expect_equal(flast(-1:1, na.rm = FALSE), baselast(-1:1))
  expect_equal(flast(x), baselast(x, na.rm = TRUE))
  expect_equal(flast(x, na.rm = FALSE), baselast(x))
  expect_equal(flast(m[, 1]), baselast(m[, 1]))
  expect_equal(flast(xNA, na.rm = FALSE), baselast(xNA))
  expect_equal(flast(xNA), baselast(xNA, na.rm = TRUE))
  expect_equal(flast(mNA[, 1]), baselast(mNA[, 1], na.rm = TRUE))
  expect_equal(flast(m), dapply(m, baselast, na.rm = TRUE))
  expect_equal(flast(m, na.rm = FALSE), dapply(m, baselast))
  expect_equal(flast(mNA, na.rm = FALSE), dapply(mNA, baselast))
  expect_equal(flast(mNA), dapply(mNA, baselast, na.rm = TRUE))
  expect_equal(flast(data, drop = FALSE), dapply(data, baselast, na.rm = TRUE, drop = FALSE))
  expect_equal(flast(data, na.rm = FALSE, drop = FALSE), dapply(data, baselast, drop = FALSE))
  expect_equal(flast(dataNA, na.rm = FALSE, drop = FALSE), dapply(dataNA, baselast, drop = FALSE))
  expect_equal(flast(dataNA, drop = FALSE), dapply(dataNA, baselast, na.rm = TRUE, drop = FALSE))
  expect_equal(flast(x, f), BY(x, f, baselast, na.rm = TRUE))
  expect_equal(flast(x, f, na.rm = FALSE), BY(x, f, baselast))
  expect_equal(flast(xNA, f, na.rm = FALSE), BY(xNA, f, baselast))
  expect_equal(flast(xNA, f), BY(xNA, f, baselast, na.rm = TRUE))
  expect_equal(flast(m, na.rm = FALSE), m[nrow(m), ])
  expect_equal(flast(m, na.rm = FALSE, drop = FALSE), setRownames(m[nrow(m), , drop = FALSE], NULL))
  expect_equal(flast(m, g), BY(setRownames(m, NULL), g, baselast, na.rm = TRUE))
  expect_equal(flast(m, g, na.rm = FALSE), BY(setRownames(m, NULL), g, baselast))
  expect_equal(flast(mNA, g, na.rm = FALSE), BY(setRownames(mNA, NULL), g, baselast))
  expect_equal(flast(mNA, g), BY(setRownames(mNA, NULL), g, baselast, na.rm = TRUE))
  expect_equal(flast(data, na.rm = FALSE, drop = FALSE), setRownames(data[nrow(data), ]))
  expect_equal(flast(data, g, use.g.names = FALSE), BY(data, g, baselast, na.rm = TRUE, use.g.names = FALSE))
  expect_equal(setRownames(flast(data, g, na.rm = FALSE, use.g.names = FALSE)), BY(data, g, baselast, use.g.names = FALSE))
  expect_equal(setRownames(flast(dataNA, g, na.rm = FALSE, use.g.names = FALSE)), BY(dataNA, g, baselast, use.g.names = FALSE))
  expect_equal(flast(dataNA, g, use.g.names = FALSE), BY(dataNA, g, baselast, na.rm = TRUE, use.g.names = FALSE))
})

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

test_that("flast handles special values in the right way", {
  expect_equal(flast(NA), NA)
  expect_equal(flast(NaN), NaN)
  expect_equal(flast(Inf), Inf)
  expect_equal(flast(-Inf), -Inf)
  expect_equal(flast(TRUE), TRUE)
  expect_equal(flast(FALSE), FALSE)
  expect_equal(flast(NA, na.rm = FALSE), NA)
  expect_equal(flast(NaN, na.rm = FALSE), NaN)
  expect_equal(flast(Inf, na.rm = FALSE), Inf)
  expect_equal(flast(-Inf, na.rm = FALSE), -Inf)
  expect_equal(flast(TRUE, na.rm = FALSE), TRUE)
  expect_equal(flast(FALSE, na.rm = FALSE), FALSE)
  expect_equal(flast(c(1,NA)), 1)
  expect_equal(flast(c(1,NaN)), 1)
  expect_equal(flast(c(1,Inf)), Inf)
  expect_equal(flast(c(1,-Inf)), -Inf)
  expect_equal(flast(c(FALSE,TRUE)), TRUE)
  expect_equal(flast(c(TRUE,FALSE)), FALSE)
  expect_equal(flast(c(1,Inf), na.rm = FALSE), Inf)
  expect_equal(flast(c(1,-Inf), na.rm = FALSE), -Inf)
  expect_equal(flast(c(FALSE,TRUE), na.rm = FALSE), TRUE)
  expect_equal(flast(c(TRUE,FALSE), na.rm = FALSE), FALSE)
})

test_that("flast produces errors for wrong input", {
  expect_visible(flast("a"))
  expect_visible(flast(NA_character_))
  expect_visible(flast(mNA))
  expect_error(flast(mNA, f))
  expect_error(flast(1:2,1:3))
  expect_error(flast(m,1:31))
  expect_error(flast(data,1:31))
  expect_warning(flast("a", w = 1))
  expect_warning(flast(1:2, w = 1:3))
  expect_warning(flast(NA_character_, w = 1))
  expect_warning(flast(mNA, w = wdat))
  expect_error(flast(mNA, f, wdat))
  expect_warning(flast(mNA, w = 1:33))
  expect_error(flast(1:2,1:2, 1:3))
  expect_error(flast(m,1:32,1:20))
  expect_error(flast(data,1:32,1:10))
  expect_warning(flast(1:2, w = c("a","b")))
  expect_visible(flast(wlddev))
  expect_warning(flast(wlddev, w = wlddev$year, drop = FALSE))
  expect_visible(flast(wlddev, wlddev$iso3c))
  expect_error(flast(wlddev, wlddev$iso3c, wlddev$year))
})