From f1e7eafacaf508e90068409e39f1cea9c137ce0a Mon Sep 17 00:00:00 2001 From: Nathalie Vialaneix Date: Wed, 10 Jun 2020 12:51:05 +0200 Subject: [PATCH 1/3] fixed issue #42 --- R/predict.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/predict.R b/R/predict.R index 315f7ca..8254288 100644 --- a/R/predict.R +++ b/R/predict.R @@ -78,7 +78,8 @@ predict_cases <- function(cases = NULL, ## If horizon is supplied limit the rts to this date if (!is.null(horizon)) { - rts <- rts[date <= (forecast_date + lubridate::days(horizon))] + max_days <- lubridate::days(horizon) + rts <- rts[date <= (forecast_date + max_days)] } ## If no sampler given assume poisson From 55b96f7f274c880695153e2f7645f2f06924162e Mon Sep 17 00:00:00 2001 From: Nathalie Vialaneix Date: Wed, 10 Jun 2020 12:57:02 +0200 Subject: [PATCH 2/3] added new tests for forecast_cases() --- tests/testthat/test_forecast_cases.R | 51 +++++++++++++++++++++------- 1 file changed, 38 insertions(+), 13 deletions(-) diff --git a/tests/testthat/test_forecast_cases.R b/tests/testthat/test_forecast_cases.R index b2719bb..4cc9609 100644 --- a/tests/testthat/test_forecast_cases.R +++ b/tests/testthat/test_forecast_cases.R @@ -29,13 +29,13 @@ test_that("forecast_cases() output is of expected format", { expect_s3_class(out, c("tbl_df", "tbl", "data.frame")) expect_named(out, c("sample", "date", "cases", "horizon")) expect_equal(nrow(forecast), nrow(out)) - + # FIXME : recommended to preserve original order forecast <- forecast[ order(forecast$sample, forecast$date) ,] expect_equal(forecast$sample, out$sample) expect_equal(forecast$date, out$date) expect_equal(forecast$horizon, out$horizon) - + # FIXME : recommended to preserve column classes (sample casted from integer to numeric) }) @@ -45,31 +45,31 @@ test_that("forecast_cases() handles missing arguments as expected", { forecast_cases(), "is missing" ) - - # FIXME : recommended to print a more explicit message + + # FIXME : recommended to print a more explicit message expect_error( forecast_cases( fit_samples = forecast, serial_interval = EpiSoon::example_serial_interval ) ) - - # FIXME : recommended to print a more explicit message + + # FIXME : recommended to print a more explicit message expect_error( forecast_cases( cases = EpiSoon::example_obs_cases, serial_interval = EpiSoon::example_serial_interval ) ) - - # FIXME : recommended to print a more explicit message + + # FIXME : recommended to print a more explicit message expect_error( forecast_cases( cases = EpiSoon::example_obs_cases, fit_samples = forecast ) ) - + expect_identical( { set.seed(42) @@ -88,7 +88,7 @@ test_that("forecast_cases() handles missing arguments as expected", { ) } ) - + expect_identical( { set.seed(42) @@ -107,7 +107,7 @@ test_that("forecast_cases() handles missing arguments as expected", { ) } ) - + expect_identical( { set.seed(42) @@ -129,8 +129,6 @@ test_that("forecast_cases() handles missing arguments as expected", { }) -# FIXME : 'horizon' appears to have no effect - test_that("forecast_cases() can handle custom sampling functions", { expect <- function(FUN) { @@ -150,3 +148,30 @@ test_that("forecast_cases() can handle custom sampling functions", { }) +test_that("forecast_cases() properly uses 'horizon'", { + set.seed(42) + predictions_h5 <- forecast_cases( + EpiSoon::example_obs_cases, + fit_samples = forecast, + serial_interval = EpiSoon::example_serial_interval, + horizon = 5 + ) + expect_equal(max(predictions_h5$horizon), 5) + + set.seed(42) + predictions_default <- forecast_cases( + EpiSoon::example_obs_cases, + fit_samples = forecast, + serial_interval = EpiSoon::example_serial_interval + ) + + set.seed(42) + predictions_h10 <- forecast_cases( + EpiSoon::example_obs_cases, + fit_samples = forecast, + serial_interval = EpiSoon::example_serial_interval, + horizon = 10 + ) + + expect_identical(predictions_h10, predictions_default) +}) From 915a4541f05040a85013c54f3f7b05d472dbf5fe Mon Sep 17 00:00:00 2001 From: Nathalie Vialaneix Date: Wed, 10 Jun 2020 13:03:13 +0200 Subject: [PATCH 3/3] added tests for 'horizon' in predict_cases() --- tests/testthat/test_predict_cases.R | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/tests/testthat/test_predict_cases.R b/tests/testthat/test_predict_cases.R index aac7408..3bcb2e6 100644 --- a/tests/testthat/test_predict_cases.R +++ b/tests/testthat/test_predict_cases.R @@ -17,6 +17,7 @@ forecast <- forecast_rt(EpiSoon::example_obs_rts[1:10, ], model = function(...){ }, ...) }, horizon = 7, samples = 1) +set.seed(10) predictedCases <- predict_cases( cases = EpiSoon::example_obs_cases, rts = forecast, @@ -39,3 +40,25 @@ test_that("The expected Rt sample forecasts predict cases are obtained", { # expect_equal(predictedCases$date, expectedTable$date) # expect_gte(cor(predictedCases$cases, expectedTable$cases), .9) }) + + +test_that("Argument 'horizon' is properly handled", { + predictedCases_h5 <- predict_cases( + cases = EpiSoon::example_obs_cases, + rts = forecast, + forecast_date = as.Date("2020-03-10"), + serial_interval = EpiSoon::example_serial_interval, + horizon = 5 + ) + expect_equal(nrow(predictedCases_h5), 5) + + set.seed(10) + predictedCases_h10 <- predict_cases( + cases = EpiSoon::example_obs_cases, + rts = forecast, + forecast_date = as.Date("2020-03-10"), + serial_interval = EpiSoon::example_serial_interval, + horizon = 10 + ) + expect_identical(predictedCases, predictedCases_h10) +})