context("CSTools::CST_BiasCorrection tests")

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

# dat1
mod <- 1 : (1 * 3 * 4 * 5 * 6 * 7)
obs <- 1 : (1 * 1 * 4 * 5 * 6 * 7)
dim(mod) <- c(dataset = 1, member = 3, sdate = 4, ftime = 5, 
                lat = 6, lon = 7)
dim(obs) <- c(dataset = 1, member = 1, sdate = 4, ftime = 5, 
                lat = 6, lon = 7)
lon <- seq(0, 30, 5)
lat <- seq(0, 25, 5)
exp <- list(data = mod, lat = lat, lon = lon)
obs <- list(data = obs, lat = lat, lon = lon)
attr(exp, 'class') <- 's2dv_cube'
attr(obs, 'class') <- 's2dv_cube'

exp1 <- list(data = array(1:20, dim = c(time = 20)))
class(exp1) <- 's2dv_cube'

obs1 <- list(data = array(1:20, dim = c(time = 20)))
class(obs1) <- 's2dv_cube'

exp1_2 <- list(data = array(1:20, dim = c(20)))
class(exp1_2) <- 's2dv_cube'

obs1_2 <- list(data = array(1:20, dim = c(20)))
class(obs1_2) <- 's2dv_cube'

exp_cor1 <- list(data = array(1:20, dim = c(20)))
class(exp_cor1) <- 's2dv_cube'

# dat2
exp2 <- exp
exp2$data[1, 2, 1, 1, 1, 1] <- NA
obs2 <- obs
obs2$data[1, 1, 2, 1, 1, 1] <- NA

# dat3
exp3 <- array(1:6, c(sdate = 3, member = 2))
obs3 <- array(3:6, c(sdate = 3, member = 1))
obs3_2 <- array(3:6, c(sdate = 3))
obs3_3 <- array(3:6, c(sdate = 3, member = 2))

# dat4
exp4 <- array(1:100, dim = c(time = 5, members = 5, lat = 2, lon = 5))
obs4 <- array(1:200, dim = c(time = 5, members = 1, lat = 2, lon = 5))
obs4_1 <- obs4
obs4_1[1,1,1,1] <- NA

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

test_that("1. Input checks", {
  # s2dv_cube
  expect_error(
    CST_BiasCorrection(exp = 1),
    paste0("Parameter 'exp' and 'obs' must be of the class 's2dv_cube', ",
         "as output by CSTools::CST_Load.")
  )
  expect_error(
    CST_BiasCorrection(exp = exp, obs = 1),
    paste0("Parameter 'exp' and 'obs' must be of the class 's2dv_cube', ",
           "as output by CSTools::CST_Load.")
  )
  expect_error(
    CST_BiasCorrection(exp = exp1),
    'argument "obs" is missing, with no default'
  )
  expect_error(
    CST_BiasCorrection(exp = exp1, obs = obs1, exp_cor = 1),
    paste0("Parameter 'exp_cor' must be of the class 's2dv_cube', as output ",
    "by CSTools::CST_Load.")
  )
  # exp and obs
  expect_error(
    CST_BiasCorrection(exp = exp1_2, obs = obs1),
    "Parameter 'exp' must have dimension names."
  )
  expect_error(
    CST_BiasCorrection(exp = exp1, obs = obs1_2),
    "Parameter 'obs' must have dimension names."
  )
  expect_warning(
    CST_BiasCorrection(exp = exp2, obs = obs2),
    "Parameter 'exp' contains NA values."
  )
  expect_warning(
    CST_BiasCorrection(exp = exp, obs = obs2),
    "Parameter 'obs' contains NA values."
  )
  expect_warning(
    CST_BiasCorrection(exp = exp2, obs = obs2),
    "Parameter 'obs' contains NA values",
    "Parameter 'exp' contains NA values."
    )
  # exp_cor
  expect_error(
    CST_BiasCorrection(exp = exp1, obs = obs1, exp_cor = exp_cor1, sdate_dim = 'time'),
    "Parameter 'exp_cor' must have dimension names."
  )
  # sdate_dim, memb_dim
  expect_error(
    CST_BiasCorrection(exp = exp1, obs = obs1, sdate_dim = 1),
    paste0("Parameter 'sdate_dim' must be a character string.")
  )
  expect_error(
    CST_BiasCorrection(exp = exp, obs = obs, sdate_dim = 'time'),
    paste0("Parameter 'sdate_dim' is not found in 'exp' or 'obs' dimension.")
  )
  expect_error(
    BiasCorrection(exp = array(1:20, dim = c(time = 1, member = 1)), 
                   obs = array(1:20, dim = c(time = 2, member = 1)), sdate_dim = 'time'),
    paste0("Parameter 'exp' must have dimension length of 'sdate_dim' bigger than 1.")
  )
  expect_error(
    CST_BiasCorrection(exp = exp1, obs = obs1, sdate_dim = 'time'),
    paste0("Parameter 'exp' requires 'sdate_dim' and 'memb_dim' dimensions.")
  )
  expect_error(
    BiasCorrection(exp = exp3, obs = obs3_3),
    paste0("If parameter 'obs' has dimension 'memb_dim' its length must be equal to 1.")
  )
  ## na.rm
  expect_warning(
    CST_BiasCorrection(exp = exp, obs = obs, na.rm = 1),
    "Paramater 'na.rm' must be a logical, it has been set to FALSE."
  )
  expect_warning(
    CST_BiasCorrection(exp = exp, obs = obs, na.rm = c(T,F)),
    "Paramter 'na.rm' has length greater than 1, and only the fist element is used."
  )
  # ncores
  expect_error(
    CST_BiasCorrection(exp = exp, obs = obs, ncores = TRUE),
    "Parameter 'ncores' must be either NULL or a positive integer."
  )
})

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

test_that("2. Output checks: dat1", {
  bc <- CST_BiasCorrection(exp = exp, obs = obs)
  expect_equal(
    length(bc),
    3
  )
  expect_equal(
    dim(bc$data),
    c(dataset = 1, member = 3, sdate = 4, ftime = 5, lat = 6, lon = 7)
  )
  expect_equal(
    bc$lat,
    lat
  )
  expect_equal(
    bc$lon,
    lon
  )
  expect_equal(
    round(BiasCorrection(exp = exp3, obs = obs3, exp_cor = exp3), 2), 
    array(c(2.66, 4.27, 3.2, 4.8, 3.73, 5.34), c(member = 2, sdate = 3))
  )
  expect_equal(
    round(BiasCorrection(exp = exp3, obs = obs3_2, exp_cor = exp3), 2),
    array(c(2.66, 4.27, 3.2, 4.8, 3.73, 5.34), c(member = 2, sdate = 3))
  )
  expect_equal(
    dim(BiasCorrection(exp = exp4, obs = obs4, sdate_dim = 'time', memb_dim = 'members')),
    c(members = 5, time = 5, lat = 2, lon = 5)
  )
  suppressWarnings(
    expect_equal(
      sum(is.na(BiasCorrection(exp = exp4, obs = obs4_1, sdate_dim = 'time', memb_dim = 'members', na.rm = TRUE))),
      0
    )
  )
  suppressWarnings(
    expect_equal(
      sum(is.na(BiasCorrection(exp = exp4, obs = obs4_1, sdate_dim = 'time', memb_dim = 'members', na.rm = FALSE))),
      20
    )
  )
})
