context("s2dv::ResidualCorr tests")

##############################################

# dat1
set.seed(1)
exp1 <- array(rnorm(180), dim = c(lat = 3, lon = 2, memb = 3, sdate = 10))
set.seed(2)
ref1 <- array(rnorm(120), dim = c(lat = 3, lon = 2, memb = 2, sdate = 10))
set.seed(3)
obs1 <- array(rnorm(60), dim = c(lat = 3, lon = 2, sdate = 10))
Neff1 <- array(rep(9:10, 3), dim = c(lat = 3, lon = 2))

# dat2
set.seed(1)
exp2 <- array(rnorm(10), dim = c(sdate = 10))
set.seed(2)
ref2 <- array(rnorm(10), dim = c(sdate = 10))
set.seed(3)
obs2 <- array(rnorm(10), dim = c(sdate = 10))



##############################################
test_that("1. Input checks", {
  # exp and obs (1)
  expect_error(
  ResidualCorr(c()),
  'Parameter "exp" must be a numeric array.'
  )
  expect_error(
  ResidualCorr(exp1, obs1, c('a')),
  'Parameter "ref" must be a numeric array.'
  )
  expect_error(
  ResidualCorr(exp1, c()),
  'Parameter "obs" must be a numeric array.'
  )
  # N.eff
  expect_error(
  ResidualCorr(exp1, obs1, ref1, N.eff = array(1, dim = c(lat = 2, lon = 2))),
'If parameter "N.eff" is provided with an array, it must have the same dimensions as "obs" except "time_dim".'
  )
  expect_error(
  ResidualCorr(exp1, obs1, ref1, N.eff = 1:3),
  'Parameter "N.eff" must be NA, a numeric, or an array with the same dimensions as "obs" except "time_dim".'
  )
  # time_dim
  expect_error(
  ResidualCorr(exp1, obs1, ref1, time_dim = 1),
  'Parameter "time_dim" must be a character string.'
  )
  expect_error(
  ResidualCorr(exp1, obs1, ref1, time_dim = 'time'),
  "Parameter 'time_dim' is not found in 'exp', 'obs', or 'ref' dimension."
  )
  # memb_dim
  expect_error(
  ResidualCorr(exp1, obs1, ref1, memb_dim = TRUE),
  "Parameter 'memb_dim' must be a character string."
  )
  expect_error(
  ResidualCorr(exp1, obs1, ref1, memb_dim = 'member'),
  "Parameter 'memb_dim' is not found in 'exp' or 'ref' dimension."
  )
  # exp, ref, and obs (2)
  expect_error(
  ResidualCorr(exp1, obs1, array(1:10, dim = c(sdate = 10, memb = 1)), memb_dim = 'memb'),
  "Parameter 'exp', 'obs', and 'ref' must have same length of all dimensions except 'memb_dim'."
  )
  # method
  expect_error(
  ResidualCorr(exp1, obs1, ref1, method = 'asd', memb_dim = 'memb'),
  'Parameter "method" must be "pearson", "kendall", or "spearman".'
  )
  # alpha
  expect_error(
  ResidualCorr(exp2, obs2, ref2, alpha = 1),
  'Parameter "alpha" must be NULL or a number between 0 and 1.'
  )
  # handle.na
  expect_error(
  ResidualCorr(exp2, obs2, ref2, handle.na = TRUE),
  'Parameter "handle.na" must be "return.na", "only.complete.triplets" or "na.fail".'
  )
  # ncores
  expect_error(
  ResidualCorr(exp2, obs2, ref2, ncores = 1.5),
  'Parameter "ncores" must be either NULL or a positive integer.'
  )

})

##############################################
test_that("2. Output checks: dat1", {
expect_equal(
names(ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb')),
c("res.corr", "p.val")
)
expect_equal(
dim(ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb')$res.corr),
c(lat = 3, lon = 2)
)
expect_equal(
dim(ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb')$p.val),
c(lat = 3, lon = 2)
)
expect_equal(
as.vector(ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb')$res.corr),
c(0.002784318, 0.537697647, -0.240071018, 0.258706464, 0.338160748, 0.432107476),
tolerance = 0.0001
)
expect_equal(
as.vector(ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb')$p),
c(0.49695468, 0.05446055, 0.25203961, 0.23522967, 0.16960864, 0.10618145),
tolerance = 0.0001
)
expect_equal(
names(ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb', alpha = 0.05)),
c("res.corr", "sign")
)
expect_equal(
as.vector(ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb', alpha = 0.05)$res.corr),
c(0.002784318, 0.537697647, -0.240071018, 0.258706464, 0.338160748, 0.432107476),
tolerance = 0.0001
)
expect_equal(
as.vector(ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb', alpha = 0.05)$sign),
rep(FALSE, 6)
)
expect_equal(
as.vector(ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb', method = "kendall")$res),
c(0.11111111, 0.42222222, -0.20000000, 0.02222222, 0.20000000, 0.42222222),
tolerance = 0.0001
)
expect_equal(
as.vector(ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb', method = "kendall")$p),
c(0.3799615, 0.1120891, 0.2897920, 0.4757064, 0.2897920, 0.1120891),
tolerance = 0.0001
)
expect_equal(
as.vector(ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb', method = "spearman")$res),
c(0.13939394, 0.61212121, -0.27272727, 0.07878788, 0.28484848, 0.47878788),
tolerance = 0.0001
)
expect_equal(
as.vector(ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb', method = "spearman")$p),
c(0.35046594, 0.02998607, 0.22291917, 0.41435870, 0.21251908, 0.08076146),
tolerance = 0.0001
)


expect_equal(
as.vector(ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb', N.eff = Neff1)$res),
c(0.002784318, 0.537697647, -0.240071018, 0.258706464, 0.338160748, 0.432107476),
tolerance = 0.0001
)
expect_equal(
as.vector(ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb', N.eff = Neff1)$p),
c(0.49716394, 0.05446055, 0.26690777, 0.23522967, 0.18671025, 0.10618145),
tolerance = 0.0001
)


#---------------------------
exp1[1] <- NA
expect_equal(
as.vector(ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb')$res.corr),
c(NA, 0.537697647, -0.240071018, 0.258706464, 0.338160748, 0.432107476),
tolerance = 0.0001
)
expect_equal(
as.vector(ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb', handle.na = 'only.complete.triplets')$res.corr),
c(-0.1082588, 0.537697647, -0.240071018, 0.258706464, 0.338160748, 0.432107476),
tolerance = 0.0001
)
expect_error(
ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb', handle.na = 'na.fail'),
"The data contain NAs."
)

exp1[1,1,1,1:3] <- NA
ref1[1,1,1,4:8] <- NA
obs1[1,1,9:10] <- NA
expect_error(
ResidualCorr(exp1, obs1, ref1, memb_dim = 'memb', handle.na = 'only.complete.triplets'),
"There is no complete set of forecasts and observations."
)


})

##############################################

test_that("3. Output checks: dat2", {
expect_equal(
names(ResidualCorr(exp2, obs2, ref2)),
c("res.corr", "p.val")
)
expect_equal(
dim(ResidualCorr(exp2, obs2, ref2)$res.corr),
NULL
)
expect_equal(
dim(ResidualCorr(exp2, obs2, ref2)$p),
NULL
)
expect_equal(
ResidualCorr(exp2, obs2, ref2)$p,
0.2209847,
tolerance = 0.0001
)
expect_equal(
ResidualCorr(exp2, obs2, ref2)$res,
-0.274962,
tolerance = 0.0001
)

})
