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