context("s2dv::Corr tests")

##############################################
  # dat1: memb_dim is NULL
  set.seed(1)
  exp1 <- array(rnorm(240), dim = c(member = 1, dataset = 2, sdate = 5,
                                   ftime = 3, lat = 2, lon = 4))

  set.seed(2)
  obs1 <- array(rnorm(120), dim = c(member = 1, dataset = 1, sdate = 5,
                                   ftime = 3, lat = 2, lon = 4))
  set.seed(2)
  na <- floor(runif(10, min = 1, max = 120))
  obs1[na] <- NA

  # dat2: memb_dim = member
  set.seed(1)
  exp2 <- array(rnorm(180), dim = c(member = 3, dataset = 2, sdate = 5,
                                    lat = 2, lon = 3))

  set.seed(2)
  obs2 <- array(rnorm(30), dim = c(member = 1, dataset = 1, sdate = 5,
                                    lat = 2, lon = 3))

  exp2_2 <- exp2
  exp2_2[1, 1, 1, 1, 1] <- NA
  obs2_2 <- obs2
  obs2_2[1, 1, 1:3, 1, 1] <- NA

  # dat3: memb_dim = member, obs has multiple memb
  set.seed(1)
  exp3 <- array(rnorm(180), dim = c(member = 3, dataset = 2, sdate = 5,
                                    lat = 2, lon = 3))

  set.seed(2)
  obs3 <- array(rnorm(120), dim = c(member = 2, dataset = 2, sdate = 5,
                                    lat = 2, lon = 3))

  # dat4: exp and obs have dataset = 1 (to check the return array by small func)
  set.seed(1)
  exp4 <- array(rnorm(10), dim = c(member = 1, dataset = 1, sdate = 5,
                                    lat = 2))

  set.seed(2)
  obs4 <- array(rnorm(10), dim = c(member = 1, dataset = 1, sdate = 5,
                                    lat = 2))

  # dat5: exp and obs have memb_dim and dataset = NULL
  set.seed(1)
  exp5 <- array(rnorm(90), dim = c(member = 3, sdate = 5,
                                    lat = 2, lon = 3))

  set.seed(2)
  obs5 <- array(rnorm(30), dim = c(member = 1, sdate = 5,
                                    lat = 2, lon = 3))

  # dat6: exp and obs have memb_dim = NULL and dataset = NULL
  set.seed(1)
  exp6 <- array(rnorm(90), dim = c(sdate = 5, lat = 2, lon = 3))

  set.seed(2)
  obs6 <- array(rnorm(30), dim = c(sdate = 5, lat = 2, lon = 3))

  # dat7: exp and obs have memb_dim = NULL and dataset = 1
  set.seed(1)
  exp7 <- array(rnorm(90), dim = c(dataset = 1, sdate = 5, lat = 2, lon = 3))

  set.seed(2)
  obs7 <- array(rnorm(30), dim = c(dataset = 1, sdate = 5, lat = 2, lon = 3))

##############################################
test_that("1. Input checks", {

  expect_error(
  Corr(c(), c()),
  "Parameter 'exp' and 'obs' cannot be NULL."
  )
  expect_error(
  Corr(c('b'), c('a')),
  "Parameter 'exp' and 'obs' must be a numeric array."
  )
  expect_error(
  Corr(c(1:10), c(2:4)),
  paste0("Parameter 'exp' and 'obs' must be at least two dimensions ",
         "containing time_dim and dat_dim.")
  )
  expect_error(
  Corr(array(1:10, dim = c(2, 5)), array(1:4, dim = c(2, 2))),
  "Parameter 'exp' and 'obs' must have dimension names."
  )
  expect_error(
  Corr(array(1:10, dim = c(a = 2, c = 5)), array(1:4, dim = c(a = 2, b = 2))),
  "Parameter 'exp' and 'obs' must have same dimension name"
  )
  expect_error(
  Corr(exp1, obs1, dat_dim = 1),
  "Parameter 'dat_dim' must be a character string."
  )
  expect_error(
  Corr(exp1, obs1, dat_dim = 'a'),
  "Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension."
  )
  expect_error(
  Corr(exp1, obs1, time_dim = c('sdate', 'a')),
  "Parameter 'time_dim' must be a character string."
  )
  expect_error(
  Corr(exp1, obs1, time_dim = 'a'),
  "Parameter 'time_dim' is not found in 'exp' or 'obs' dimension."
  )
  expect_error(
  Corr(exp1, obs1, comp_dim = c('sdate', 'ftime')),
  "Parameter 'comp_dim' must be a character string."
  )
  expect_error(
  Corr(exp1, obs1, comp_dim = 'a'),
  "Parameter 'comp_dim' is not found in 'exp' or 'obs' dimension."
  )
  expect_error(
  Corr(exp1, obs1, limits = c(1,3)),
  "Paramter 'comp_dim' cannot be NULL if 'limits' is assigned."
  )
  expect_error(
  Corr(exp1, obs1, comp_dim = 'ftime', limits = c(1)),
  paste0("Parameter 'limits' must be a vector of two positive ",
                  "integers smaller than the length of paramter 'comp_dim'.")
  )
  expect_error(
  Corr(exp1, obs1, alpha = -1),
  "Parameter 'alpha' must be a numeric number between 0 and 1."
  )
  expect_error(
  Corr(exp1, obs1, method = 1),
  "Parameter 'method' must be one of 'kendall', 'spearman' or 'pearson'."
  )
  expect_error(
  Corr(exp1, obs1, memb_dim = 1),
  "Parameter 'memb_dim' must be a character string."
  )
  expect_error(
  Corr(exp1, obs1, memb_dim = 'memb'),
  "Parameter 'memb_dim' is not found in 'exp' or 'obs' dimension."
  )
  expect_error(
  Corr(exp2, obs2, memb_dim = 'member', memb = 1),
  "Parameter 'memb' must be one logical value."
  )
  expect_error(
  Corr(exp1, obs1, conf = 1),
  "Parameter 'conf' must be one logical value."
  )
  expect_error(
  Corr(exp1, obs1, pval = 'TRUE'),
  "Parameter 'pval' must be one logical value."
  )
  expect_error(
  Corr(exp1, obs1, ncores = 1.5),
  "Parameter 'ncores' must be a positive integer."
  )
  expect_error(
  Corr(exp = array(1:10, dim = c(sdate = 1, dataset = 5, a = 1)),
       obs = array(1:4, dim = c(a = 1, sdate = 2, dataset = 2))),
  "Parameter 'exp' and 'obs' must have same length of all dimension except 'dat_dim' and 'memb_dim'."
  )
  expect_error(
  Corr(exp = array(1:10, dim = c(sdate = 2, dataset = 5, a = 1)),
       obs = array(1:4, dim = c(a = 1, sdate = 2, dataset = 2))),
  "The length of time_dim must be at least 3 to compute correlation."
  )

})

##############################################
test_that("2. Output checks: dat1", {
suppressWarnings(
  expect_equal(
    dim(Corr(exp1, obs1)$corr),
    c(nexp = 2, nobs = 1, member = 1, ftime = 3, lat = 2, lon = 4)
  )
)
suppressWarnings(
  expect_equal(
    Corr(exp1, obs1)$corr[1:6],
    c(0.11503859, -0.46959987, -0.64113021, 0.09776572, -0.32393603, 0.27565829), 
    tolerance = 0.001
  )
)
suppressWarnings(
  expect_equal(
    length(which(is.na(Corr(exp1, obs1)$p.val))),
    2
  )
)
suppressWarnings(
  expect_equal(
    max(Corr(exp1, obs1)$conf.lower, na.rm = T),
    0.6332941,
    tolerance = 0.001
  )
)
suppressWarnings(
  expect_equal(
    length(which(is.na(Corr(exp1, obs1, comp_dim = 'ftime')$corr))),
    6
  )
)
suppressWarnings(
  expect_equal(
    length(which(is.na(Corr(exp1, obs1, comp_dim = 'ftime', limits = c(2, 3))$corr))),
    2
  )
)
suppressWarnings(
  expect_equal(
    min(Corr(exp1, obs1, alpha = 0.01)$conf.upper, na.rm = TRUE),
    0.2747904,
    tolerance = 0.0001
  )
)
suppressWarnings(
  expect_equal(
    length(Corr(exp1, obs1, conf = FALSE, pval = FALSE)),
    1
  )
)
suppressWarnings(
  expect_equal(
    length(Corr(exp1, obs1, conf = FALSE)),
    2
  )
)
suppressWarnings(
  expect_equal(
    length(Corr(exp1, obs1, pval = FALSE)),
    3
  )
)
suppressWarnings(
  expect_equal(
    Corr(exp1, obs1, method = 'spearman')$corr[1:6],
    c(-0.3, -0.4, -0.6, 0.3, -0.3, 0.2)
  )
)
suppressWarnings(
  expect_equal(
    range(Corr(exp1, obs1, method = 'spearman', comp_dim = 'ftime')$p.val, na.rm = T),
    c(0.0, 0.5),
    tolerance = 0.001
  )
)

})

##############################################
test_that("3. Output checks: dat2", {
  # individual member
  expect_equal(
    dim(Corr(exp2, obs2, memb_dim = 'member')$corr),
    c(nexp = 2, nobs = 1, exp_memb = 3, obs_memb = 1, lat = 2, lon = 3)
  )
  expect_equal(
    dim(Corr(exp2, obs2, memb_dim = 'member')$corr),
    dim(Corr(exp2, obs2, memb_dim = 'member')$p)
  )
  expect_equal(
    names(Corr(exp2, obs2, memb_dim = 'member')),
    c("corr", "p.val", "conf.lower", "conf.upper")
  )
  expect_equal(
    names(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE)),
    c("corr")
  )
  expect_equal(
    names(Corr(exp2, obs2, memb_dim = 'member', conf = FALSE)),
    c("corr", "p.val")
  )
  expect_equal(
    names(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE)),
    c("corr", "conf.lower", "conf.upper")
  )
  expect_equal(
    names(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, sign = T)),
    c("corr", "conf.lower", "conf.upper", "sign")
  )

  expect_equal(
    mean(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr),
    0.01645575,
    tolerance = 0.0001
  )
  expect_equal(
    median(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr),
    0.03024513,
    tolerance = 0.0001
  )
  expect_equal(
    max(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr),
    0.9327993,
    tolerance = 0.0001
  )
  expect_equal(
    min(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr),
    -0.9361258,
    tolerance = 0.0001
  )
  expect_equal(
    Corr(exp2, obs2, memb_dim = 'member', conf = FALSE)$p.val[1:5],
    c(0.24150854, 0.21790352, 0.04149139, 0.49851332, 0.19859843),
    tolerance = 0.0001
  )
  expect_equal(
    Corr(exp2, obs2, memb_dim = 'member', pval = FALSE)$conf.lower[1:5],
    c(-0.9500121, -0.9547642, -0.9883400, -0.8817478, -0.6879465),
    tolerance = 0.0001
  )
  expect_equal(
    which(Corr(exp2, obs2, memb_dim = 'member', pval = FALSE, conf = F, sign = T)$sign),
    c(3, 6, 12, 17, 23, 34)
  )

  # ensemble mean
  expect_equal(
    dim(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE)$corr),
    c(nexp = 2, nobs = 1, lat = 2, lon = 3)
  )
  expect_equal(
    mean(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr),
    0.02939929,
    tolerance = 0.0001
  )
  expect_equal(
    median(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr),
    0.03147432,
    tolerance = 0.0001
  )
  expect_equal(
    max(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr),
    0.8048901,
    tolerance = 0.0001
  )
  expect_equal(
    min(Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr),
    -0.6839388,
    tolerance = 0.0001
  )
  expect_equal(
    Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, conf = FALSE)$p.val[1:5],
    c(0.1999518, 0.2776874, 0.3255444, 0.2839667, 0.1264518),
    tolerance = 0.0001
  )
  expect_equal(
    Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE)$conf.lower[1:5],
    c(-0.9582891, -0.7668065, -0.9316879, -0.9410621, -0.5659657),
    tolerance = 0.0001
  )

  # exp2_2
  expect_equal(
    which(is.na(Corr(exp2_2, obs2_2, memb_dim = 'member', memb = FALSE, pval = FALSE)$corr)),
    1:2
  )
  expect_equal(
  Corr(exp2_2, obs2_2, memb_dim = 'member', memb = FALSE, pval = FALSE)$corr[-c(1:2)],
  Corr(exp2, obs2, memb_dim = 'member', memb = FALSE, pval = FALSE)$corr[-c(1:2)]
  )

})

##############################################
test_that("4. Output checks: dat3", {
  # individual member
  expect_equal(
    dim(Corr(exp3, obs3, memb_dim = 'member')$corr),
    c(nexp = 2, nobs = 2, exp_memb = 3, obs_memb = 2, lat = 2, lon = 3)
  )
  expect_equal(
    names(Corr(exp3, obs3, memb_dim = 'member')),
    c("corr", "p.val", "conf.lower", "conf.upper")
  )
  expect_equal(
    mean(Corr(exp3, obs3, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr),
    0.006468017,
    tolerance = 0.0001
  )
  expect_equal(
    median(Corr(exp3, obs3, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr),
    0.03662394,
    tolerance = 0.0001
  )
  expect_equal(
    max(Corr(exp3, obs3, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr),
    0.9798228,
    tolerance = 0.0001
  )
  expect_equal(
    min(Corr(exp3, obs3, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr),
    -0.9464891,
    tolerance = 0.0001
  )

  # ensemble mean
  expect_equal(
    dim(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE)$corr),
    c(nexp = 2, nobs = 2, lat = 2, lon = 3)
  )
  expect_equal(
    mean(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr),
    -0.01001896,
    tolerance = 0.0001
  )
  expect_equal(
    median(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr),
    -0.01895816,
    tolerance = 0.0001
  )
  expect_equal(
    max(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr),
    0.798233,
    tolerance = 0.0001
  )
  expect_equal(
    min(Corr(exp3, obs3, memb_dim = 'member', memb = FALSE, pval = FALSE, conf = FALSE)$corr),
    -0.6464809,
    tolerance = 0.0001
  )
})

##############################################
test_that("5. Output checks: dat4", {
  # no member
  expect_equal(
    dim(Corr(exp4, obs4)$corr),
    c(nexp = 1, nobs = 1, member = 1, lat = 2)
  )
  # individual member
  expect_equal(
    dim(Corr(exp4, obs4, memb_dim = 'member')$corr),
    c(nexp = 1, nobs = 1, exp_memb = 1, obs_memb = 1, lat = 2)
  )
  # ensemble
  expect_equal(
    dim(Corr(exp4, obs4, memb_dim = 'member', memb = FALSE)$corr),
    c(nexp = 1, nobs = 1, lat = 2)
  )

})

##############################################
test_that("6. Output checks: dat5", {
  expect_equal(
    dim(Corr(exp5, obs5, dat_dim = NULL, memb_dim = 'member')$corr),
    c(exp_memb = 3, obs_memb = 1, lat = 2, lon = 3)
  )
  expect_equal(
    names(Corr(exp5, obs5, dat_dim = NULL, memb_dim = 'member')),
    c("corr", "p.val", "conf.lower", "conf.upper")
  )
  expect_equal(
    names(Corr(exp5, obs5, dat_dim = NULL, memb_dim = 'member', pval = FALSE, conf = FALSE)),
    c("corr")
  )
  expect_equal(
    mean(Corr(exp5, obs5, dat_dim = NULL, memb_dim = 'member', pval = FALSE, conf = FALSE)$corr),
    0.1880204,
    tolerance = 0.0001
  )
})
##############################################
test_that("7. Output checks: dat6", {
  expect_equal(
    dim(Corr(exp6, obs6, dat_dim = NULL, memb_dim = NULL)$corr),
    c(lat = 2, lon = 3)
  )
  expect_equal(
    names(Corr(exp6, obs6, dat_dim = NULL, memb_dim = NULL)),
    c("corr", "p.val", "conf.lower", "conf.upper")
  )
  expect_equal(
    names(Corr(exp6, obs6, dat_dim = NULL, memb_dim = NULL, pval = FALSE, conf = FALSE)),
    c("corr")
  )
  expect_equal(
    mean(Corr(exp6, obs6, dat_dim = NULL, memb_dim = NULL, pval = FALSE, conf = FALSE)$corr),
    0.1084488,
    tolerance = 0.0001
  )
  # kendall
  expect_equal(
  as.vector(Corr(exp6, obs6, dat_dim = NULL, memb_dim = NULL, method = 'kendall')$corr[2:4]),
  c(0.0, 0.6, 0.2),
  tolerance = 0.0001
  )
  expect_equal(
  as.vector(Corr(exp6, obs6, dat_dim = NULL, memb_dim = NULL, method = 'kendall')$p[2:4]),
  c(0.5000000, 0.1423785, 0.3735300),
  tolerance = 0.0001
  )
  expect_equal(
  as.vector(Corr(exp6, obs6, dat_dim = NULL, memb_dim = NULL, method = 'kendall')$conf.low[2:4]),
  c(-0.8822664, -0.5997500, -0.8284490),
  tolerance = 0.0001
  )

})
##############################################
test_that("8. Output checks: dat6 and dat7", {
  expect_equal(
    mean(Corr(exp6, obs6, dat_dim = NULL, memb_dim = NULL, pval = FALSE, conf = FALSE)$corr),
    mean(Corr(exp7, obs7, memb_dim = NULL, pval = FALSE, conf = FALSE)$corr),
    tolerance = 0.0001
  )
})
##############################################
