tests/testthat/test-fmean.R

context("fmean")

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

bmean <- base::mean
bsum <- base::sum

# rm(list = ls())
set.seed(101)
x <- rnorm(100)
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"

wmean <- function(x, w, na.rm = FALSE) {
  if(na.rm) {
    cc <- complete.cases(x, w)
    x <- x[cc]
    w <- w[cc]
  }
  bsum(x*w)/bsum(w)
}


for (nth in 1:2) {

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

test_that("fmean performs like base::mean", {
  expect_equal(fmean(NA), bmean(NA))
  expect_equal(fmean(NA, na.rm = FALSE), bmean(NA))
  expect_equal(fmean(1), bmean(1, na.rm = TRUE))
  expect_equal(fmean(1:3), bmean(1:3, na.rm = TRUE))
  expect_equal(fmean(-1:1), bmean(-1:1, na.rm = TRUE))
  expect_equal(fmean(1, na.rm = FALSE), bmean(1))
  expect_equal(fmean(1:3, na.rm = FALSE), bmean(1:3))
  expect_equal(fmean(-1:1, na.rm = FALSE), bmean(-1:1))
  expect_equal(fmean(x), bmean(x, na.rm = TRUE))
  expect_equal(fmean(x, na.rm = FALSE), bmean(x))
  expect_equal(fmean(xNA, na.rm = FALSE), bmean(xNA))
  expect_equal(fmean(xNA), bmean(xNA, na.rm = TRUE))
  expect_equal(fmean(mtcars), fmean(m))
  expect_equal(fmean(m), dapply(m, bmean, na.rm = TRUE))
  expect_equal(fmean(m, na.rm = FALSE), dapply(m, bmean))
  expect_equal(fmean(mNA, na.rm = FALSE), dapply(mNA, bmean))
  expect_equal(fmean(mNA), dapply(mNA, bmean, na.rm = TRUE))
  expect_equal(fmean(mtcars), dapply(mtcars, bmean, na.rm = TRUE))
  expect_equal(fmean(mtcars, na.rm = FALSE), dapply(mtcars, bmean))
  expect_equal(fmean(mtcNA, na.rm = FALSE), dapply(mtcNA, bmean))
  expect_equal(fmean(mtcNA), dapply(mtcNA, bmean, na.rm = TRUE))
  expect_equal(fmean(x, f), BY(x, f, bmean, na.rm = TRUE))
  expect_equal(fmean(x, f, na.rm = FALSE), BY(x, f, bmean))
  expect_equal(fmean(xNA, f, na.rm = FALSE), BY(xNA, f, bmean))
  expect_equal(fmean(xNA, f), BY(xNA, f, bmean, na.rm = TRUE))
  expect_equal(fmean(m, g), BY(m, g, bmean, na.rm = TRUE))
  expect_equal(fmean(m, g, na.rm = FALSE), BY(m, g, bmean))
  expect_equal(fmean(mNA, g, na.rm = FALSE), BY(mNA, g, bmean))
  expect_equal(fmean(mNA, g), BY(mNA, g, bmean, na.rm = TRUE))
  expect_equal(fmean(mtcars, g), BY(mtcars, g, bmean, na.rm = TRUE))
  expect_equal(fmean(mtcars, g, na.rm = FALSE), BY(mtcars, g, bmean))
  expect_equal(fmean(mtcNA, g, na.rm = FALSE), BY(mtcNA, g, bmean))
  expect_equal(fmean(mtcNA, g), BY(mtcNA, g, bmean, na.rm = TRUE))
})

test_that("fmean with weights performs as intended (unbiased)", {
  expect_equal(fmean(c(2,2,4,5,5,5)), fmean(c(2,4,5), w = c(2,1,3)))
  expect_equal(fmean(c(2,2,4,5,5,5), na.rm = FALSE), fmean(c(2,4,5), w = c(2,1,3), na.rm = FALSE))
  expect_equal(fmean(c(2.456,2.456,4.123,5.009,5.009,5.009)), fmean(c(2.456,4.123,5.009), w = c(2,1,3)))
  expect_equal(fmean(c(2.456,2.456,4.123,5.009,5.009,5.009), na.rm = FALSE), fmean(c(2.456,4.123,5.009), w = c(2,1,3), na.rm = FALSE))
  expect_equal(fmean(c(2,2,NA,5,5,5)), fmean(c(2,NA,5), w = c(2,1,3)))
  expect_equal(fmean(c(2,2,NA,5,5,5), na.rm = FALSE), fmean(c(2,NA,5), w = c(2,1,3), na.rm = FALSE))
  expect_equal(fmean(c(2,2,NA,5,5,5)), fmean(c(2,4,5), w = c(2,NA,3)))
  expect_equal(fmean(c(2,2,NA,5,5,5), na.rm = FALSE), fmean(c(2,4,5), w = c(2,NA,3), na.rm = FALSE))
  expect_equal(fmean(c(NA,NA,4.123,5.009,5.009,5.009)), fmean(c(NA,4.123,5.009), w = c(2,1,3)))
  expect_equal(fmean(c(NA,NA,4.123,5.009,5.009,5.009), na.rm = FALSE), fmean(c(NA,4.123,5.009), w = c(2,1,3), na.rm = FALSE))
  expect_equal(fmean(c(NA,NA,4.123,5.009,5.009,5.009)), fmean(c(2.456,4.123,5.009), w = c(NA,1,3)))
  expect_equal(fmean(c(NA,NA,4.123,5.009,5.009,5.009), na.rm = FALSE), fmean(c(2.456,4.123,5.009), w = c(NA,1,3), na.rm = FALSE))
  f <- as.factor(rep(1:2, each = 6)); fs <- as.factor(rep(1:2, each = 3))
  v <- c(2,2,4,5,5,5,2,2,4,5,5,5); vs <- c(2,4,5,2,4,5); w <- c(2,1,3,2,1,3)
  v2 <- c(2.456,2.456,4.123,5.009,5.009,5.009,2.456,2.456,4.123,5.009,5.009,5.009); v2s <- c(2.456,4.123,5.009,2.456,4.123,5.009)
  expect_equal(fmean(v, f), fmean(vs, fs, w))
  expect_equal(fmean(v, f, na.rm = FALSE), fmean(vs, fs, w, na.rm = FALSE))
  expect_equal(fmean(v2, f), fmean(v2s, fs, w))
  expect_equal(fmean(v2, f, na.rm = FALSE), fmean(v2s, fs, w, na.rm = FALSE))
  v[c(3,9)] <- NA; vs[c(2,5)] <- NA
  expect_equal(fmean(v, f), fmean(vs, fs, w))
  expect_equal(fmean(v, f, na.rm = FALSE), fmean(vs, fs, w, na.rm = FALSE))
  vs[c(2,5)] <- 4; w[c(2,5)] <- NA
  expect_equal(fmean(v, f), fmean(vs, fs, w))
  expect_equal(fmean(v, f, na.rm = FALSE), fmean(vs, fs, w, na.rm = FALSE))
  w[c(2,5)] <- 1; v2[c(1:2,7:8)] <- NA; v2s[c(1,4)] <- NA
  expect_equal(fmean(v2, f), fmean(v2s, fs, w))
  expect_equal(fmean(v2, f, na.rm = FALSE), fmean(v2s, fs, w, na.rm = FALSE))
  v2s[c(1,4)] <- 2.456; w[c(1,4)] <- NA
  expect_equal(fmean(v2, f), fmean(v2s, fs, w))
  expect_equal(fmean(v2, f, na.rm = FALSE), fmean(v2s, fs, w, na.rm = FALSE))
})

test_that("fmean performs like fmean with weights all equal", {
  expect_equal(fmean(NA), fmean(NA, w = 0.99999999))
  expect_equal(fmean(NA, na.rm = FALSE), fmean(NA, w = 2.946, na.rm = FALSE))
  expect_equal(fmean(1), fmean(1, w = 3))
  expect_equal(fmean(1:3), fmean(1:3, w = rep(0.999,3)))
  expect_equal(fmean(-1:1), fmean(-1:1, w = rep(4.2,3)))
  expect_equal(fmean(1, na.rm = FALSE), fmean(1, w = 5, na.rm = FALSE))
  expect_equal(fmean(1:3, na.rm = FALSE), fmean(1:3, w = rep(1.44565, 3), na.rm = FALSE))
  expect_equal(fmean(-1:1, na.rm = FALSE), fmean(-1:1, w = rep(1.44565, 3), na.rm = FALSE))
  expect_equal(fmean(x), fmean(x, w = rep(1,100)))
  expect_equal(fmean(x, na.rm = FALSE), fmean(x, w = rep(1.44565, 100), na.rm = FALSE))
  expect_equal(fmean(xNA, na.rm = FALSE), fmean(xNA, w = rep(4.676587, 100), na.rm = FALSE))
  expect_equal(fmean(xNA), fmean(xNA, w = rep(4.676587, 100)))
  expect_equal(fmean(m), fmean(m, w = rep(6587.3454, 32)))
  expect_equal(fmean(m, na.rm = FALSE), fmean(m, w = rep(6587.3454, 32), na.rm = FALSE))
  expect_equal(fmean(mNA, na.rm = FALSE), fmean(mNA, w = rep(6587.3454, 32), na.rm = FALSE))
  expect_equal(fmean(mNA), fmean(mNA, w = rep(6587.3454, 32)))
  expect_equal(fmean(mtcars), fmean(mtcars, w = rep(6787.3454, 32)))
  expect_equal(fmean(mtcars, na.rm = FALSE), fmean(mtcars, w = rep(6787.3454, 32), na.rm = FALSE))
  expect_equal(fmean(mtcNA, na.rm = FALSE), fmean(mtcNA, w = rep(6787.3454, 32), na.rm = FALSE))
  expect_equal(fmean(mtcNA), fmean(mtcNA, w = rep(6787.3454, 32)))
  expect_equal(fmean(x, f), fmean(x, f, rep(546.78,100)))
  expect_equal(fmean(x, f, na.rm = FALSE), fmean(x, f, rep(5.88,100), na.rm = FALSE))
  expect_equal(fmean(xNA, f, na.rm = FALSE), fmean(xNA, f, rep(52.7,100), na.rm = FALSE))
  expect_equal(fmean(xNA, f), fmean(xNA, f, rep(5997456,100)))
  expect_equal(fmean(m, g), fmean(m, g, rep(546.78,32)))
  expect_equal(fmean(m, g, na.rm = FALSE), fmean(m, g, rep(0.0001,32), na.rm = FALSE))
  expect_equal(fmean(mNA, g, na.rm = FALSE), fmean(mNA, g, rep(5.7,32), na.rm = FALSE))
  expect_equal(fmean(mNA, g), fmean(mNA, g, rep(1.1,32)))
  expect_equal(fmean(mtcars, g), fmean(mtcars, g, rep(53,32)))
  expect_equal(fmean(mtcars, g, na.rm = FALSE), fmean(mtcars, g, rep(546.78,32), na.rm = FALSE))
  expect_equal(fmean(mtcNA, g, na.rm = FALSE), fmean(mtcNA, g, rep(0.999999,32), na.rm = FALSE))
  expect_equal(fmean(mtcNA, g), fmean(mtcNA, g, rep(999.9999,32)))
})

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

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

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


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

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

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

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

}

Try the collapse package in your browser

Any scripts or data that you put into this service are public.

collapse documentation built on Nov. 13, 2023, 1:08 a.m.