Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
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))
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
##############################################
test_that("1. Inpput checks", {
# s2dv_cube
CST_BiasCorrection(exp = 1),
paste0("Parameter 'exp' and 'obs' must be of the class 's2dv_cube', ",
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
"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, 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("The length of the dimension 'memb_dim' in the component 'data' of the parameter 'obs' must be equal to 1.")
)
## 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."
)
})
##############################################
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
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 = 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))),
)
)