test-zoo.R
In roll: Rolling and Expanding Statistics

test_that("equivalent to zoo::rollapply", {
  
  skip("long-running test")
  
  if (!requireNamespace("zoo", quietly = TRUE)) {
    skip("zoo package required for this test")
  }
  
  # test data
  test_zoo_x <- c(lapply(test_ls[-3], function(x){x[ , 1:3]}),
                  list("random vector with 0's" = test_ls[[2]][ , 1]))
  test_zoo_y <- c(lapply(test_ls[-3], function(x){x[ , 4:5]}),
                  list("random vector with 0's" = test_ls[[2]][ , 4]))
  test_zoo_yy <- c(lapply(test_ls[-3], function(x){x[ , 4, drop = FALSE]}), # univariate 'y' for base::lm
                   list("random vector with 0's" = test_ls[[2]][ , 4]))
  
  for (ax in 1:length(test_zoo_x)) {
    for (b in 1:length(test_width)) {
      
      width <- test_width[b]     
      test_weights <- list(rep(1, width))
      
      for (i in 1:length(test_online)) {
        
        expect_equal(roll_any(test_zoo_x[[ax]] < 0, width,
                              test_min_obs[1], test_complete_obs[2],
                              test_na_restore[2], test_online[i]),
                     zoo::rollapplyr(test_zoo_x[[ax]] < 0, width = width,
                                     any, partial = TRUE))

        expect_equal(roll_all(test_zoo_x[[ax]] < 0, width,
                              test_min_obs[1], test_complete_obs[2],
                              test_na_restore[2], test_online[i]),
                     zoo::rollapplyr(test_zoo_x[[ax]] < 0, width = width,
                                     all, partial = TRUE))

        expect_equal(roll_sum(test_zoo_x[[ax]], width,
                              test_weights[[1]], test_min_obs[1],
                              test_complete_obs[2], test_na_restore[2],
                              test_online[i]),
                     zoo::rollapplyr(test_zoo_x[[ax]], width = width,
                                     sum, partial = TRUE))

        expect_equal(roll_prod(test_zoo_x[[ax]], width,
                               test_weights[[1]], test_min_obs[1],
                               test_complete_obs[2], test_na_restore[2],
                               test_online[i]),
                     zoo::rollapplyr(test_zoo_x[[ax]], width = width,
                                     prod, partial = TRUE))

        expect_equal(roll_mean(test_zoo_x[[ax]], width,
                               test_weights[[1]], test_min_obs[1],
                               test_complete_obs[2], test_na_restore[2],
                               test_online[i]),
                     zoo::rollapplyr(test_zoo_x[[ax]], width = width,
                                     mean, partial = TRUE))

        expect_equal(roll_min(test_zoo_x[[ax]], width,
                              test_weights[[1]], test_min_obs[1],
                              test_complete_obs[2], test_na_restore[2],
                              test_online[i]),
                     zoo::rollapplyr(test_zoo_x[[ax]], width = width,
                                     min, partial = TRUE))

        expect_equal(roll_max(test_zoo_x[[ax]], width,
                              test_weights[[1]], test_min_obs[1],
                              test_complete_obs[2], test_na_restore[2],
                              test_online[i]),
                     zoo::rollapplyr(test_zoo_x[[ax]], width = width,
                                     max, partial = TRUE))

        expect_equal(roll_idxmin(test_zoo_x[[ax]], width,
                                 test_weights[[1]], test_min_obs[1],
                                 test_complete_obs[2], test_na_restore[2],
                                 test_online[i]),
                     zoo::rollapplyr(test_zoo_x[[ax]], width = width,
                                     which.min, partial = TRUE))

        expect_equal(roll_idxmax(test_zoo_x[[ax]], width,
                                 test_weights[[1]], test_min_obs[1],
                                 test_complete_obs[2], test_na_restore[2],
                                 test_online[i]),
                     zoo::rollapplyr(test_zoo_x[[ax]], width = width,
                                     which.max, partial = TRUE))

        # "'online' is not supported"
        expect_equal(roll_median(test_zoo_x[[ax]], width,
                                 test_weights[[1]], test_min_obs[1],
                                 test_complete_obs[2], test_na_restore[2],
                                 test_online[i]),
                     zoo::rollapplyr(test_zoo_x[[ax]], width = width,
                                     median, partial = TRUE))

        for (g in 1:length(test_p)) {

          # "'online' is not supported"
          expect_equal(roll_quantile(test_zoo_x[[ax]], width,
                                     test_weights[[1]], test_p[[g]],
                                     test_min_obs[1], test_complete_obs[2],
                                     test_na_restore[2], test_online[i]),
                       zoo::rollapplyr(test_zoo_x[[ax]], width = width,
                                       quantile, probs = test_p[[g]],
                                       type = 2, names = FALSE,
                                       partial = TRUE))

        }

        expect_equal(roll_var(test_zoo_x[[ax]], width,
                              test_weights[[1]], test_center[1],
                              test_min_obs[1], test_complete_obs[2],
                              test_na_restore[2], test_online[i]),
                     zoo::rollapplyr(test_zoo_x[[ax]], width = width,
                                     var, partial = TRUE))

        expect_equal(roll_sd(test_zoo_x[[ax]], width,
                             test_weights[[1]], test_center[1],
                             test_min_obs[1], test_complete_obs[2],
                             test_na_restore[2], test_online[i]),
                     zoo::rollapplyr(test_zoo_x[[ax]], width = width,
                                     sd, partial = TRUE))

        for (g in 1:length(test_center)) {
          for (h in 1:length(test_scale)) {

            expect_equal(roll_scale(test_zoo_x[[ax]], width,
                                    test_weights[[1]], test_center[g],
                                    test_scale[h], test_min_obs[1],
                                    test_complete_obs[2], test_na_restore[2],
                                    test_online[i]),
                         zoo::rollapplyr(test_zoo_x[[ax]], width = width,
                                         scale_z, center = test_center[g],
                                         scale = test_scale[h], partial = TRUE))

          }
        }

        for (ay in 1:length(test_zoo_y)) {

          expect_equal(roll_cov(test_zoo_x[[ax]], test_zoo_y[[ay]],
                                width, test_weights[[1]],
                                test_center[1], test_scale[2],
                                test_min_obs[1], test_complete_obs[2],
                                test_na_restore[2], test_online[i]),
                       rollapplyr_cube(cov, test_zoo_x[[ax]],
                                       test_zoo_y[[ay]], width))

          # "the standard deviation is zero"
          expect_equal(roll_cor(test_zoo_x[[ax]], test_zoo_y[[ay]],
                                width, test_weights[[1]],
                                test_center[1], test_scale[1],
                                test_min_obs[1], test_complete_obs[2],
                                test_na_restore[2], test_online[i]),
                       rollapplyr_cube(cor, test_zoo_x[[ax]],
                                       test_zoo_y[[ay]], width))

          expect_equal(roll_crossprod(test_zoo_x[[ax]], test_zoo_y[[ay]],
                                      width, test_weights[[1]],
                                      test_center[2], test_scale[2],
                                      test_min_obs[1], test_complete_obs[2],
                                      test_na_restore[2], test_online[i]),
                       rollapplyr_cube(crossprod_scale, test_zoo_x[[ax]],
                                       test_zoo_y[[ay]], width))

        }
        
        for (ay in 1:length(test_zoo_yy)) {
          for (g in 1:length(test_intercept)) {
            
            # "essentially perfect fit: summary may be unreliable"
            # "'complete_obs = FALSE' is not supported"
            expect_equal(roll_lm(test_zoo_x[[ax]], test_zoo_yy[[ay]],
                                 width, test_weights[[1]],
                                 test_intercept[g], test_min_obs[1],
                                 test_complete_obs[2], test_na_restore[2],
                                 test_online[i]),
                         rollapplyr_lm(test_zoo_x[[ax]], test_zoo_yy[[ay]],
                                       width, test_intercept[g]))
            
          }
        }
        
      }
      
    }
  }
  
})