|
| 1 | +# Loading |
| 2 | +library(tidyverse) |
| 3 | +library(covidcast) |
| 4 | +library(delphi.epidata) |
| 5 | +library(epiprocess) |
| 6 | +library(tidymodels) |
| 7 | + |
| 8 | +# Taken from example-recipe |
| 9 | +x <- covidcast( |
| 10 | + data_source = "jhu-csse", |
| 11 | + signals = "confirmed_7dav_incidence_prop", |
| 12 | + time_type = "day", |
| 13 | + geo_type = "state", |
| 14 | + time_values = epirange(20200301, 20211231), |
| 15 | + geo_values = "*" |
| 16 | +) %>% |
| 17 | + fetch_tbl() %>% |
| 18 | + select(geo_value, time_value, case_rate = value) |
| 19 | + |
| 20 | +y <- covidcast( |
| 21 | + data_source = "jhu-csse", |
| 22 | + signals = "deaths_7dav_incidence_prop", |
| 23 | + time_type = "day", |
| 24 | + geo_type = "state", |
| 25 | + time_values = epirange(20200301, 20211231), |
| 26 | + geo_values = "*" |
| 27 | +) %>% |
| 28 | + fetch_tbl() %>% |
| 29 | + select(geo_value, time_value, death_rate = value) |
| 30 | + |
| 31 | +x <- x %>% |
| 32 | + full_join(y, by = c("geo_value", "time_value")) %>% |
| 33 | + as_epi_df() |
| 34 | +rm(y) |
| 35 | + |
| 36 | +xx <- x %>% filter(time_value > "2021-12-01") |
| 37 | + |
| 38 | +slm_fit <- function(recipe, data = x) { |
| 39 | + workflow() %>% |
| 40 | + add_recipe(recipe) %>% |
| 41 | + add_model(linear_reg()) %>% |
| 42 | + fit(data = data) |
| 43 | +} |
| 44 | + |
| 45 | +# Tests |
| 46 | +test_that("Check that epi_ahead shifts properly", { |
| 47 | + r1 <- epi_recipe(x) %>% |
| 48 | + step_epi_ahead(death_rate, ahead = 7) %>% |
| 49 | + step_epi_lag(death_rate, lag = -7) %>% |
| 50 | + step_naomit(all_predictors()) %>% |
| 51 | + step_naomit(all_outcomes(), skip = TRUE) |
| 52 | + |
| 53 | + slm_fit1 <- slm_fit(r1) |
| 54 | + |
| 55 | + slope_ahead <- slm_fit1$fit$fit$fit$coefficients[[2]] |
| 56 | + expect_equal(slope_ahead,1) |
| 57 | +}) |
| 58 | + |
| 59 | +test_that("Check that epi_lag shifts properly", { |
| 60 | + r2 <- epi_recipe(x) %>% |
| 61 | + step_epi_ahead(death_rate, ahead = -7) %>% |
| 62 | + step_epi_lag(death_rate, lag = 7) %>% |
| 63 | + step_naomit(all_predictors()) %>% |
| 64 | + step_naomit(all_outcomes(), skip = TRUE) |
| 65 | + |
| 66 | + slm_fit2 <- slm_fit(r2) |
| 67 | + |
| 68 | + slope_lag <- slm_fit2$fit$fit$fit$coefficients[[2]] |
| 69 | + expect_equal(slope_lag,1) |
| 70 | +}) |
| 71 | + |
| 72 | +test_that("Check for non-integer values", { |
| 73 | + r3 <- epi_recipe(x) %>% |
| 74 | + step_epi_ahead(death_rate, ahead = 3.6) %>% |
| 75 | + step_epi_lag(death_rate, lag = 1.9) |
| 76 | + expect_error( |
| 77 | + slm_fit(r3) |
| 78 | + ) |
| 79 | +}) |
| 80 | + |
| 81 | +test_that("Check for duplicate values", { |
| 82 | + r4 <- epi_recipe(x) %>% |
| 83 | + step_epi_ahead(death_rate, ahead = 7) %>% |
| 84 | + step_epi_lag(death_rate, lag = 7) %>% |
| 85 | + step_epi_lag(death_rate, lag = 7) |
| 86 | + expect_error( |
| 87 | + slm_fit(r4) |
| 88 | + ) |
| 89 | +}) |
0 commit comments