context("s2dv::BrierScore tests")

##############################################
# dat1
set.seed(1)
exp1 <- array(runif(10), dim = c(dataset = 1, sdate = 5, ftime = 2))
set.seed(2)
obs1 <- array(round(runif(10)), dim = c(dataset = 1, sdate = 5, ftime = 2))

# dat2
set.seed(1)
exp2 <- runif(10)
set.seed(2)
obs2 <- round(runif(10))

# dat3
set.seed(1)
exp3 <- array(sample(c(0, 1), 60, replace = T),
              dim = c(dataset = 2, member = 3, sdate = 5, ftime = 2))
set.seed(2)
obs3 <- array(sample(c(0, 1), 10, replace = T),
              dim = c(dataset = 1, sdate = 5, ftime = 2))

##############################################
test_that("1. Input checks", {
  # exp and obs
  expect_error(
  BrierScore(exp1, c()),
  "Parameter 'exp' and 'obs' cannot be NULL."
  )
  expect_error(
  BrierScore(c('b'), obs1),
  "Parameter 'exp' and 'obs' must be a numeric vector or a numeric array."
  )
  expect_error(
  BrierScore(array(1:10, dim = c(2, 5)), array(1:4, dim = c(2, 2))),
  "Parameter 'exp' and 'obs' must have dimension names."
  )
  expect_error(
  BrierScore(exp = 1:10, obs = obs1),
  "Parameter 'exp' must be within \\[0, 1\\] range."
  )
  expect_error(
  BrierScore(exp = array(exp1, dim = dim(exp3)), obs = obs3, memb_dim = 'member'),
  "Parameter 'exp' must be 0 or 1 if it has memb_dim."
  )
  expect_error(
  BrierScore(exp1, runif(10)),
  "Parameter 'obs' must be binary events \\(0 or 1\\)."
  )
  expect_error( 
  BrierScore(exp3, obs3),
  paste0("Parameter 'exp' and 'obs' must have the same names and lengths ",
         "of all the dimensions except 'dat_dim' and 'memb_dim'.")
  )
  # thresholds
  expect_error(  
  BrierScore(exp2, obs2, thresholds = TRUE),
  "Parameter 'thresholds' must be a numeric vector."
  )
  expect_error(
  BrierScore(exp2, obs2, thresholds = seq(0, 1, length.out = 4)),
  "Parameter 'thresholds' must be between 0 and 1 as the bin-breaks."
  )
  # time_dim
  expect_error(
  BrierScore(exp2, obs2, time_dim = 1),
  "Parameter 'time_dim' must be a character string."
  )
  expect_error(
  BrierScore(exp1, obs1, memb_dim = 'member', time_dim = 'time'),
  "Parameter 'time_dim' is not found in 'exp' and 'obs' dimension."
  )
  # dat_dim
  expect_error(
  BrierScore(exp1, obs1, dat_dim = 2),
  "Parameter 'dat_dim' must be a character string."
  )
  expect_error(
  BrierScore(exp1, obs1, dat_dim = 'dat'),
  "Parameter 'dat_dim' is not found in 'exp' and 'obs' dimension."
  )
  # memb_dim
  expect_error(
  BrierScore(exp2, obs2, memb_dim = 2),
  "Parameter 'memb_dim' must be a character string."
  )
  expect_error(
  BrierScore(exp2, obs2, memb_dim = 'ensemble'),
  "Parameter 'memb_dim' is not found in 'exp' dimension."
  )
  expect_error(
  BrierScore(exp3, array(1, dim = c(dataset = 1, member = 3, sdate = 5, ftime = 2)), memb_dim = 'member'),
  "The length of parameter 'memb_dim' in 'obs' must be 1."
  )
  # ncores
  expect_error(
  BrierScore(exp2, obs2, ncores = 0),
  "Parameter 'ncores' must be a positive integer."
  )

})


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

expect_equal(
length(BrierScore(exp1, obs1)),
16
)
expect_equal(
names(BrierScore(exp1, obs1)),
c('rel', 'res', 'unc', 'bs', 'bs_check_res', 'bss_res', 'gres',
  'bs_check_gres', 'bss_gres', 'rel_bias_corrected', 'gres_bias_corrected',
  'unc_bias_corrected', 'bss_bias_corrected', 'nk', 'fkbar', 'okbar')
)
expect_equal(
dim(BrierScore(exp1, obs1)$rel),
c(dataset = 1, ftime = 2)
)
expect_equal(
BrierScore(exp1, obs1)$rel[1, ],
c(0.3086934, 0.3650011),
tolerance = 0.0001
)
expect_equal(
BrierScore(exp1, obs1)$res[1, ],
c(0.14, 0.14),
tolerance = 0.0001
)
expect_equal(
BrierScore(exp1, obs1)$bs[1, ],
c(0.4218661, 0.4587647),
tolerance = 0.0001
)
expect_equal(
dim(BrierScore(exp1, obs1)$okbar),
c(bin = 10, dataset = 1, ftime = 2)
)
expect_equal(
BrierScore(exp1, obs1)$okbar[, 1, 1],
c(NaN, NaN, 0.5,1.0, NaN, 1.0, NaN, NaN, NaN, 0.0)
)
expect_equal(
BrierScore(exp1, obs1)$fkbar[, 1, 1],
c(NaN, NaN, 0.2335953, 0.3721239, NaN, 0.5728534, NaN, NaN, NaN, 0.9082078),
tolerance = 0.0001
)
expect_equal(
BrierScore(exp1, obs1)$nk[, 1, 1],
c(0, 0, 2, 1, 0, 1, 0, 0, 0, 1)
)

expect_equal(
dim(BrierScore(exp1, obs1, dat_dim = 'dataset')$rel),
c(nexp = 1, nobs = 1, ftime = 2)
)
expect_equal(
dim(BrierScore(exp1, obs1, dat_dim = 'dataset')$nk),
c(nexp = 1, nobs = 1, bin = 10, ftime = 2)
)
expect_equal(
as.vector(BrierScore(exp1, obs1, dat_dim = 'dataset')$nk),
as.vector(BrierScore(exp1, obs1)$nk)
)
expect_equal(
as.vector(BrierScore(exp1, obs1, dat_dim = 'dataset')$bs),
as.vector(BrierScore(exp1, obs1)$bs)
)

})

##############################################
test_that("3. Output checks: dat2", {
expect_equal(
length(BrierScore(exp2, obs2)),
16
)
expect_equal(
dim(BrierScore(exp2, obs2))$bss,
NULL
)
expect_equal(
length(BrierScore(exp2, obs2)$bss_res),
1
)
expect_equal(
dim(BrierScore(exp2, obs2))$nk,
NULL
) 
expect_equal(
length(BrierScore(exp2, obs2)$nk),
10
)
expect_equal(
BrierScore(exp2, obs2)$bs,
0.4403154,
tolerance = 0.0001
)
expect_equal(
BrierScore(exp2, obs2)$gres_bias_corrected,
0.06313199,
tolerance = 0.0001
)
expect_equal(
BrierScore(exp2, obs2)$bss_bias_corrected,
-0.6511828,
tolerance = 0.0001
)
expect_equal(
as.vector(BrierScore(exp2, obs2)$nk),
c(1, 0, 2, 1, 0, 1, 2, 0, 1, 2)
)

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

expect_equal(
length(BrierScore(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset')),
16
)
expect_equal(
names(BrierScore(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset')),
c('rel', 'res', 'unc', 'bs', 'bs_check_res', 'bss_res', 'gres',
  'bs_check_gres', 'bss_gres', 'rel_bias_corrected', 'gres_bias_corrected',
  'unc_bias_corrected', 'bss_bias_corrected', 'nk', 'fkbar', 'okbar')
)
expect_equal(
dim(BrierScore(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset')$rel),
c(nexp = 2, nobs = 1, ftime = 2)
)
expect_equal(
BrierScore(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset')$rel[, 1, 2],
c(0.3555556, 0.2222222),
tolerance = 0.0001
)
expect_equal(
BrierScore(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset')$res[1, 1, ],
c(0.0000000, 0.1066667),
tolerance = 0.0001
)
expect_equal(
BrierScore(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset')$bs[2, 1, ],
c(0.3555556, 0.4222222),
tolerance = 0.0001
)
expect_equal(
dim(BrierScore(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset')$okbar),
c(nexp = 2, nobs = 1, bin = 10, ftime = 2)
)
expect_equal(
BrierScore(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset')$okbar[, 1, 1, 1],
c(NaN, 1)
)
expect_equal(
BrierScore(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset', thresholds = 1:2/3)$fkbar[2, 1, , 1],
c(0.0000000, 0.3333333, 0.6666667),
tolerance = 0.0001
)
expect_equal(
BrierScore(exp3, obs3, memb_dim = 'member', dat_dim = 'dataset', thresholds = 1:2/3)$nk[1, 1, , 1],
c(0, 5, 0)
)

})


