tests/testthat/test-roll.R

In roll: Rolling and Expanding Statistics

test_that("equal to online algorithm", {
  
  skip("long-running test")
  
  # test data
  test_roll_x <- c(lapply(test_ls, function(x){x[ , 1:3]}),
                   list("random vector with 0's and NA's" = test_ls[[3]][ , 1]))
  test_roll_y <- c(lapply(test_ls, function(x){x[ , 4:5]}),
                   list("random vector with 0's and NA's" = test_ls[[3]][ , 4]))
  test_roll_null <- c(test_roll_x, "null object" = list(NULL))
  
  if (requireNamespace("zoo", quietly = TRUE)) {
    names(test_roll_x[[4]]) <- zoo::index(test_roll_x[[1]])
    names(test_roll_y[[4]]) <- zoo::index(test_roll_y[[1]])
  }
  
  for (ax in 1:length(test_roll_x)) {
    for (b in 1:length(test_width)) {
      
      width <- test_width[b]
      test_weights <- list(lambda ^ ((2 * width):1))
      # test_weights <- list(rep(1, width), lambda ^ (width:1), 1:width,
      #                      rep(1, 2 * width), lambda ^ ((2 * width):1), 1:(width * 2))
      # test_weights <- lapply(test_weights, "-")
      # test_weights <- list(rep(0, width))
      
      for (c in 1:length(test_min_obs)) {
        for (d in 1:length(test_complete_obs)) {
          for (e in 1:length(test_na_restore)) {
            
            expect_equal(roll_any(test_roll_x[[ax]] < 0, width,
                                  test_min_obs[c], test_complete_obs[d],
                                  test_na_restore[e], test_online[1]),
                         roll_any(test_roll_x[[ax]] < 0, width,
                                  test_min_obs[c], test_complete_obs[d],
                                  test_na_restore[e], test_online[2]))
            
            expect_equal(roll_all(test_roll_x[[ax]] < 0, width,
                                  test_min_obs[c], test_complete_obs[d],
                                  test_na_restore[e], test_online[1]),
                         roll_all(test_roll_x[[ax]] < 0, width,
                                  test_min_obs[c], test_complete_obs[d],
                                  test_na_restore[e], test_online[2]))
            
            for (f in 1:length(test_weights)) {
              
              expect_equal(roll_sum(test_roll_x[[ax]], width,
                                    test_weights[[f]], test_min_obs[c],
                                    test_complete_obs[d], test_na_restore[e],
                                    test_online[1]),
                           roll_sum(test_roll_x[[ax]], width,
                                    test_weights[[f]], test_min_obs[c],
                                    test_complete_obs[d], test_na_restore[e],
                                    test_online[2]))

              expect_equal(roll_prod(test_roll_x[[ax]], width,
                                     test_weights[[f]], test_min_obs[c],
                                     test_complete_obs[d], test_na_restore[e],
                                     test_online[1]),
                           roll_prod(test_roll_x[[ax]], width,
                                     test_weights[[f]], test_min_obs[c],
                                     test_complete_obs[d], test_na_restore[e],
                                     test_online[2]))
              
              expect_equal(roll_mean(test_roll_x[[ax]], width,
                                     test_weights[[f]], test_min_obs[c],
                                     test_complete_obs[d], test_na_restore[e],
                                     test_online[1]),
                           roll_mean(test_roll_x[[ax]], width,
                                     test_weights[[f]], test_min_obs[c],
                                     test_complete_obs[d], test_na_restore[e],
                                     test_online[2]))
              
              expect_equal(roll_min(test_roll_x[[ax]], width,
                                    test_weights[[f]], test_min_obs[c],
                                    test_complete_obs[d], test_na_restore[e],
                                    test_online[1]),
                           roll_min(test_roll_x[[ax]], width,
                                    test_weights[[f]], test_min_obs[c],
                                    test_complete_obs[d], test_na_restore[e],
                                    test_online[2]))

              expect_equal(roll_max(test_roll_x[[ax]], width,
                                    test_weights[[f]], test_min_obs[c],
                                    test_complete_obs[d], test_na_restore[e],
                                    test_online[1]),
                           roll_max(test_roll_x[[ax]], width,
                                    test_weights[[f]], test_min_obs[c],
                                    test_complete_obs[d], test_na_restore[e],
                                    test_online[2]))

              expect_equal(roll_idxmin(test_roll_x[[ax]], width,
                                       test_weights[[f]], test_min_obs[c],
                                       test_complete_obs[d], test_na_restore[e],
                                       test_online[1]),
                           roll_idxmin(test_roll_x[[ax]], width,
                                       test_weights[[f]], test_min_obs[c],
                                       test_complete_obs[d], test_na_restore[e],
                                       test_online[2]))

              expect_equal(roll_idxmax(test_roll_x[[ax]], width,
                                       test_weights[[f]], test_min_obs[c],
                                       test_complete_obs[d], test_na_restore[e],
                                       test_online[1]),
                           roll_idxmax(test_roll_x[[ax]], width,
                                       test_weights[[f]], test_min_obs[c],
                                       test_complete_obs[d], test_na_restore[e],
                                       test_online[2]))

              # "'online' is not supported"
              expect_equal(roll_median(test_roll_x[[ax]], width,
                                       test_weights[[f]], test_min_obs[c],
                                       test_complete_obs[d], test_na_restore[e],
                                       test_online[1]),
                           roll_median(test_roll_x[[ax]], width,
                                       test_weights[[f]], test_min_obs[c],
                                       test_complete_obs[d], test_na_restore[e],
                                       test_online[2]))
              
              for (g in 1:length(test_p)) {
                
                # "'online' is not supported"
                expect_equal(roll_quantile(test_roll_x[[ax]],  width,
                                           test_weights[[f]], test_p[[g]],
                                           test_min_obs[c], test_complete_obs[d],
                                           test_na_restore[e], test_online[1]),
                             roll_quantile(test_roll_x[[ax]], width,
                                           test_weights[[f]], test_p[[g]],
                                           test_min_obs[c], test_complete_obs[d],
                                           test_na_restore[e], test_online[2]))
                
              }
              
              for (g in 1:length(test_center)) {
                
                expect_equal(roll_var(test_roll_x[[ax]], width,
                                      test_weights[[f]], test_center[g],
                                      test_min_obs[c], test_complete_obs[d],
                                      test_na_restore[e], test_online[1]),
                             roll_var(test_roll_x[[ax]], width,
                                      test_weights[[f]], test_center[g],
                                      test_min_obs[c], test_complete_obs[d],
                                      test_na_restore[e], test_online[2]))
                
                expect_equal(roll_sd(test_roll_x[[ax]], width,
                                     test_weights[[f]], test_center[g],
                                     test_min_obs[c], test_complete_obs[d],
                                     test_na_restore[e], test_online[1]),
                             roll_sd(test_roll_x[[ax]], width,
                                     test_weights[[f]], test_center[g],
                                     test_min_obs[c], test_complete_obs[d],
                                     test_na_restore[e], test_online[2]))
                
                for (h in 1:length(test_scale)) {
                  
                  expect_equal(roll_scale(test_roll_x[[ax]], width,
                                          test_weights[[f]], test_center[g],
                                          test_scale[h], test_min_obs[c],
                                          test_complete_obs[d], test_na_restore[e],
                                          test_online[1]),
                               roll_scale(test_roll_x[[ax]], width,
                                          test_weights[[f]], test_center[g],
                                          test_scale[h], test_min_obs[c],
                                          test_complete_obs[d], test_na_restore[e],
                                          test_online[2]))
                  
                  for (ay in 1:length(test_roll_null)) {
                    
                    expect_equal(roll_cov(test_roll_x[[ax]], test_roll_null[[ay]],
                                          width, test_weights[[f]],
                                          test_center[g], test_scale[h],
                                          test_min_obs[c], test_complete_obs[d],
                                          test_na_restore[e], test_online[1]),
                                 roll_cov(test_roll_x[[ax]], test_roll_null[[ay]],
                                          width, test_weights[[f]],
                                          test_center[g], test_scale[h],
                                          test_min_obs[c], test_complete_obs[d],
                                          test_na_restore[e], test_online[2]))
                    
                    expect_equal(roll_cor(test_roll_x[[ax]], test_roll_null[[ay]],
                                          width, test_weights[[f]],
                                          test_center[g], test_scale[h],
                                          test_min_obs[c], test_complete_obs[d],
                                          test_na_restore[e], test_online[1]),
                                 roll_cor(test_roll_x[[ax]], test_roll_null[[ay]],
                                          width, test_weights[[f]],
                                          test_center[g], test_scale[h],
                                          test_min_obs[c], test_complete_obs[d],
                                          test_na_restore[e], test_online[2]))
                    
                    expect_equal(roll_crossprod(test_roll_x[[ax]], test_roll_null[[ay]],
                                                width, test_weights[[f]],
                                                test_center[g], test_scale[h],
                                                test_min_obs[c], test_complete_obs[d],
                                                test_na_restore[e], test_online[1]),
                                 roll_crossprod(test_roll_x[[ax]], test_roll_null[[ay]],
                                                width, test_weights[[f]],
                                                test_center[g], test_scale[h],
                                                test_min_obs[c], test_complete_obs[d],
                                                test_na_restore[e], test_online[2]))
                    
                  }
                  
                }
                
              }
              
              for (ay in 1:length(test_roll_y)) {
                for (g in 1:length(test_intercept)) {
                  
                  # "'complete_obs = FALSE' is not supported"
                  expect_equal(roll_lm(test_roll_x[[ax]], test_roll_y[[ay]],
                                       test_width[b], test_weights[[f]],
                                       test_intercept[g], test_min_obs[c],
                                       test_complete_obs[d], test_na_restore[e],
                                       test_online[1]),
                               roll_lm(test_roll_x[[ax]], test_roll_y[[ay]],
                                       test_width[b], test_weights[[f]],
                                       test_intercept[g], test_min_obs[c],
                                       test_complete_obs[d], test_na_restore[e],
                                       test_online[2]))
                  
                }
              }
              
            }
            
          }
        }
      }
      
    }
  }
  
})