Nothing
tests/testthat/test-fbetween-fwithin-B-W.R
In collapse: Advanced and Fast Data Transformation
context("fbetween / B and fwithin / W")
if(!is.null(attributes(identical(FALSE, TRUE)))) stop("OECD label issue")
# 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(rep(1:10, each = 10))
g <- as.factor(rep(c(1,2,2,3,3,3,4,4,4,4,5,5,5,5,5,7,7,7,7,7,7,7,10,10,10,10,10,10,10,10,10,10)))
mtcNA <- na_insert(mtcars)
mtcNA[1,1] <- NA # single group NA !!
m <- as.matrix(mtcars)
mNA <- as.matrix(mtcNA)
mNAc <- mNA
storage.mode(mNAc) <- "character"
# x = rnorm(1e7)
# xNA = x
# xNA[sample.int(1e7,1e6)] <- NA
# w = abs(100*rnorm(1e7))
# wNA = w
# wNA[sample.int(1e7,1e6)] <- NA
# microbenchmark(fwithin(xNA), fbetween(xNA), fbetween(xNA, w = w), fwithin(xNA, w = w), fbetween(xNA, w = wNA), fwithin(xNA, w = wNA))
# Unit: milliseconds
# expr min lq mean median uq max neval cld
# fwithin(xNA) 59.89809 61.45215 81.20188 63.21997 65.99563 303.5464 100 a
# fbetween(xNA) 71.32829 73.00953 86.06850 74.51227 77.79108 275.6274 100 ab
# fbetween(xNA, w = w) 81.95167 84.85050 106.61714 86.65870 90.92104 314.8245 100 cd
# fwithin(xNA, w = w) 71.24841 73.72264 88.08572 75.32935 80.46232 279.5597 100 a c
# fbetween(xNA, w = wNA) 90.99712 93.71455 107.38818 95.91545 98.16989 328.8951 100 d
# fwithin(xNA, w = wNA) 80.13678 83.62511 103.55614 86.22361 93.18352 301.7070 100 bcd
bsum <- base::sum
between <- function(x, na.rm = FALSE) {
if(!na.rm) return(ave(x))
cc <- !is.na(x)
x[cc] <- ave(x[cc])
return(x)
}
within <- function(x, na.rm = FALSE, mean = 0) {
if(!na.rm) return(x - ave(x) + mean)
cc <- !is.na(x)
m <- bsum(x[cc]) / bsum(cc)
return(x - m + mean)
}
# NOTE: This is what fbetween and fwithin currently do: If missing values, compute weighted mean on available obs, and center x using it. But don't insert additional missing values in x for missing weights ..
wbetween <- function(x, w, na.rm = FALSE) {
if(na.rm) {
xcc <- !is.na(x)
cc <- xcc & !is.na(w)
w <- w[cc]
wm <- bsum(w * x[cc]) / bsum(w)
x[xcc] <- rep(wm, bsum(xcc))
return(x)
} else {
wm <- bsum(w * x) / bsum(w)
return(rep(wm, length(x)))
}
}
wwithin <- function(x, w, na.rm = FALSE, mean = 0) {
if(na.rm) {
cc <- complete.cases(x, w)
w <- w[cc]
wm <- bsum(w * x[cc]) / bsum(w)
} else wm <- bsum(w * x) / bsum(w)
return(x - wm + mean)
}
# fbetween
test_that("fbetween performs like between", {
expect_equal(fbetween(NA), as.double(between(NA)))
expect_equal(fbetween(NA, na.rm = FALSE), as.double(between(NA)))
expect_equal(fbetween(1), between(1, na.rm = TRUE))
expect_equal(fbetween(1:3), between(1:3, na.rm = TRUE))
expect_equal(fbetween(-1:1), between(-1:1, na.rm = TRUE))
expect_equal(fbetween(1, na.rm = FALSE), between(1))
expect_equal(fbetween(1:3, na.rm = FALSE), between(1:3))
expect_equal(fbetween(-1:1, na.rm = FALSE), between(-1:1))
expect_equal(fbetween(x), between(x, na.rm = TRUE))
expect_equal(fbetween(x, na.rm = FALSE), between(x))
expect_equal(fbetween(xNA, na.rm = FALSE), between(xNA))
expect_equal(fbetween(xNA), between(xNA, na.rm = TRUE))
expect_equal(qM(fbetween(mtcars)), fbetween(m))
expect_equal(fbetween(m), dapply(m, between, na.rm = TRUE))
expect_equal(fbetween(m, na.rm = FALSE), dapply(m, between))
expect_equal(fbetween(mNA, na.rm = FALSE), dapply(mNA, between))
expect_equal(fbetween(mNA), dapply(mNA, between, na.rm = TRUE))
expect_equal(fbetween(mtcars), dapply(mtcars, between, na.rm = TRUE))
expect_equal(fbetween(mtcars, na.rm = FALSE), dapply(mtcars, between))
expect_equal(fbetween(mtcNA, na.rm = FALSE), dapply(mtcNA, between))
expect_equal(fbetween(mtcNA), dapply(mtcNA, between, na.rm = TRUE))
expect_equal(fbetween(x, f), BY(x, f, between, na.rm = TRUE, use.g.names = FALSE))
expect_equal(fbetween(x, f, na.rm = FALSE), BY(x, f, between, use.g.names = FALSE))
expect_equal(fbetween(xNA, f, na.rm = FALSE), BY(xNA, f, between, use.g.names = FALSE))
expect_equal(fbetween(xNA, f), BY(xNA, f, between, na.rm = TRUE, use.g.names = FALSE))
expect_equal(fbetween(m, g), BY(m, g, between, na.rm = TRUE, use.g.names = FALSE))
expect_equal(fbetween(m, g, na.rm = FALSE), BY(m, g, between, use.g.names = FALSE))
expect_equal(fbetween(mNA, g, na.rm = FALSE), BY(mNA, g, between, use.g.names = FALSE))
expect_equal(fbetween(mNA, g), BY(mNA, g, between, na.rm = TRUE, use.g.names = FALSE))
expect_equal(fbetween(mtcars, g), BY(mtcars, g, between, na.rm = TRUE, use.g.names = FALSE))
expect_equal(fbetween(mtcars, g, na.rm = FALSE), BY(mtcars, g, between, use.g.names = FALSE))
expect_equal(fbetween(mtcNA, g, na.rm = FALSE), BY(mtcNA, g, between, use.g.names = FALSE))
expect_equal(fbetween(mtcNA, g), BY(mtcNA, g, between, na.rm = TRUE, use.g.names = FALSE))
})
test_that("fbetween performs like fbetween with weights all equal", {
expect_equal(fbetween(NA), fbetween(NA, w = 0.99999999))
expect_equal(fbetween(NA, na.rm = FALSE), fbetween(NA, w = 2.946, na.rm = FALSE))
expect_equal(fbetween(1), fbetween(1, w = 3))
expect_equal(fbetween(1:3), fbetween(1:3, w = rep(0.999,3)))
expect_equal(fbetween(-1:1), fbetween(-1:1, w = rep(4.2,3)))
expect_equal(fbetween(1, na.rm = FALSE), fbetween(1, w = 5, na.rm = FALSE))
expect_equal(fbetween(1:3, na.rm = FALSE), fbetween(1:3, w = rep(1.44565, 3), na.rm = FALSE))
expect_equal(fbetween(-1:1, na.rm = FALSE), fbetween(-1:1, w = rep(1.44565, 3), na.rm = FALSE))
expect_equal(fbetween(x), fbetween(x, w = rep(1,100)))
expect_equal(fbetween(x, na.rm = FALSE), fbetween(x, w = rep(1.44565, 100), na.rm = FALSE))
expect_equal(fbetween(xNA, na.rm = FALSE), fbetween(xNA, w = rep(4.676587, 100), na.rm = FALSE))
expect_equal(fbetween(xNA), fbetween(xNA, w = rep(4.676587, 100)))
expect_equal(fbetween(m), fbetween(m, w = rep(6587.3454, 32)))
expect_equal(fbetween(m, na.rm = FALSE), fbetween(m, w = rep(6587.3454, 32), na.rm = FALSE))
expect_equal(fbetween(mNA, na.rm = FALSE), fbetween(mNA, w = rep(6587.3454, 32), na.rm = FALSE))
expect_equal(fbetween(mNA), fbetween(mNA, w = rep(6587.3454, 32)))
expect_equal(fbetween(mtcars), fbetween(mtcars, w = rep(6787.3454, 32)))
expect_equal(fbetween(mtcars, na.rm = FALSE), fbetween(mtcars, w = rep(6787.3454, 32), na.rm = FALSE))
expect_equal(fbetween(mtcNA, na.rm = FALSE), fbetween(mtcNA, w = rep(6787.3454, 32), na.rm = FALSE))
expect_equal(fbetween(mtcNA), fbetween(mtcNA, w = rep(6787.3454, 32)))
expect_equal(fbetween(x, f), fbetween(x, f, rep(546.78,100)))
expect_equal(fbetween(x, f, na.rm = FALSE), fbetween(x, f, rep(5.88,100), na.rm = FALSE))
expect_equal(fbetween(xNA, f, na.rm = FALSE), fbetween(xNA, f, rep(52.7,100), na.rm = FALSE))
expect_equal(fbetween(xNA, f), fbetween(xNA, f, rep(5997456,100)))
expect_equal(fbetween(m, g), fbetween(m, g, rep(546.78,32)))
expect_equal(fbetween(m, g, na.rm = FALSE), fbetween(m, g, rep(0.0001,32), na.rm = FALSE))
expect_equal(fbetween(mNA, g, na.rm = FALSE), fbetween(mNA, g, rep(5.7,32), na.rm = FALSE))
expect_equal(fbetween(mNA, g), fbetween(mNA, g, rep(1.1,32)))
expect_equal(fbetween(mtcars, g), fbetween(mtcars, g, rep(53,32)))
expect_equal(fbetween(mtcars, g, na.rm = FALSE), fbetween(mtcars, g, rep(546.78,32), na.rm = FALSE))
expect_equal(fbetween(mtcNA, g, na.rm = FALSE), fbetween(mtcNA, g, rep(0.999999,32), na.rm = FALSE))
expect_equal(fbetween(mtcNA, g), fbetween(mtcNA, g, rep(999.9999,32)))
})
test_that("fbetween with weights performs like wbetween (defined above)", {
# complete weights
expect_equal(fbetween(NA, w = 1), wbetween(NA, 1))
expect_equal(fbetween(NA, w = 1, na.rm = FALSE), wbetween(NA, 1))
expect_equal(fbetween(1, w = 1), wbetween(1, w = 1))
expect_equal(fbetween(1:3, w = 1:3), wbetween(1:3, 1:3))
expect_equal(fbetween(-1:1, w = 1:3), wbetween(-1:1, 1:3))
expect_equal(fbetween(1, w = 1, na.rm = FALSE), wbetween(1, 1))
expect_equal(fbetween(1:3, w = c(0.99,3454,1.111), na.rm = FALSE), wbetween(1:3, c(0.99,3454,1.111)))
expect_equal(fbetween(-1:1, w = 1:3, na.rm = FALSE), wbetween(-1:1, 1:3))
expect_equal(fbetween(x, w = w), wbetween(x, w))
expect_equal(fbetween(x, w = w, na.rm = FALSE), wbetween(x, w))
expect_equal(fbetween(xNA, w = w, na.rm = FALSE), wbetween(xNA, w))
expect_equal(fbetween(xNA, w = w), wbetween(xNA, w, na.rm = TRUE))
expect_equal(qM(fbetween(mtcars, w = wdat)), fbetween(m, w = wdat))
expect_equal(fbetween(m, w = wdat), dapply(m, wbetween, wdat, na.rm = TRUE))
expect_equal(fbetween(m, w = wdat, na.rm = FALSE), dapply(m, wbetween, wdat))
expect_equal(fbetween(mNA, w = wdat, na.rm = FALSE), dapply(mNA, wbetween, wdat))
expect_equal(fbetween(mNA, w = wdat), dapply(mNA, wbetween, wdat, na.rm = TRUE))
expect_equal(fbetween(mtcars, w = wdat), dapply(mtcars, wbetween, wdat, na.rm = TRUE))
expect_equal(fbetween(mtcars, w = wdat, na.rm = FALSE), dapply(mtcars, wbetween, wdat))
expect_equal(fbetween(mtcNA, w = wdat, na.rm = FALSE), dapply(mtcNA, wbetween, wdat))
expect_equal(fbetween(mtcNA, w = wdat), dapply(mtcNA, wbetween, wdat, na.rm = TRUE))
expect_equal(fbetween(x, f, w), BY(x, f, wbetween, w))
expect_equal(fbetween(x, f, w, na.rm = FALSE), BY(x, f, wbetween, w))
expect_equal(fbetween(xNA, f, w, na.rm = FALSE), BY(xNA, f, wbetween, w))
expect_equal(fbetween(xNA, f, w), BY(xNA, f, wbetween, w, na.rm = TRUE))
expect_equal(fbetween(m, g, wdat), BY(m, g, wbetween, wdat))
expect_equal(fbetween(m, g, wdat, na.rm = FALSE), BY(m, g, wbetween, wdat))
expect_equal(fbetween(mNA, g, wdat, na.rm = FALSE), BY(mNA, g, wbetween, wdat))
expect_equal(fbetween(mNA, g, wdat), BY(mNA, g, wbetween, wdat, na.rm = TRUE))
expect_equal(fbetween(mtcars, g, wdat), BY(mtcars, g, wbetween, wdat))
expect_equal(fbetween(mtcars, g, wdat, na.rm = FALSE), BY(mtcars, g, wbetween, wdat))
expect_equal(fbetween(mtcNA, g, wdat, na.rm = FALSE), BY(mtcNA, g, wbetween, wdat))
expect_equal(fbetween(mtcNA, g, wdat), BY(mtcNA, g, wbetween, wdat, na.rm = TRUE))
# missing weights
expect_equal(fbetween(NA, w = NA), wbetween(NA, NA))
expect_equal(fbetween(NA, w = NA, na.rm = FALSE), wbetween(NA, NA))
expect_equal(fbetween(1, w = NA), wbetween(1, w = NA))
expect_equal(fbetween(1:3, w = c(NA,1:2)), wbetween(1:3, c(NA,1:2), na.rm = TRUE))
expect_equal(fbetween(-1:1, w = c(NA,1:2)), wbetween(-1:1, c(NA,1:2), na.rm = TRUE))
expect_equal(fbetween(1, w = NA, na.rm = FALSE), wbetween(1, NA))
expect_equal(fbetween(1:3, w = c(NA,1:2), na.rm = FALSE), wbetween(1:3, c(NA,1:2)))
expect_equal(fbetween(-1:1, w = c(NA,1:2), na.rm = FALSE), wbetween(-1:1, c(NA,1:2)))
expect_equal(fbetween(x, w = wNA), wbetween(x, wNA, na.rm = TRUE))
expect_equal(fbetween(x, w = wNA, na.rm = FALSE), wbetween(x, wNA))
expect_equal(fbetween(xNA, w = wNA, na.rm = FALSE), wbetween(xNA, wNA))
expect_equal(fbetween(xNA, w = wNA), wbetween(xNA, wNA, na.rm = TRUE))
expect_equal(qM(fbetween(mtcars, w = wdatNA)), fbetween(m, w = wdatNA))
expect_equal(fbetween(m, w = wdatNA), dapply(m, wbetween, wdatNA, na.rm = TRUE))
expect_equal(fbetween(m, w = wdatNA, na.rm = FALSE), dapply(m, wbetween, wdatNA))
expect_equal(fbetween(mNA, w = wdatNA, na.rm = FALSE), dapply(mNA, wbetween, wdatNA))
expect_equal(fbetween(mNA, w = wdatNA), dapply(mNA, wbetween, wdatNA, na.rm = TRUE))
expect_equal(fbetween(mtcars, w = wdatNA), dapply(mtcars, wbetween, wdatNA, na.rm = TRUE))
expect_equal(fbetween(mtcars, w = wdatNA, na.rm = FALSE), dapply(mtcars, wbetween, wdatNA))
expect_equal(fbetween(mtcNA, w = wdatNA, na.rm = FALSE), dapply(mtcNA, wbetween, wdatNA))
expect_equal(fbetween(mtcNA, w = wdatNA), dapply(mtcNA, wbetween, wdatNA, na.rm = TRUE))
expect_equal(fbetween(x, f, wNA), BY(x, f, wbetween, wNA, na.rm = TRUE))
expect_equal(fbetween(x, f, wNA, na.rm = FALSE), BY(x, f, wbetween, wNA))
expect_equal(fbetween(xNA, f, wNA, na.rm = FALSE), BY(xNA, f, wbetween, wNA))
expect_equal(fbetween(xNA, f, wNA), BY(xNA, f, wbetween, wNA, na.rm = TRUE))
expect_equal(fbetween(m, g, wdatNA), BY(m, g, wbetween, wdatNA, na.rm = TRUE))
expect_equal(fbetween(m, g, wdatNA, na.rm = FALSE), BY(m, g, wbetween, wdatNA))
expect_equal(fbetween(mNA, g, wdatNA, na.rm = FALSE), BY(mNA, g, wbetween, wdatNA))
expect_equal(fbetween(mNA, g, wdatNA), BY(mNA, g, wbetween, wdatNA, na.rm = TRUE))
expect_equal(fbetween(mtcars, g, wdatNA), BY(mtcars, g, wbetween, wdatNA, na.rm = TRUE))
expect_equal(fbetween(mtcars, g, wdatNA, na.rm = FALSE), BY(mtcars, g, wbetween, wdatNA))
expect_equal(fbetween(mtcNA, g, wdatNA, na.rm = FALSE), BY(mtcNA, g, wbetween, wdatNA))
expect_equal(fbetween(mtcNA, g, wdatNA), BY(mtcNA, g, wbetween, wdatNA, na.rm = TRUE))
})
test_that("fbetween performs numerically stable", {
expect_true(all_obj_equal(replicate(50, fbetween(1), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(NA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(NA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, f), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, f, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, f, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, f), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, g), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, g, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, g, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, g), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, g), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, g, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, g, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, g), simplify = FALSE)))
})
test_that("fbetween with complete weights performs numerically stable", {
expect_true(all_obj_equal(replicate(50, fbetween(1, w = 1), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(NA, w = 1), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(NA, w = 1, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, w = w), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, w = w, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, w = w, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, w = w), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, w = wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, w = wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, w = wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, w = wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, w = wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, w = wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, w = wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, w = wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, f, w), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, f, w, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, f, w, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, f, w), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, g, wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, g, wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, g, wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, g, wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, g, wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, g, wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, g, wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, g, wdat), simplify = FALSE)))
})
test_that("fbetween with missing weights performs numerically stable", {
expect_true(all_obj_equal(replicate(50, fbetween(1, w = NA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(NA, w = NA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(NA, w = NA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, w = wNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, w = wNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, w = wNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, w = wNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, w = wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, w = wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, w = wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, w = wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, f, wNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, f, wNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, f, wNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, f, wNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, g, wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, g, wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, g, wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, g, wdatNA), simplify = FALSE)))
})
test_that("fbetween handles special values in the right way", {
expect_equal(fbetween(NA), NA_real_)
expect_equal(fbetween(NaN), NaN)
expect_equal(fbetween(Inf), Inf)
expect_equal(fbetween(c(Inf,Inf)), c(Inf,Inf))
expect_equal(fbetween(-Inf), -Inf)
expect_equal(fbetween(c(-Inf,-Inf)), c(-Inf,-Inf))
expect_equal(fbetween(TRUE), 1)
expect_equal(fbetween(FALSE), 0)
expect_equal(fbetween(NA, na.rm = FALSE), NA_real_)
expect_equal(fbetween(NaN, na.rm = FALSE), NaN)
expect_equal(fbetween(Inf, na.rm = FALSE), Inf)
expect_equal(fbetween(c(Inf,Inf), na.rm = FALSE), c(Inf,Inf))
expect_equal(fbetween(-Inf, na.rm = FALSE), -Inf)
expect_equal(fbetween(c(-Inf,-Inf), na.rm = FALSE), c(-Inf,-Inf))
expect_equal(fbetween(TRUE, na.rm = FALSE), 1)
expect_equal(fbetween(FALSE, na.rm = FALSE), 0)
expect_equal(fbetween(c(1,NA)), c(1,NA_real_))
expect_equal(fbetween(c(1,NaN)), c(1,NaN))
expect_equal(fbetween(c(1,Inf)), c(Inf,Inf))
expect_equal(fbetween(c(1,-Inf)), c(-Inf,-Inf))
expect_equal(fbetween(c(1,Inf), na.rm = FALSE), c(Inf,Inf))
expect_equal(fbetween(c(1,-Inf), na.rm = FALSE), c(-Inf,-Inf))
expect_equal(fbetween(c(NA,-Inf), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fbetween(c(FALSE,FALSE), na.rm = FALSE), c(0,0))
expect_equal(fbetween(c(1,NA), na.rm = FALSE), c(NA_real_,NA_real_))
})
test_that("fbetween with weights handles special values in the right way", {
expect_equal(fbetween(NA, w = 1), NA_real_)
expect_equal(fbetween(NaN, w = 1), NaN)
expect_equal(fbetween(Inf, w = 1), Inf)
expect_equal(fbetween(c(Inf,Inf), w = 1:2), c(Inf,Inf))
expect_equal(fbetween(-Inf, w = 1), -Inf)
expect_equal(fbetween(c(-Inf,-Inf), w = 1:2), c(-Inf,-Inf))
expect_equal(fbetween(TRUE, w = 1), 1)
expect_equal(fbetween(FALSE, w = 1), 0)
expect_equal(fbetween(NA, w = 1, na.rm = FALSE), NA_real_)
expect_equal(fbetween(NaN, w = 1, na.rm = FALSE), NaN)
expect_equal(fbetween(Inf, w = 1, na.rm = FALSE), Inf)
expect_equal(fbetween(c(Inf,Inf), w = 1:2, na.rm = FALSE), c(Inf,Inf))
expect_equal(fbetween(-Inf, w = 1, na.rm = FALSE), -Inf)
expect_equal(fbetween(c(-Inf,-Inf), w = 1:2, na.rm = FALSE), c(-Inf,-Inf))
expect_equal(fbetween(TRUE, w = 1, na.rm = FALSE), 1)
expect_equal(fbetween(FALSE, w = 1, na.rm = FALSE), 0)
expect_equal(fbetween(c(1,NA), w = 1:2), c(1,NA_real_))
expect_equal(fbetween(c(1,NaN), w = 1:2), c(1,NaN))
expect_equal(fbetween(c(1,Inf), w = 1:2), c(Inf,Inf))
expect_equal(fbetween(c(1,-Inf), w = 1:2), c(-Inf,-Inf))
expect_equal(fbetween(c(1,Inf), w = 1:2, na.rm = FALSE), c(Inf,Inf))
expect_equal(fbetween(c(1,-Inf), w = 1:2, na.rm = FALSE), c(-Inf,-Inf))
expect_equal(fbetween(c(NA,-Inf), w = 1:2, na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fbetween(c(FALSE,FALSE), w = 1:2, na.rm = FALSE), c(0,0))
expect_equal(fbetween(c(1,NA), w = 1:2, na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fbetween(1:3, w = c(1,Inf,3)), c(NA_real_,NA_real_,NA_real_))
expect_equal(fbetween(1:3, w = c(1,-Inf,3)), c(NA_real_,NA_real_,NA_real_))
expect_equal(fbetween(1:3, w = c(1,Inf,3), na.rm = FALSE), c(NA_real_,NA_real_,NA_real_))
expect_equal(fbetween(1:3, w = c(1,-Inf,3), na.rm = FALSE), c(NA_real_,NA_real_,NA_real_))
expect_equal(fbetween(NA, w = NA), NA_real_)
expect_equal(fbetween(NaN, w = NA), NaN)
expect_equal(fbetween(Inf, w = NA), NA_real_)
expect_equal(fbetween(c(Inf,Inf), w = c(NA,2)), c(Inf,Inf))
expect_equal(fbetween(-Inf, w = NA), NA_real_)
expect_equal(fbetween(c(-Inf,-Inf), w = c(NA,2)), c(-Inf,-Inf))
expect_equal(fbetween(TRUE, w = NA), NA_real_)
expect_equal(fbetween(FALSE, w = NA), NA_real_)
expect_equal(fbetween(NA, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fbetween(NaN, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fbetween(Inf, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fbetween(c(Inf,Inf), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fbetween(-Inf, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fbetween(c(-Inf,-Inf), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fbetween(TRUE, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fbetween(FALSE, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fbetween(c(1,NA), w = c(NA,2)), c(NA_real_,NA_real_))
expect_equal(fbetween(c(1,NaN), w = c(NA,2)), c(NA_real_,NA_real_))
expect_equal(fbetween(c(1,Inf), w = c(NA,2)), c(Inf,Inf))
expect_equal(fbetween(c(1,-Inf), w = c(NA,2)), c(-Inf,-Inf))
expect_equal(fbetween(c(1,Inf), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fbetween(c(1,-Inf), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fbetween(c(NA,-Inf), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fbetween(c(FALSE,FALSE), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fbetween(c(1,NA), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fbetween(1:3, w = c(NA,Inf,3)), c(NA_real_,NA_real_,NA_real_))
expect_equal(fbetween(1:3, w = c(NA,-Inf,3)), c(NA_real_,NA_real_,NA_real_))
expect_equal(fbetween(1:3, w = c(NA,Inf,3), na.rm = FALSE), c(NA_real_,NA_real_,NA_real_))
expect_equal(fbetween(1:3, w = c(NA,-Inf,3), na.rm = FALSE), c(NA_real_,NA_real_,NA_real_))
})
test_that("fbetween produces errors for wrong input", {
expect_error(fbetween("a"))
expect_error(fbetween(NA_character_))
expect_error(fbetween(mNAc))
expect_error(fbetween(mNAc, f))
expect_error(fbetween(1:2,1:3))
expect_error(fbetween(m,1:31))
expect_error(fbetween(mtcars,1:31))
expect_error(fbetween(mtcars, w = 1:31))
expect_error(fbetween("a", w = 1))
expect_error(fbetween(1:2, w = 1:3))
expect_error(fbetween(NA_character_, w = 1))
expect_error(fbetween(mNAc, w = wdat))
expect_error(fbetween(mNAc, f, wdat))
expect_error(fbetween(mNA, w = 1:33))
expect_error(fbetween(1:2,1:2, 1:3))
expect_error(fbetween(m,1:32,1:20))
expect_error(fbetween(mtcars,1:32,1:10))
expect_error(fbetween(1:2, w = c("a","b")))
expect_error(fbetween(wlddev))
expect_error(fbetween(wlddev, w = wlddev$year))
expect_error(fbetween(wlddev, wlddev$iso3c))
expect_error(fbetween(wlddev, wlddev$iso3c, wlddev$year))
})
# B
test_that("B produces errors for wrong input", {
expect_error(B("a"))
expect_error(B(NA_character_))
expect_error(B(mNAc))
expect_error(B(mNAc, f))
expect_error(B(1:2,1:3))
expect_error(B(m,1:31))
expect_error(B(mtcars,1:31))
expect_error(B(mtcars, w = 1:31))
expect_error(B("a", w = 1))
expect_error(B(1:2, w = c("a","b")))
expect_error(B(1:2, w = 1:3))
expect_error(B(NA_character_, w = 1))
expect_error(B(mNAc, w = wdat))
expect_error(B(mNAc, f, wdat))
expect_error(B(mNA, w = 1:33))
expect_error(B(mtcNA, w = 1:33))
expect_error(B(1:2,1:2, 1:3))
expect_error(B(m,1:32,1:20))
expect_error(B(mtcars,1:32,1:10))
expect_error(B(1:2, 1:3, 1:2))
expect_error(B(m,1:31,1:32))
expect_error(B(mtcars,1:33,1:32))
})
test_that("B.data.frame method is foolproof", {
expect_visible(B(wlddev))
expect_visible(B(wlddev, w = wlddev$year))
expect_visible(B(wlddev, w = ~year))
expect_visible(B(wlddev, wlddev$iso3c))
expect_visible(B(wlddev, ~iso3c))
expect_visible(B(wlddev, ~iso3c + region))
expect_visible(B(wlddev, wlddev$iso3c, wlddev$year))
expect_visible(B(wlddev, ~iso3c, ~year))
expect_visible(B(wlddev, cols = 9:12))
expect_visible(B(wlddev, w = wlddev$year, cols = 9:12))
expect_visible(B(wlddev, w = ~year, cols = 9:12))
expect_visible(B(wlddev, wlddev$iso3c, cols = 9:12))
expect_visible(B(wlddev, ~iso3c, cols = 9:12))
expect_visible(B(wlddev, wlddev$iso3c, wlddev$year, cols = 9:12))
expect_visible(B(wlddev, ~iso3c, ~year, cols = 9:12))
expect_visible(B(wlddev, cols = c("PCGDP","LIFEEX")))
expect_visible(B(wlddev, w = wlddev$year, cols = c("PCGDP","LIFEEX")))
expect_visible(B(wlddev, w = ~year, cols = c("PCGDP","LIFEEX")))
expect_visible(B(wlddev, wlddev$iso3c, cols = c("PCGDP","LIFEEX")))
expect_visible(B(wlddev, ~iso3c, cols = c("PCGDP","LIFEEX")))
expect_visible(B(wlddev, wlddev$iso3c, wlddev$year, cols = c("PCGDP","LIFEEX")))
expect_visible(B(wlddev, ~iso3c, ~year, cols = c("PCGDP","LIFEEX")))
expect_error(B(wlddev, cols = NULL))
expect_error(B(wlddev, w = wlddev$year, cols = NULL))
expect_error(B(wlddev, w = ~year, cols = NULL))
expect_error(B(wlddev, wlddev$iso3c, cols = NULL))
expect_error(B(wlddev, ~iso3c, cols = NULL))
expect_error(B(wlddev, wlddev$iso3c, wlddev$year, cols = NULL))
expect_error(B(wlddev, ~iso3c, ~year, cols = NULL))
expect_error(B(wlddev, cols = 9:14))
expect_error(B(wlddev, w = wlddev$year, cols = 9:14))
expect_error(B(wlddev, w = ~year, cols = 9:14))
expect_error(B(wlddev, wlddev$iso3c, cols = 9:14))
expect_error(B(wlddev, ~iso3c, cols = 9:14))
expect_error(B(wlddev, wlddev$iso3c, wlddev$year, cols = 9:14))
expect_error(B(wlddev, ~iso3c, ~year, cols = 9:14))
expect_error(B(wlddev, cols = c("PCGDP","LIFEEX","bla")))
expect_error(B(wlddev, w = wlddev$year, cols = c("PCGDP","LIFEEX","bla")))
expect_error(B(wlddev, w = ~year, cols = c("PCGDP","LIFEEX","bla")))
expect_error(B(wlddev, wlddev$iso3c, cols = c("PCGDP","LIFEEX","bla")))
expect_error(B(wlddev, ~iso3c, cols = c("PCGDP","LIFEEX","bla")))
expect_error(B(wlddev, wlddev$iso3c, wlddev$year, cols = c("PCGDP","LIFEEX","bla")))
expect_error(B(wlddev, ~iso3c, ~year, cols = c("PCGDP","LIFEEX","bla")))
expect_error(B(wlddev, w = mtcars))
expect_error(B(wlddev, w = 4))
expect_error(B(wlddev, w = "year"))
expect_error(B(wlddev, w = ~year2))
# suppressWarnings(expect_error(B(wlddev, w = ~year + region)))
expect_error(B(wlddev, mtcars))
expect_error(B(wlddev, 2))
expect_error(B(wlddev, "iso3c"))
expect_error(B(wlddev, ~iso3c2))
expect_error(B(wlddev, ~iso3c + bla))
expect_error(B(wlddev, mtcars$mpg, mtcars$cyl))
expect_error(B(wlddev, 2, 4))
expect_error(B(wlddev, ~iso3c2, ~year2))
expect_error(B(wlddev, cols = ~bla))
expect_error(B(wlddev, w = ~bla, cols = 9:12))
expect_error(B(wlddev, w = 4, cols = 9:12))
expect_error(B(wlddev, w = "year", cols = 9:12))
expect_error(B(wlddev, w = ~yewar, cols = 9:12))
expect_error(B(wlddev, mtcars$mpg, cols = 9:12))
expect_error(B(wlddev, ~iso3c + ss, cols = 9:12))
expect_error(B(wlddev, 2, cols = 9:12))
expect_error(B(wlddev, "iso3c", cols = 9:12))
expect_error(B(wlddev, wlddev$iso3c, ~year + bla, cols = 9:12))
expect_error(B(wlddev, ~iso3c3, ~year, cols = 9:12))
expect_error(B(wlddev, cols = c("PC3GDP","LIFEEX")))
})
# fwithin
test_that("fwithin performs like within", {
expect_equal(fwithin(NA), as.double(within(NA)))
expect_equal(fwithin(NA, na.rm = FALSE), as.double(within(NA)))
expect_equal(fwithin(1), within(1, na.rm = TRUE))
expect_equal(fwithin(1:3), within(1:3, na.rm = TRUE))
expect_equal(fwithin(-1:1), within(-1:1, na.rm = TRUE))
expect_equal(fwithin(1, na.rm = FALSE), within(1))
expect_equal(fwithin(1:3, na.rm = FALSE), within(1:3))
expect_equal(fwithin(-1:1, na.rm = FALSE), within(-1:1))
expect_equal(fwithin(x), within(x, na.rm = TRUE))
expect_equal(fwithin(x, na.rm = FALSE), within(x))
expect_equal(fwithin(xNA, na.rm = FALSE), within(xNA))
expect_equal(fwithin(xNA), within(xNA, na.rm = TRUE))
expect_equal(qM(fwithin(mtcars)), fwithin(m))
expect_equal(fwithin(m), dapply(m, within, na.rm = TRUE))
expect_equal(fwithin(m, na.rm = FALSE), dapply(m, within))
expect_equal(fwithin(mNA, na.rm = FALSE), dapply(mNA, within))
expect_equal(fwithin(mNA), dapply(mNA, within, na.rm = TRUE))
expect_equal(fwithin(mtcars), dapply(mtcars, within, na.rm = TRUE))
expect_equal(fwithin(mtcars, na.rm = FALSE), dapply(mtcars, within))
expect_equal(fwithin(mtcNA, na.rm = FALSE), dapply(mtcNA, within))
expect_equal(fwithin(mtcNA), dapply(mtcNA, within, na.rm = TRUE))
expect_equal(fwithin(x, f), BY(x, f, within, na.rm = TRUE))
expect_equal(fwithin(x, f, na.rm = FALSE), BY(x, f, within))
expect_equal(fwithin(xNA, f, na.rm = FALSE), BY(xNA, f, within))
expect_equal(fwithin(xNA, f), BY(xNA, f, within, na.rm = TRUE))
expect_equal(fwithin(m, g), BY(m, g, within, na.rm = TRUE))
expect_equal(fwithin(m, g, na.rm = FALSE), BY(m, g, within))
expect_equal(fwithin(mNA, g, na.rm = FALSE), BY(mNA, g, within))
expect_equal(fwithin(mNA, g), BY(mNA, g, within, na.rm = TRUE))
expect_equal(fwithin(mtcars, g), BY(mtcars, g, within, na.rm = TRUE))
expect_equal(fwithin(mtcars, g, na.rm = FALSE), BY(mtcars, g, within))
expect_equal(fwithin(mtcNA, g, na.rm = FALSE), BY(mtcNA, g, within))
expect_equal(fwithin(mtcNA, g), BY(mtcNA, g, within, na.rm = TRUE))
})
test_that("fwithin with custom mean performs like within (defined above)", {
expect_equal(fwithin(x, mean = 4.8456), within(x, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(x, na.rm = FALSE, mean = 4.8456), within(x, mean = 4.8456))
expect_equal(fwithin(xNA, na.rm = FALSE, mean = 4.8456), within(xNA, mean = 4.8456))
expect_equal(fwithin(xNA, mean = 4.8456), within(xNA, na.rm = TRUE, mean = 4.8456))
expect_equal(qM(fwithin(mtcars, mean = 4.8456)), fwithin(m, mean = 4.8456))
expect_equal(fwithin(m, mean = 4.8456), dapply(m, within, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(m, na.rm = FALSE, mean = 4.8456), dapply(m, within, mean = 4.8456))
expect_equal(fwithin(mNA, na.rm = FALSE, mean = 4.8456), dapply(mNA, within, mean = 4.8456))
expect_equal(fwithin(mNA, mean = 4.8456), dapply(mNA, within, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(x, f, mean = 4.8456), BY(x, f, within, na.rm = TRUE, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(x, f, na.rm = FALSE, mean = 4.8456), BY(x, f, within, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(xNA, f, na.rm = FALSE, mean = 4.8456), BY(xNA, f, within, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(xNA, f, mean = 4.8456), BY(xNA, f, within, na.rm = TRUE, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(m, g, mean = 4.8456), BY(m, g, within, na.rm = TRUE, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(m, g, na.rm = FALSE, mean = 4.8456), BY(m, g, within, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(mNA, g, na.rm = FALSE, mean = 4.8456), BY(mNA, g, within, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(mNA, g, mean = 4.8456), BY(mNA, g, within, na.rm = TRUE, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(mtcars, g, mean = 4.8456), BY(mtcars, g, within, na.rm = TRUE, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(mtcars, g, na.rm = FALSE, mean = 4.8456), BY(mtcars, g, within, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(mtcNA, g, na.rm = FALSE, mean = 4.8456), BY(mtcNA, g, within, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(mtcNA, g, mean = 4.8456), BY(mtcNA, g, within, na.rm = TRUE, use.g.names = FALSE, mean = 4.8456))
})
test_that("Centering on overall mean performs as indended", {
expect_equal(fwithin(x, f, mean = "overall.mean"), BY(x, f, within, na.rm = TRUE, use.g.names = FALSE) + ave(x))
expect_equal(fwithin(x, f, na.rm = FALSE, mean = "overall.mean"), BY(x, f, within, use.g.names = FALSE) + ave(x))
# expect_equal(fwithin(xNA, f, na.rm = FALSE, mean = "overall.mean"), BY(xNA, f, within, use.g.names = FALSE) + B(xNA)) # Not the same !!
expect_equal(fwithin(xNA, f, mean = "overall.mean"), BY(xNA, f, within, na.rm = TRUE, use.g.names = FALSE) + B(xNA))
expect_equal(fwithin(m, g, mean = "overall.mean"), BY(m, g, within, na.rm = TRUE, use.g.names = FALSE) + B(m))
expect_equal(fwithin(m, g, na.rm = FALSE, mean = "overall.mean"), BY(m, g, within, use.g.names = FALSE) + B(m))
# expect_equal(fwithin(mNA, g, na.rm = FALSE, mean = "overall.mean"), BY(mNA, g, within, use.g.names = FALSE) + B(mNA))
expect_equal(fwithin(mNA, g, mean = "overall.mean"), BY(mNA, g, within, na.rm = TRUE, use.g.names = FALSE) + B(mNA))
expect_equal(fwithin(mtcars, g, mean = "overall.mean"), BY(mtcars, g, within, na.rm = TRUE, use.g.names = FALSE) + B(mtcars))
expect_equal(fwithin(mtcars, g, na.rm = FALSE, mean = "overall.mean"), BY(mtcars, g, within, use.g.names = FALSE) + B(mtcars))
# expect_equal(fwithin(mtcNA, g, na.rm = FALSE, mean = "overall.mean"), BY(mtcNA, g, within, use.g.names = FALSE) + B(mtcNA))
expect_equal(fwithin(mtcNA, g, mean = "overall.mean"), BY(mtcNA, g, within, na.rm = TRUE, use.g.names = FALSE)+ B(mtcNA))
})
test_that("fwithin performs like fwithin with weights all equal", {
expect_equal(fwithin(NA), fwithin(NA, w = 0.99999999))
expect_equal(fwithin(NA, na.rm = FALSE), fwithin(NA, w = 2.946, na.rm = FALSE))
expect_equal(fwithin(1), fwithin(1, w = 3))
expect_equal(fwithin(1:3), fwithin(1:3, w = rep(0.999,3)))
expect_equal(fwithin(-1:1), fwithin(-1:1, w = rep(4.2,3)))
expect_equal(fwithin(1, na.rm = FALSE), fwithin(1, w = 5, na.rm = FALSE))
expect_equal(fwithin(1:3, na.rm = FALSE), fwithin(1:3, w = rep(1.44565, 3), na.rm = FALSE))
expect_equal(fwithin(-1:1, na.rm = FALSE), fwithin(-1:1, w = rep(1.44565, 3), na.rm = FALSE))
expect_equal(fwithin(x), fwithin(x, w = rep(1,100)))
expect_equal(fwithin(x, na.rm = FALSE), fwithin(x, w = rep(1.44565, 100), na.rm = FALSE))
expect_equal(fwithin(xNA, na.rm = FALSE), fwithin(xNA, w = rep(4.676587, 100), na.rm = FALSE))
expect_equal(fwithin(xNA), fwithin(xNA, w = rep(4.676587, 100)))
expect_equal(fwithin(m), fwithin(m, w = rep(6587.3454, 32)))
expect_equal(fwithin(m, na.rm = FALSE), fwithin(m, w = rep(6587.3454, 32), na.rm = FALSE))
expect_equal(fwithin(mNA, na.rm = FALSE), fwithin(mNA, w = rep(6587.3454, 32), na.rm = FALSE))
expect_equal(fwithin(mNA), fwithin(mNA, w = rep(6587.3454, 32)))
expect_equal(fwithin(mtcars), fwithin(mtcars, w = rep(6787.3454, 32)))
expect_equal(fwithin(mtcars, na.rm = FALSE), fwithin(mtcars, w = rep(6787.3454, 32), na.rm = FALSE))
expect_equal(fwithin(mtcNA, na.rm = FALSE), fwithin(mtcNA, w = rep(6787.3454, 32), na.rm = FALSE))
expect_equal(fwithin(mtcNA), fwithin(mtcNA, w = rep(6787.3454, 32)))
expect_equal(fwithin(x, f), fwithin(x, f, rep(546.78,100)))
expect_equal(fwithin(x, f, na.rm = FALSE), fwithin(x, f, rep(5.88,100), na.rm = FALSE))
expect_equal(fwithin(xNA, f, na.rm = FALSE), fwithin(xNA, f, rep(52.7,100), na.rm = FALSE))
expect_equal(fwithin(xNA, f), fwithin(xNA, f, rep(5997456,100)))
expect_equal(fwithin(m, g), fwithin(m, g, rep(546.78,32)))
expect_equal(fwithin(m, g, na.rm = FALSE), fwithin(m, g, rep(0.0001,32), na.rm = FALSE))
expect_equal(fwithin(mNA, g, na.rm = FALSE), fwithin(mNA, g, rep(5.7,32), na.rm = FALSE))
expect_equal(fwithin(mNA, g), fwithin(mNA, g, rep(1.1,32)))
expect_equal(fwithin(mtcars, g), fwithin(mtcars, g, rep(53,32)))
expect_equal(fwithin(mtcars, g, na.rm = FALSE), fwithin(mtcars, g, rep(546.78,32), na.rm = FALSE))
expect_equal(fwithin(mtcNA, g, na.rm = FALSE), fwithin(mtcNA, g, rep(0.999999,32), na.rm = FALSE))
expect_equal(fwithin(mtcNA, g), fwithin(mtcNA, g, rep(999.9999,32)))
})
test_that("fwithin with weights performs like wwithin (defined above)", {
# complete weights
expect_equal(fwithin(NA, w = 1), wwithin(NA, 1))
expect_equal(fwithin(NA, w = 1, na.rm = FALSE), wwithin(NA, 1))
expect_equal(fwithin(1, w = 1), wwithin(1, w = 1))
expect_equal(fwithin(1:3, w = 1:3), wwithin(1:3, 1:3))
expect_equal(fwithin(-1:1, w = 1:3), wwithin(-1:1, 1:3))
expect_equal(fwithin(1, w = 1, na.rm = FALSE), wwithin(1, 1))
expect_equal(fwithin(1:3, w = c(0.99,3454,1.111), na.rm = FALSE), wwithin(1:3, c(0.99,3454,1.111)))
expect_equal(fwithin(-1:1, w = 1:3, na.rm = FALSE), wwithin(-1:1, 1:3))
expect_equal(fwithin(x, w = w), wwithin(x, w))
expect_equal(fwithin(x, w = w, na.rm = FALSE), wwithin(x, w))
expect_equal(fwithin(xNA, w = w, na.rm = FALSE), wwithin(xNA, w))
expect_equal(fwithin(xNA, w = w), wwithin(xNA, w, na.rm = TRUE))
expect_equal(qM(fwithin(mtcars, w = wdat)), fwithin(m, w = wdat))
expect_equal(fwithin(m, w = wdat), dapply(m, wwithin, wdat, na.rm = TRUE))
expect_equal(fwithin(m, w = wdat, na.rm = FALSE), dapply(m, wwithin, wdat))
expect_equal(fwithin(mNA, w = wdat, na.rm = FALSE), dapply(mNA, wwithin, wdat))
expect_equal(fwithin(mNA, w = wdat), dapply(mNA, wwithin, wdat, na.rm = TRUE))
expect_equal(fwithin(mtcars, w = wdat), dapply(mtcars, wwithin, wdat, na.rm = TRUE))
expect_equal(fwithin(mtcars, w = wdat, na.rm = FALSE), dapply(mtcars, wwithin, wdat))
expect_equal(fwithin(mtcNA, w = wdat, na.rm = FALSE), dapply(mtcNA, wwithin, wdat))
expect_equal(fwithin(mtcNA, w = wdat), dapply(mtcNA, wwithin, wdat, na.rm = TRUE))
expect_equal(fwithin(x, f, w), BY(x, f, wwithin, w))
expect_equal(fwithin(x, f, w, na.rm = FALSE), BY(x, f, wwithin, w))
expect_equal(fwithin(xNA, f, w, na.rm = FALSE), BY(xNA, f, wwithin, w))
expect_equal(fwithin(xNA, f, w), BY(xNA, f, wwithin, w, na.rm = TRUE))
expect_equal(fwithin(m, g, wdat), BY(m, g, wwithin, wdat))
expect_equal(fwithin(m, g, wdat, na.rm = FALSE), BY(m, g, wwithin, wdat))
expect_equal(fwithin(mNA, g, wdat, na.rm = FALSE), BY(mNA, g, wwithin, wdat))
expect_equal(fwithin(mNA, g, wdat), BY(mNA, g, wwithin, wdat, na.rm = TRUE))
expect_equal(fwithin(mtcars, g, wdat), BY(mtcars, g, wwithin, wdat))
expect_equal(fwithin(mtcars, g, wdat, na.rm = FALSE), BY(mtcars, g, wwithin, wdat))
expect_equal(fwithin(mtcNA, g, wdat, na.rm = FALSE), BY(mtcNA, g, wwithin, wdat))
expect_equal(fwithin(mtcNA, g, wdat), BY(mtcNA, g, wwithin, wdat, na.rm = TRUE))
# missing weights
expect_equal(fwithin(NA, w = NA), wwithin(NA, NA))
expect_equal(fwithin(NA, w = NA, na.rm = FALSE), wwithin(NA, NA))
expect_equal(fwithin(1, w = NA), wwithin(1, w = NA))
expect_equal(fwithin(1:3, w = c(NA,1:2)), wwithin(1:3, c(NA,1:2), na.rm = TRUE))
expect_equal(fwithin(-1:1, w = c(NA,1:2)), wwithin(-1:1, c(NA,1:2), na.rm = TRUE))
expect_equal(fwithin(1, w = NA, na.rm = FALSE), wwithin(1, NA))
expect_equal(fwithin(1:3, w = c(NA,1:2), na.rm = FALSE), wwithin(1:3, c(NA,1:2)))
expect_equal(fwithin(-1:1, w = c(NA,1:2), na.rm = FALSE), wwithin(-1:1, c(NA,1:2)))
expect_equal(fwithin(x, w = wNA), wwithin(x, wNA, na.rm = TRUE))
expect_equal(fwithin(x, w = wNA, na.rm = FALSE), wwithin(x, wNA))
expect_equal(fwithin(xNA, w = wNA, na.rm = FALSE), wwithin(xNA, wNA))
expect_equal(fwithin(xNA, w = wNA), wwithin(xNA, wNA, na.rm = TRUE))
expect_equal(qM(fwithin(mtcars, w = wdatNA)), fwithin(m, w = wdatNA))
expect_equal(fwithin(m, w = wdatNA), dapply(m, wwithin, wdatNA, na.rm = TRUE))
expect_equal(fwithin(m, w = wdatNA, na.rm = FALSE), dapply(m, wwithin, wdatNA))
expect_equal(fwithin(mNA, w = wdatNA, na.rm = FALSE), dapply(mNA, wwithin, wdatNA))
expect_equal(fwithin(mNA, w = wdatNA), dapply(mNA, wwithin, wdatNA, na.rm = TRUE))
expect_equal(fwithin(mtcars, w = wdatNA), dapply(mtcars, wwithin, wdatNA, na.rm = TRUE))
expect_equal(fwithin(mtcars, w = wdatNA, na.rm = FALSE), dapply(mtcars, wwithin, wdatNA))
expect_equal(fwithin(mtcNA, w = wdatNA, na.rm = FALSE), dapply(mtcNA, wwithin, wdatNA))
expect_equal(fwithin(mtcNA, w = wdatNA), dapply(mtcNA, wwithin, wdatNA, na.rm = TRUE))
expect_equal(fwithin(x, f, wNA), BY(x, f, wwithin, wNA, na.rm = TRUE))
expect_equal(fwithin(x, f, wNA, na.rm = FALSE), BY(x, f, wwithin, wNA))
expect_equal(fwithin(xNA, f, wNA, na.rm = FALSE), BY(xNA, f, wwithin, wNA))
expect_equal(fwithin(xNA, f, wNA), BY(xNA, f, wwithin, wNA, na.rm = TRUE))
expect_equal(fwithin(m, g, wdatNA), BY(m, g, wwithin, wdatNA, na.rm = TRUE))
expect_equal(fwithin(m, g, wdatNA, na.rm = FALSE), BY(m, g, wwithin, wdatNA))
expect_equal(fwithin(mNA, g, wdatNA, na.rm = FALSE), BY(mNA, g, wwithin, wdatNA))
expect_equal(fwithin(mNA, g, wdatNA), BY(mNA, g, wwithin, wdatNA, na.rm = TRUE))
expect_equal(fwithin(mtcars, g, wdatNA), BY(mtcars, g, wwithin, wdatNA, na.rm = TRUE))
expect_equal(fwithin(mtcars, g, wdatNA, na.rm = FALSE), BY(mtcars, g, wwithin, wdatNA))
expect_equal(fwithin(mtcNA, g, wdatNA, na.rm = FALSE), BY(mtcNA, g, wwithin, wdatNA))
expect_equal(fwithin(mtcNA, g, wdatNA), BY(mtcNA, g, wwithin, wdatNA, na.rm = TRUE))
})
test_that("fwithin with custom mean and weights performs like wwithin (defined above)", {
# complete weights
expect_equal(fwithin(x, w = w, mean = 4.8456), wwithin(x, w, mean = 4.8456))
expect_equal(fwithin(x, w = w, na.rm = FALSE, mean = 4.8456), wwithin(x, w, mean = 4.8456))
expect_equal(fwithin(xNA, w = w, na.rm = FALSE, mean = 4.8456), wwithin(xNA, w, mean = 4.8456))
expect_equal(fwithin(xNA, w = w, mean = 4.8456), wwithin(xNA, w, na.rm = TRUE, mean = 4.8456))
expect_equal(qM(fwithin(mtcars, w = wdat, mean = 4.8456)), fwithin(m, w = wdat, mean = 4.8456))
expect_equal(fwithin(m, w = wdat, mean = 4.8456), dapply(m, wwithin, wdat, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(m, w = wdat, na.rm = FALSE, mean = 4.8456), dapply(m, wwithin, wdat, mean = 4.8456))
expect_equal(fwithin(mNA, w = wdat, na.rm = FALSE, mean = 4.8456), dapply(mNA, wwithin, wdat, mean = 4.8456))
expect_equal(fwithin(mNA, w = wdat, mean = 4.8456), dapply(mNA, wwithin, wdat, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(mtcars, w = wdat, mean = 4.8456), dapply(mtcars, wwithin, wdat, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(mtcars, w = wdat, na.rm = FALSE, mean = 4.8456), dapply(mtcars, wwithin, wdat, mean = 4.8456))
expect_equal(fwithin(mtcNA, w = wdat, na.rm = FALSE, mean = 4.8456), dapply(mtcNA, wwithin, wdat, mean = 4.8456))
expect_equal(fwithin(mtcNA, w = wdat, mean = 4.8456), dapply(mtcNA, wwithin, wdat, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(x, f, w, mean = 4.8456), BY(x, f, wwithin, w, mean = 4.8456))
expect_equal(fwithin(x, f, w, na.rm = FALSE, mean = 4.8456), BY(x, f, wwithin, w, mean = 4.8456))
expect_equal(fwithin(xNA, f, w, na.rm = FALSE, mean = 4.8456), BY(xNA, f, wwithin, w, mean = 4.8456))
expect_equal(fwithin(xNA, f, w, mean = 4.8456), BY(xNA, f, wwithin, w, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(m, g, wdat, mean = 4.8456), BY(m, g, wwithin, wdat, mean = 4.8456))
expect_equal(fwithin(m, g, wdat, na.rm = FALSE, mean = 4.8456), BY(m, g, wwithin, wdat, mean = 4.8456))
expect_equal(fwithin(mNA, g, wdat, na.rm = FALSE, mean = 4.8456), BY(mNA, g, wwithin, wdat, mean = 4.8456))
expect_equal(fwithin(mNA, g, wdat, mean = 4.8456), BY(mNA, g, wwithin, wdat, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(mtcars, g, wdat, mean = 4.8456), BY(mtcars, g, wwithin, wdat, mean = 4.8456))
expect_equal(fwithin(mtcars, g, wdat, na.rm = FALSE, mean = 4.8456), BY(mtcars, g, wwithin, wdat, mean = 4.8456))
expect_equal(fwithin(mtcNA, g, wdat, na.rm = FALSE, mean = 4.8456), BY(mtcNA, g, wwithin, wdat, mean = 4.8456))
expect_equal(fwithin(mtcNA, g, wdat, mean = 4.8456), BY(mtcNA, g, wwithin, wdat, na.rm = TRUE, mean = 4.8456))
# missing weights
expect_equal(fwithin(x, w = wNA, mean = 4.8456), wwithin(x, wNA, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(x, w = wNA, na.rm = FALSE, mean = 4.8456), wwithin(x, wNA, mean = 4.8456))
expect_equal(fwithin(xNA, w = wNA, na.rm = FALSE, mean = 4.8456), wwithin(xNA, wNA, mean = 4.8456))
expect_equal(fwithin(xNA, w = wNA, mean = 4.8456), wwithin(xNA, wNA, na.rm = TRUE, mean = 4.8456))
expect_equal(qM(fwithin(mtcars, w = wdatNA, mean = 4.8456)), fwithin(m, w = wdatNA, mean = 4.8456))
expect_equal(fwithin(m, w = wdatNA, mean = 4.8456), dapply(m, wwithin, wdatNA, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(m, w = wdatNA, na.rm = FALSE, mean = 4.8456), dapply(m, wwithin, wdatNA, mean = 4.8456))
expect_equal(fwithin(mNA, w = wdatNA, na.rm = FALSE, mean = 4.8456), dapply(mNA, wwithin, wdatNA, mean = 4.8456))
expect_equal(fwithin(mNA, w = wdatNA, mean = 4.8456), dapply(mNA, wwithin, wdatNA, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(mtcars, w = wdatNA, mean = 4.8456), dapply(mtcars, wwithin, wdatNA, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(mtcars, w = wdatNA, na.rm = FALSE, mean = 4.8456), dapply(mtcars, wwithin, wdatNA, mean = 4.8456))
expect_equal(fwithin(mtcNA, w = wdatNA, na.rm = FALSE, mean = 4.8456), dapply(mtcNA, wwithin, wdatNA, mean = 4.8456))
expect_equal(fwithin(mtcNA, w = wdatNA, mean = 4.8456), dapply(mtcNA, wwithin, wdatNA, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(x, f, wNA, mean = 4.8456), BY(x, f, wwithin, wNA, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(x, f, wNA, na.rm = FALSE, mean = 4.8456), BY(x, f, wwithin, wNA, mean = 4.8456))
expect_equal(fwithin(xNA, f, wNA, na.rm = FALSE, mean = 4.8456), BY(xNA, f, wwithin, wNA, mean = 4.8456))
expect_equal(fwithin(xNA, f, wNA, mean = 4.8456), BY(xNA, f, wwithin, wNA, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(m, g, wdatNA, mean = 4.8456), BY(m, g, wwithin, wdatNA, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(m, g, wdatNA, na.rm = FALSE, mean = 4.8456), BY(m, g, wwithin, wdatNA, mean = 4.8456))
expect_equal(fwithin(mNA, g, wdatNA, na.rm = FALSE, mean = 4.8456), BY(mNA, g, wwithin, wdatNA, mean = 4.8456))
expect_equal(fwithin(mNA, g, wdatNA, mean = 4.8456), BY(mNA, g, wwithin, wdatNA, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(mtcars, g, wdatNA, mean = 4.8456), BY(mtcars, g, wwithin, wdatNA, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(mtcars, g, wdatNA, na.rm = FALSE, mean = 4.8456), BY(mtcars, g, wwithin, wdatNA, mean = 4.8456))
expect_equal(fwithin(mtcNA, g, wdatNA, na.rm = FALSE, mean = 4.8456), BY(mtcNA, g, wwithin, wdatNA, mean = 4.8456))
expect_equal(fwithin(mtcNA, g, wdatNA, mean = 4.8456), BY(mtcNA, g, wwithin, wdatNA, na.rm = TRUE, mean = 4.8456))
})
test_that("Weighted centering on overall weighted mean performs as indended", {
# complete weights
expect_equal(fwithin(x, f, w, mean = "overall.mean"), as.numeric(mapply(wwithin, split(x, f), split(w, f), na.rm = TRUE)) + B(x, w = w))
expect_equal(fwithin(x, f, w, na.rm = FALSE, mean = "overall.mean"), as.numeric(mapply(wwithin, split(x, f), split(w, f))) + B(x, w = w))
# expect_equal(fwithin(xNA, f, w, na.rm = FALSE, mean = "overall.mean"), as.numeric(mapply(wwithin, split(xNA, f), split(w, f))) + B(xNA, w = w)) # Not the same !!
expect_equal(fwithin(xNA, f, w, mean = "overall.mean"), as.numeric(mapply(wwithin, split(xNA, f), split(w, f), na.rm = TRUE)) + B(xNA, w = w))
})
# Do more than this to test the rest ...
test_that("fwithin performs numerically stable", {
expect_true(all_obj_equal(replicate(50, fwithin(1), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(NA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(NA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, f), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, f, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, f, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, f), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, g), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, g, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, g, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, g), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, g), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, g, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, g, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, g), simplify = FALSE)))
})
test_that("fwithin with complete weights performs numerically stable", {
expect_true(all_obj_equal(replicate(50, fwithin(1, w = 1), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(NA, w = 1), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(NA, w = 1, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, w = w), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, w = w, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, w = w, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, w = w), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, w = wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, w = wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, w = wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, w = wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, w = wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, w = wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, w = wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, w = wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, f, w), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, f, w, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, f, w, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, f, w), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, g, wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, g, wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, g, wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, g, wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, g, wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, g, wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, g, wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, g, wdat), simplify = FALSE)))
})
test_that("fwithin with missing weights performs numerically stable", {
expect_true(all_obj_equal(replicate(50, fwithin(1, w = NA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(NA, w = NA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(NA, w = NA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, w = wNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, w = wNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, w = wNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, w = wNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, w = wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, w = wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, w = wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, w = wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, f, wNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, f, wNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, f, wNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, f, wNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, g, wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, g, wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, g, wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, g, wdatNA), simplify = FALSE)))
})
test_that("fwithin handles special values in the right way", {
expect_equal(fwithin(NA), NA_real_)
expect_equal(fwithin(NaN), NaN)
expect_equal(fwithin(Inf), NaN)
expect_equal(fwithin(c(Inf,Inf)), c(NaN,NaN))
expect_equal(fwithin(-Inf), NaN)
expect_equal(fwithin(c(-Inf,-Inf)), c(NaN,NaN))
expect_equal(fwithin(TRUE), 0)
expect_equal(fwithin(FALSE), 0)
expect_equal(fwithin(NA, na.rm = FALSE), NA_real_)
expect_equal(fwithin(NaN, na.rm = FALSE), NaN)
expect_equal(fwithin(Inf, na.rm = FALSE), NaN)
expect_equal(fwithin(c(Inf,Inf), na.rm = FALSE), c(NaN,NaN))
expect_equal(fwithin(-Inf, na.rm = FALSE), NaN)
expect_equal(fwithin(c(-Inf,-Inf), na.rm = FALSE), c(NaN,NaN))
expect_equal(fwithin(TRUE, na.rm = FALSE), 0)
expect_equal(fwithin(FALSE, na.rm = FALSE), 0)
expect_equal(fwithin(c(1,NA)), c(0,NA_real_))
expect_equal(fwithin(c(1,NaN)), c(0,NaN))
expect_equal(fwithin(c(1,Inf)), c(-Inf,NaN))
expect_equal(fwithin(c(1,-Inf)), c(Inf,NaN))
expect_equal(fwithin(c(1,Inf), na.rm = FALSE), c(-Inf,NaN))
expect_equal(fwithin(c(1,-Inf), na.rm = FALSE), c(Inf,NaN))
expect_equal(fwithin(c(NA,-Inf), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fwithin(c(TRUE,TRUE), na.rm = FALSE), c(0,0))
expect_equal(fwithin(c(1,NA), na.rm = FALSE), c(NA_real_,NA_real_))
})
test_that("fwithin with weights handles special values in the right way", {
expect_equal(fwithin(NA, w = 1), NA_real_)
expect_equal(fwithin(NaN, w = 1), NaN)
expect_equal(fwithin(Inf, w = 1), NaN)
expect_equal(fwithin(c(Inf,Inf), w = 1:2), c(NaN,NaN))
expect_equal(fwithin(-Inf, w = 1), NaN)
expect_equal(fwithin(c(-Inf,-Inf), w = 1:2), c(NaN,NaN))
expect_equal(fwithin(TRUE, w = 1), 0)
expect_equal(fwithin(FALSE, w = 1), 0)
expect_equal(fwithin(NA, w = 1, na.rm = FALSE), NA_real_)
expect_equal(fwithin(NaN, w = 1, na.rm = FALSE), NaN)
expect_equal(fwithin(Inf, w = 1, na.rm = FALSE), NaN)
expect_equal(fwithin(c(Inf,Inf), w = 1:2, na.rm = FALSE), c(NaN,NaN))
expect_equal(fwithin(-Inf, w = 1, na.rm = FALSE), NaN)
expect_equal(fwithin(c(-Inf,-Inf), w = 1:2, na.rm = FALSE), c(NaN,NaN))
expect_equal(fwithin(TRUE, w = 1, na.rm = FALSE), 0)
expect_equal(fwithin(FALSE, w = 1, na.rm = FALSE), 0)
expect_equal(fwithin(c(1,NA), w = 1:2), c(0,NA))
expect_equal(fwithin(c(1,NaN), w = 1:2), c(0,NaN))
expect_equal(fwithin(c(1,Inf), w = 1:2), c(-Inf,NaN))
expect_equal(fwithin(c(1,-Inf), w = 1:2), c(Inf,NaN))
expect_equal(fwithin(c(1,Inf), w = 1:2, na.rm = FALSE), c(-Inf,NaN))
expect_equal(fwithin(c(1,-Inf), w = 1:2, na.rm = FALSE), c(Inf,NaN))
expect_equal(fwithin(c(NA,-Inf), w = 1:2, na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fwithin(c(FALSE,FALSE), w = 1:2, na.rm = FALSE), c(0,0))
expect_equal(fwithin(c(1,NA), w = 1:2, na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fwithin(1:3, w = c(1,Inf,3)), c(NaN,NaN,NaN))
expect_equal(fwithin(1:3, w = c(1,-Inf,3)), c(NaN,NaN,NaN))
expect_equal(fwithin(1:3, w = c(1,Inf,3), na.rm = FALSE), c(NaN,NaN,NaN))
expect_equal(fwithin(1:3, w = c(1,-Inf,3), na.rm = FALSE), c(NaN,NaN,NaN))
expect_equal(fwithin(NA, w = NA), NA_real_)
expect_equal(fwithin(NaN, w = NA), NaN)
expect_equal(fwithin(Inf, w = NA), NaN)
expect_equal(fwithin(c(Inf,Inf), w = c(NA,2)), c(NaN,NaN))
expect_equal(fwithin(-Inf, w = NA), NA_real_)
expect_equal(fwithin(c(-Inf,-Inf), w = c(NA,2)), c(NaN,NaN))
expect_equal(fwithin(TRUE, w = NA), NA_real_)
expect_equal(fwithin(FALSE, w = NA), NA_real_)
expect_equal(fwithin(NA, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fwithin(NaN, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fwithin(Inf, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fwithin(c(Inf,Inf), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fwithin(-Inf, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fwithin(c(-Inf,-Inf), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fwithin(TRUE, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fwithin(FALSE, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fwithin(c(1,NA), w = c(NA,2)), c(NA_real_,NA_real_))
expect_equal(fwithin(c(1,NaN), w = c(NA,2)), c(NA_real_,NA_real_))
expect_equal(fwithin(c(1,Inf), w = c(NA,2)), c(-Inf,NaN))
expect_equal(fwithin(c(1,-Inf), w = c(NA,2)), c(Inf,NaN))
expect_equal(fwithin(c(1,Inf), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fwithin(c(1,-Inf), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fwithin(c(NA,-Inf), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fwithin(c(FALSE,FALSE), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fwithin(c(1,NA), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fwithin(1:3, w = c(NA,Inf,3)), c(NaN,NaN,NaN))
expect_equal(fwithin(1:3, w = c(NA,-Inf,3)), c(NaN,NaN,NaN))
expect_equal(fwithin(1:3, w = c(NA,Inf,3), na.rm = FALSE), c(NA_real_,NA_real_,NA_real_))
expect_equal(fwithin(1:3, w = c(NA,-Inf,3), na.rm = FALSE), c(NA_real_,NA_real_,NA_real_))
})
test_that("fwithin produces errors for wrong input", {
expect_error(fwithin("a"))
expect_error(fwithin(NA_character_))
expect_error(fwithin(mNAc))
expect_error(fwithin(mNAc, f))
expect_error(fwithin(1:2,1:3))
expect_error(fwithin(m,1:31))
expect_error(fwithin(mtcars,1:31))
expect_error(fwithin(mtcars, w = 1:31))
expect_error(fwithin("a", w = 1))
expect_error(fwithin(1:2, w = 1:3))
expect_error(fwithin(NA_character_, w = 1))
expect_error(fwithin(mNAc, w = wdat))
expect_error(fwithin(mNAc, f, wdat))
expect_error(fwithin(mNA, w = 1:33))
expect_error(fwithin(1:2,1:2, 1:3))
expect_error(fwithin(m,1:32,1:20))
expect_error(fwithin(mtcars,1:32,1:10))
expect_error(fwithin(1:2, w = c("a","b")))
expect_error(fwithin(wlddev))
expect_error(fwithin(wlddev, w = wlddev$year))
expect_error(fwithin(wlddev, wlddev$iso3c))
expect_error(fwithin(wlddev, wlddev$iso3c, wlddev$year))
})
test_that("fwithin shoots errors for wrong input to mean", {
expect_error(fwithin(x, mean = FALSE))
expect_error(fwithin(m, mean = FALSE))
expect_error(fwithin(mtcars, mean = FALSE))
expect_error(fwithin(x, mean = "overall.mean"))
expect_error(fwithin(m, mean = "overall.mean"))
expect_error(fwithin(mtcars, mean = "overall.mean"))
expect_error(fwithin(m, mean = fmean(m)))
expect_error(fwithin(mtcars, mean = fmean(mtcars)))
})
# W
test_that("W produces errors for wrong input", {
expect_error(W("a"))
expect_error(W(NA_character_))
expect_error(W(mNAc))
expect_error(W(mNAc, f))
expect_error(W(1:2,1:3))
expect_error(W(m,1:31))
expect_error(W(mtcars,1:31))
expect_error(W(mtcars, w = 1:31))
expect_error(W("a", w = 1))
expect_error(W(1:2, w = c("a","b")))
expect_error(W(1:2, w = 1:3))
expect_error(W(NA_character_, w = 1))
expect_error(W(mNAc, w = wdat))
expect_error(W(mNAc, f, wdat))
expect_error(W(mNA, w = 1:33))
expect_error(W(mtcNA, w = 1:33))
expect_error(W(1:2,1:2, 1:3))
expect_error(W(m,1:32,1:20))
expect_error(W(mtcars,1:32,1:10))
expect_error(W(1:2, 1:3, 1:2))
expect_error(W(m,1:31,1:32))
expect_error(W(mtcars,1:33,1:32))
})
test_that("W.data.frame method is foolproof", {
expect_visible(W(wlddev))
expect_visible(W(wlddev, w = wlddev$year))
expect_visible(W(wlddev, w = ~year))
expect_visible(W(wlddev, wlddev$iso3c))
expect_visible(W(wlddev, ~iso3c))
expect_visible(W(wlddev, ~iso3c + region))
expect_visible(W(wlddev, wlddev$iso3c, wlddev$year))
expect_visible(W(wlddev, ~iso3c, ~year))
expect_visible(W(wlddev, cols = 9:12))
expect_visible(W(wlddev, w = wlddev$year, cols = 9:12))
expect_visible(W(wlddev, w = ~year, cols = 9:12))
expect_visible(W(wlddev, wlddev$iso3c, cols = 9:12))
expect_visible(W(wlddev, ~iso3c, cols = 9:12))
expect_visible(W(wlddev, wlddev$iso3c, wlddev$year, cols = 9:12))
expect_visible(W(wlddev, ~iso3c, ~year, cols = 9:12))
expect_visible(W(wlddev, cols = c("PCGDP","LIFEEX")))
expect_visible(W(wlddev, w = wlddev$year, cols = c("PCGDP","LIFEEX")))
expect_visible(W(wlddev, w = ~year, cols = c("PCGDP","LIFEEX")))
expect_visible(W(wlddev, wlddev$iso3c, cols = c("PCGDP","LIFEEX")))
expect_visible(W(wlddev, ~iso3c, cols = c("PCGDP","LIFEEX")))
expect_visible(W(wlddev, wlddev$iso3c, wlddev$year, cols = c("PCGDP","LIFEEX")))
expect_visible(W(wlddev, ~iso3c, ~year, cols = c("PCGDP","LIFEEX")))
expect_error(W(wlddev, cols = NULL))
expect_error(W(wlddev, w = wlddev$year, cols = NULL))
expect_error(W(wlddev, w = ~year, cols = NULL))
expect_error(W(wlddev, wlddev$iso3c, cols = NULL))
expect_error(W(wlddev, ~iso3c, cols = NULL))
expect_error(W(wlddev, wlddev$iso3c, wlddev$year, cols = NULL))
expect_error(W(wlddev, ~iso3c, ~year, cols = NULL))
expect_error(W(wlddev, cols = 9:14))
expect_error(W(wlddev, w = wlddev$year, cols = 9:14))
expect_error(W(wlddev, w = ~year, cols = 9:14))
expect_error(W(wlddev, wlddev$iso3c, cols = 9:14))
expect_error(W(wlddev, ~iso3c, cols = 9:14))
expect_error(W(wlddev, wlddev$iso3c, wlddev$year, cols = 9:14))
expect_error(W(wlddev, ~iso3c, ~year, cols = 9:14))
expect_error(W(wlddev, cols = c("PCGDP","LIFEEX","bla")))
expect_error(W(wlddev, w = wlddev$year, cols = c("PCGDP","LIFEEX","bla")))
expect_error(W(wlddev, w = ~year, cols = c("PCGDP","LIFEEX","bla")))
expect_error(W(wlddev, wlddev$iso3c, cols = c("PCGDP","LIFEEX","bla")))
expect_error(W(wlddev, ~iso3c, cols = c("PCGDP","LIFEEX","bla")))
expect_error(W(wlddev, wlddev$iso3c, wlddev$year, cols = c("PCGDP","LIFEEX","bla")))
expect_error(W(wlddev, ~iso3c, ~year, cols = c("PCGDP","LIFEEX","bla")))
expect_error(W(wlddev, w = mtcars))
expect_error(W(wlddev, w = 4))
expect_error(W(wlddev, w = "year"))
expect_error(W(wlddev, w = ~year2))
# suppressWarnings(expect_error(W(wlddev, w = ~year + region)))
expect_error(W(wlddev, mtcars))
expect_error(W(wlddev, 2))
expect_error(W(wlddev, "iso3c"))
expect_error(W(wlddev, ~iso3c2))
expect_error(W(wlddev, ~iso3c + bla))
expect_error(W(wlddev, mtcars$mpg, mtcars$cyl))
expect_error(W(wlddev, 2, 4))
expect_error(W(wlddev, ~iso3c2, ~year2))
expect_error(W(wlddev, cols = ~bla))
expect_error(W(wlddev, w = ~bla, cols = 9:12))
expect_error(W(wlddev, w = 4, cols = 9:12))
expect_error(W(wlddev, w = "year", cols = 9:12))
expect_error(W(wlddev, w = ~yewar, cols = 9:12))
expect_error(W(wlddev, mtcars$mpg, cols = 9:12))
expect_error(W(wlddev, ~iso3c + ss, cols = 9:12))
expect_error(W(wlddev, 2, cols = 9:12))
expect_error(W(wlddev, "iso3c", cols = 9:12))
expect_error(W(wlddev, wlddev$iso3c, ~year + bla, cols = 9:12))
expect_error(W(wlddev, ~iso3c3, ~year, cols = 9:12))
expect_error(W(wlddev, cols = c("PC3GDP","LIFEEX")))
})
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.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
context("fbetween / B and fwithin / W")
if(!is.null(attributes(identical(FALSE, TRUE)))) stop("OECD label issue")
# 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(rep(1:10, each = 10))
g <- as.factor(rep(c(1,2,2,3,3,3,4,4,4,4,5,5,5,5,5,7,7,7,7,7,7,7,10,10,10,10,10,10,10,10,10,10)))
mtcNA <- na_insert(mtcars)
mtcNA[1,1] <- NA # single group NA !!
m <- as.matrix(mtcars)
mNA <- as.matrix(mtcNA)
mNAc <- mNA
storage.mode(mNAc) <- "character"
# x = rnorm(1e7)
# xNA = x
# xNA[sample.int(1e7,1e6)] <- NA
# w = abs(100*rnorm(1e7))
# wNA = w
# wNA[sample.int(1e7,1e6)] <- NA
# microbenchmark(fwithin(xNA), fbetween(xNA), fbetween(xNA, w = w), fwithin(xNA, w = w), fbetween(xNA, w = wNA), fwithin(xNA, w = wNA))
# Unit: milliseconds
# expr min lq mean median uq max neval cld
# fwithin(xNA) 59.89809 61.45215 81.20188 63.21997 65.99563 303.5464 100 a
# fbetween(xNA) 71.32829 73.00953 86.06850 74.51227 77.79108 275.6274 100 ab
# fbetween(xNA, w = w) 81.95167 84.85050 106.61714 86.65870 90.92104 314.8245 100 cd
# fwithin(xNA, w = w) 71.24841 73.72264 88.08572 75.32935 80.46232 279.5597 100 a c
# fbetween(xNA, w = wNA) 90.99712 93.71455 107.38818 95.91545 98.16989 328.8951 100 d
# fwithin(xNA, w = wNA) 80.13678 83.62511 103.55614 86.22361 93.18352 301.7070 100 bcd
bsum <- base::sum
between <- function(x, na.rm = FALSE) {
if(!na.rm) return(ave(x))
cc <- !is.na(x)
x[cc] <- ave(x[cc])
return(x)
}
within <- function(x, na.rm = FALSE, mean = 0) {
if(!na.rm) return(x - ave(x) + mean)
cc <- !is.na(x)
m <- bsum(x[cc]) / bsum(cc)
return(x - m + mean)
}
# NOTE: This is what fbetween and fwithin currently do: If missing values, compute weighted mean on available obs, and center x using it. But don't insert additional missing values in x for missing weights ..
wbetween <- function(x, w, na.rm = FALSE) {
if(na.rm) {
xcc <- !is.na(x)
cc <- xcc & !is.na(w)
w <- w[cc]
wm <- bsum(w * x[cc]) / bsum(w)
x[xcc] <- rep(wm, bsum(xcc))
return(x)
} else {
wm <- bsum(w * x) / bsum(w)
return(rep(wm, length(x)))
}
}
wwithin <- function(x, w, na.rm = FALSE, mean = 0) {
if(na.rm) {
cc <- complete.cases(x, w)
w <- w[cc]
wm <- bsum(w * x[cc]) / bsum(w)
} else wm <- bsum(w * x) / bsum(w)
return(x - wm + mean)
}
# fbetween
test_that("fbetween performs like between", {
expect_equal(fbetween(NA), as.double(between(NA)))
expect_equal(fbetween(NA, na.rm = FALSE), as.double(between(NA)))
expect_equal(fbetween(1), between(1, na.rm = TRUE))
expect_equal(fbetween(1:3), between(1:3, na.rm = TRUE))
expect_equal(fbetween(-1:1), between(-1:1, na.rm = TRUE))
expect_equal(fbetween(1, na.rm = FALSE), between(1))
expect_equal(fbetween(1:3, na.rm = FALSE), between(1:3))
expect_equal(fbetween(-1:1, na.rm = FALSE), between(-1:1))
expect_equal(fbetween(x), between(x, na.rm = TRUE))
expect_equal(fbetween(x, na.rm = FALSE), between(x))
expect_equal(fbetween(xNA, na.rm = FALSE), between(xNA))
expect_equal(fbetween(xNA), between(xNA, na.rm = TRUE))
expect_equal(qM(fbetween(mtcars)), fbetween(m))
expect_equal(fbetween(m), dapply(m, between, na.rm = TRUE))
expect_equal(fbetween(m, na.rm = FALSE), dapply(m, between))
expect_equal(fbetween(mNA, na.rm = FALSE), dapply(mNA, between))
expect_equal(fbetween(mNA), dapply(mNA, between, na.rm = TRUE))
expect_equal(fbetween(mtcars), dapply(mtcars, between, na.rm = TRUE))
expect_equal(fbetween(mtcars, na.rm = FALSE), dapply(mtcars, between))
expect_equal(fbetween(mtcNA, na.rm = FALSE), dapply(mtcNA, between))
expect_equal(fbetween(mtcNA), dapply(mtcNA, between, na.rm = TRUE))
expect_equal(fbetween(x, f), BY(x, f, between, na.rm = TRUE, use.g.names = FALSE))
expect_equal(fbetween(x, f, na.rm = FALSE), BY(x, f, between, use.g.names = FALSE))
expect_equal(fbetween(xNA, f, na.rm = FALSE), BY(xNA, f, between, use.g.names = FALSE))
expect_equal(fbetween(xNA, f), BY(xNA, f, between, na.rm = TRUE, use.g.names = FALSE))
expect_equal(fbetween(m, g), BY(m, g, between, na.rm = TRUE, use.g.names = FALSE))
expect_equal(fbetween(m, g, na.rm = FALSE), BY(m, g, between, use.g.names = FALSE))
expect_equal(fbetween(mNA, g, na.rm = FALSE), BY(mNA, g, between, use.g.names = FALSE))
expect_equal(fbetween(mNA, g), BY(mNA, g, between, na.rm = TRUE, use.g.names = FALSE))
expect_equal(fbetween(mtcars, g), BY(mtcars, g, between, na.rm = TRUE, use.g.names = FALSE))
expect_equal(fbetween(mtcars, g, na.rm = FALSE), BY(mtcars, g, between, use.g.names = FALSE))
expect_equal(fbetween(mtcNA, g, na.rm = FALSE), BY(mtcNA, g, between, use.g.names = FALSE))
expect_equal(fbetween(mtcNA, g), BY(mtcNA, g, between, na.rm = TRUE, use.g.names = FALSE))
})
test_that("fbetween performs like fbetween with weights all equal", {
expect_equal(fbetween(NA), fbetween(NA, w = 0.99999999))
expect_equal(fbetween(NA, na.rm = FALSE), fbetween(NA, w = 2.946, na.rm = FALSE))
expect_equal(fbetween(1), fbetween(1, w = 3))
expect_equal(fbetween(1:3), fbetween(1:3, w = rep(0.999,3)))
expect_equal(fbetween(-1:1), fbetween(-1:1, w = rep(4.2,3)))
expect_equal(fbetween(1, na.rm = FALSE), fbetween(1, w = 5, na.rm = FALSE))
expect_equal(fbetween(1:3, na.rm = FALSE), fbetween(1:3, w = rep(1.44565, 3), na.rm = FALSE))
expect_equal(fbetween(-1:1, na.rm = FALSE), fbetween(-1:1, w = rep(1.44565, 3), na.rm = FALSE))
expect_equal(fbetween(x), fbetween(x, w = rep(1,100)))
expect_equal(fbetween(x, na.rm = FALSE), fbetween(x, w = rep(1.44565, 100), na.rm = FALSE))
expect_equal(fbetween(xNA, na.rm = FALSE), fbetween(xNA, w = rep(4.676587, 100), na.rm = FALSE))
expect_equal(fbetween(xNA), fbetween(xNA, w = rep(4.676587, 100)))
expect_equal(fbetween(m), fbetween(m, w = rep(6587.3454, 32)))
expect_equal(fbetween(m, na.rm = FALSE), fbetween(m, w = rep(6587.3454, 32), na.rm = FALSE))
expect_equal(fbetween(mNA, na.rm = FALSE), fbetween(mNA, w = rep(6587.3454, 32), na.rm = FALSE))
expect_equal(fbetween(mNA), fbetween(mNA, w = rep(6587.3454, 32)))
expect_equal(fbetween(mtcars), fbetween(mtcars, w = rep(6787.3454, 32)))
expect_equal(fbetween(mtcars, na.rm = FALSE), fbetween(mtcars, w = rep(6787.3454, 32), na.rm = FALSE))
expect_equal(fbetween(mtcNA, na.rm = FALSE), fbetween(mtcNA, w = rep(6787.3454, 32), na.rm = FALSE))
expect_equal(fbetween(mtcNA), fbetween(mtcNA, w = rep(6787.3454, 32)))
expect_equal(fbetween(x, f), fbetween(x, f, rep(546.78,100)))
expect_equal(fbetween(x, f, na.rm = FALSE), fbetween(x, f, rep(5.88,100), na.rm = FALSE))
expect_equal(fbetween(xNA, f, na.rm = FALSE), fbetween(xNA, f, rep(52.7,100), na.rm = FALSE))
expect_equal(fbetween(xNA, f), fbetween(xNA, f, rep(5997456,100)))
expect_equal(fbetween(m, g), fbetween(m, g, rep(546.78,32)))
expect_equal(fbetween(m, g, na.rm = FALSE), fbetween(m, g, rep(0.0001,32), na.rm = FALSE))
expect_equal(fbetween(mNA, g, na.rm = FALSE), fbetween(mNA, g, rep(5.7,32), na.rm = FALSE))
expect_equal(fbetween(mNA, g), fbetween(mNA, g, rep(1.1,32)))
expect_equal(fbetween(mtcars, g), fbetween(mtcars, g, rep(53,32)))
expect_equal(fbetween(mtcars, g, na.rm = FALSE), fbetween(mtcars, g, rep(546.78,32), na.rm = FALSE))
expect_equal(fbetween(mtcNA, g, na.rm = FALSE), fbetween(mtcNA, g, rep(0.999999,32), na.rm = FALSE))
expect_equal(fbetween(mtcNA, g), fbetween(mtcNA, g, rep(999.9999,32)))
})
test_that("fbetween with weights performs like wbetween (defined above)", {
# complete weights
expect_equal(fbetween(NA, w = 1), wbetween(NA, 1))
expect_equal(fbetween(NA, w = 1, na.rm = FALSE), wbetween(NA, 1))
expect_equal(fbetween(1, w = 1), wbetween(1, w = 1))
expect_equal(fbetween(1:3, w = 1:3), wbetween(1:3, 1:3))
expect_equal(fbetween(-1:1, w = 1:3), wbetween(-1:1, 1:3))
expect_equal(fbetween(1, w = 1, na.rm = FALSE), wbetween(1, 1))
expect_equal(fbetween(1:3, w = c(0.99,3454,1.111), na.rm = FALSE), wbetween(1:3, c(0.99,3454,1.111)))
expect_equal(fbetween(-1:1, w = 1:3, na.rm = FALSE), wbetween(-1:1, 1:3))
expect_equal(fbetween(x, w = w), wbetween(x, w))
expect_equal(fbetween(x, w = w, na.rm = FALSE), wbetween(x, w))
expect_equal(fbetween(xNA, w = w, na.rm = FALSE), wbetween(xNA, w))
expect_equal(fbetween(xNA, w = w), wbetween(xNA, w, na.rm = TRUE))
expect_equal(qM(fbetween(mtcars, w = wdat)), fbetween(m, w = wdat))
expect_equal(fbetween(m, w = wdat), dapply(m, wbetween, wdat, na.rm = TRUE))
expect_equal(fbetween(m, w = wdat, na.rm = FALSE), dapply(m, wbetween, wdat))
expect_equal(fbetween(mNA, w = wdat, na.rm = FALSE), dapply(mNA, wbetween, wdat))
expect_equal(fbetween(mNA, w = wdat), dapply(mNA, wbetween, wdat, na.rm = TRUE))
expect_equal(fbetween(mtcars, w = wdat), dapply(mtcars, wbetween, wdat, na.rm = TRUE))
expect_equal(fbetween(mtcars, w = wdat, na.rm = FALSE), dapply(mtcars, wbetween, wdat))
expect_equal(fbetween(mtcNA, w = wdat, na.rm = FALSE), dapply(mtcNA, wbetween, wdat))
expect_equal(fbetween(mtcNA, w = wdat), dapply(mtcNA, wbetween, wdat, na.rm = TRUE))
expect_equal(fbetween(x, f, w), BY(x, f, wbetween, w))
expect_equal(fbetween(x, f, w, na.rm = FALSE), BY(x, f, wbetween, w))
expect_equal(fbetween(xNA, f, w, na.rm = FALSE), BY(xNA, f, wbetween, w))
expect_equal(fbetween(xNA, f, w), BY(xNA, f, wbetween, w, na.rm = TRUE))
expect_equal(fbetween(m, g, wdat), BY(m, g, wbetween, wdat))
expect_equal(fbetween(m, g, wdat, na.rm = FALSE), BY(m, g, wbetween, wdat))
expect_equal(fbetween(mNA, g, wdat, na.rm = FALSE), BY(mNA, g, wbetween, wdat))
expect_equal(fbetween(mNA, g, wdat), BY(mNA, g, wbetween, wdat, na.rm = TRUE))
expect_equal(fbetween(mtcars, g, wdat), BY(mtcars, g, wbetween, wdat))
expect_equal(fbetween(mtcars, g, wdat, na.rm = FALSE), BY(mtcars, g, wbetween, wdat))
expect_equal(fbetween(mtcNA, g, wdat, na.rm = FALSE), BY(mtcNA, g, wbetween, wdat))
expect_equal(fbetween(mtcNA, g, wdat), BY(mtcNA, g, wbetween, wdat, na.rm = TRUE))
# missing weights
expect_equal(fbetween(NA, w = NA), wbetween(NA, NA))
expect_equal(fbetween(NA, w = NA, na.rm = FALSE), wbetween(NA, NA))
expect_equal(fbetween(1, w = NA), wbetween(1, w = NA))
expect_equal(fbetween(1:3, w = c(NA,1:2)), wbetween(1:3, c(NA,1:2), na.rm = TRUE))
expect_equal(fbetween(-1:1, w = c(NA,1:2)), wbetween(-1:1, c(NA,1:2), na.rm = TRUE))
expect_equal(fbetween(1, w = NA, na.rm = FALSE), wbetween(1, NA))
expect_equal(fbetween(1:3, w = c(NA,1:2), na.rm = FALSE), wbetween(1:3, c(NA,1:2)))
expect_equal(fbetween(-1:1, w = c(NA,1:2), na.rm = FALSE), wbetween(-1:1, c(NA,1:2)))
expect_equal(fbetween(x, w = wNA), wbetween(x, wNA, na.rm = TRUE))
expect_equal(fbetween(x, w = wNA, na.rm = FALSE), wbetween(x, wNA))
expect_equal(fbetween(xNA, w = wNA, na.rm = FALSE), wbetween(xNA, wNA))
expect_equal(fbetween(xNA, w = wNA), wbetween(xNA, wNA, na.rm = TRUE))
expect_equal(qM(fbetween(mtcars, w = wdatNA)), fbetween(m, w = wdatNA))
expect_equal(fbetween(m, w = wdatNA), dapply(m, wbetween, wdatNA, na.rm = TRUE))
expect_equal(fbetween(m, w = wdatNA, na.rm = FALSE), dapply(m, wbetween, wdatNA))
expect_equal(fbetween(mNA, w = wdatNA, na.rm = FALSE), dapply(mNA, wbetween, wdatNA))
expect_equal(fbetween(mNA, w = wdatNA), dapply(mNA, wbetween, wdatNA, na.rm = TRUE))
expect_equal(fbetween(mtcars, w = wdatNA), dapply(mtcars, wbetween, wdatNA, na.rm = TRUE))
expect_equal(fbetween(mtcars, w = wdatNA, na.rm = FALSE), dapply(mtcars, wbetween, wdatNA))
expect_equal(fbetween(mtcNA, w = wdatNA, na.rm = FALSE), dapply(mtcNA, wbetween, wdatNA))
expect_equal(fbetween(mtcNA, w = wdatNA), dapply(mtcNA, wbetween, wdatNA, na.rm = TRUE))
expect_equal(fbetween(x, f, wNA), BY(x, f, wbetween, wNA, na.rm = TRUE))
expect_equal(fbetween(x, f, wNA, na.rm = FALSE), BY(x, f, wbetween, wNA))
expect_equal(fbetween(xNA, f, wNA, na.rm = FALSE), BY(xNA, f, wbetween, wNA))
expect_equal(fbetween(xNA, f, wNA), BY(xNA, f, wbetween, wNA, na.rm = TRUE))
expect_equal(fbetween(m, g, wdatNA), BY(m, g, wbetween, wdatNA, na.rm = TRUE))
expect_equal(fbetween(m, g, wdatNA, na.rm = FALSE), BY(m, g, wbetween, wdatNA))
expect_equal(fbetween(mNA, g, wdatNA, na.rm = FALSE), BY(mNA, g, wbetween, wdatNA))
expect_equal(fbetween(mNA, g, wdatNA), BY(mNA, g, wbetween, wdatNA, na.rm = TRUE))
expect_equal(fbetween(mtcars, g, wdatNA), BY(mtcars, g, wbetween, wdatNA, na.rm = TRUE))
expect_equal(fbetween(mtcars, g, wdatNA, na.rm = FALSE), BY(mtcars, g, wbetween, wdatNA))
expect_equal(fbetween(mtcNA, g, wdatNA, na.rm = FALSE), BY(mtcNA, g, wbetween, wdatNA))
expect_equal(fbetween(mtcNA, g, wdatNA), BY(mtcNA, g, wbetween, wdatNA, na.rm = TRUE))
})
test_that("fbetween performs numerically stable", {
expect_true(all_obj_equal(replicate(50, fbetween(1), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(NA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(NA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, f), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, f, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, f, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, f), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, g), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, g, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, g, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, g), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, g), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, g, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, g, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, g), simplify = FALSE)))
})
test_that("fbetween with complete weights performs numerically stable", {
expect_true(all_obj_equal(replicate(50, fbetween(1, w = 1), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(NA, w = 1), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(NA, w = 1, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, w = w), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, w = w, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, w = w, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, w = w), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, w = wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, w = wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, w = wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, w = wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, w = wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, w = wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, w = wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, w = wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, f, w), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, f, w, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, f, w, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, f, w), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, g, wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, g, wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, g, wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, g, wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, g, wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, g, wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, g, wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, g, wdat), simplify = FALSE)))
})
test_that("fbetween with missing weights performs numerically stable", {
expect_true(all_obj_equal(replicate(50, fbetween(1, w = NA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(NA, w = NA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(NA, w = NA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, w = wNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, w = wNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, w = wNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, w = wNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, w = wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, w = wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, w = wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, w = wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, f, wNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(x, f, wNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, f, wNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(xNA, f, wNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, g, wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(m, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mNA, g, wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, g, wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcars, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fbetween(mtcNA, g, wdatNA), simplify = FALSE)))
})
test_that("fbetween handles special values in the right way", {
expect_equal(fbetween(NA), NA_real_)
expect_equal(fbetween(NaN), NaN)
expect_equal(fbetween(Inf), Inf)
expect_equal(fbetween(c(Inf,Inf)), c(Inf,Inf))
expect_equal(fbetween(-Inf), -Inf)
expect_equal(fbetween(c(-Inf,-Inf)), c(-Inf,-Inf))
expect_equal(fbetween(TRUE), 1)
expect_equal(fbetween(FALSE), 0)
expect_equal(fbetween(NA, na.rm = FALSE), NA_real_)
expect_equal(fbetween(NaN, na.rm = FALSE), NaN)
expect_equal(fbetween(Inf, na.rm = FALSE), Inf)
expect_equal(fbetween(c(Inf,Inf), na.rm = FALSE), c(Inf,Inf))
expect_equal(fbetween(-Inf, na.rm = FALSE), -Inf)
expect_equal(fbetween(c(-Inf,-Inf), na.rm = FALSE), c(-Inf,-Inf))
expect_equal(fbetween(TRUE, na.rm = FALSE), 1)
expect_equal(fbetween(FALSE, na.rm = FALSE), 0)
expect_equal(fbetween(c(1,NA)), c(1,NA_real_))
expect_equal(fbetween(c(1,NaN)), c(1,NaN))
expect_equal(fbetween(c(1,Inf)), c(Inf,Inf))
expect_equal(fbetween(c(1,-Inf)), c(-Inf,-Inf))
expect_equal(fbetween(c(1,Inf), na.rm = FALSE), c(Inf,Inf))
expect_equal(fbetween(c(1,-Inf), na.rm = FALSE), c(-Inf,-Inf))
expect_equal(fbetween(c(NA,-Inf), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fbetween(c(FALSE,FALSE), na.rm = FALSE), c(0,0))
expect_equal(fbetween(c(1,NA), na.rm = FALSE), c(NA_real_,NA_real_))
})
test_that("fbetween with weights handles special values in the right way", {
expect_equal(fbetween(NA, w = 1), NA_real_)
expect_equal(fbetween(NaN, w = 1), NaN)
expect_equal(fbetween(Inf, w = 1), Inf)
expect_equal(fbetween(c(Inf,Inf), w = 1:2), c(Inf,Inf))
expect_equal(fbetween(-Inf, w = 1), -Inf)
expect_equal(fbetween(c(-Inf,-Inf), w = 1:2), c(-Inf,-Inf))
expect_equal(fbetween(TRUE, w = 1), 1)
expect_equal(fbetween(FALSE, w = 1), 0)
expect_equal(fbetween(NA, w = 1, na.rm = FALSE), NA_real_)
expect_equal(fbetween(NaN, w = 1, na.rm = FALSE), NaN)
expect_equal(fbetween(Inf, w = 1, na.rm = FALSE), Inf)
expect_equal(fbetween(c(Inf,Inf), w = 1:2, na.rm = FALSE), c(Inf,Inf))
expect_equal(fbetween(-Inf, w = 1, na.rm = FALSE), -Inf)
expect_equal(fbetween(c(-Inf,-Inf), w = 1:2, na.rm = FALSE), c(-Inf,-Inf))
expect_equal(fbetween(TRUE, w = 1, na.rm = FALSE), 1)
expect_equal(fbetween(FALSE, w = 1, na.rm = FALSE), 0)
expect_equal(fbetween(c(1,NA), w = 1:2), c(1,NA_real_))
expect_equal(fbetween(c(1,NaN), w = 1:2), c(1,NaN))
expect_equal(fbetween(c(1,Inf), w = 1:2), c(Inf,Inf))
expect_equal(fbetween(c(1,-Inf), w = 1:2), c(-Inf,-Inf))
expect_equal(fbetween(c(1,Inf), w = 1:2, na.rm = FALSE), c(Inf,Inf))
expect_equal(fbetween(c(1,-Inf), w = 1:2, na.rm = FALSE), c(-Inf,-Inf))
expect_equal(fbetween(c(NA,-Inf), w = 1:2, na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fbetween(c(FALSE,FALSE), w = 1:2, na.rm = FALSE), c(0,0))
expect_equal(fbetween(c(1,NA), w = 1:2, na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fbetween(1:3, w = c(1,Inf,3)), c(NA_real_,NA_real_,NA_real_))
expect_equal(fbetween(1:3, w = c(1,-Inf,3)), c(NA_real_,NA_real_,NA_real_))
expect_equal(fbetween(1:3, w = c(1,Inf,3), na.rm = FALSE), c(NA_real_,NA_real_,NA_real_))
expect_equal(fbetween(1:3, w = c(1,-Inf,3), na.rm = FALSE), c(NA_real_,NA_real_,NA_real_))
expect_equal(fbetween(NA, w = NA), NA_real_)
expect_equal(fbetween(NaN, w = NA), NaN)
expect_equal(fbetween(Inf, w = NA), NA_real_)
expect_equal(fbetween(c(Inf,Inf), w = c(NA,2)), c(Inf,Inf))
expect_equal(fbetween(-Inf, w = NA), NA_real_)
expect_equal(fbetween(c(-Inf,-Inf), w = c(NA,2)), c(-Inf,-Inf))
expect_equal(fbetween(TRUE, w = NA), NA_real_)
expect_equal(fbetween(FALSE, w = NA), NA_real_)
expect_equal(fbetween(NA, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fbetween(NaN, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fbetween(Inf, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fbetween(c(Inf,Inf), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fbetween(-Inf, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fbetween(c(-Inf,-Inf), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fbetween(TRUE, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fbetween(FALSE, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fbetween(c(1,NA), w = c(NA,2)), c(NA_real_,NA_real_))
expect_equal(fbetween(c(1,NaN), w = c(NA,2)), c(NA_real_,NA_real_))
expect_equal(fbetween(c(1,Inf), w = c(NA,2)), c(Inf,Inf))
expect_equal(fbetween(c(1,-Inf), w = c(NA,2)), c(-Inf,-Inf))
expect_equal(fbetween(c(1,Inf), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fbetween(c(1,-Inf), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fbetween(c(NA,-Inf), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fbetween(c(FALSE,FALSE), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fbetween(c(1,NA), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fbetween(1:3, w = c(NA,Inf,3)), c(NA_real_,NA_real_,NA_real_))
expect_equal(fbetween(1:3, w = c(NA,-Inf,3)), c(NA_real_,NA_real_,NA_real_))
expect_equal(fbetween(1:3, w = c(NA,Inf,3), na.rm = FALSE), c(NA_real_,NA_real_,NA_real_))
expect_equal(fbetween(1:3, w = c(NA,-Inf,3), na.rm = FALSE), c(NA_real_,NA_real_,NA_real_))
})
test_that("fbetween produces errors for wrong input", {
expect_error(fbetween("a"))
expect_error(fbetween(NA_character_))
expect_error(fbetween(mNAc))
expect_error(fbetween(mNAc, f))
expect_error(fbetween(1:2,1:3))
expect_error(fbetween(m,1:31))
expect_error(fbetween(mtcars,1:31))
expect_error(fbetween(mtcars, w = 1:31))
expect_error(fbetween("a", w = 1))
expect_error(fbetween(1:2, w = 1:3))
expect_error(fbetween(NA_character_, w = 1))
expect_error(fbetween(mNAc, w = wdat))
expect_error(fbetween(mNAc, f, wdat))
expect_error(fbetween(mNA, w = 1:33))
expect_error(fbetween(1:2,1:2, 1:3))
expect_error(fbetween(m,1:32,1:20))
expect_error(fbetween(mtcars,1:32,1:10))
expect_error(fbetween(1:2, w = c("a","b")))
expect_error(fbetween(wlddev))
expect_error(fbetween(wlddev, w = wlddev$year))
expect_error(fbetween(wlddev, wlddev$iso3c))
expect_error(fbetween(wlddev, wlddev$iso3c, wlddev$year))
})
# B
test_that("B produces errors for wrong input", {
expect_error(B("a"))
expect_error(B(NA_character_))
expect_error(B(mNAc))
expect_error(B(mNAc, f))
expect_error(B(1:2,1:3))
expect_error(B(m,1:31))
expect_error(B(mtcars,1:31))
expect_error(B(mtcars, w = 1:31))
expect_error(B("a", w = 1))
expect_error(B(1:2, w = c("a","b")))
expect_error(B(1:2, w = 1:3))
expect_error(B(NA_character_, w = 1))
expect_error(B(mNAc, w = wdat))
expect_error(B(mNAc, f, wdat))
expect_error(B(mNA, w = 1:33))
expect_error(B(mtcNA, w = 1:33))
expect_error(B(1:2,1:2, 1:3))
expect_error(B(m,1:32,1:20))
expect_error(B(mtcars,1:32,1:10))
expect_error(B(1:2, 1:3, 1:2))
expect_error(B(m,1:31,1:32))
expect_error(B(mtcars,1:33,1:32))
})
test_that("B.data.frame method is foolproof", {
expect_visible(B(wlddev))
expect_visible(B(wlddev, w = wlddev$year))
expect_visible(B(wlddev, w = ~year))
expect_visible(B(wlddev, wlddev$iso3c))
expect_visible(B(wlddev, ~iso3c))
expect_visible(B(wlddev, ~iso3c + region))
expect_visible(B(wlddev, wlddev$iso3c, wlddev$year))
expect_visible(B(wlddev, ~iso3c, ~year))
expect_visible(B(wlddev, cols = 9:12))
expect_visible(B(wlddev, w = wlddev$year, cols = 9:12))
expect_visible(B(wlddev, w = ~year, cols = 9:12))
expect_visible(B(wlddev, wlddev$iso3c, cols = 9:12))
expect_visible(B(wlddev, ~iso3c, cols = 9:12))
expect_visible(B(wlddev, wlddev$iso3c, wlddev$year, cols = 9:12))
expect_visible(B(wlddev, ~iso3c, ~year, cols = 9:12))
expect_visible(B(wlddev, cols = c("PCGDP","LIFEEX")))
expect_visible(B(wlddev, w = wlddev$year, cols = c("PCGDP","LIFEEX")))
expect_visible(B(wlddev, w = ~year, cols = c("PCGDP","LIFEEX")))
expect_visible(B(wlddev, wlddev$iso3c, cols = c("PCGDP","LIFEEX")))
expect_visible(B(wlddev, ~iso3c, cols = c("PCGDP","LIFEEX")))
expect_visible(B(wlddev, wlddev$iso3c, wlddev$year, cols = c("PCGDP","LIFEEX")))
expect_visible(B(wlddev, ~iso3c, ~year, cols = c("PCGDP","LIFEEX")))
expect_error(B(wlddev, cols = NULL))
expect_error(B(wlddev, w = wlddev$year, cols = NULL))
expect_error(B(wlddev, w = ~year, cols = NULL))
expect_error(B(wlddev, wlddev$iso3c, cols = NULL))
expect_error(B(wlddev, ~iso3c, cols = NULL))
expect_error(B(wlddev, wlddev$iso3c, wlddev$year, cols = NULL))
expect_error(B(wlddev, ~iso3c, ~year, cols = NULL))
expect_error(B(wlddev, cols = 9:14))
expect_error(B(wlddev, w = wlddev$year, cols = 9:14))
expect_error(B(wlddev, w = ~year, cols = 9:14))
expect_error(B(wlddev, wlddev$iso3c, cols = 9:14))
expect_error(B(wlddev, ~iso3c, cols = 9:14))
expect_error(B(wlddev, wlddev$iso3c, wlddev$year, cols = 9:14))
expect_error(B(wlddev, ~iso3c, ~year, cols = 9:14))
expect_error(B(wlddev, cols = c("PCGDP","LIFEEX","bla")))
expect_error(B(wlddev, w = wlddev$year, cols = c("PCGDP","LIFEEX","bla")))
expect_error(B(wlddev, w = ~year, cols = c("PCGDP","LIFEEX","bla")))
expect_error(B(wlddev, wlddev$iso3c, cols = c("PCGDP","LIFEEX","bla")))
expect_error(B(wlddev, ~iso3c, cols = c("PCGDP","LIFEEX","bla")))
expect_error(B(wlddev, wlddev$iso3c, wlddev$year, cols = c("PCGDP","LIFEEX","bla")))
expect_error(B(wlddev, ~iso3c, ~year, cols = c("PCGDP","LIFEEX","bla")))
expect_error(B(wlddev, w = mtcars))
expect_error(B(wlddev, w = 4))
expect_error(B(wlddev, w = "year"))
expect_error(B(wlddev, w = ~year2))
# suppressWarnings(expect_error(B(wlddev, w = ~year + region)))
expect_error(B(wlddev, mtcars))
expect_error(B(wlddev, 2))
expect_error(B(wlddev, "iso3c"))
expect_error(B(wlddev, ~iso3c2))
expect_error(B(wlddev, ~iso3c + bla))
expect_error(B(wlddev, mtcars$mpg, mtcars$cyl))
expect_error(B(wlddev, 2, 4))
expect_error(B(wlddev, ~iso3c2, ~year2))
expect_error(B(wlddev, cols = ~bla))
expect_error(B(wlddev, w = ~bla, cols = 9:12))
expect_error(B(wlddev, w = 4, cols = 9:12))
expect_error(B(wlddev, w = "year", cols = 9:12))
expect_error(B(wlddev, w = ~yewar, cols = 9:12))
expect_error(B(wlddev, mtcars$mpg, cols = 9:12))
expect_error(B(wlddev, ~iso3c + ss, cols = 9:12))
expect_error(B(wlddev, 2, cols = 9:12))
expect_error(B(wlddev, "iso3c", cols = 9:12))
expect_error(B(wlddev, wlddev$iso3c, ~year + bla, cols = 9:12))
expect_error(B(wlddev, ~iso3c3, ~year, cols = 9:12))
expect_error(B(wlddev, cols = c("PC3GDP","LIFEEX")))
})
# fwithin
test_that("fwithin performs like within", {
expect_equal(fwithin(NA), as.double(within(NA)))
expect_equal(fwithin(NA, na.rm = FALSE), as.double(within(NA)))
expect_equal(fwithin(1), within(1, na.rm = TRUE))
expect_equal(fwithin(1:3), within(1:3, na.rm = TRUE))
expect_equal(fwithin(-1:1), within(-1:1, na.rm = TRUE))
expect_equal(fwithin(1, na.rm = FALSE), within(1))
expect_equal(fwithin(1:3, na.rm = FALSE), within(1:3))
expect_equal(fwithin(-1:1, na.rm = FALSE), within(-1:1))
expect_equal(fwithin(x), within(x, na.rm = TRUE))
expect_equal(fwithin(x, na.rm = FALSE), within(x))
expect_equal(fwithin(xNA, na.rm = FALSE), within(xNA))
expect_equal(fwithin(xNA), within(xNA, na.rm = TRUE))
expect_equal(qM(fwithin(mtcars)), fwithin(m))
expect_equal(fwithin(m), dapply(m, within, na.rm = TRUE))
expect_equal(fwithin(m, na.rm = FALSE), dapply(m, within))
expect_equal(fwithin(mNA, na.rm = FALSE), dapply(mNA, within))
expect_equal(fwithin(mNA), dapply(mNA, within, na.rm = TRUE))
expect_equal(fwithin(mtcars), dapply(mtcars, within, na.rm = TRUE))
expect_equal(fwithin(mtcars, na.rm = FALSE), dapply(mtcars, within))
expect_equal(fwithin(mtcNA, na.rm = FALSE), dapply(mtcNA, within))
expect_equal(fwithin(mtcNA), dapply(mtcNA, within, na.rm = TRUE))
expect_equal(fwithin(x, f), BY(x, f, within, na.rm = TRUE))
expect_equal(fwithin(x, f, na.rm = FALSE), BY(x, f, within))
expect_equal(fwithin(xNA, f, na.rm = FALSE), BY(xNA, f, within))
expect_equal(fwithin(xNA, f), BY(xNA, f, within, na.rm = TRUE))
expect_equal(fwithin(m, g), BY(m, g, within, na.rm = TRUE))
expect_equal(fwithin(m, g, na.rm = FALSE), BY(m, g, within))
expect_equal(fwithin(mNA, g, na.rm = FALSE), BY(mNA, g, within))
expect_equal(fwithin(mNA, g), BY(mNA, g, within, na.rm = TRUE))
expect_equal(fwithin(mtcars, g), BY(mtcars, g, within, na.rm = TRUE))
expect_equal(fwithin(mtcars, g, na.rm = FALSE), BY(mtcars, g, within))
expect_equal(fwithin(mtcNA, g, na.rm = FALSE), BY(mtcNA, g, within))
expect_equal(fwithin(mtcNA, g), BY(mtcNA, g, within, na.rm = TRUE))
})
test_that("fwithin with custom mean performs like within (defined above)", {
expect_equal(fwithin(x, mean = 4.8456), within(x, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(x, na.rm = FALSE, mean = 4.8456), within(x, mean = 4.8456))
expect_equal(fwithin(xNA, na.rm = FALSE, mean = 4.8456), within(xNA, mean = 4.8456))
expect_equal(fwithin(xNA, mean = 4.8456), within(xNA, na.rm = TRUE, mean = 4.8456))
expect_equal(qM(fwithin(mtcars, mean = 4.8456)), fwithin(m, mean = 4.8456))
expect_equal(fwithin(m, mean = 4.8456), dapply(m, within, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(m, na.rm = FALSE, mean = 4.8456), dapply(m, within, mean = 4.8456))
expect_equal(fwithin(mNA, na.rm = FALSE, mean = 4.8456), dapply(mNA, within, mean = 4.8456))
expect_equal(fwithin(mNA, mean = 4.8456), dapply(mNA, within, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(x, f, mean = 4.8456), BY(x, f, within, na.rm = TRUE, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(x, f, na.rm = FALSE, mean = 4.8456), BY(x, f, within, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(xNA, f, na.rm = FALSE, mean = 4.8456), BY(xNA, f, within, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(xNA, f, mean = 4.8456), BY(xNA, f, within, na.rm = TRUE, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(m, g, mean = 4.8456), BY(m, g, within, na.rm = TRUE, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(m, g, na.rm = FALSE, mean = 4.8456), BY(m, g, within, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(mNA, g, na.rm = FALSE, mean = 4.8456), BY(mNA, g, within, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(mNA, g, mean = 4.8456), BY(mNA, g, within, na.rm = TRUE, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(mtcars, g, mean = 4.8456), BY(mtcars, g, within, na.rm = TRUE, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(mtcars, g, na.rm = FALSE, mean = 4.8456), BY(mtcars, g, within, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(mtcNA, g, na.rm = FALSE, mean = 4.8456), BY(mtcNA, g, within, use.g.names = FALSE, mean = 4.8456))
expect_equal(fwithin(mtcNA, g, mean = 4.8456), BY(mtcNA, g, within, na.rm = TRUE, use.g.names = FALSE, mean = 4.8456))
})
test_that("Centering on overall mean performs as indended", {
expect_equal(fwithin(x, f, mean = "overall.mean"), BY(x, f, within, na.rm = TRUE, use.g.names = FALSE) + ave(x))
expect_equal(fwithin(x, f, na.rm = FALSE, mean = "overall.mean"), BY(x, f, within, use.g.names = FALSE) + ave(x))
# expect_equal(fwithin(xNA, f, na.rm = FALSE, mean = "overall.mean"), BY(xNA, f, within, use.g.names = FALSE) + B(xNA)) # Not the same !!
expect_equal(fwithin(xNA, f, mean = "overall.mean"), BY(xNA, f, within, na.rm = TRUE, use.g.names = FALSE) + B(xNA))
expect_equal(fwithin(m, g, mean = "overall.mean"), BY(m, g, within, na.rm = TRUE, use.g.names = FALSE) + B(m))
expect_equal(fwithin(m, g, na.rm = FALSE, mean = "overall.mean"), BY(m, g, within, use.g.names = FALSE) + B(m))
# expect_equal(fwithin(mNA, g, na.rm = FALSE, mean = "overall.mean"), BY(mNA, g, within, use.g.names = FALSE) + B(mNA))
expect_equal(fwithin(mNA, g, mean = "overall.mean"), BY(mNA, g, within, na.rm = TRUE, use.g.names = FALSE) + B(mNA))
expect_equal(fwithin(mtcars, g, mean = "overall.mean"), BY(mtcars, g, within, na.rm = TRUE, use.g.names = FALSE) + B(mtcars))
expect_equal(fwithin(mtcars, g, na.rm = FALSE, mean = "overall.mean"), BY(mtcars, g, within, use.g.names = FALSE) + B(mtcars))
# expect_equal(fwithin(mtcNA, g, na.rm = FALSE, mean = "overall.mean"), BY(mtcNA, g, within, use.g.names = FALSE) + B(mtcNA))
expect_equal(fwithin(mtcNA, g, mean = "overall.mean"), BY(mtcNA, g, within, na.rm = TRUE, use.g.names = FALSE)+ B(mtcNA))
})
test_that("fwithin performs like fwithin with weights all equal", {
expect_equal(fwithin(NA), fwithin(NA, w = 0.99999999))
expect_equal(fwithin(NA, na.rm = FALSE), fwithin(NA, w = 2.946, na.rm = FALSE))
expect_equal(fwithin(1), fwithin(1, w = 3))
expect_equal(fwithin(1:3), fwithin(1:3, w = rep(0.999,3)))
expect_equal(fwithin(-1:1), fwithin(-1:1, w = rep(4.2,3)))
expect_equal(fwithin(1, na.rm = FALSE), fwithin(1, w = 5, na.rm = FALSE))
expect_equal(fwithin(1:3, na.rm = FALSE), fwithin(1:3, w = rep(1.44565, 3), na.rm = FALSE))
expect_equal(fwithin(-1:1, na.rm = FALSE), fwithin(-1:1, w = rep(1.44565, 3), na.rm = FALSE))
expect_equal(fwithin(x), fwithin(x, w = rep(1,100)))
expect_equal(fwithin(x, na.rm = FALSE), fwithin(x, w = rep(1.44565, 100), na.rm = FALSE))
expect_equal(fwithin(xNA, na.rm = FALSE), fwithin(xNA, w = rep(4.676587, 100), na.rm = FALSE))
expect_equal(fwithin(xNA), fwithin(xNA, w = rep(4.676587, 100)))
expect_equal(fwithin(m), fwithin(m, w = rep(6587.3454, 32)))
expect_equal(fwithin(m, na.rm = FALSE), fwithin(m, w = rep(6587.3454, 32), na.rm = FALSE))
expect_equal(fwithin(mNA, na.rm = FALSE), fwithin(mNA, w = rep(6587.3454, 32), na.rm = FALSE))
expect_equal(fwithin(mNA), fwithin(mNA, w = rep(6587.3454, 32)))
expect_equal(fwithin(mtcars), fwithin(mtcars, w = rep(6787.3454, 32)))
expect_equal(fwithin(mtcars, na.rm = FALSE), fwithin(mtcars, w = rep(6787.3454, 32), na.rm = FALSE))
expect_equal(fwithin(mtcNA, na.rm = FALSE), fwithin(mtcNA, w = rep(6787.3454, 32), na.rm = FALSE))
expect_equal(fwithin(mtcNA), fwithin(mtcNA, w = rep(6787.3454, 32)))
expect_equal(fwithin(x, f), fwithin(x, f, rep(546.78,100)))
expect_equal(fwithin(x, f, na.rm = FALSE), fwithin(x, f, rep(5.88,100), na.rm = FALSE))
expect_equal(fwithin(xNA, f, na.rm = FALSE), fwithin(xNA, f, rep(52.7,100), na.rm = FALSE))
expect_equal(fwithin(xNA, f), fwithin(xNA, f, rep(5997456,100)))
expect_equal(fwithin(m, g), fwithin(m, g, rep(546.78,32)))
expect_equal(fwithin(m, g, na.rm = FALSE), fwithin(m, g, rep(0.0001,32), na.rm = FALSE))
expect_equal(fwithin(mNA, g, na.rm = FALSE), fwithin(mNA, g, rep(5.7,32), na.rm = FALSE))
expect_equal(fwithin(mNA, g), fwithin(mNA, g, rep(1.1,32)))
expect_equal(fwithin(mtcars, g), fwithin(mtcars, g, rep(53,32)))
expect_equal(fwithin(mtcars, g, na.rm = FALSE), fwithin(mtcars, g, rep(546.78,32), na.rm = FALSE))
expect_equal(fwithin(mtcNA, g, na.rm = FALSE), fwithin(mtcNA, g, rep(0.999999,32), na.rm = FALSE))
expect_equal(fwithin(mtcNA, g), fwithin(mtcNA, g, rep(999.9999,32)))
})
test_that("fwithin with weights performs like wwithin (defined above)", {
# complete weights
expect_equal(fwithin(NA, w = 1), wwithin(NA, 1))
expect_equal(fwithin(NA, w = 1, na.rm = FALSE), wwithin(NA, 1))
expect_equal(fwithin(1, w = 1), wwithin(1, w = 1))
expect_equal(fwithin(1:3, w = 1:3), wwithin(1:3, 1:3))
expect_equal(fwithin(-1:1, w = 1:3), wwithin(-1:1, 1:3))
expect_equal(fwithin(1, w = 1, na.rm = FALSE), wwithin(1, 1))
expect_equal(fwithin(1:3, w = c(0.99,3454,1.111), na.rm = FALSE), wwithin(1:3, c(0.99,3454,1.111)))
expect_equal(fwithin(-1:1, w = 1:3, na.rm = FALSE), wwithin(-1:1, 1:3))
expect_equal(fwithin(x, w = w), wwithin(x, w))
expect_equal(fwithin(x, w = w, na.rm = FALSE), wwithin(x, w))
expect_equal(fwithin(xNA, w = w, na.rm = FALSE), wwithin(xNA, w))
expect_equal(fwithin(xNA, w = w), wwithin(xNA, w, na.rm = TRUE))
expect_equal(qM(fwithin(mtcars, w = wdat)), fwithin(m, w = wdat))
expect_equal(fwithin(m, w = wdat), dapply(m, wwithin, wdat, na.rm = TRUE))
expect_equal(fwithin(m, w = wdat, na.rm = FALSE), dapply(m, wwithin, wdat))
expect_equal(fwithin(mNA, w = wdat, na.rm = FALSE), dapply(mNA, wwithin, wdat))
expect_equal(fwithin(mNA, w = wdat), dapply(mNA, wwithin, wdat, na.rm = TRUE))
expect_equal(fwithin(mtcars, w = wdat), dapply(mtcars, wwithin, wdat, na.rm = TRUE))
expect_equal(fwithin(mtcars, w = wdat, na.rm = FALSE), dapply(mtcars, wwithin, wdat))
expect_equal(fwithin(mtcNA, w = wdat, na.rm = FALSE), dapply(mtcNA, wwithin, wdat))
expect_equal(fwithin(mtcNA, w = wdat), dapply(mtcNA, wwithin, wdat, na.rm = TRUE))
expect_equal(fwithin(x, f, w), BY(x, f, wwithin, w))
expect_equal(fwithin(x, f, w, na.rm = FALSE), BY(x, f, wwithin, w))
expect_equal(fwithin(xNA, f, w, na.rm = FALSE), BY(xNA, f, wwithin, w))
expect_equal(fwithin(xNA, f, w), BY(xNA, f, wwithin, w, na.rm = TRUE))
expect_equal(fwithin(m, g, wdat), BY(m, g, wwithin, wdat))
expect_equal(fwithin(m, g, wdat, na.rm = FALSE), BY(m, g, wwithin, wdat))
expect_equal(fwithin(mNA, g, wdat, na.rm = FALSE), BY(mNA, g, wwithin, wdat))
expect_equal(fwithin(mNA, g, wdat), BY(mNA, g, wwithin, wdat, na.rm = TRUE))
expect_equal(fwithin(mtcars, g, wdat), BY(mtcars, g, wwithin, wdat))
expect_equal(fwithin(mtcars, g, wdat, na.rm = FALSE), BY(mtcars, g, wwithin, wdat))
expect_equal(fwithin(mtcNA, g, wdat, na.rm = FALSE), BY(mtcNA, g, wwithin, wdat))
expect_equal(fwithin(mtcNA, g, wdat), BY(mtcNA, g, wwithin, wdat, na.rm = TRUE))
# missing weights
expect_equal(fwithin(NA, w = NA), wwithin(NA, NA))
expect_equal(fwithin(NA, w = NA, na.rm = FALSE), wwithin(NA, NA))
expect_equal(fwithin(1, w = NA), wwithin(1, w = NA))
expect_equal(fwithin(1:3, w = c(NA,1:2)), wwithin(1:3, c(NA,1:2), na.rm = TRUE))
expect_equal(fwithin(-1:1, w = c(NA,1:2)), wwithin(-1:1, c(NA,1:2), na.rm = TRUE))
expect_equal(fwithin(1, w = NA, na.rm = FALSE), wwithin(1, NA))
expect_equal(fwithin(1:3, w = c(NA,1:2), na.rm = FALSE), wwithin(1:3, c(NA,1:2)))
expect_equal(fwithin(-1:1, w = c(NA,1:2), na.rm = FALSE), wwithin(-1:1, c(NA,1:2)))
expect_equal(fwithin(x, w = wNA), wwithin(x, wNA, na.rm = TRUE))
expect_equal(fwithin(x, w = wNA, na.rm = FALSE), wwithin(x, wNA))
expect_equal(fwithin(xNA, w = wNA, na.rm = FALSE), wwithin(xNA, wNA))
expect_equal(fwithin(xNA, w = wNA), wwithin(xNA, wNA, na.rm = TRUE))
expect_equal(qM(fwithin(mtcars, w = wdatNA)), fwithin(m, w = wdatNA))
expect_equal(fwithin(m, w = wdatNA), dapply(m, wwithin, wdatNA, na.rm = TRUE))
expect_equal(fwithin(m, w = wdatNA, na.rm = FALSE), dapply(m, wwithin, wdatNA))
expect_equal(fwithin(mNA, w = wdatNA, na.rm = FALSE), dapply(mNA, wwithin, wdatNA))
expect_equal(fwithin(mNA, w = wdatNA), dapply(mNA, wwithin, wdatNA, na.rm = TRUE))
expect_equal(fwithin(mtcars, w = wdatNA), dapply(mtcars, wwithin, wdatNA, na.rm = TRUE))
expect_equal(fwithin(mtcars, w = wdatNA, na.rm = FALSE), dapply(mtcars, wwithin, wdatNA))
expect_equal(fwithin(mtcNA, w = wdatNA, na.rm = FALSE), dapply(mtcNA, wwithin, wdatNA))
expect_equal(fwithin(mtcNA, w = wdatNA), dapply(mtcNA, wwithin, wdatNA, na.rm = TRUE))
expect_equal(fwithin(x, f, wNA), BY(x, f, wwithin, wNA, na.rm = TRUE))
expect_equal(fwithin(x, f, wNA, na.rm = FALSE), BY(x, f, wwithin, wNA))
expect_equal(fwithin(xNA, f, wNA, na.rm = FALSE), BY(xNA, f, wwithin, wNA))
expect_equal(fwithin(xNA, f, wNA), BY(xNA, f, wwithin, wNA, na.rm = TRUE))
expect_equal(fwithin(m, g, wdatNA), BY(m, g, wwithin, wdatNA, na.rm = TRUE))
expect_equal(fwithin(m, g, wdatNA, na.rm = FALSE), BY(m, g, wwithin, wdatNA))
expect_equal(fwithin(mNA, g, wdatNA, na.rm = FALSE), BY(mNA, g, wwithin, wdatNA))
expect_equal(fwithin(mNA, g, wdatNA), BY(mNA, g, wwithin, wdatNA, na.rm = TRUE))
expect_equal(fwithin(mtcars, g, wdatNA), BY(mtcars, g, wwithin, wdatNA, na.rm = TRUE))
expect_equal(fwithin(mtcars, g, wdatNA, na.rm = FALSE), BY(mtcars, g, wwithin, wdatNA))
expect_equal(fwithin(mtcNA, g, wdatNA, na.rm = FALSE), BY(mtcNA, g, wwithin, wdatNA))
expect_equal(fwithin(mtcNA, g, wdatNA), BY(mtcNA, g, wwithin, wdatNA, na.rm = TRUE))
})
test_that("fwithin with custom mean and weights performs like wwithin (defined above)", {
# complete weights
expect_equal(fwithin(x, w = w, mean = 4.8456), wwithin(x, w, mean = 4.8456))
expect_equal(fwithin(x, w = w, na.rm = FALSE, mean = 4.8456), wwithin(x, w, mean = 4.8456))
expect_equal(fwithin(xNA, w = w, na.rm = FALSE, mean = 4.8456), wwithin(xNA, w, mean = 4.8456))
expect_equal(fwithin(xNA, w = w, mean = 4.8456), wwithin(xNA, w, na.rm = TRUE, mean = 4.8456))
expect_equal(qM(fwithin(mtcars, w = wdat, mean = 4.8456)), fwithin(m, w = wdat, mean = 4.8456))
expect_equal(fwithin(m, w = wdat, mean = 4.8456), dapply(m, wwithin, wdat, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(m, w = wdat, na.rm = FALSE, mean = 4.8456), dapply(m, wwithin, wdat, mean = 4.8456))
expect_equal(fwithin(mNA, w = wdat, na.rm = FALSE, mean = 4.8456), dapply(mNA, wwithin, wdat, mean = 4.8456))
expect_equal(fwithin(mNA, w = wdat, mean = 4.8456), dapply(mNA, wwithin, wdat, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(mtcars, w = wdat, mean = 4.8456), dapply(mtcars, wwithin, wdat, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(mtcars, w = wdat, na.rm = FALSE, mean = 4.8456), dapply(mtcars, wwithin, wdat, mean = 4.8456))
expect_equal(fwithin(mtcNA, w = wdat, na.rm = FALSE, mean = 4.8456), dapply(mtcNA, wwithin, wdat, mean = 4.8456))
expect_equal(fwithin(mtcNA, w = wdat, mean = 4.8456), dapply(mtcNA, wwithin, wdat, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(x, f, w, mean = 4.8456), BY(x, f, wwithin, w, mean = 4.8456))
expect_equal(fwithin(x, f, w, na.rm = FALSE, mean = 4.8456), BY(x, f, wwithin, w, mean = 4.8456))
expect_equal(fwithin(xNA, f, w, na.rm = FALSE, mean = 4.8456), BY(xNA, f, wwithin, w, mean = 4.8456))
expect_equal(fwithin(xNA, f, w, mean = 4.8456), BY(xNA, f, wwithin, w, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(m, g, wdat, mean = 4.8456), BY(m, g, wwithin, wdat, mean = 4.8456))
expect_equal(fwithin(m, g, wdat, na.rm = FALSE, mean = 4.8456), BY(m, g, wwithin, wdat, mean = 4.8456))
expect_equal(fwithin(mNA, g, wdat, na.rm = FALSE, mean = 4.8456), BY(mNA, g, wwithin, wdat, mean = 4.8456))
expect_equal(fwithin(mNA, g, wdat, mean = 4.8456), BY(mNA, g, wwithin, wdat, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(mtcars, g, wdat, mean = 4.8456), BY(mtcars, g, wwithin, wdat, mean = 4.8456))
expect_equal(fwithin(mtcars, g, wdat, na.rm = FALSE, mean = 4.8456), BY(mtcars, g, wwithin, wdat, mean = 4.8456))
expect_equal(fwithin(mtcNA, g, wdat, na.rm = FALSE, mean = 4.8456), BY(mtcNA, g, wwithin, wdat, mean = 4.8456))
expect_equal(fwithin(mtcNA, g, wdat, mean = 4.8456), BY(mtcNA, g, wwithin, wdat, na.rm = TRUE, mean = 4.8456))
# missing weights
expect_equal(fwithin(x, w = wNA, mean = 4.8456), wwithin(x, wNA, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(x, w = wNA, na.rm = FALSE, mean = 4.8456), wwithin(x, wNA, mean = 4.8456))
expect_equal(fwithin(xNA, w = wNA, na.rm = FALSE, mean = 4.8456), wwithin(xNA, wNA, mean = 4.8456))
expect_equal(fwithin(xNA, w = wNA, mean = 4.8456), wwithin(xNA, wNA, na.rm = TRUE, mean = 4.8456))
expect_equal(qM(fwithin(mtcars, w = wdatNA, mean = 4.8456)), fwithin(m, w = wdatNA, mean = 4.8456))
expect_equal(fwithin(m, w = wdatNA, mean = 4.8456), dapply(m, wwithin, wdatNA, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(m, w = wdatNA, na.rm = FALSE, mean = 4.8456), dapply(m, wwithin, wdatNA, mean = 4.8456))
expect_equal(fwithin(mNA, w = wdatNA, na.rm = FALSE, mean = 4.8456), dapply(mNA, wwithin, wdatNA, mean = 4.8456))
expect_equal(fwithin(mNA, w = wdatNA, mean = 4.8456), dapply(mNA, wwithin, wdatNA, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(mtcars, w = wdatNA, mean = 4.8456), dapply(mtcars, wwithin, wdatNA, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(mtcars, w = wdatNA, na.rm = FALSE, mean = 4.8456), dapply(mtcars, wwithin, wdatNA, mean = 4.8456))
expect_equal(fwithin(mtcNA, w = wdatNA, na.rm = FALSE, mean = 4.8456), dapply(mtcNA, wwithin, wdatNA, mean = 4.8456))
expect_equal(fwithin(mtcNA, w = wdatNA, mean = 4.8456), dapply(mtcNA, wwithin, wdatNA, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(x, f, wNA, mean = 4.8456), BY(x, f, wwithin, wNA, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(x, f, wNA, na.rm = FALSE, mean = 4.8456), BY(x, f, wwithin, wNA, mean = 4.8456))
expect_equal(fwithin(xNA, f, wNA, na.rm = FALSE, mean = 4.8456), BY(xNA, f, wwithin, wNA, mean = 4.8456))
expect_equal(fwithin(xNA, f, wNA, mean = 4.8456), BY(xNA, f, wwithin, wNA, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(m, g, wdatNA, mean = 4.8456), BY(m, g, wwithin, wdatNA, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(m, g, wdatNA, na.rm = FALSE, mean = 4.8456), BY(m, g, wwithin, wdatNA, mean = 4.8456))
expect_equal(fwithin(mNA, g, wdatNA, na.rm = FALSE, mean = 4.8456), BY(mNA, g, wwithin, wdatNA, mean = 4.8456))
expect_equal(fwithin(mNA, g, wdatNA, mean = 4.8456), BY(mNA, g, wwithin, wdatNA, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(mtcars, g, wdatNA, mean = 4.8456), BY(mtcars, g, wwithin, wdatNA, na.rm = TRUE, mean = 4.8456))
expect_equal(fwithin(mtcars, g, wdatNA, na.rm = FALSE, mean = 4.8456), BY(mtcars, g, wwithin, wdatNA, mean = 4.8456))
expect_equal(fwithin(mtcNA, g, wdatNA, na.rm = FALSE, mean = 4.8456), BY(mtcNA, g, wwithin, wdatNA, mean = 4.8456))
expect_equal(fwithin(mtcNA, g, wdatNA, mean = 4.8456), BY(mtcNA, g, wwithin, wdatNA, na.rm = TRUE, mean = 4.8456))
})
test_that("Weighted centering on overall weighted mean performs as indended", {
# complete weights
expect_equal(fwithin(x, f, w, mean = "overall.mean"), as.numeric(mapply(wwithin, split(x, f), split(w, f), na.rm = TRUE)) + B(x, w = w))
expect_equal(fwithin(x, f, w, na.rm = FALSE, mean = "overall.mean"), as.numeric(mapply(wwithin, split(x, f), split(w, f))) + B(x, w = w))
# expect_equal(fwithin(xNA, f, w, na.rm = FALSE, mean = "overall.mean"), as.numeric(mapply(wwithin, split(xNA, f), split(w, f))) + B(xNA, w = w)) # Not the same !!
expect_equal(fwithin(xNA, f, w, mean = "overall.mean"), as.numeric(mapply(wwithin, split(xNA, f), split(w, f), na.rm = TRUE)) + B(xNA, w = w))
})
# Do more than this to test the rest ...
test_that("fwithin performs numerically stable", {
expect_true(all_obj_equal(replicate(50, fwithin(1), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(NA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(NA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, f), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, f, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, f, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, f), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, g), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, g, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, g, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, g), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, g), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, g, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, g, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, g), simplify = FALSE)))
})
test_that("fwithin with complete weights performs numerically stable", {
expect_true(all_obj_equal(replicate(50, fwithin(1, w = 1), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(NA, w = 1), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(NA, w = 1, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, w = w), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, w = w, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, w = w, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, w = w), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, w = wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, w = wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, w = wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, w = wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, w = wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, w = wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, w = wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, w = wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, f, w), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, f, w, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, f, w, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, f, w), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, g, wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, g, wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, g, wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, g, wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, g, wdat), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, g, wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, g, wdat, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, g, wdat), simplify = FALSE)))
})
test_that("fwithin with missing weights performs numerically stable", {
expect_true(all_obj_equal(replicate(50, fwithin(1, w = NA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(NA, w = NA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(NA, w = NA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, w = wNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, w = wNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, w = wNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, w = wNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, w = wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, w = wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, w = wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, w = wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, w = wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, f, wNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(x, f, wNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, f, wNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(xNA, f, wNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, g, wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(m, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mNA, g, wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, g, wdatNA), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcars, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, g, wdatNA, na.rm = FALSE), simplify = FALSE)))
expect_true(all_obj_equal(replicate(50, fwithin(mtcNA, g, wdatNA), simplify = FALSE)))
})
test_that("fwithin handles special values in the right way", {
expect_equal(fwithin(NA), NA_real_)
expect_equal(fwithin(NaN), NaN)
expect_equal(fwithin(Inf), NaN)
expect_equal(fwithin(c(Inf,Inf)), c(NaN,NaN))
expect_equal(fwithin(-Inf), NaN)
expect_equal(fwithin(c(-Inf,-Inf)), c(NaN,NaN))
expect_equal(fwithin(TRUE), 0)
expect_equal(fwithin(FALSE), 0)
expect_equal(fwithin(NA, na.rm = FALSE), NA_real_)
expect_equal(fwithin(NaN, na.rm = FALSE), NaN)
expect_equal(fwithin(Inf, na.rm = FALSE), NaN)
expect_equal(fwithin(c(Inf,Inf), na.rm = FALSE), c(NaN,NaN))
expect_equal(fwithin(-Inf, na.rm = FALSE), NaN)
expect_equal(fwithin(c(-Inf,-Inf), na.rm = FALSE), c(NaN,NaN))
expect_equal(fwithin(TRUE, na.rm = FALSE), 0)
expect_equal(fwithin(FALSE, na.rm = FALSE), 0)
expect_equal(fwithin(c(1,NA)), c(0,NA_real_))
expect_equal(fwithin(c(1,NaN)), c(0,NaN))
expect_equal(fwithin(c(1,Inf)), c(-Inf,NaN))
expect_equal(fwithin(c(1,-Inf)), c(Inf,NaN))
expect_equal(fwithin(c(1,Inf), na.rm = FALSE), c(-Inf,NaN))
expect_equal(fwithin(c(1,-Inf), na.rm = FALSE), c(Inf,NaN))
expect_equal(fwithin(c(NA,-Inf), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fwithin(c(TRUE,TRUE), na.rm = FALSE), c(0,0))
expect_equal(fwithin(c(1,NA), na.rm = FALSE), c(NA_real_,NA_real_))
})
test_that("fwithin with weights handles special values in the right way", {
expect_equal(fwithin(NA, w = 1), NA_real_)
expect_equal(fwithin(NaN, w = 1), NaN)
expect_equal(fwithin(Inf, w = 1), NaN)
expect_equal(fwithin(c(Inf,Inf), w = 1:2), c(NaN,NaN))
expect_equal(fwithin(-Inf, w = 1), NaN)
expect_equal(fwithin(c(-Inf,-Inf), w = 1:2), c(NaN,NaN))
expect_equal(fwithin(TRUE, w = 1), 0)
expect_equal(fwithin(FALSE, w = 1), 0)
expect_equal(fwithin(NA, w = 1, na.rm = FALSE), NA_real_)
expect_equal(fwithin(NaN, w = 1, na.rm = FALSE), NaN)
expect_equal(fwithin(Inf, w = 1, na.rm = FALSE), NaN)
expect_equal(fwithin(c(Inf,Inf), w = 1:2, na.rm = FALSE), c(NaN,NaN))
expect_equal(fwithin(-Inf, w = 1, na.rm = FALSE), NaN)
expect_equal(fwithin(c(-Inf,-Inf), w = 1:2, na.rm = FALSE), c(NaN,NaN))
expect_equal(fwithin(TRUE, w = 1, na.rm = FALSE), 0)
expect_equal(fwithin(FALSE, w = 1, na.rm = FALSE), 0)
expect_equal(fwithin(c(1,NA), w = 1:2), c(0,NA))
expect_equal(fwithin(c(1,NaN), w = 1:2), c(0,NaN))
expect_equal(fwithin(c(1,Inf), w = 1:2), c(-Inf,NaN))
expect_equal(fwithin(c(1,-Inf), w = 1:2), c(Inf,NaN))
expect_equal(fwithin(c(1,Inf), w = 1:2, na.rm = FALSE), c(-Inf,NaN))
expect_equal(fwithin(c(1,-Inf), w = 1:2, na.rm = FALSE), c(Inf,NaN))
expect_equal(fwithin(c(NA,-Inf), w = 1:2, na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fwithin(c(FALSE,FALSE), w = 1:2, na.rm = FALSE), c(0,0))
expect_equal(fwithin(c(1,NA), w = 1:2, na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fwithin(1:3, w = c(1,Inf,3)), c(NaN,NaN,NaN))
expect_equal(fwithin(1:3, w = c(1,-Inf,3)), c(NaN,NaN,NaN))
expect_equal(fwithin(1:3, w = c(1,Inf,3), na.rm = FALSE), c(NaN,NaN,NaN))
expect_equal(fwithin(1:3, w = c(1,-Inf,3), na.rm = FALSE), c(NaN,NaN,NaN))
expect_equal(fwithin(NA, w = NA), NA_real_)
expect_equal(fwithin(NaN, w = NA), NaN)
expect_equal(fwithin(Inf, w = NA), NaN)
expect_equal(fwithin(c(Inf,Inf), w = c(NA,2)), c(NaN,NaN))
expect_equal(fwithin(-Inf, w = NA), NA_real_)
expect_equal(fwithin(c(-Inf,-Inf), w = c(NA,2)), c(NaN,NaN))
expect_equal(fwithin(TRUE, w = NA), NA_real_)
expect_equal(fwithin(FALSE, w = NA), NA_real_)
expect_equal(fwithin(NA, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fwithin(NaN, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fwithin(Inf, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fwithin(c(Inf,Inf), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fwithin(-Inf, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fwithin(c(-Inf,-Inf), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fwithin(TRUE, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fwithin(FALSE, w = NA, na.rm = FALSE), NA_real_)
expect_equal(fwithin(c(1,NA), w = c(NA,2)), c(NA_real_,NA_real_))
expect_equal(fwithin(c(1,NaN), w = c(NA,2)), c(NA_real_,NA_real_))
expect_equal(fwithin(c(1,Inf), w = c(NA,2)), c(-Inf,NaN))
expect_equal(fwithin(c(1,-Inf), w = c(NA,2)), c(Inf,NaN))
expect_equal(fwithin(c(1,Inf), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fwithin(c(1,-Inf), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fwithin(c(NA,-Inf), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fwithin(c(FALSE,FALSE), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fwithin(c(1,NA), w = c(NA,2), na.rm = FALSE), c(NA_real_,NA_real_))
expect_equal(fwithin(1:3, w = c(NA,Inf,3)), c(NaN,NaN,NaN))
expect_equal(fwithin(1:3, w = c(NA,-Inf,3)), c(NaN,NaN,NaN))
expect_equal(fwithin(1:3, w = c(NA,Inf,3), na.rm = FALSE), c(NA_real_,NA_real_,NA_real_))
expect_equal(fwithin(1:3, w = c(NA,-Inf,3), na.rm = FALSE), c(NA_real_,NA_real_,NA_real_))
})
test_that("fwithin produces errors for wrong input", {
expect_error(fwithin("a"))
expect_error(fwithin(NA_character_))
expect_error(fwithin(mNAc))
expect_error(fwithin(mNAc, f))
expect_error(fwithin(1:2,1:3))
expect_error(fwithin(m,1:31))
expect_error(fwithin(mtcars,1:31))
expect_error(fwithin(mtcars, w = 1:31))
expect_error(fwithin("a", w = 1))
expect_error(fwithin(1:2, w = 1:3))
expect_error(fwithin(NA_character_, w = 1))
expect_error(fwithin(mNAc, w = wdat))
expect_error(fwithin(mNAc, f, wdat))
expect_error(fwithin(mNA, w = 1:33))
expect_error(fwithin(1:2,1:2, 1:3))
expect_error(fwithin(m,1:32,1:20))
expect_error(fwithin(mtcars,1:32,1:10))
expect_error(fwithin(1:2, w = c("a","b")))
expect_error(fwithin(wlddev))
expect_error(fwithin(wlddev, w = wlddev$year))
expect_error(fwithin(wlddev, wlddev$iso3c))
expect_error(fwithin(wlddev, wlddev$iso3c, wlddev$year))
})
test_that("fwithin shoots errors for wrong input to mean", {
expect_error(fwithin(x, mean = FALSE))
expect_error(fwithin(m, mean = FALSE))
expect_error(fwithin(mtcars, mean = FALSE))
expect_error(fwithin(x, mean = "overall.mean"))
expect_error(fwithin(m, mean = "overall.mean"))
expect_error(fwithin(mtcars, mean = "overall.mean"))
expect_error(fwithin(m, mean = fmean(m)))
expect_error(fwithin(mtcars, mean = fmean(mtcars)))
})
# W
test_that("W produces errors for wrong input", {
expect_error(W("a"))
expect_error(W(NA_character_))
expect_error(W(mNAc))
expect_error(W(mNAc, f))
expect_error(W(1:2,1:3))
expect_error(W(m,1:31))
expect_error(W(mtcars,1:31))
expect_error(W(mtcars, w = 1:31))
expect_error(W("a", w = 1))
expect_error(W(1:2, w = c("a","b")))
expect_error(W(1:2, w = 1:3))
expect_error(W(NA_character_, w = 1))
expect_error(W(mNAc, w = wdat))
expect_error(W(mNAc, f, wdat))
expect_error(W(mNA, w = 1:33))
expect_error(W(mtcNA, w = 1:33))
expect_error(W(1:2,1:2, 1:3))
expect_error(W(m,1:32,1:20))
expect_error(W(mtcars,1:32,1:10))
expect_error(W(1:2, 1:3, 1:2))
expect_error(W(m,1:31,1:32))
expect_error(W(mtcars,1:33,1:32))
})
test_that("W.data.frame method is foolproof", {
expect_visible(W(wlddev))
expect_visible(W(wlddev, w = wlddev$year))
expect_visible(W(wlddev, w = ~year))
expect_visible(W(wlddev, wlddev$iso3c))
expect_visible(W(wlddev, ~iso3c))
expect_visible(W(wlddev, ~iso3c + region))
expect_visible(W(wlddev, wlddev$iso3c, wlddev$year))
expect_visible(W(wlddev, ~iso3c, ~year))
expect_visible(W(wlddev, cols = 9:12))
expect_visible(W(wlddev, w = wlddev$year, cols = 9:12))
expect_visible(W(wlddev, w = ~year, cols = 9:12))
expect_visible(W(wlddev, wlddev$iso3c, cols = 9:12))
expect_visible(W(wlddev, ~iso3c, cols = 9:12))
expect_visible(W(wlddev, wlddev$iso3c, wlddev$year, cols = 9:12))
expect_visible(W(wlddev, ~iso3c, ~year, cols = 9:12))
expect_visible(W(wlddev, cols = c("PCGDP","LIFEEX")))
expect_visible(W(wlddev, w = wlddev$year, cols = c("PCGDP","LIFEEX")))
expect_visible(W(wlddev, w = ~year, cols = c("PCGDP","LIFEEX")))
expect_visible(W(wlddev, wlddev$iso3c, cols = c("PCGDP","LIFEEX")))
expect_visible(W(wlddev, ~iso3c, cols = c("PCGDP","LIFEEX")))
expect_visible(W(wlddev, wlddev$iso3c, wlddev$year, cols = c("PCGDP","LIFEEX")))
expect_visible(W(wlddev, ~iso3c, ~year, cols = c("PCGDP","LIFEEX")))
expect_error(W(wlddev, cols = NULL))
expect_error(W(wlddev, w = wlddev$year, cols = NULL))
expect_error(W(wlddev, w = ~year, cols = NULL))
expect_error(W(wlddev, wlddev$iso3c, cols = NULL))
expect_error(W(wlddev, ~iso3c, cols = NULL))
expect_error(W(wlddev, wlddev$iso3c, wlddev$year, cols = NULL))
expect_error(W(wlddev, ~iso3c, ~year, cols = NULL))
expect_error(W(wlddev, cols = 9:14))
expect_error(W(wlddev, w = wlddev$year, cols = 9:14))
expect_error(W(wlddev, w = ~year, cols = 9:14))
expect_error(W(wlddev, wlddev$iso3c, cols = 9:14))
expect_error(W(wlddev, ~iso3c, cols = 9:14))
expect_error(W(wlddev, wlddev$iso3c, wlddev$year, cols = 9:14))
expect_error(W(wlddev, ~iso3c, ~year, cols = 9:14))
expect_error(W(wlddev, cols = c("PCGDP","LIFEEX","bla")))
expect_error(W(wlddev, w = wlddev$year, cols = c("PCGDP","LIFEEX","bla")))
expect_error(W(wlddev, w = ~year, cols = c("PCGDP","LIFEEX","bla")))
expect_error(W(wlddev, wlddev$iso3c, cols = c("PCGDP","LIFEEX","bla")))
expect_error(W(wlddev, ~iso3c, cols = c("PCGDP","LIFEEX","bla")))
expect_error(W(wlddev, wlddev$iso3c, wlddev$year, cols = c("PCGDP","LIFEEX","bla")))
expect_error(W(wlddev, ~iso3c, ~year, cols = c("PCGDP","LIFEEX","bla")))
expect_error(W(wlddev, w = mtcars))
expect_error(W(wlddev, w = 4))
expect_error(W(wlddev, w = "year"))
expect_error(W(wlddev, w = ~year2))
# suppressWarnings(expect_error(W(wlddev, w = ~year + region)))
expect_error(W(wlddev, mtcars))
expect_error(W(wlddev, 2))
expect_error(W(wlddev, "iso3c"))
expect_error(W(wlddev, ~iso3c2))
expect_error(W(wlddev, ~iso3c + bla))
expect_error(W(wlddev, mtcars$mpg, mtcars$cyl))
expect_error(W(wlddev, 2, 4))
expect_error(W(wlddev, ~iso3c2, ~year2))
expect_error(W(wlddev, cols = ~bla))
expect_error(W(wlddev, w = ~bla, cols = 9:12))
expect_error(W(wlddev, w = 4, cols = 9:12))
expect_error(W(wlddev, w = "year", cols = 9:12))
expect_error(W(wlddev, w = ~yewar, cols = 9:12))
expect_error(W(wlddev, mtcars$mpg, cols = 9:12))
expect_error(W(wlddev, ~iso3c + ss, cols = 9:12))
expect_error(W(wlddev, 2, cols = 9:12))
expect_error(W(wlddev, "iso3c", cols = 9:12))
expect_error(W(wlddev, wlddev$iso3c, ~year + bla, cols = 9:12))
expect_error(W(wlddev, ~iso3c3, ~year, cols = 9:12))
expect_error(W(wlddev, cols = c("PC3GDP","LIFEEX")))
})
Try the collapse package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.