context("s2dv::RPSS tests")

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

# dat1
set.seed(1)
exp1 <- array(rnorm(60), dim = c(member = 3, sdate = 10, lat = 2))
set.seed(2)
obs1 <- array(rnorm(20), dim = c(sdate = 10, lat = 2))
set.seed(3)
ref1 <- array(rnorm(40), dim = c(member = 2, sdate = 10, lat = 2))
set.seed(4)
weights1 <- array(abs(rnorm(30)), dim = c(member = 3, sdate = 10))

# dat2
set.seed(1)
exp2 <- array(rnorm(20), dim = c(member = 2, sdate = 10))
set.seed(2)
obs2 <- array(rnorm(10), dim = c(sdate = 10))
set.seed(2)
obs2_1 <- array(rnorm(10), dim = c(member = 1, sdate = 10))
set.seed(3)
ref2 <- array(rnorm(20), dim = c(member = 2, sdate = 10))
set.seed(4)
weights2 <- array(abs(rnorm(60)), dim = c(member = 2, sdate = 10))

# dat3
set.seed(1)
exp3 <- array(rnorm(60), dim = c(member = 2, sdate = 10, dataset = 3))
set.seed(2)
obs3 <- array(rnorm(20), dim = c(member = 1, sdate = 10, dataset = 2))
set.seed(3)
ref3 <- array(rnorm(60), dim = c(member = 2, sdate = 10, dataset = 3))
set.seed(4)
weights3 <- array(abs(rnorm(60)), dim = c(member = 2, sdate = 10, dataset = 3))

# dat4
set.seed(1)
exp4 <- array(rnorm(60), dim = c(member = 2, sdate = 10, dataset = 3, lat = 2))
set.seed(2)
obs4 <- array(rnorm(20), dim = c(member = 1, sdate = 10, dataset = 2, lat = 2))
set.seed(3)
ref4 <- array(rnorm(40), dim = c(member = 2, sdate = 10, lat = 2))
set.seed(4)
weights_exp4 <- array(abs(rnorm(60)), dim = c(member = 2, sdate = 10, dataset = 3))
set.seed(5)
weights_ref4 <- array(abs(rnorm(20)), dim = c(member = 2, sdate = 10))

##############################################
test_that("1. Input checks", {
  # exp and obs (1)
  expect_error(
    RPSS(c()),
    "Parameter 'exp' must be a numeric array."
  )
  expect_error(
    RPSS(exp1, c()),
    "Parameter 'obs' must be a numeric array."
  )

  # time_dim
  expect_error(
    RPSS(exp1, obs1, time_dim = 1),
    "Parameter 'time_dim' must be a character string."
  )
  expect_error(
    RPSS(exp1, obs1, time_dim = 'time'),
    "Parameter 'time_dim' is not found in 'exp' or 'obs' dimension."
  )
  expect_error(
    RPSS(exp2, obs2, array(rnorm(20), dim = c(member = 2, time = 10))),
    "Parameter 'time_dim' is not found in 'ref' dimension."
  )
  # memb_dim
  expect_error(
    RPSS(exp1, obs1, memb_dim = TRUE),
    "Parameter 'memb_dim' must be a character string."
  )
  expect_error(
    RPSS(exp1, obs1, memb_dim = 'memb'),
    "Parameter 'memb_dim' is not found in 'exp' dimension."
  )
  expect_error(
    RPSS(exp2, obs2, array(rnorm(20), dim = c(memb = 2, sdate = 10))),
    "Parameter 'memb_dim' is not found in 'ref' dimension."
  )
  # exp, ref, and obs (2)
  expect_error(
    RPSS(exp1, array(1:9, dim = c(sdate = 9))),
    "Parameter 'exp' and 'obs' must have same length of all dimensions except 'memb_dim' and 'dat_dim'."
  )
  expect_error(
    RPSS(exp3, obs3, array(rnorm(60), dim = c(member = 2, sdate = 10, dataset = 4)), dat_dim = 'dataset'),
    "If parameter 'ref' has dataset dimension, it must be equal to dataset dimension of 'exp'."
  )
  expect_error(
    RPSS(exp1, obs1, ref2),
    "Parameter 'exp' and 'ref' must have the same length of all dimensions except 'memb_dim' and 'dat_dim' if there is only one reference dataset."
  )
  # prob_thresholds
  expect_error(
    RPSS(exp1, obs1, ref1, prob_thresholds = 1),
    "Parameter 'prob_thresholds' must be a numeric vector between 0 and 1."
  )
  # indices_for_clim
  expect_error(
    RPSS(exp1, obs1, ref1, indices_for_clim = array(1:6, dim = c(2, 3))),
    "Parameter 'indices_for_clim' must be NULL or a numeric vector."
  )
  expect_error(
    RPSS(exp1, obs1, indices_for_clim = 3:11),
    "Parameter 'indices_for_clim' should be the indices of 'time_dim'."
  )
  # Fair
  expect_error(
    RPSS(exp1, obs1, Fair = 1),
    "Parameter 'Fair' must be either TRUE or FALSE."
  )
  # weights_exp and weights_ref
  expect_error(
    RPSS(exp1, obs1, weights_exp = c(0, 1)),
    "Parameter 'weights_exp' must be a named numeric array."
  )
  expect_error(
    RPSS(exp1, obs1, weights_exp = array(1, dim = c(member = 3, time = 10))),
    "Parameter 'weights_exp' must have two dimensions with the names of 'memb_dim' and 'time_dim'."
  )
  expect_error(
    RPSS(exp1, obs1, ref1, weights_ref = array(1, dim = c(member = 3, sdate = 1))),
    "Parameter 'weights_ref' must have the same dimension lengths as 'memb_dim' and 'time_dim' in 'ref'."
  )
  expect_error(
    RPSS(exp3, obs3, dat_dim = 'dataset', weights_exp = weights1),
    "Parameter 'weights_exp' must have three dimensions with the names of 'memb_dim', 'time_dim' and 'dat_dim'."
  )
  expect_error(
    RPSS(exp4, obs4, ref4, dat_dim = 'dataset', weights_ref = weights1),
    "Parameter 'weights_ref' must have the same dimension lengths as 'memb_dim' and 'time_dim' in 'ref'."
  )
  # ncores
  expect_error(
    RPSS(exp2, obs2, ncores = 1.5),
    "Parameter 'ncores' must be either NULL or a positive integer."
  )

})

##############################################
test_that("2. Output checks: dat1", {

  expect_equal(
    names(RPSS(exp1, obs1)),
    c("rpss", "sign")
  )
  expect_equal(
    names(RPSS(exp1, obs1, ref1)),
    c("rpss", "sign")
  )
  expect_equal(
    dim(RPSS(exp1, obs1)$rpss),
    c(lat = 2)
  )
  expect_equal(
    dim(RPSS(exp1, obs1)$sign),
    c(lat = 2)
  )
  expect_equal(
    dim(RPSS(exp1, obs1, ref1)$rpss),
    c(lat = 2)
  )
  expect_equal(
    dim(RPSS(exp1, obs1, ref1)$sign),
    c(lat = 2)
  )
  # ref = NULL
  expect_equal(
    as.vector(RPSS(exp1, obs1)$rpss),
    c(0.15789474, -0.05263158),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(RPSS(exp1, obs1)$sign),
    c(FALSE, FALSE),
  )
  expect_equal(
    as.vector(RPSS(exp1, obs1, Fair = T)$rpss),
    c(0.5263158, 0.3684211),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(RPSS(exp1, obs1, indices_for_clim = 3:5)$rpss),
    c(-0.4062500, -0.1052632),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(RPSS(exp1, obs1, prob_thresholds = seq(0.1, 0.9, 0.1))$rpss),
    c(0.03030303, -0.14478114),
    tolerance = 0.0001
  )
  # ref = ref
  expect_equal(
    as.vector(RPSS(exp1, obs1, ref1)$rpss),
    c(0.5259259, 0.4771242),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(RPSS(exp1, obs1, ref1, weights_exp = weights1, weights_ref = weights1)$rpss),
    c(0.6596424, 0.4063579),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(RPSS(exp1, obs1, ref1)$sign),
    c(FALSE, FALSE)
  )
  expect_equal(
    as.vector(RPSS(exp1, obs1, ref1, Fair = T)$rpss),
    c(0.6000000, 0.6190476),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(RPSS(exp1, obs1, ref1, indices_for_clim = 3:5)$rpss),
    c(0.2857143, 0.4166667),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(RPSS(exp1, obs1, ref1, indices_for_clim = 3:5)$sign),
    c(FALSE, FALSE)
  )
  expect_equal(
    as.vector(RPSS(exp1, obs1, ref1, prob_thresholds = seq(0.1, 0.9, 0.1))$rpss),
    c(0.4754098, 0.3703704),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(RPSS(exp1, obs1, ref1, prob_thresholds = seq(0.1, 0.9, 0.1))$sign),
    c(T, F)
  )

})

##############################################
test_that("3. Output checks: dat2", {

  expect_equal(
    names(RPSS(exp2, obs2)),
    c("rpss", "sign")
  )
  expect_equal(
    names(RPSS(exp2, obs2, ref2)),
    c("rpss", "sign")
  )
  expect_equal(
    dim(RPSS(exp2, obs2)$rpss),
    NULL
  )
  expect_equal(
    dim(RPSS(exp2, obs2)$sign),
    NULL
  )
  expect_equal(
    dim(RPSS(exp2, obs2, ref2)$rpss),
    NULL
  )
  expect_equal(
    dim(RPSS(exp2, obs2, ref2)$sign),
    NULL
  )
  # ref = NULL
  expect_equal(
    as.vector(RPSS(exp2, obs2)$rpss),
    c(-0.7763158),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(RPSS(exp2, obs2)$sign),
    FALSE,
  )
  expect_equal(
    as.vector(RPSS(exp2, obs2, Fair = T)$rpss),
    c(-0.1842105),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(RPSS(exp2, obs2, indices_for_clim = 3:5)$rpss),
    -0.8984375,
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(RPSS(exp2, obs2, prob_thresholds = seq(0.1, 0.9, 0.1))$rpss),
    c(-0.7272727),
    tolerance = 0.0001
  )
  # ref = ref
  expect_equal(
    as.vector(RPSS(exp2, obs2, ref2)$rpss),
    0,
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(RPSS(exp2, obs2, ref2)$sign),
    FALSE
  )
  expect_equal(
    as.vector(RPSS(exp2, obs2, ref2, Fair = T)$rpss),
    0,
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(RPSS(exp2, obs2, ref2, indices_for_clim = 3:5)$rpss),
    0.03571429,
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(RPSS(exp2, obs2, ref2, indices_for_clim = 3:5)$sign),
    FALSE
  )
  expect_equal(
    as.vector(RPSS(exp2, obs2, ref2, prob_thresholds = seq(0.1, 0.9, 0.1))$rpss),
    0.06557377,
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(RPSS(exp2, obs2, ref2, prob_thresholds = seq(0.1, 0.9, 0.1))$sign),
    FALSE
  )
  expect_equal(
    RPSS(exp2, obs2),
    RPSS(exp2, obs2_1)
  )

})
##############################################
test_that("4. Output checks: dat3", {

  expect_equal(
    dim(RPSS(exp3, obs3, dat_dim = 'dataset')$rpss),
    c('nexp' = 3, 'nobs' = 2)
  )
  expect_equal(
    mean(RPSS(exp3, obs3, dat_dim = 'dataset')$rpss),
    c(-0.8157895),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(RPSS(exp3, obs3, dat_dim = 'dataset')$sign)[1:3],
    c(FALSE, FALSE, FALSE),
  )
  expect_equal(
    mean(RPSS(exp3, obs3, dat_dim = 'dataset', weights_exp = weights3, Fair = T)$rpss),
    c(-0.7015067),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(RPSS(exp3, obs3, dat_dim = 'dataset', weights_exp = weights3, Fair = T)$rpss),
    c(-0.7962495, -0.4511230, -0.8497759, -0.5538201, -1.1312592, -0.4268125),
    tolerance = 0.0001
  )
  expect_equal(
    mean(RPSS(exp3, obs3, ref3, dat_dim = 'dataset', weights_ref = weights3, Fair = T)$rpss),
    c(0.06145283),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(RPSS(exp3, obs3, ref3, dat_dim = 'dataset', weights_ref = weights3, Fair = T)$rpss),
    c(0.32938699, 0.29749323, -0.66130649, 0.09722641, 0.10193502, 0.20398179),
    tolerance = 0.0001
  )
  expect_equal(
    RPSS(exp3, obs3, ref3, dat_dim = 'dataset', weights_ref = weights3, Fair = T)$rpss[1, ],
    RPSS(exp3, obs3, ref2, dat_dim = 'dataset', weights_ref = weights2, Fair = T)$rpss[1, ]
  )
  expect_equal(
    RPSS(exp3, obs3, dat_dim = 'dataset')$rpss[1],
    RPSS(exp2, obs2)$rpss
  )
})

##############################################
test_that("5. Output checks: dat4", {

  expect_equal(
    dim(RPSS(exp4, obs4, ref4, dat_dim = 'dataset')$rpss),
    c('nexp' = 3, 'nobs' = 2, 'lat' = 2)
  )
  expect_equal(
    mean(RPSS(exp4, obs4, ref4, dat_dim = 'dataset', weights_exp = weights_exp4, weights_ref = weights_ref4)$rpss),
    c(-0.03715614),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(RPSS(exp4, obs4, ref4, dat_dim = 'dataset', weights_exp = weights_exp4, weights_ref = weights_ref4)$rpss[, , 2]),
    c(-0.22913563, 0.04784362, -0.15832178, 0.13330236, -0.05285335, 0.26871923),
    tolerance = 0.0001
  )
  expect_equal(
    RPSS(exp4, obs4, dat_dim = 'dataset', weights_exp = weights_exp4)$rpss[1],
    RPSS(exp2, obs2, weights_exp = weights2)$rpss
  )
  expect_equal(
    RPSS(exp4, obs4, dat_dim = 'dataset', weights_exp = weights_exp4)$rpss[, , 1],
    RPSS(exp3, obs3, weights_exp = weights3, dat_dim = 'dataset')$rpss
  )

})
