context("CSTools::CST_BiasCorrection tests") ############################################## # 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) exp <- list(data = mod, lat = lat, lon = lon) obs <- list(data = obs, lat = lat, lon = lon) 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)) # dat4 exp4 <- array(1:100, dim = c(time = 2, members = 5, lat = 2, lon = 5)) obs4 <- array(1:200, dim = c(time = 2, members = 5, lat = 2, lon = 5)) obs4_1 <- obs4 obs4_1[1,1,1,1] <- NA ############################################## test_that("1. Inpput checks", { # s2dv_cube expect_error( CST_BiasCorrection(exp = 1), paste0("Parameter 'exp' and 'obs' must be of the class 's2dv_cube', ", "as output by CSTools::CST_Load.") ) expect_error( CST_BiasCorrection(exp = exp, obs = 1), paste0("Parameter 'exp' and 'obs' must be of the class 's2dv_cube', ", "as output by CSTools::CST_Load.") ) 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', as output ", "by CSTools::CST_Load.") ) # 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, member_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 'member_dim' dimensions.") ) ## 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), 3 ) expect_equal( dim(bc$data), c(dataset = 1, member = 3, sdate = 4, ftime = 5, lat = 6, lon = 7) ) expect_equal( bc$lat, lat ) expect_equal( bc$lon, lon ) expect_equal( round(BiasCorrection(exp = exp3, obs = obs3, exp_cor = exp3), 2), array(c(2.66, 4.27, 3.2, 4.8, 3.73, 5.34), c(member = 2, sdate = 3)) ) expect_equal( round(BiasCorrection(exp = exp3, obs = obs3_2, exp_cor = exp3), 2), array(c(2.66, 4.27, 3.2, 4.8, 3.73, 5.34), c(member = 2, sdate = 3)) ) expect_equal( dim(BiasCorrection(exp = exp4, obs = obs4, sdate_dim = 'time', memb_dim = 'members')), c(members = 5, time = 2, 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))), 5 ) ) })