Newer
Older
context("s2dv::EOF tests")
##############################################
# dat1
set.seed(1)
lat1 <- seq(10, 30, length.out = 6)
lon1 <- c(10, 12)
# dat2
set.seed(1)
lat2 <- seq(-10, 10, length.out = 6)
lon2 <- c(-10, -12)
# dat3
set.seed(1)
dat3 <- array(rnorm(480), dim = c(dat = 2, lat = 6, lon = 2, sdate = 20))
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
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
lat3 <- seq(10, 30, length.out = 6)
lon3 <- c(10, 12)
##############################################
test_that("1. Input checks", {
# ano
expect_error(
EOF(c()),
"Parameter 'ano' cannot be NULL."
)
expect_error(
EOF(c(NA, NA)),
"Parameter 'ano' must be a numeric array."
)
expect_error(
EOF(list(a = array(rnorm(50), dim = c(dat = 5, sdate = 10)), b = c(1:4))),
"Parameter 'ano' must be a numeric array."
)
expect_error(
EOF(array(1:10, dim = c(2, 5))),
"Parameter 'ano' must have dimension names."
)
# time_dim
expect_error(
EOF(dat1, time_dim = 2),
"Parameter 'time_dim' must be a character string."
)
expect_error(
EOF(dat1, time_dim = c('a','sdate')),
"Parameter 'time_dim' must be a character string."
)
# space_dim
expect_error(
EOF(dat1, space_dim = 'lat'),
"Parameter 'space_dim' must be a character vector of 2."
)
expect_error(
EOF(dat1, space_dim = c('latitude', 'longitude')),
"Parameter 'space_dim' is not found in 'ano' dimension."
)
# lat
expect_error(
EOF(dat1, lat = 1:10),
paste0("Parameter 'lat' must be a numeric vector with the same ",
"length as the latitude dimension of 'ano'.")
)
expect_error(
EOF(dat1, lat = seq(-100, -80, length.out = 6)),
"Parameter 'lat' must contain values within the range \\[-90, 90\\]."
)
# lon
expect_error(
EOF(dat1, lat = lat1, lon = c('a', 'b')),
paste0("Parameter 'lon' must be a numeric vector with the same ",
"length as the longitude dimension of 'ano'.")
)
expect_warning(
EOF(dat1, lat = lat1, lon = c(350, 370)),
"Some 'lon' is out of the range \\[-360, 360\\]."
)
# neofs
expect_error(
EOF(dat1, lat = lat1, lon = lon1, neofs = -1),
"Parameter 'neofs' must be a positive integer."
)
# corr
expect_error(
EOF(dat1, lat = lat1, lon = lon1, corr = 0.1),
"Parameter 'corr' must be one logical value."
)
# ncores
expect_error(
EOF(dat1, lat1, lon1, ncore = 3.5),
"Parameter 'ncores' must be a positive integer."
)
})
##############################################
test_that("2. dat1", {
res1 <- EOF(dat1, lon = lon1, lat = lat1, neofs = 10)
names(res1),
dim(res1$EOFs),
dim(res1$PCs),
dim(res1$var),
dim(res1$mask),
c(lat = 6, lon = 2)
)
expect_equal(
dim(res1$wght),
c(lat = 6, lon = 2)
)
expect_equal(
res1$EOFs[1:5],
c(-0.2888168, 0.2792765, 0.1028387, 0.1883640, -0.2896943),
tolerance = 0.0001
)
expect_equal(
mean(res1$EOFs),
0.01792716,
tolerance = 0.0001
)
expect_equal(
res1$PCs[1:5],
c(3.2061306, -0.1692669, 0.5420990, -2.5324441, -0.6143680),
tolerance = 0.0001
)
expect_equal(
mean(res1$PCs),
0.08980279,
tolerance = 0.0001
)
expect_equal(
res1$var[1:5],
array(c(29.247073, 25.364840, 13.247046, 11.121006, 8.662517), dim = c(mode = 5)),
tolerance = 0.0001
)
expect_equal(
sum(res1$mask),
12
)
expect_equal(
res1$wght[1:5],
c(0.9923748, 0.9850359, 0.9752213, 0.9629039, 0.9480475),
tolerance = 0.0001
)
res1$tot_var,
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
# rebuild the field
latlon_eof <- array(res1$EOFs, dim = c(mode = 10, latlon = 12))
field <- res1$PCs %*% latlon_eof
latlon_dat1<- array(dat1, dim = c(sdate = 10, laton = 12))
expect_equal(
as.vector(latlon_dat1),
as.vector(field)
)
dat1_1 <- dat1
dat1_1[, 2, 1] <- NA
res1_1 <- EOF(dat1_1, lon = lon1, lat = lat1, neofs = 10)
expect_equal(
mean(res1_1$EOFs, na.rm = T),
0.02270081,
tolerance = 0.0001
)
expect_equal(
mean(res1_1$PCs, na.rm = T),
0.1092327,
tolerance = 0.0001
)
# rebuild the field
latlon_eof <- array(res1_1$EOFs, dim = c(mode = 10, latlon = 12))
field <- res1_1$PCs %*% latlon_eof
latlon_dat1<- array(dat1_1, dim = c(sdate = 10, laton = 12))
expect_equal(
as.vector(latlon_dat1),
as.vector(field)
)
dat1_2 <- dat1
dat1_2[2:5, 2, 1] <- NA
expect_error(
EOF(dat1_2, lon = lon1, lat = lat1, neofs = 10),
"Detect certain grid points have NAs but not consistent across time dimension. If the grid point is NA, it should have NA at all time step."
)
})
##############################################
test_that("3. dat2", {
expect_equal(
dim(EOF(dat2, lon = lon2, lat = lat2)$EOFs),
)
expect_equal(
dim(EOF(dat2, lon = lon2, lat = lat2)$PCs),
)
expect_equal(
EOF(dat2, lon = lon2, lat = lat2)$EOFs[1:5],
c(0.33197201, 0.18837900, -0.19697143, 0.08305805, -0.51297585),
tolerance = 0.0001
)
expect_equal(
mean(EOF(dat2, lon = lon2, lat = lat2)$EOFs),
0.02720393,
tolerance = 0.0001
)
})
##############################################
test_that("4. dat3", {
expect_equal(
dim(EOF(dat3, lon = lon3, lat = lat3)$EOFs),
)
expect_equal(
dim(EOF(dat3, lon = lon3, lat = lat3)$PCs),
)
expect_equal(
dim(EOF(dat3, lon = lon3, lat = lat3)$var),
)
expect_equal(
dim(EOF(dat3, lon = lon3, lat = lat3)$mask),
c(lat = 6, lon = 2, dat = 2)
)
expect_equal(
dim(EOF(dat3, lon = lon3, lat = lat3)$wght),
c(lat = 6, lon = 2)
)
expect_equal(
mean(EOF(dat3, lon = lon3, lat = lat3)$EOFs),
0.01214845,
tolerance = 0.0001
)
expect_equal(
EOF(dat3, lon = lon3, lat = lat3)$EOFs[1:5],
c(0.3292733, 0.1787016, -0.3801986, 0.1957160, -0.4377031),
tolerance = 0.0001
)
expect_equal(
EOF(dat3, lon = lon3, lat = lat3)$tot_var,
array(c(213.2422, 224.4203), dim = c(dat = 2)),
tolerance = 0.0001
)
})
##############################################