context("s2dv::Corr tests") ############################################## # dat1: memb_dim is NULL set.seed(1) exp1 <- array(rnorm(240), dim = c(member = 1, dataset = 2, sdate = 5, ftime = 3, lat = 2, lon = 4)) set.seed(2) obs1 <- array(rnorm(120), dim = c(member = 1, dataset = 1, sdate = 5, ftime = 3, lat = 2, lon = 4)) set.seed(2) na <- floor(runif(10, min = 1, max = 120)) obs1[na] <- NA # dat2: memb_dim = member set.seed(1) exp2 <- array(rnorm(180), dim = c(member = 3, dataset = 2, sdate = 5, lat = 2, lon = 3)) set.seed(2) obs2 <- array(rnorm(30), dim = c(member = 1, dataset = 1, sdate = 5, lat = 2, lon = 3)) # dat3: memb_dim = member, obs has multiple memb set.seed(1) exp3 <- array(rnorm(180), dim = c(member = 3, dataset = 2, sdate = 5, lat = 2, lon = 3)) set.seed(2) obs3 <- array(rnorm(120), dim = c(member = 2, dataset = 2, sdate = 5, lat = 2, lon = 3)) # dat4: exp and obs have dataset = 1 (to check the return array by small func) set.seed(1) exp4 <- array(rnorm(10), dim = c(member = 1, dataset = 1, sdate = 5, lat = 2)) set.seed(2) obs4 <- array(rnorm(10), dim = c(member = 1, dataset = 1, sdate = 5, lat = 2)) ############################################## test_that("1. Input checks", { expect_error( Corr(c(), c()), "Parameter 'exp' and 'obs' cannot be NULL." ) expect_error( Corr(c('b'), c('a')), "Parameter 'exp' and 'obs' must be a numeric array." ) expect_error( Corr(c(1:10), c(2:4)), paste0("Parameter 'exp' and 'obs' must be at least two dimensions ", "containing time_dim and dat_dim.") ) expect_error( Corr(array(1:10, dim = c(2, 5)), array(1:4, dim = c(2, 2))), "Parameter 'exp' and 'obs' must have dimension names." ) expect_error( Corr(array(1:10, dim = c(a = 2, c = 5)), array(1:4, dim = c(a = 2, b = 2))), "Parameter 'exp' and 'obs' must have same dimension name" ) expect_error( Corr(exp1, obs1, dat_dim = 1), "Parameter 'dat_dim' must be a character string." ) expect_error( Corr(exp1, obs1, dat_dim = 'a'), "Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension." ) expect_error( Corr(exp1, obs1, time_dim = c('sdate', 'a')), "Parameter 'time_dim' must be a character string." ) expect_error( Corr(exp1, obs1, time_dim = 'a'), "Parameter 'time_dim' is not found in 'exp' or 'obs' dimension." ) expect_error( Corr(exp1, obs1, comp_dim = c('sdate', 'ftime')), "Parameter 'comp_dim' must be a character string." ) expect_error( Corr(exp1, obs1, comp_dim = 'a'), "Parameter 'comp_dim' is not found in 'exp' or 'obs' dimension." ) expect_error( Corr(exp1, obs1, limits = c(1,3)), "Paramter 'comp_dim' cannot be NULL if 'limits' is assigned." ) expect_error( Corr(exp1, obs1, comp_dim = 'ftime', limits = c(1)), paste0("Parameter 'limits' must be a vector of two positive ", "integers smaller than the length of paramter 'comp_dim'.") ) expect_error( Corr(exp1, obs1, conf.lev = -1), "Parameter 'conf.lev' must be a numeric number between 0 and 1." ) expect_error( Corr(exp1, obs1, method = 1), "Parameter 'method' must be one of 'kendall', 'spearman' or 'pearson'." ) expect_error( Corr(exp1, obs1, memb_dim = 1), "Parameter 'memb_dim' must be a character string." ) expect_error( Corr(exp1, obs1, memb_dim = 'memb'), "Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension." ) expect_error( Corr(exp2, obs2, memb_dim = 'member', memb = 1), "Parameter 'memb' must be one logical value." ) expect_error( Corr(exp1, obs1, conf = 1), "Parameter 'conf' must be one logical value." ) expect_error( Corr(exp1, obs1, pval = 'TRUE'), "Parameter 'pval' must be one logical value." ) expect_error( Corr(exp1, obs1, ncores = 1.5), "Parameter 'ncores' must be a positive integer." ) expect_error( Corr(exp = array(1:10, dim = c(sdate = 1, dataset = 5, a = 1)), obs = array(1:4, dim = c(a = 1, sdate = 2, dataset = 2))), "Parameter 'exp' and 'obs' must have same length of all dimension expect 'dat_dim'." ) expect_error( Corr(exp = array(1:10, dim = c(sdate = 2, dataset = 5, a = 1)), obs = array(1:4, dim = c(a = 1, sdate = 2, dataset = 2))), "The length of time_dim must be at least 3 to compute correlation." ) }) ############################################## test_that("2. Output checks: dat1", { suppressWarnings( expect_equal( dim(Corr(exp1, obs1)$corr), c(nexp = 2, nobs = 1, member = 1, ftime = 3, lat = 2, lon = 4) ) ) suppressWarnings( expect_equal( Corr(exp1, obs1)$corr[1:6], c(0.11503859, -0.46959987, -0.64113021, 0.09776572, -0.32393603, 0.27565829), tolerance = 0.001 ) ) suppressWarnings( expect_equal( length(which(is.na(Corr(exp1, obs1)$p.val))), 2 ) ) suppressWarnings( expect_equal( max(Corr(exp1, obs1)$conf.lower, na.rm = T), 0.6332941, tolerance = 0.001 ) ) suppressWarnings( expect_equal( length(which(is.na(Corr(exp1, obs1, comp_dim = 'ftime')$corr))), 6 ) ) suppressWarnings( expect_equal( length(which(is.na(Corr(exp1, obs1, comp_dim = 'ftime', limits = c(2, 3))$corr))), 2 ) ) suppressWarnings( expect_equal( min(Corr(exp1, obs1, conf.lev = 0.99)$conf.upper, na.rm = TRUE), 0.2747904, tolerance = 0.0001 ) ) suppressWarnings( expect_equal( length(Corr(exp1, obs1, conf = FALSE, pval = FALSE)), 1 ) ) suppressWarnings( expect_equal( length(Corr(exp1, obs1, conf = FALSE)), 2 ) ) suppressWarnings( expect_equal( length(Corr(exp1, obs1, pval = FALSE)), 3 ) ) suppressWarnings( expect_equal( Corr(exp1, obs1, method = 'spearman')$corr[1:6], c(-0.3, -0.4, -0.6, 0.3, -0.3, 0.2) ) ) suppressWarnings( expect_equal( range(Corr(exp1, obs1, method = 'spearman', comp_dim = 'ftime')$p.val, na.rm = T), c(0.0, 0.5), tolerance = 0.001 ) ) }) ############################################## test_that("3. Output checks: dat2", { # individual member expect_equal( dim(Corr(exp2, obs2, memb_dim = 'member')$corr), c(nexp = 2, nobs = 1, exp_memb = 3, obs_memb = 1, lat = 2, lon = 3) ) expect_equal( names(Corr(exp2, obs2, memb_dim = 'member')), c("corr", "p.val", "conf.lower", "conf.upper") ) expect_equal( names(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE)), c("corr") ) expect_equal( names(Corr(exp2, obs2, memb_dim = 'member', conf = FALSE)), c("corr", "p.val") ) expect_equal( names(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE)), c("corr", "conf.lower", "conf.upper") ) expect_equal( mean(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), 0.01645575, tolerance = 0.0001 ) expect_equal( median(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), 0.03024513, tolerance = 0.0001 ) expect_equal( max(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), 0.9327993, tolerance = 0.0001 ) expect_equal( min(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), -0.9361258, tolerance = 0.0001 ) expect_equal( Corr(exp2, obs2, memb_dim = 'member', conf = FALSE)$p.val[1:5], c(0.24150854, 0.21790352, 0.04149139, 0.49851332, 0.19859843), tolerance = 0.0001 ) expect_equal( Corr(exp2, obs2, memb_dim = 'member', pval = FALSE)$conf.lower[1:5], c(-0.9500121, -0.9547642, -0.9883400, -0.8817478, -0.6879465), tolerance = 0.0001 ) # ensemble mean expect_equal( dim(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE)$corr), c(nexp = 2, nobs = 1, lat = 2, lon = 3) ) expect_equal( mean(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), 0.02939929, tolerance = 0.0001 ) expect_equal( median(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), 0.03147432, tolerance = 0.0001 ) expect_equal( max(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), 0.8048901, tolerance = 0.0001 ) expect_equal( min(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), -0.6839388, tolerance = 0.0001 ) expect_equal( Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, conf = FALSE)$p.val[1:5], c(0.1999518, 0.2776874, 0.3255444, 0.2839667, 0.1264518), tolerance = 0.0001 ) expect_equal( Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE)$conf.lower[1:5], c(-0.9582891, -0.7668065, -0.9316879, -0.9410621, -0.5659657), tolerance = 0.0001 ) }) ############################################## test_that("4. Output checks: dat3", { # individual member expect_equal( dim(Corr(exp3, obs3, memb_dim = 'member')$corr), c(nexp = 2, nobs = 2, exp_memb = 3, obs_memb = 2, lat = 2, lon = 3) ) expect_equal( names(Corr(exp3, obs3, memb_dim = 'member')), c("corr", "p.val", "conf.lower", "conf.upper") ) expect_equal( mean(Corr(exp3, obs3, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), 0.006468017, tolerance = 0.0001 ) expect_equal( median(Corr(exp3, obs3, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), 0.03662394, tolerance = 0.0001 ) expect_equal( max(Corr(exp3, obs3, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), 0.9798228, tolerance = 0.0001 ) expect_equal( min(Corr(exp3, obs3, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr), -0.9464891, tolerance = 0.0001 ) # ensemble mean expect_equal( dim(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE)$corr), c(nexp = 2, nobs = 2, lat = 2, lon = 3) ) expect_equal( mean(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), -0.01001896, tolerance = 0.0001 ) expect_equal( median(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), -0.01895816, tolerance = 0.0001 ) expect_equal( max(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), 0.798233, tolerance = 0.0001 ) expect_equal( min(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr), -0.6464809, tolerance = 0.0001 ) }) ############################################## test_that("5. Output checks: dat4", { # no member expect_equal( dim(Corr(exp4, obs4)$corr), c(nexp = 1, nobs = 1, member = 1, lat = 2) ) # individual member expect_equal( dim(Corr(exp4, obs4, memb_dim = 'member')$corr), c(nexp = 1, nobs = 1, exp_memb = 1, obs_memb = 1, lat = 2) ) # ensemble expect_equal( dim(Corr(exp4, obs4, memb_dim = 'member', memb = FALSE)$corr), c(nexp = 1, nobs = 1, lat = 2) ) }) ##############################################