context("s2dv::CRPSS 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))

# 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(3)
ref2 <- array(rnorm(20), dim = c(member = 2, sdate = 10))

# dat2_2
set.seed(1)
exp2_2 <- array(rnorm(20), dim = c(member = 2, sdate = 10, dataset = 1))
set.seed(2)
obs2_2 <- array(rnorm(10), dim = c(sdate = 10, dataset = 1))
set.seed(3)
ref2_2 <- array(rnorm(20), dim = c(member = 2, sdate = 10, dataset = 1))

# 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))

# 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(60), dim = c(member = 2, sdate = 10, lat = 2))

# dat5
set.seed(1)
exp5 <- array(rnorm(60), dim = c(member = 2, sdate = 10, dataset = 3))
set.seed(2)
obs5 <- array(rnorm(20), dim = c(member = 1, sdate = 10, dataset = 2))

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

  # time_dim
  expect_error(
   CRPSS(exp1, obs1, time_dim = 1),
    "Parameter 'time_dim' must be a character string."
  )
  expect_error(
   CRPSS(exp1, obs1, time_dim = 'time'),
    "Parameter 'time_dim' is not found in 'exp' or 'obs' dimension."
  )
  expect_error(
   CRPSS(exp2, obs2, array(rnorm(20), dim = c(member = 2, time = 10))),
    "Parameter 'time_dim' is not found in 'ref' dimension."
  )
  # memb_dim
  expect_error(
   CRPSS(exp1, obs1, memb_dim = TRUE),
    "Parameter 'memb_dim' must be a character string."
  )
  expect_error(
   CRPSS(exp1, obs1, memb_dim = 'memb'),
    "Parameter 'memb_dim' is not found in 'exp' dimension."
  )
  expect_error(
   CRPSS(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(
   CRPSS(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(
   CRPSS(exp2_2, obs2_2, array(1:9, dim = c(sdate = 9, member = 2, dataset = 3)), dat_dim = 'dataset'),
    "If parameter 'ref' has 'dat_dim' dimension it must be equal to 'dat_dim' dimension of 'exp'."
  )
  expect_error(
   CRPSS(exp1, obs1, ref2),
    "Parameter 'exp' and 'ref' must have same length of all dimensions except 'memb_dim' and 'dat_dim'."
  )
  expect_error(
   CRPSS(exp3, array(rnorm(60), dim = c(member = 2, sdate = 10, dataset = 3)), ref3, dat_dim = 'dataset'),
    "Not implemented for observations with members ('obs' can have 'memb_dim', but it should be of length=1)."
    , fixed = TRUE
  )
  # Fair
  expect_error(
   CRPSS(exp1, obs1, Fair = 1),
    "Parameter 'Fair' must be either TRUE or FALSE."
  )
  # ncores
  expect_error(
   CRPSS(exp2, obs2, ncores = 1.5),
    "Parameter 'ncores' must be either NULL or a positive integer."
  )

})

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

  expect_equal(
    names(CRPSS(exp1, obs1)),
    c("crpss", "sign")
  )
  expect_equal(
    names(CRPSS(exp1, obs1, ref1)),
    c("crpss", "sign")
  )
  expect_equal(
    dim(CRPSS(exp1, obs1)$crpss),
    c(lat = 2)
  )
  expect_equal(
    dim(CRPSS(exp1, obs1)$sign),
    c(lat = 2)
  )
  expect_equal(
    dim(CRPSS(exp1, obs1, ref1)$crpss),
    c(lat = 2)
  )
  expect_equal(
    dim(CRPSS(exp1, obs1, ref1)$sign),
    c(lat = 2)
  )
  # ref = NULL
  expect_equal(
    as.vector(CRPSS(exp1, obs1)$crpss),
    c(-0.1582765, -0.2390707),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(CRPSS(exp1, obs1)$sign),
    c(FALSE, FALSE),
  )
  expect_equal(
    as.vector(CRPSS(exp1, obs1, Fair = T)$crpss),
    c(0.07650872, -0.09326681),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(CRPSS(exp1, obs1)$crpss),
    c(-0.1582765, -0.2390707),
    tolerance = 0.0001
  )
  # ref = ref
  expect_equal(
    as.vector(CRPSS(exp1, obs1, ref1)$crpss),
    c(0.3491793, 0.3379610),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(CRPSS(exp1, obs1, ref1)$sign),
    c(FALSE, FALSE)
  )
  expect_equal(
    as.vector(CRPSS(exp1, obs1, ref1, Fair = T)$crpss),
    c( 0.3901440, 0.3788467),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(CRPSS(exp1, obs1, ref1)$crpss),
    c( 0.3491793, 0.3379610),
    tolerance = 0.0001
  )

})

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

  expect_equal(
    names(CRPSS(exp2, obs2)),
    c("crpss", "sign")
  )
  expect_equal(
    names(CRPSS(exp2, obs2, ref2)),
    c("crpss", "sign")
  )
  expect_equal(
    dim(CRPSS(exp2, obs2)$crpss),
    NULL
  )
  expect_equal(
    dim(CRPSS(exp2, obs2)$sign),
    NULL
  )
  expect_equal(
    dim(CRPSS(exp2, obs2, ref2)$crpss),
    NULL
  )
  expect_equal(
    dim(CRPSS(exp2, obs2, ref2)$sign),
    NULL
  )
  # ref = NULL
  expect_equal(
    as.vector(CRPSS(exp2, obs2)$crpss),
    c(-0.8209236),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(CRPSS(exp2, obs2)$crpss),
    as.vector(CRPSS(exp2_2, obs2_2, dat_dim = 'dataset')$crpss),
    tolerance = 0.0001
  )

  expect_equal(
    as.vector(CRPSS(exp2, obs2)$sign),
    TRUE,
  )
  expect_equal(
    as.vector(CRPSS(exp2, obs2, Fair = T)$crpss),
    c(-0.468189),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(CRPSS(exp2, obs2, Fair = T)$crpss),
    as.vector(CRPSS(exp2_2, obs2_2, dat_dim = 'dataset', Fair = T)$crpss),
    tolerance = 0.0001
  )
  # ref = ref
  expect_equal(
    as.vector(CRPSS(exp2, obs2, ref2)$crpss),
    -0.02315361,
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(CRPSS(exp2, obs2, ref2)$crpss),
    as.vector(CRPSS(exp2_2, obs2_2, ref2_2, dat_dim = 'dataset')$crpss),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(CRPSS(exp2, obs2, ref2)$sign),
    FALSE
  )
  expect_equal(
    as.vector(CRPSS(exp2, obs2, ref2, Fair = T)$crpss),
    0.030436,
    tolerance = 0.0001
  )

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

  expect_equal(
    dim(CRPSS(exp3, obs3, dat_dim = 'dataset')$crpss),
    c('nexp' = 3, 'nobs' = 2)
  )
  expect_equal(
    mean(CRPSS(exp3, obs3, dat_dim = 'dataset')$crpss),
    c(-0.7390546),
    tolerance = 0.0001
  )
  expect_equal(
    as.vector(CRPSS(exp3, obs3, dat_dim = 'dataset')$sign)[1:3],
    c(FALSE, FALSE, FALSE),
  )
  expect_equal(
    mean(CRPSS(exp3, obs3, dat_dim = 'dataset', Fair = T)$crpss),
    c(-0.5302703),
    tolerance = 0.0001
  )
})

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

  expect_equal(
    dim(CRPSS(exp4, obs4, ref4, dat_dim = 'dataset')$crpss),
    c('nexp' = 3, 'nobs' = 2, 'lat' = 2)
  )
  expect_equal(
   as.vector(CRPSS(exp2, obs2)$crpss),
   as.vector(CRPSS(exp3, obs3, dat_dim = 'dataset')$crpss[1])
  )

})
