Merge pull request #33 from epiforecasts/optim

optim for sampling
epiforecasts · Apr 7, 2020 · 23d3a4e · 23d3a4e
2 parents 5bff7ee + f9f85e3
commit 23d3a4e
Show file tree

Hide file tree

Showing 5 changed files with 27 additions and 18 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -53,7 +53,8 @@ Imports:
     ggplot2,
     cowplot,
     HDInterval,
-    R.utils
+    R.utils,
+    data.table
 Remotes:
   epiforecasts/scoringutils
 Suggests: 

diff --git a/R/draw_from_si_prob.R b/R/draw_from_si_prob.R
@@ -10,19 +10,15 @@
 #' @examples
 #'
 #' ## Draw
-#' draw_from_si_prob(c(1, 4, 6), EpiSoon::example_serial_interval)
+#' draw_from_si_prob(c(1, 2, 4, 10), EpiSoon::example_serial_interval)
 draw_from_si_prob <- function(days_ago = NULL,
                          serial_interval = NULL) {
 
 
-  draws <- purrr::map_dbl(days_ago, function(day) {
-    if (day > length(serial_interval)) {
-      draw <- 0
-    }else{
-      draw <- serial_interval[day]
-    }
-    return(draw)
-  })
+  var_length <- length(serial_interval)
+
+  draws <- ifelse(days_ago > var_length, 0, days_ago)
+  draws <- ifelse(draws == 0, draws, serial_interval[draws])
 
 
   return(draws)

diff --git a/R/predict_current_cases.R b/R/predict_current_cases.R
@@ -12,7 +12,6 @@
 #' @importFrom purrr map_dbl
 #' @examples
 #'
-#'
 #' predict_current_cases(cases = EpiSoon::example_obs_cases,
 #'                       rts = EpiSoon::example_obs_rts,
 #'                       serial_interval = EpiSoon::example_serial_interval)
@@ -27,14 +26,28 @@ predict_current_cases <- function(
     rdist <- rpois
   }
 
+  ## Get first and last date
+  first_rt_date <- min(rts$date, na.rm = TRUE)
+  final_rt_date <- max(rts$date, na.rm = TRUE)
+
+  ## Get early cases
+  early_cases <- dplyr::filter(cases, date <= first_rt_date)$cases
+
+  ## Get following cases
+  subsequent_cases <- dplyr::filter(cases,
+                                    date > first_rt_date,
+                                    date <= final_rt_date)$cases
+
+  ## Build an iterative list of cases
+  cases <- purrr::map(1:length(subsequent_cases), ~ c(early_cases, subsequent_cases[1:.]))
+  cases <- c(list(early_cases), cases)
+
+
   predictions <-
     dplyr::mutate(rts,
       infectiousness =
-        purrr::map_dbl(date,
-                       function(rt_date) {
-                         filt_cases <- dplyr::filter(cases, date <= rt_date)
-                         cases_vect <- filt_cases$cases
-
+        purrr::map_dbl(cases,
+                       function(cases_vect) {
                          inf <- sum(cases_vect * EpiSoon::draw_from_si_prob(
                                                           length(cases_vect):1,
                                                           serial_interval

diff --git a/man/draw_from_si_prob.Rd b/man/draw_from_si_prob.Rd
diff --git a/man/predict_current_cases.Rd b/man/predict_current_cases.Rd