test-Persistence.R

context("s2dv::Persistence tests")

##############################################
#dat1: year
set.seed(1)
dat1 <- rnorm(1 * 70 * 6 * 7)
dim(dat1) <- c(member = 1, time = 70, lat = 6, lon = 7)
dates1 <- seq(1920, 1989, 1)
start1 <- 1961
end1 <- 1990
res <- Persistence(obs1, dates = dates1, start = 1961, end = 1990, ft_start = 1,
                   nmemb = 40)

#dat2: day
dates2 <- seq(as.Date(ISOdate(1990, 1, 1)), as.Date(ISOdate(1990, 4, 1)) ,1)
set.seed(2)
dat2 <- rnorm(1 * length(dates2) * 6 * 7)
dim(dat2) <- c(member = 1, time = length(dates2), lat = 6, lon = 7)
start2 <- as.Date(ISOdate(1990, 2, 15))
end2 <-  as.Date(ISOdate(1990, 4, 1))
 
##############################################
test_that("1. Input checks", {

  expect_error(
  Persistence(c()),
  "Parameter 'data' cannot be NULL."
  )
  expect_error(
  Persistence(data = 'a'),
  "Parameter 'data' must be a numeric array."
  )
  expect_error(
  Persistence(data = array(1:10, dim = c(2, 5))),
  "Parameter 'data' must have dimension names."
  )
  expect_error(
  Persistence(data = dat1, dates = dates1, time_dim = 12),
  "Parameter 'time_dim' must be a character string."
  )
  expect_error(
  Persistence(data = dat1, dates = dates1, time_dim = 'ftime'),
  "Parameter 'time_dim' is not found in 'data' dimension."
  )
  expect_error(
  Persistence(data = dat1, dates = c(1:10)),
  paste0("Parameter 'dates' must be a sequence of integer \\(YYYY\\) or ",
                "string \\(YYYY-MM-DD\\) in class 'Date'.")
  )
  expect_error(
  Persistence(data = dat1, dates = seq(1900, 2009, 1)),
  "Parameter 'dates' must have the same length as in 'time_dim'."
  )
  expect_error(
  Persistence(data = dat1, dates = dates1, start = start1, end = end2),
  "Parameter 'dates', 'start', and 'end' should be the same format."
  )
  # start
  expect_error(
  Persistence(data = dat1, dates = dates1, start = 1800, end = end1),
  paste0("Parameter 'start' must be an integer or a string in class ",
                  "'Date' between 1850 and 2020.")
  )
  expect_error(
  Persistence(data = dat1, dates = dates1, start = 1851, end = end1),
  "Parameter 'start' must be one of the values of 'dates'."
  )
  expect_error(
  Persistence(data = dat1, dates = dates1, start = 1921, end = end1),
  paste0("Parameter 'start' must start at least 40 time steps after ",
                  "the first 'dates'.")
  )
  # end
  expect_error(
  Persistence(data = dat2, dates = dates2, start = start2, end = as.Date(ISOdate(2021, 1, 1))),
  paste0("Parameter 'end' must be an integer or a string in class ",
                  "'Date' between 1850 and 2020.")
  )
  expect_error(
  Persistence(data = dat2, dates = dates2, start = start2, end = as.Date(ISOdate(1990, 4, 3))),
  paste0("Parameter 'end' must end at most 1 time steps after ",
                  "the last 'dates'.")
  )
  # ft_start
  expect_error(
  Persistence(data = dat1, dates = dates1, start = start1, end = end1, ft_start = 0.5),
  "Parameter 'ft_start' must be a positive integer."
  )
  # ft_end
  expect_error(
  Persistence(data = dat1, dates = dates1, start = start1, end = end1, ft_start = 1,
              ft_end = 12),
  "Parameter 'ft_end' must be a positive integer below 'max_ft'."
  )
  # max_ft
  expect_error(
  Persistence(data = dat1, dates = dates1, start = start1, end = end1, ft_start = 1,
              ft_end = 12, max_ft = 13.5),
  "Parameter 'max_ft' must be a positive integer."
  )
  # nmemb
  expect_error(
  Persistence(data = dat1, dates = dates1, start = start1, end = end1, ft_start = 1, nmemb = 0),
  "Parameter 'nmemb' must be a positive integer."
  )

  expect_error(
  Persistence(data = dat1, dates = dates1, start = start1, end = end1, ft_start = 1,
              na.action = T),
  paste0("Parameter 'na.action' must be a function for NA values or ",
         "a numeric indicating the number of NA values allowed ",
         "before returning NA.")
  )
  expect_error(
  Persistence(data = dat1, dates = dates1, start = start1, end = end1, ft_start = 1,
              ncores = 0),
  "Parameter 'ncores' must be a positive integer."
  )

})

##############################################
test_that("2. Output checks: dat1", {
  res <- Persistence(dat1, dates = dates1, start = start1, end = end1, ft_start = 1)

  expect_equal(
    names(res),
    c('persistence', 'persistence.mean', 'persistence.predint', 'AR.slope',
      'AR.intercept', 'AR.lowCI', 'AR.highCI')
  )
  expect_equal(
    dim(res$persistence),
    c(realization = 1, time = 30, member = 1, lat = 6, lon = 7)
  )
  expect_equal(
    dim(res$persistence.mean),
    c(30, member = 1, lat = 6, lon = 7)
  )
})

##############################################
test_that("2. Output checks: dat1", {
  res <- Persistence(dat2, dates = dates2, start = start2, end = end2, ft_start = 1)

  expect_equal(
    names(res),
    c('persistence', 'persistence.mean', 'persistence.predint', 'AR.slope',
      'AR.intercept', 'AR.lowCI', 'AR.highCI')
  )
  expect_equal(
    dim(res$persistence),
    c(realization = 1, time = 46, member = 1, lat = 6, lon = 7)
  )
})