context("s2dv::DiffCorr 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(
  DiffCorr(c()),
  'Parameter "exp" must be a numeric array.'
  )
  expect_error(
  DiffCorr(exp1, c('a')),
  'Parameter "obs" must be a numeric array.'
  )
  expect_error(
  DiffCorr(exp1, obs1, c()),
  'Parameter "ref" must be a numeric array.'
  )
  # N.eff
  expect_error(
  DiffCorr(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(
  DiffCorr(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(
  DiffCorr(exp1, obs1, ref1, time_dim = 1),
  'Parameter "time_dim" must be a character string.'
  )
  expect_error(
  DiffCorr(exp1, obs1, ref1, time_dim = 'time'),
  "Parameter 'time_dim' is not found in 'exp', 'obs', or 'ref' dimension."
  )
  # memb_dim
  expect_error(
  DiffCorr(exp1, obs1, ref1, memb_dim = TRUE),
  "Parameter 'memb_dim' must be a character string."
  )
  expect_error(
  DiffCorr(exp1, obs1, ref1, memb_dim = 'member'),
  "Parameter 'memb_dim' is not found in 'exp' or 'ref' dimension."
  )
  # exp, ref, and obs (2)
  expect_error(
  DiffCorr(exp1, array(1:10, dim = c(sdate = 10, memb = 1)), ref1, memb_dim = 'memb'),
  "Parameter 'exp', 'obs', and 'ref' must have same length of all dimensions except 'memb_dim'."
  )
  # method
  expect_error(
  DiffCorr(exp1, obs1, ref1, method = 'asd', memb_dim = 'memb'),
  'Parameter "method" must be "pearson" or "spearman".'
  )
  expect_warning(
  DiffCorr(exp1, obs1, ref1, memb_dim = 'memb', method = 'spearman'),
  paste0("The test used in this function is built on Pearson method. ",
         "To verify if Spearman method is reliable, you can run the ",
         "Monte-Carlo simulations that are done in Siegert et al., 2017")
  )
  # alpha
  expect_error(
  DiffCorr(exp2, obs2, ref2, alpha = 1),
  'Parameter "alpha" must be NULL or a number between 0 and 1.'
  )
  # handle.na
  expect_error(
  DiffCorr(exp2, obs2, ref2, handle.na = TRUE),
  'Parameter "handle.na" must be "return.na", "only.complete.triplets" or "na.fail".'
  )
  # ncores
  expect_error(
  DiffCorr(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(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb')),
c("diff.corr", "p.val")
)
expect_equal(
dim(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb')$diff),
c(lat = 3, lon = 2)
)
expect_equal(
dim(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb')$p.val),
c(lat = 3, lon = 2)
)
expect_equal(
as.vector(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb')$diff),
c(0.27347087, 0.50556882, 0.08855968, 0.24199701, 0.22935182, 0.88336336),
tolerance = 0.0001
)
expect_equal(
as.vector(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb')$p),
c(0.26166060, 0.15899774, 0.39264452, 0.27959883, 0.34736305, 0.07479832),
tolerance = 0.0001
)
expect_equal(
names(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb', alpha = 0.05)),
c("diff.corr", "sign")
)
expect_equal(
as.vector(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb', alpha = 0.05)$diff.corr),
c(0.27347087, 0.50556882, 0.08855968, 0.24199701, 0.22935182, 0.88336336),
tolerance = 0.0001
)
expect_equal(
as.vector(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb', alpha = 0.05)$sign),
rep(FALSE, 6)
)
expect_equal(
suppressWarnings(as.vector(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb', method = "spearman")$diff.corr)),
c(0.07272727, 0.54545455, 0.10909091, -0.01212121, -0.03636364, 1.01818182),
tolerance = 0.0001
)
expect_equal(
suppressWarnings(as.vector(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb', method = "spearman")$p)),
c(0.4358970, 0.1341575, 0.3448977, 0.5114262, 0.5264872, 0.0437861),
tolerance = 0.0001
)
expect_equal(
as.vector(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb', N.eff = Neff1)$diff.corr),
c(0.27347087, 0.50556882, 0.08855968, 0.24199701, 0.22935182, 0.88336336),
tolerance = 0.0001
)
expect_equal(
as.vector(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb', N.eff = Neff1)$p),
c(0.27841537, 0.15899774, 0.40096749, 0.27959883, 0.35889690, 0.07479832),
tolerance = 0.0001
)


#---------------------------
exp1[1] <- NA
expect_equal(
as.vector(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb')$diff.corr),
c(NA, 0.50556882, 0.08855968, 0.24199701, 0.22935182, 0.88336336),
tolerance = 0.0001
)
expect_equal(
as.vector(DiffCorr(exp1, obs1, ref1, memb_dim = 'memb', handle.na = 'only.complete.triplets')$diff.corr),
c(0.17418065, 0.50556882, 0.08855968, 0.24199701, 0.22935182, 0.88336336),
tolerance = 0.0001
)
expect_error(
DiffCorr(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(
DiffCorr(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(DiffCorr(exp2, obs2, ref2)),
c("diff.corr", "p.val")
)
expect_equal(
dim(DiffCorr(exp2, obs2, ref2)$diff.corr),
NULL
)
expect_equal(
dim(DiffCorr(exp2, obs2, ref2)$p),
NULL
)
expect_equal(
DiffCorr(exp2, obs2, ref2)$p,
0.6577392,
tolerance = 0.0001
)
expect_equal(
DiffCorr(exp2, obs2, ref2)$diff,
-0.2434725,
tolerance = 0.0001
)

})
