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

context("fprod")

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

bprod <- base::prod

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

na21 <- function(x) {
  x[is.na(x)] <- 1
  x
}

wprod <- 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]
  }
  bprod(x*w)
}



test_that("fprod performs like base::prod", {
  expect_equal(fprod(NA), as.double(bprod(NA)))
  expect_equal(fprod(NA, na.rm = FALSE), as.double(bprod(NA)))
  expect_equal(fprod(1), bprod(1, na.rm = TRUE))
  expect_equal(fprod(1:3), bprod(1:3, na.rm = TRUE))
  expect_equal(fprod(-1:1), bprod(-1:1, na.rm = TRUE))
  expect_equal(fprod(1, na.rm = FALSE), bprod(1))
  expect_equal(fprod(1:3, na.rm = FALSE), bprod(1:3))
  expect_equal(fprod(-1:1, na.rm = FALSE), bprod(-1:1))
  expect_equal(fprod(x), bprod(x, na.rm = TRUE))
  expect_equal(fprod(x, na.rm = FALSE), bprod(x))
  expect_equal(fprod(xNA, na.rm = FALSE), bprod(xNA))
  expect_equal(fprod(xNA), bprod(xNA, na.rm = TRUE))
  expect_equal(fprod(mtcars), fprod(m))
  expect_equal(fprod(m), dapply(m, bprod, na.rm = TRUE))
  expect_equal(fprod(m, na.rm = FALSE), dapply(m, bprod))
  expect_equal(fprod(mNA, na.rm = FALSE), dapply(mNA, bprod))
  expect_equal(fprod(mNA), dapply(mNA, bprod, na.rm = TRUE))
  expect_equal(fprod(mtcars), dapply(mtcars, bprod, na.rm = TRUE))
  expect_equal(fprod(mtcars, na.rm = FALSE), dapply(mtcars, bprod))
  expect_equal(fprod(mtcNA, na.rm = FALSE), dapply(mtcNA, bprod))
  expect_equal(fprod(mtcNA), dapply(mtcNA, bprod, na.rm = TRUE))
  expect_equal(fprod(x, f), BY(x, f, bprod, na.rm = TRUE))
  expect_equal(fprod(x, f, na.rm = FALSE), BY(x, f, bprod))
  expect_equal(fprod(xNA, f, na.rm = FALSE), BY(xNA, f, bprod))
  expect_equal(na21(fprod(xNA, f)), BY(xNA, f, bprod, na.rm = TRUE))
  expect_equal(fprod(m, g), BY(m, g, bprod, na.rm = TRUE))
  expect_equal(fprod(m, g, na.rm = FALSE), BY(m, g, bprod))
  expect_equal(fprod(mNA, g, na.rm = FALSE), BY(mNA, g, bprod))
  expect_equal(na21(fprod(mNA, g)), BY(mNA, g, bprod, na.rm = TRUE)) # bprod(NA, na.rm = TRUE) gives 1
  expect_equal(fprod(mtcars, g), BY(mtcars, g, bprod, na.rm = TRUE))
  expect_equal(fprod(mtcars, g, na.rm = FALSE), BY(mtcars, g, bprod))
  expect_equal(fprod(mtcNA, g, na.rm = FALSE), BY(mtcNA, g, bprod))
  expect_equal(na21(fprod(mtcNA, g)), BY(mtcNA, g, bprod, na.rm = TRUE)) # bprod(NA, na.rm = TRUE) gives 1
})

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

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

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

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

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

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

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