############################################## # dat1 mod <- 1 : (1 * 3 * 4 * 5 * 6 * 7) obs <- 1 : (1 * 1 * 4 * 5 * 6 * 7) dim(mod) <- c(dataset = 1, member = 3, sdate = 4, ftime = 5, lat = 6, lon = 7) dim(obs) <- c(dataset = 1, member = 1, sdate = 4, ftime = 5, lat = 6, lon = 7) lon <- seq(0, 30, 5) lat <- seq(0, 25, 5) coords <- list(lat = lat, lon = lon) exp <- list(data = mod, coords = coords) obs <- list(data = obs, coords = coords) attr(exp, 'class') <- 's2dv_cube' attr(obs, 'class') <- 's2dv_cube' exp1 <- list(data = array(1:20, dim = c(time = 20))) class(exp1) <- 's2dv_cube' obs1 <- list(data = array(1:20, dim = c(time = 20))) class(obs1) <- 's2dv_cube' exp1_2 <- list(data = array(1:20, dim = c(20))) class(exp1_2) <- 's2dv_cube' obs1_2 <- list(data = array(1:20, dim = c(20))) class(obs1_2) <- 's2dv_cube' exp_cor1 <- list(data = array(1:20, dim = c(20))) class(exp_cor1) <- 's2dv_cube' # dat2 exp2 <- exp exp2$data[1, 2, 1, 1, 1, 1] <- NA obs2 <- obs obs2$data[1, 1, 2, 1, 1, 1] <- NA # dat3 exp3 <- array(1:6, c(sdate = 3, member = 2)) obs3 <- array(3:6, c(sdate = 3, member = 1)) obs3_2 <- array(3:6, c(sdate = 3)) obs3_3 <- array(3:6, c(sdate = 3, member = 2)) # dat4 exp4 <- array(1:100, dim = c(time = 5, members = 5, lat = 2, lon = 5)) obs4 <- array(1:200, dim = c(time = 5, members = 1, lat = 2, lon = 5)) obs4_1 <- obs4 obs4_1[1,1,1,1] <- NA # dat5 set.seed(1) exp5 <- array(rnorm(80), dim = c(member = 2, sdate = 10, lat = 2, dataset = 2)) set.seed(2) obs5 <- array(rnorm(60), dim = c(sdate = 10, lat = 2, dataset = 3)) set.seed(3) exp_cor5 <- array(rnorm(20), dim = c(member = 2, sdate = 10, lat = 2)) # dat6 set.seed(1) exp6 <- array(rnorm(20), dim = c(member = 2, sdate = 10)) exp6_1 <- array(exp6, dim = c(member = 2, sdate = 10, dataset = 1)) exp6_2 <- exp6_1 exp6_2[1] <- NA set.seed(2) obs6 <- array(rnorm(10), dim = c(member = 1, sdate = 10)) obs6_1 <- array(obs6, dim = c(member = 1, sdate = 10, dataset = 1)) obs6_2 <- obs6_1 obs6_2[c(1, 3)] <- NA set.seed(3) exp_cor6 <- array(rnorm(20), dim = c(member = 2, sdate = 10)) # dat7 exp_cor7 <- array(rnorm(400), dim = c(member = 10, sdate = 10, lat = 2, dataset = 2)) ############################################## test_that("1. Input checks", { # s2dv_cube expect_error( CST_BiasCorrection(exp = 1), paste0("Parameter 'exp' and 'obs' must be of the class 's2dv_cube'.") ) expect_error( CST_BiasCorrection(exp = exp, obs = 1), paste0("Parameter 'exp' and 'obs' must be of the class 's2dv_cube'.") ) expect_error( CST_BiasCorrection(exp = exp1), 'argument "obs" is missing, with no default' ) expect_error( CST_BiasCorrection(exp = exp1, obs = obs1, exp_cor = 1), paste0("Parameter 'exp_cor' must be of the class 's2dv_cube'.") ) # exp and obs expect_error( CST_BiasCorrection(exp = exp1_2, obs = obs1), "Parameter 'exp' must have dimension names." ) expect_error( CST_BiasCorrection(exp = exp1, obs = obs1_2), "Parameter 'obs' must have dimension names." ) expect_warning( CST_BiasCorrection(exp = exp2, obs = obs2), "Parameter 'exp' contains NA values." ) expect_warning( CST_BiasCorrection(exp = exp, obs = obs2), "Parameter 'obs' contains NA values." ) expect_warning( CST_BiasCorrection(exp = exp2, obs = obs2), "Parameter 'obs' contains NA values", "Parameter 'exp' contains NA values." ) # exp_cor expect_error( CST_BiasCorrection(exp = exp1, obs = obs1, exp_cor = exp_cor1, sdate_dim = 'time'), "Parameter 'exp_cor' must have dimension names." ) # sdate_dim, memb_dim expect_error( CST_BiasCorrection(exp = exp1, obs = obs1, sdate_dim = 1), paste0("Parameter 'sdate_dim' must be a character string.") ) expect_error( CST_BiasCorrection(exp = exp, obs = obs, sdate_dim = 'time'), paste0("Parameter 'sdate_dim' is not found in 'exp' or 'obs' dimension.") ) expect_error( BiasCorrection(exp = array(1:20, dim = c(time = 1, member = 1)), obs = array(1:20, dim = c(time = 2, member = 1)), sdate_dim = 'time'), paste0("Parameter 'exp' must have dimension length of 'sdate_dim' bigger than 1.") ) expect_error( CST_BiasCorrection(exp = exp1, obs = obs1, sdate_dim = 'time'), paste0("Parameter 'exp' requires 'sdate_dim' and 'memb_dim' dimensions.") ) expect_error( BiasCorrection(exp = exp3, obs = obs3_3), paste0("If parameter 'obs' has dimension 'memb_dim' its length must be equal to 1.") ) ## dat_dim expect_error( BiasCorrection(exp = exp3, obs = obs3, dat_dim = 1), paste0("Parameter 'dat_dim' must be a character string.") ) expect_error( BiasCorrection(exp = exp3, obs = obs3, dat_dim = 'dataset'), paste0("Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension.", " Set it as NULL if there is no dataset dimension.") ) ## exp, obs, and exp_cor (2) expect_error( BiasCorrection(exp = array(1:6, c(sdate = 3, member = 2, dataset = 2, lon = 1)), obs = array(1:6, c(sdate = 3, member = 1, dataset = 3, lon = 2)), dat_dim = 'dataset'), paste0("Parameter 'exp' and 'obs' must have same length of all dimensions", " except 'memb_dim' and 'dat_dim'.") ) expect_error( BiasCorrection(exp = array(1:6, c(sdate = 3, member = 2, dataset = 2, lon = 1)), obs = array(1:6, c(sdate = 3, member = 1, dataset = 3, lon = 1)), exp_cor = array(1:6, c(sdate = 3, member = 1, dataset = 3, lon = 1)), dat_dim = 'dataset'), paste0("If parameter 'exp_cor' has dataset dimension, it must be", " equal to dataset dimension of 'exp'.") ) expect_error( BiasCorrection(exp = array(1:6, c(sdate = 3, member = 2, dataset = 2, lon = 1)), obs = array(1:6, c(sdate = 3, member = 1, dataset = 3, lon = 1)), exp_cor = array(1:6, c(sdate = 3, member = 1, lon = 3)), dat_dim = 'dataset'), paste0("Parameter 'exp' and 'exp_cor' must have the same length of all common dimensions", " except 'dat_dim', 'sdate_dim' and 'memb_dim'.") ) ## na.rm expect_warning( CST_BiasCorrection(exp = exp, obs = obs, na.rm = 1), "Paramater 'na.rm' must be a logical, it has been set to FALSE." ) expect_warning( CST_BiasCorrection(exp = exp, obs = obs, na.rm = c(T,F)), "Paramter 'na.rm' has length greater than 1, and only the fist element is used." ) # ncores expect_error( CST_BiasCorrection(exp = exp, obs = obs, ncores = TRUE), "Parameter 'ncores' must be either NULL or a positive integer." ) }) ############################################## test_that("2. Output checks: dat1", { bc <- CST_BiasCorrection(exp = exp, obs = obs) expect_equal( length(bc), 2 ) expect_equal( dim(bc$data), c(dataset = 1, member = 3, sdate = 4, ftime = 5, lat = 6, lon = 7) ) expect_equal( bc$coords$lat, lat ) expect_equal( bc$coords$lon, lon ) expect_equal( as.vector(BiasCorrection(exp = exp3, obs = obs3, exp_cor = exp3)), c(2.663694, 3.198216, 3.732739, 4.267261, 4.801784, 5.336306), tolerance = 1e-6 ) expect_equal( as.vector(BiasCorrection(exp = exp3, obs = obs3_2, exp_cor = exp3)), c(2.663694, 3.198216, 3.732739, 4.267261, 4.801784, 5.336306), tolerance = 1e-6 ) expect_equal( dim(BiasCorrection(exp = exp4, obs = obs4, sdate_dim = 'time', memb_dim = 'members')), c(time = 5, members = 5, lat = 2, lon = 5) ) suppressWarnings( expect_equal( sum(is.na(BiasCorrection(exp = exp4, obs = obs4_1, sdate_dim = 'time', memb_dim = 'members', na.rm = TRUE))), 0 ) ) suppressWarnings( expect_equal( sum(is.na(BiasCorrection(exp = exp4, obs = obs4_1, sdate_dim = 'time', memb_dim = 'members', na.rm = FALSE))), 20 ) ) }) ############################################## test_that("3. Output checks: dat5", { expect_equal( dim(BiasCorrection(exp5, obs5, memb_dim = 'member', dat_dim = 'dataset')), c(member = 2, sdate = 10, lat = 2, nexp = 2, nobs = 3) ) expect_equal( dim(BiasCorrection(exp5, obs5, exp_cor5, memb_dim = 'member', dat_dim = 'dataset')), c(member = 2, sdate = 10, lat = 2, nexp = 2, nobs = 3) ) expect_equal( as.vector(BiasCorrection(exp5, obs5, memb_dim = 'member', dat_dim = 'dataset'))[5:10], c(0.1466060, -0.9764600, 0.6914021, 0.9330733, 0.6567210, -0.3036642), tolerance = 0.0001 ) expect_equal( as.vector(BiasCorrection(exp5, obs5, exp_cor5, memb_dim = 'member', dat_dim = 'dataset'))[5:10], c(0.21682367, 0.03815268, 0.09778966, 1.20997987, -1.30893321, 1.37258011), tolerance = 0.0001 ) expect_equal( as.vector(BiasCorrection(exp5[, , , 1], obs5[, , 1], memb_dim = 'member'))[1:5], as.vector(BiasCorrection(exp5, obs5, memb_dim = 'member', dat_dim = 'dataset')[, , , 1, 1][1:5]) ) expect_equal( as.vector(BiasCorrection(exp5[, , , 1], obs5[, , 1], exp_cor5, memb_dim = 'member'))[1:5], as.vector(BiasCorrection(exp5, obs5, exp_cor5, memb_dim = 'member', dat_dim = 'dataset')[, , , 1, 1][1:5]) ) expect_equal( as.vector(BiasCorrection(exp5, obs5, exp_cor5, memb_dim = 'member', dat_dim = 'dataset', na.rm = TRUE))[1:5], c(-1.0318284, -0.3098404, 0.2847780, -1.2369666, 0.2168237), tolerance = 0.0001 ) }) ############################################## test_that("4. Output checks: dat6", { expect_equal( dim(BiasCorrection(exp6, obs6)), c(member = 2, sdate = 10) ) expect_equal( as.vector(BiasCorrection(exp6, obs6))[1:5], c(-0.5430181, 0.2807323, -0.9954539, 1.9298249, 0.1466060), tolerance = 0.0001 ) expect_equal( as.vector(BiasCorrection(exp6, obs6, exp_cor6))[1:5], c(-1.0318284, -0.3098404, 0.2847780, -1.2369666, 0.2168237), tolerance = 0.0001 ) expect_equal( dim(BiasCorrection(exp6_1, obs6_1, dat_dim = 'dataset')), c(member = 2, sdate = 10, nexp = 1, nobs = 1) ) expect_equal( as.vector(BiasCorrection(exp6_1, obs6_1, dat_dim = 'dataset')), as.vector(BiasCorrection(exp6, obs6)), tolerance = 0.0001 ) expect_equal( as.vector(BiasCorrection(exp6_1, obs6_1, exp_cor6, dat_dim = 'dataset')), as.vector(BiasCorrection(exp6, obs6, exp_cor6)), tolerance = 0.0001 ) expect_equal( suppressWarnings( as.vector(BiasCorrection(exp6_1, obs6_2, dat_dim = 'dataset')) ), rep(as.numeric(NA), 20) ) expect_equal( suppressWarnings( as.vector(BiasCorrection(exp6_1, obs6_2, dat_dim = 'dataset', na.rm = T))[5:10] ), c(0.2644706, -0.8392515, 0.6458045, 0.8511290, 0.5959483, -0.2908764), tolerance = 0.0001 ) expect_equal( suppressWarnings( as.vector(BiasCorrection(exp6_2, obs6_2, exp_cor6, dat_dim = 'dataset', na.rm = T))[5:10] ), c(0.14077312, -0.02076059, 0.03315629, 1.03867041, -1.23864029, 1.18567478), tolerance = 0.0001 ) }) ############################################## test_that("6. Output checks: dat4", { expect_equal( dim(BiasCorrection(exp5, obs5, exp_cor7, dat_dim = 'dataset')), c(member = 10, sdate = 10, lat = 2, nexp = 2, nobs = 3) ) })