test-fsum.R
In collapse: Advanced and Fast Data Transformation

context("fsum")

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

bsum <- base::sum

# TODO:
# identical(as.integer(fsum(td, g)), unname(fsum(t, g)))
# str(fsum(m))
# Do integer checks using identical, not all.equal..

# rm(list = ls())
set.seed(101)
x <- rnorm(100) * 1000
w <- abs(100*rnorm(100))
wdat <- abs(100*rnorm(32))
xNA <- x
wNA <- w
wdatNA <- wdat
xNA[sample.int(100,20)] <- NA
wNA[sample.int(100,20)] <- NA
wdatNA[sample.int(32, 5)] <- NA
f <- as.factor(sample.int(10, 100, TRUE))
g <- GRP(mtcars, ~ cyl + vs + am)
gf <- as_factor_GRP(g)
mtcNA <- na_insert(mtcars)
mtcNA[27,1] <- NA # single group NA !!
m <- as.matrix(mtcars)
mNA <- as.matrix(mtcNA)
mNAc <- mNA
storage.mode(mNAc) <- "character"

na20 <- function(x) {
  x[is.na(x)] <- 0L
  x
}

condan20 <- function(x, cond) if(cond) dapply(x, na20) else x

wsum <- function(x, w, na.rm = FALSE) {
  if(na.rm) {
    cc <- complete.cases(x, w)
    if(!any(cc)) return(NA_real_)
    x <- x[cc]
    w <- w[cc]
  }
  bsum(x*w)
}


for (nth in 1:2) {

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

for(fill_arg in 1:2) {

 if(fill_arg == 2L) fsum <- function(x, ...) collapse::fsum(x, ..., fill = TRUE)

test_that("fsum performs like base::sum and base::colSums", {
  expect_equal(fsum(NA), if(fill_arg == 1L) NA_real_ else 0)
  expect_equal(fsum(NA, na.rm = FALSE), bsum(NA))
  expect_equal(fsum(1), bsum(1, na.rm = TRUE))
  expect_identical(fsum(1:3), bsum(1:3, na.rm = TRUE))
  expect_identical(fsum(-1:1), bsum(-1:1, na.rm = TRUE))
  expect_equal(fsum(1, na.rm = FALSE), bsum(1))
  expect_identical(fsum(1:3, na.rm = FALSE), bsum(1:3))
  expect_identical(fsum(-1:1, na.rm = FALSE), bsum(-1:1))
  expect_equal(fsum(x), bsum(x, na.rm = TRUE))
  expect_equal(fsum(x, na.rm = FALSE), bsum(x))
  expect_equal(fsum(xNA, na.rm = FALSE), bsum(xNA))
  expect_equal(fsum(xNA), bsum(xNA, na.rm = TRUE))
  expect_equal(fsum(mtcars), fsum(m))
  expect_equal(fsum(m), colSums(m, na.rm = TRUE))
  expect_equal(fsum(m, na.rm = FALSE), colSums(m))
  expect_equal(fsum(mNA, na.rm = FALSE), colSums(mNA))
  expect_equal(fsum(mNA), colSums(mNA, na.rm = TRUE))
  expect_equal(fsum(mtcars), dapply(mtcars, bsum, na.rm = TRUE))
  expect_equal(fsum(mtcars, na.rm = FALSE), dapply(mtcars, bsum))
  expect_equal(fsum(mtcNA, na.rm = FALSE), dapply(mtcNA, bsum))
  expect_equal(fsum(mtcNA), dapply(mtcNA, bsum, na.rm = TRUE))
  expect_equal(fsum(x, f), BY(x, f, bsum, na.rm = TRUE))
  expect_equal(fsum(x, f, na.rm = FALSE), BY(x, f, bsum))
  expect_equal(fsum(xNA, f, na.rm = FALSE), BY(xNA, f, bsum))
  expect_equal(na20(fsum(xNA, f)), BY(xNA, f, bsum, na.rm = TRUE))
  expect_equal(fsum(m, g), BY(m, g, bsum, na.rm = TRUE))
  expect_equal(fsum(m, g, na.rm = FALSE), BY(m, g, bsum))
  expect_equal(fsum(mNA, g, na.rm = FALSE), BY(mNA, g, bsum))
  expect_equal(na20(fsum(mNA, g)), BY(mNA, g, bsum, na.rm = TRUE)) # error, bsum(NA) give 0
  expect_equal(fsum(mtcars, g), BY(mtcars, g, bsum, na.rm = TRUE))
  expect_equal(fsum(mtcars, g, na.rm = FALSE), BY(mtcars, g, bsum))
  expect_equal(fsum(mtcNA, g, na.rm = FALSE), BY(mtcNA, g, bsum))
  expect_equal(na20(fsum(mtcNA, g)), BY(mtcNA, g, bsum, na.rm = TRUE)) # error, bsum(NA) give 0
})

test_that("fsum with weights performs like wsum (defined above)", {
  # complete weights
  expect_equal(fsum(NA, w = 1), if(fill_arg == 1L) NA_real_ else 0)
  expect_equal(fsum(NA, w = 1, na.rm = FALSE), wsum(NA, 1))
  expect_equal(fsum(1, w = 1), wsum(1, w = 1))
  expect_equal(fsum(1:3, w = 1:3), wsum(1:3, 1:3))
  expect_equal(fsum(-1:1, w = 1:3), wsum(-1:1, 1:3))
  expect_equal(fsum(1, w = 1, na.rm = FALSE), wsum(1, 1))
  expect_equal(fsum(1:3, w = c(0.99,3454,1.111), na.rm = FALSE), wsum(1:3, c(0.99,3454,1.111)))
  expect_equal(fsum(-1:1, w = 1:3, na.rm = FALSE), wsum(-1:1, 1:3))
  expect_equal(fsum(x, w = w), wsum(x, w))
  expect_equal(fsum(x, w = w, na.rm = FALSE), wsum(x, w))
  expect_equal(fsum(xNA, w = w, na.rm = FALSE), wsum(xNA, w))
  expect_equal(fsum(xNA, w = w), wsum(xNA, w, na.rm = TRUE))
  expect_equal(fsum(mtcars, w = wdat), fsum(m, w = wdat))
  expect_equal(fsum(m, w = wdat), dapply(m, wsum, wdat, na.rm = TRUE))
  expect_equal(fsum(m, w = wdat, na.rm = FALSE), dapply(m, wsum, wdat))
  expect_equal(fsum(mNA, w = wdat, na.rm = FALSE), dapply(mNA, wsum, wdat))
  expect_equal(fsum(mNA, w = wdat), dapply(mNA, wsum, wdat, na.rm = TRUE))
  expect_equal(fsum(mtcars, w = wdat), dapply(mtcars, wsum, wdat, na.rm = TRUE))
  expect_equal(fsum(mtcars, w = wdat, na.rm = FALSE), dapply(mtcars, wsum, wdat))
  expect_equal(fsum(mtcNA, w = wdat, na.rm = FALSE), dapply(mtcNA, wsum, wdat))
  expect_equal(fsum(mtcNA, w = wdat), dapply(mtcNA, wsum, wdat, na.rm = TRUE))
  expect_equal(fsum(x, f, w), BY(x, f, wsum, w))
  expect_equal(fsum(x, f, w, na.rm = FALSE), BY(x, f, wsum, w))
  expect_equal(fsum(xNA, f, w, na.rm = FALSE), BY(xNA, f, wsum, w))
  expect_equal(fsum(xNA, f, w), BY(xNA, f, wsum, w, na.rm = TRUE))
  expect_equal(fsum(m, g, wdat), BY(m, gf, wsum, wdat))
  expect_equal(fsum(m, g, wdat, na.rm = FALSE), BY(m, gf, wsum, wdat))
  expect_equal(fsum(mNA, g, wdat, na.rm = FALSE),  BY(mNA, gf, wsum, wdat))
  expect_equal(fsum(mNA, g, wdat), condan20(BY(mNA, gf, wsum, wdat, na.rm = TRUE), fill_arg == 2L))
  expect_equal(fsum(mtcars, g, wdat), BY(mtcars, gf, wsum, wdat))
  expect_equal(fsum(mtcars, g, wdat, na.rm = FALSE), BY(mtcars, gf, wsum, wdat))
  expect_equal(fsum(mtcNA, g, wdat, na.rm = FALSE), BY(mtcNA, gf, wsum, wdat))
  expect_equal(fsum(mtcNA, g, wdat), condan20(BY(mtcNA, gf, wsum, wdat, na.rm = TRUE), fill_arg == 2L))
  # missing weights
  expect_equal(fsum(NA, w = NA), if(fill_arg == 1L) NA_real_ else 0)
  expect_equal(fsum(NA, w = NA, na.rm = FALSE), wsum(NA, NA))
  expect_equal(fsum(1, w = NA), if(fill_arg == 1L) NA_real_ else 0)
  expect_equal(fsum(1:3, w = c(NA,1:2)), wsum(1:3, c(NA,1:2), na.rm = TRUE))
  expect_equal(fsum(-1:1, w = c(NA,1:2)), wsum(-1:1, c(NA,1:2), na.rm = TRUE))
  expect_equal(fsum(1, w = NA, na.rm = FALSE), wsum(1, NA))
  expect_equal(fsum(1:3, w = c(NA,1:2), na.rm = FALSE), wsum(1:3, c(NA,1:2)))
  expect_equal(fsum(-1:1, w = c(NA,1:2), na.rm = FALSE), wsum(-1:1, c(NA,1:2)))
  expect_equal(fsum(x, w = wNA), wsum(x, wNA, na.rm = TRUE))
  expect_equal(fsum(x, w = wNA, na.rm = FALSE), wsum(x, wNA))
  expect_equal(fsum(xNA, w = wNA, na.rm = FALSE), wsum(xNA, wNA))
  expect_equal(fsum(xNA, w = wNA), wsum(xNA, wNA, na.rm = TRUE))
  expect_equal(fsum(mtcars, w = wdatNA), fsum(m, w = wdatNA))
  expect_equal(fsum(m, w = wdatNA), dapply(m, wsum, wdatNA, na.rm = TRUE))
  expect_equal(fsum(m, w = wdatNA, na.rm = FALSE), dapply(m, wsum, wdatNA))
  expect_equal(fsum(mNA, w = wdatNA, na.rm = FALSE), dapply(mNA, wsum, wdatNA))
  expect_equal(fsum(mNA, w = wdatNA), dapply(mNA, wsum, wdatNA, na.rm = TRUE))
  expect_equal(fsum(mtcars, w = wdatNA), dapply(mtcars, wsum, wdatNA, na.rm = TRUE))
  expect_equal(fsum(mtcars, w = wdatNA, na.rm = FALSE), dapply(mtcars, wsum, wdatNA))
  expect_equal(fsum(mtcNA, w = wdatNA, na.rm = FALSE), dapply(mtcNA, wsum, wdatNA))
  expect_equal(fsum(mtcNA, w = wdatNA), dapply(mtcNA, wsum, wdatNA, na.rm = TRUE))
  expect_equal(fsum(x, f, wNA), BY(x, f, wsum, wNA, na.rm = TRUE))
  expect_equal(fsum(x, f, wNA, na.rm = FALSE), BY(x, f, wsum, wNA))
  expect_equal(fsum(xNA, f, wNA, na.rm = FALSE), BY(xNA, f, wsum, wNA))
  expect_equal(fsum(xNA, f, wNA), BY(xNA, f, wsum, wNA, na.rm = TRUE))
  expect_equal(fsum(m, g, wdatNA), BY(m, gf, wsum, wdatNA, na.rm = TRUE))
  expect_equal(fsum(m, g, wdatNA, na.rm = FALSE), BY(m, gf, wsum, wdatNA))
  expect_equal(fsum(mNA, g, wdatNA, na.rm = FALSE),  BY(mNA, gf, wsum, wdatNA))
  expect_equal(fsum(mNA, g, wdatNA), condan20(BY(mNA, gf, wsum, wdatNA, na.rm = TRUE), fill_arg == 2L))
  expect_equal(fsum(mtcars, g, wdatNA), BY(mtcars, gf, wsum, wdatNA, na.rm = TRUE))
  expect_equal(fsum(mtcars, g, wdatNA, na.rm = FALSE), BY(mtcars, gf, wsum, wdatNA))
  expect_equal(fsum(mtcNA, g, wdatNA, na.rm = FALSE), BY(mtcNA, gf, wsum, wdatNA))
  expect_equal(fsum(mtcNA, g, wdatNA), condan20(BY(mtcNA, gf, wsum, wdatNA, na.rm = TRUE), fill_arg == 2L))
})

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

test_that("fsum with complete weights performs numerically stable", {
  expect_true(all_obj_equal(replicate(50, fsum(1, w = 1), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(NA, w = 1), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(NA, w = 1, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(x, w = w), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(x, w = w, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(xNA, w = w, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(xNA, w = w), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(m, w = wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(m, w = wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mNA, w = wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mNA, w = wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcars, w = wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcars, w = wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcNA, w = wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcNA, w = wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(x, f, w), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(x, f, w, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(xNA, f, w, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(xNA, f, w), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(m, g, wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(m, g, wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mNA, g, wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mNA, g, wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcars, g, wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcars, g, wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcNA, g, wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcNA, g, wdat), simplify = FALSE)))
})

test_that("fsum with missing weights performs numerically stable", {
  expect_true(all_obj_equal(replicate(50, fsum(1, w = NA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(NA, w = NA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(NA, w = NA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(x, w = wNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(x, w = wNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(xNA, w = wNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(xNA, w = wNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(m, w = wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(m, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mNA, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mNA, w = wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcars, w = wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcars, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcNA, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcNA, w = wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(x, f, wNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(x, f, wNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(xNA, f, wNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(xNA, f, wNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(m, g, wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(m, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mNA, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mNA, g, wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcars, g, wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcars, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcNA, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcNA, g, wdatNA), simplify = FALSE)))
})

test_that("fsum handles special values in the right way", {
  expect_equal(fsum(NA), if(fill_arg == 1L) NA_real_ else 0)
  expect_equal(fsum(NaN), if(fill_arg == 1L) NaN else 0)
  expect_equal(fsum(Inf), Inf)
  expect_equal(fsum(-Inf), -Inf)
  expect_equal(fsum(TRUE), 1)
  expect_equal(fsum(FALSE), 0)
  expect_equal(fsum(NA, na.rm = FALSE), NA_real_)
  expect_equal(fsum(NaN, na.rm = FALSE), NaN)
  expect_equal(fsum(Inf, na.rm = FALSE), Inf)
  expect_equal(fsum(-Inf, na.rm = FALSE), -Inf)
  expect_equal(fsum(TRUE, na.rm = FALSE), 1)
  expect_equal(fsum(FALSE, na.rm = FALSE), 0)
  expect_equal(fsum(c(1,NA)), 1)
  expect_equal(fsum(c(1,NaN)), 1)
  expect_equal(fsum(c(1,Inf)), Inf)
  expect_equal(fsum(c(1,-Inf)), -Inf)
  expect_equal(fsum(c(FALSE,TRUE)), 1)
  expect_equal(fsum(c(TRUE,TRUE)), 2)
  expect_equal(fsum(c(1,Inf), na.rm = FALSE), Inf)
  expect_equal(fsum(c(1,-Inf), na.rm = FALSE), -Inf)
  expect_equal(fsum(c(FALSE,TRUE), na.rm = FALSE), 1)
  expect_equal(fsum(c(TRUE,TRUE), na.rm = FALSE), 2)
})

test_that("fsum with weights handles special values in the right way", {
  expect_equal(fsum(NA, w = 1), if(fill_arg == 1L) NA_real_ else 0)
  expect_equal(fsum(NaN, w = 1), if(fill_arg == 1L) NaN else 0)
  expect_equal(fsum(Inf, w = 1), Inf)
  expect_equal(fsum(-Inf, w = 1), -Inf)
  expect_equal(fsum(TRUE, w = 1), 1)
  expect_equal(fsum(FALSE, w = 1), 0)
  expect_equal(fsum(NA, w = 1, na.rm = FALSE), NA_real_)
  expect_equal(fsum(NaN, w = 1, na.rm = FALSE), NaN)
  expect_equal(fsum(Inf, w = 1, na.rm = FALSE), Inf)
  expect_equal(fsum(-Inf, w = 1, na.rm = FALSE), -Inf)
  expect_equal(fsum(TRUE, w = 1, na.rm = FALSE), 1)
  expect_equal(fsum(FALSE, w = 1, na.rm = FALSE), 0)
  expect_equal(fsum(NA, w = NA), if(fill_arg == 1L) NA_real_ else 0)
  expect_equal(fsum(NaN, w = NA), if(fill_arg == 1L) NA_real_ else 0)
  expect_equal(fsum(Inf, w = NA), if(fill_arg == 1L) NA_real_ else 0)
  expect_equal(fsum(-Inf, w = NA), if(fill_arg == 1L) NA_real_ else 0)
  expect_equal(fsum(TRUE, w = NA), if(fill_arg == 1L) NA_real_ else 0)
  expect_equal(fsum(FALSE, w = NA), if(fill_arg == 1L) NA_real_ else 0)
  expect_equal(fsum(NA, w = NA, na.rm = FALSE), NA_real_)
  expect_equal(fsum(NaN, w = NA, na.rm = FALSE), NA_real_)
  expect_equal(fsum(Inf, w = NA, na.rm = FALSE), NA_real_)
  expect_equal(fsum(-Inf, w = NA, na.rm = FALSE), NA_real_)
  expect_equal(fsum(TRUE, w = NA, na.rm = FALSE), NA_real_)
  expect_equal(fsum(FALSE, w = NA, na.rm = FALSE), NA_real_)
  expect_equal(fsum(1:3, w = c(1,Inf,3)), Inf)
  expect_equal(fsum(1:3, w = c(1,-Inf,3)), -Inf)
  expect_equal(fsum(1:3, w = c(1,Inf,3), na.rm = FALSE), Inf)
  expect_equal(fsum(1:3, w = c(1,-Inf,3), na.rm = FALSE), -Inf)
})

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

# Testing fsum with integers...

x <- as.integer(x)
xNA <- as.integer(xNA)
mtcars <- dapply(mtcars, as.integer)
mtcNA <- dapply(mtcNA, as.integer)
storage.mode(m) <- "integer"
storage.mode(mNA) <- "integer"

toint <- function(x) {
  storage.mode(x) <- "integer"
  x
}

test_that("fsum with integers performs like base::sum and base::colSums", {
  expect_identical(fsum(x), bsum(x, na.rm = TRUE))
  expect_identical(fsum(x, na.rm = FALSE), bsum(x))
  expect_identical(fsum(xNA, na.rm = FALSE), bsum(xNA))
  expect_identical(fsum(xNA), bsum(xNA, na.rm = TRUE))
  expect_identical(toint(fsum(mtcars)), fsum(m))
  expect_identical(fsum(m), toint(colSums(m, na.rm = TRUE)))
  expect_identical(fsum(m, na.rm = FALSE), toint(colSums(m)))
  expect_identical(fsum(mNA, na.rm = FALSE), toint(colSums(mNA)))
  expect_identical(fsum(mNA), toint(colSums(mNA, na.rm = TRUE)))
  expect_identical(toint(fsum(mtcars)), dapply(mtcars, bsum, na.rm = TRUE))
  expect_identical(toint(fsum(mtcars, na.rm = FALSE)), dapply(mtcars, bsum))
  expect_identical(toint(fsum(mtcNA, na.rm = FALSE)), dapply(mtcNA, bsum))
  expect_identical(toint(fsum(mtcNA)), dapply(mtcNA, bsum, na.rm = TRUE))
  expect_identical(fsum(x, f), BY(x, f, bsum, na.rm = TRUE))
  expect_identical(fsum(x, f, na.rm = FALSE), BY(x, f, bsum))
  expect_identical(fsum(xNA, f, na.rm = FALSE), BY(xNA, f, bsum))
  expect_identical(na20(fsum(xNA, f)), BY(xNA, f, bsum, na.rm = TRUE))
  expect_identical(fsum(m, g), BY(m, g, bsum, na.rm = TRUE))
  expect_identical(fsum(m, g, na.rm = FALSE), BY(m, g, bsum))
  expect_identical(fsum(mNA, g, na.rm = FALSE), BY(mNA, g, bsum))
  expect_identical(na20(fsum(mNA, g)), BY(mNA, g, bsum, na.rm = TRUE)) # error, bsum(NA) give 0
  expect_identical(fsum(mtcars, g), BY(mtcars, g, bsum, na.rm = TRUE))
  expect_identical(fsum(mtcars, g, na.rm = FALSE), BY(mtcars, g, bsum))
  expect_identical(fsum(mtcNA, g, na.rm = FALSE), BY(mtcNA, g, bsum))
  expect_identical(na20(fsum(mtcNA, g)), BY(mtcNA, g, bsum, na.rm = TRUE)) # error, bsum(NA) give 0
})

test_that("fsum with integers and weights performs like wsum (defined above)", {
  # complete weights
  expect_equal(fsum(x, w = w), wsum(x, w))
  expect_equal(fsum(x, w = w, na.rm = FALSE), wsum(x, w))
  expect_equal(fsum(xNA, w = w, na.rm = FALSE), wsum(xNA, w))
  expect_equal(fsum(xNA, w = w), wsum(xNA, w, na.rm = TRUE))
  expect_equal(fsum(mtcars, w = wdat), fsum(m, w = wdat))
  expect_equal(fsum(m, w = wdat), dapply(m, wsum, wdat, na.rm = TRUE))
  expect_equal(fsum(m, w = wdat, na.rm = FALSE), dapply(m, wsum, wdat))
  expect_equal(fsum(mNA, w = wdat, na.rm = FALSE), dapply(mNA, wsum, wdat))
  expect_equal(fsum(mNA, w = wdat), dapply(mNA, wsum, wdat, na.rm = TRUE))
  expect_equal(fsum(mtcars, w = wdat), dapply(mtcars, wsum, wdat, na.rm = TRUE))
  expect_equal(fsum(mtcars, w = wdat, na.rm = FALSE), dapply(mtcars, wsum, wdat))
  expect_equal(fsum(mtcNA, w = wdat, na.rm = FALSE), dapply(mtcNA, wsum, wdat))
  expect_equal(fsum(mtcNA, w = wdat), dapply(mtcNA, wsum, wdat, na.rm = TRUE))
  expect_equal(fsum(x, f, w), BY(x, f, wsum, w))
  expect_equal(fsum(x, f, w, na.rm = FALSE), BY(x, f, wsum, w))
  expect_equal(fsum(xNA, f, w, na.rm = FALSE), BY(xNA, f, wsum, w))
  expect_equal(fsum(xNA, f, w), BY(xNA, f, wsum, w, na.rm = TRUE))
  expect_equal(fsum(m, g, wdat), BY(m, gf, wsum, wdat))
  expect_equal(fsum(m, g, wdat, na.rm = FALSE), BY(m, gf, wsum, wdat))
  expect_equal(fsum(mNA, g, wdat, na.rm = FALSE),  BY(mNA, gf, wsum, wdat))
  expect_equal(fsum(mNA, g, wdat), condan20(BY(mNA, gf, wsum, wdat, na.rm = TRUE), fill_arg == 2L))
  expect_equal(fsum(mtcars, g, wdat), BY(mtcars, gf, wsum, wdat))
  expect_equal(fsum(mtcars, g, wdat, na.rm = FALSE), BY(mtcars, gf, wsum, wdat))
  expect_equal(fsum(mtcNA, g, wdat, na.rm = FALSE), BY(mtcNA, gf, wsum, wdat))
  expect_equal(fsum(mtcNA, g, wdat), condan20(BY(mtcNA, gf, wsum, wdat, na.rm = TRUE), fill_arg == 2L))
  # missing weights
  expect_equal(fsum(x, w = wNA), wsum(x, wNA, na.rm = TRUE))
  expect_equal(fsum(x, w = wNA, na.rm = FALSE), wsum(x, wNA))
  expect_equal(fsum(xNA, w = wNA, na.rm = FALSE), wsum(xNA, wNA))
  expect_equal(fsum(xNA, w = wNA), wsum(xNA, wNA, na.rm = TRUE))
  expect_equal(fsum(mtcars, w = wdatNA), fsum(m, w = wdatNA))
  expect_equal(fsum(m, w = wdatNA), dapply(m, wsum, wdatNA, na.rm = TRUE))
  expect_equal(fsum(m, w = wdatNA, na.rm = FALSE), dapply(m, wsum, wdatNA))
  expect_equal(fsum(mNA, w = wdatNA, na.rm = FALSE), dapply(mNA, wsum, wdatNA))
  expect_equal(fsum(mNA, w = wdatNA), dapply(mNA, wsum, wdatNA, na.rm = TRUE))
  expect_equal(fsum(mtcars, w = wdatNA), dapply(mtcars, wsum, wdatNA, na.rm = TRUE))
  expect_equal(fsum(mtcars, w = wdatNA, na.rm = FALSE), dapply(mtcars, wsum, wdatNA))
  expect_equal(fsum(mtcNA, w = wdatNA, na.rm = FALSE), dapply(mtcNA, wsum, wdatNA))
  expect_equal(fsum(mtcNA, w = wdatNA), dapply(mtcNA, wsum, wdatNA, na.rm = TRUE))
  expect_equal(fsum(x, f, wNA), BY(x, f, wsum, wNA, na.rm = TRUE))
  expect_equal(fsum(x, f, wNA, na.rm = FALSE), BY(x, f, wsum, wNA))
  expect_equal(fsum(xNA, f, wNA, na.rm = FALSE), BY(xNA, f, wsum, wNA))
  expect_equal(fsum(xNA, f, wNA), BY(xNA, f, wsum, wNA, na.rm = TRUE))
  expect_equal(fsum(m, g, wdatNA), BY(m, gf, wsum, wdatNA, na.rm = TRUE))
  expect_equal(fsum(m, g, wdatNA, na.rm = FALSE), BY(m, gf, wsum, wdatNA))
  expect_equal(fsum(mNA, g, wdatNA, na.rm = FALSE),  BY(mNA, gf, wsum, wdatNA))
  expect_equal(fsum(mNA, g, wdatNA), condan20(BY(mNA, gf, wsum, wdatNA, na.rm = TRUE), fill_arg == 2L))
  expect_equal(fsum(mtcars, g, wdatNA), BY(mtcars, gf, wsum, wdatNA, na.rm = TRUE))
  expect_equal(fsum(mtcars, g, wdatNA, na.rm = FALSE), BY(mtcars, gf, wsum, wdatNA))
  expect_equal(fsum(mtcNA, g, wdatNA, na.rm = FALSE), BY(mtcNA, gf, wsum, wdatNA))
  expect_equal(fsum(mtcNA, g, wdatNA), condan20(BY(mtcNA, gf, wsum, wdatNA, na.rm = TRUE), fill_arg == 2L))
})

test_that("fsum performs numerically stable", {
  expect_true(all_identical(replicate(50, fsum(x), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(x, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(xNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(xNA), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(m), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(m, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(mNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(mNA), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(mtcars), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(mtcars, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(mtcNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(mtcNA), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(x, f), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(x, f, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(xNA, f, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(xNA, f), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(m, g), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(m, g, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(mNA, g, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(mNA, g), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(mtcars, g), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(mtcars, g, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(mtcNA, g, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_identical(replicate(50, fsum(mtcNA, g), simplify = FALSE)))
})

test_that("fsum with integers and complete weights performs numerically stable", {
  expect_true(all_obj_equal(replicate(50, fsum(x, w = w), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(x, w = w, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(xNA, w = w, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(xNA, w = w), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(m, w = wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(m, w = wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mNA, w = wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mNA, w = wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcars, w = wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcars, w = wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcNA, w = wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcNA, w = wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(x, f, w), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(x, f, w, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(xNA, f, w, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(xNA, f, w), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(m, g, wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(m, g, wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mNA, g, wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mNA, g, wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcars, g, wdat), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcars, g, wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcNA, g, wdat, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcNA, g, wdat), simplify = FALSE)))
})

test_that("fsum with integers and missing weights performs numerically stable", {
  expect_true(all_obj_equal(replicate(50, fsum(x, w = wNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(x, w = wNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(xNA, w = wNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(xNA, w = wNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(m, w = wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(m, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mNA, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mNA, w = wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcars, w = wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcars, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcNA, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcNA, w = wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(x, f, wNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(x, f, wNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(xNA, f, wNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(xNA, f, wNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(m, g, wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(m, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mNA, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mNA, g, wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcars, g, wdatNA), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcars, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcNA, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
  expect_true(all_obj_equal(replicate(50, fsum(mtcNA, g, wdatNA), simplify = FALSE)))
})

test_that("fsum with integers produces errors for wrong input", {
  expect_error(fsum(m,1:31))
  expect_error(fsum(mtcars,1:31))
  expect_error(fsum(mtcars, w = 1:31))
  expect_error(fsum(mNA, w = 1:33))
  expect_error(fsum(m,1:32,1:20))
  expect_error(fsum(mtcars,1:32,1:10))
})

test_that("Miscellaneous Issues with Integers", {
  expect_identical(fsum(NA_integer_), if(fill_arg == 1L) NA_integer_ else 0L)
  expect_identical(fsum(NA_integer_, na.rm = FALSE), NA_integer_)
  expect_identical(fsum(c(NA_integer_, NA_integer_)), if(fill_arg == 1L) NA_integer_ else 0L)
  expect_identical(fsum(c(NA_integer_, NA_integer_), na.rm = FALSE), NA_integer_)
  expect_identical(fsum(c(NA_integer_, 1L)), 1L)
  expect_identical(fsum(c(NA_integer_, 1L), na.rm = FALSE), NA_integer_)
  expect_identical(fsum(c(-2147483646L, -2L)), -2147483648)
  expect_identical(fsum(c(-2147483646L, -2L), na.rm = FALSE), -2147483648)
  expect_identical(fsum(-c(-2147483646L, -2L)), 2147483648)
  expect_identical(fsum(-c(-2147483646L, -2L), na.rm = FALSE), 2147483648)
})

z <- as.integer(wlddev$year*1000000L)
set.seed(101)
zNA <- na_insert(z)
gz <- wlddev$iso3c
test_that("Integer overflow errors", {
  # With groups
  expect_error(fsum(z, gz))
  expect_error(fsum(z, gz, na.rm = FALSE))
  expect_error(fsum(zNA, gz))
  expect_error(fsum(zNA, gz, na.rm = FALSE))
})

# Recreating doubles before next iteration...
set.seed(101)
x <- rnorm(100) * 1000
xNA <- x
xNA[sample.int(100,20)] <- NA
rm(mtcars)
mtcNA <- na_insert(mtcars)
mtcNA[27,1] <- NA # single group NA !!
m <- as.matrix(mtcars)
mNA <- as.matrix(mtcNA)

if(fill_arg == 2L) rm(fsum)
}

}


test_that("fill arg works as intended", {
  expect_equal(fsum(NA, fill = TRUE), 0)
  expect_equal(fsum(c(NA, NA), fill = TRUE), 0)
  expect_equal(fsum(NA, w = 1, fill = TRUE), 0)
  expect_equal(fsum(c(NA, NA), w = 1:2, fill = TRUE), 0)

  expect_equal(unattrib(fsum(NA, 1, fill = TRUE)), 0)
  expect_equal(unattrib(fsum(c(NA, NA), 1:2, fill = TRUE)), c(0, 0))
  expect_equal(unattrib(fsum(NA, 1, 1, fill = TRUE)), 0)
  expect_equal(unattrib(fsum(c(NA, NA), 1:2, 1:2, fill = TRUE)), c(0, 0))
})