context("fsum") 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)) })