Merge pull request #89 from annecori/fix-broken-quantiles

Fix broken quantiles (#88)
mrc-ide · Apr 1, 2020 · ce2ab43 · ce2ab43
2 parents c41d6e8 + 478ec36
commit ce2ab43
Show file tree

Hide file tree

Showing 10 changed files with 84 additions and 73 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,8 @@
+# Unreleased
+
+## FIXED
+* Fixed incorrect quantiles (issue #88) (#89, @jstockwin)
+
 # EpiEstim 2.2-2
 
 ## MISC

diff --git a/R/estimate_r.R b/R/estimate_r.R
@@ -532,11 +532,11 @@ estimate_R_func <- function(incid,
         na.rm = TRUE
       )
       median_posterior <- apply(r_sample, 2, median, na.rm = TRUE)
-      quantile_0.25_posterior <- apply(r_sample, 2, quantile,
+      quantile_0.75_posterior <- apply(r_sample, 2, quantile,
         0.75,
         na.rm = TRUE
       )
-      quantile_0.25_posterior <- apply(r_sample, 2, quantile,
+      quantile_0.95_posterior <- apply(r_sample, 2, quantile,
         0.95,
         na.rm = TRUE
       )
@@ -587,11 +587,11 @@ estimate_R_func <- function(incid,
         na.rm = TRUE
       )
       median_posterior <- apply(r_sample, 2, median, na.rm = TRUE)
-      quantile_0.25_posterior <- apply(r_sample, 2, quantile,
+      quantile_0.75_posterior <- apply(r_sample, 2, quantile,
         0.75,
         na.rm = TRUE
       )
-      quantile_0.25_posterior <- apply(r_sample, 2, quantile,
+      quantile_0.95_posterior <- apply(r_sample, 2, quantile,
         0.95,
         na.rm = TRUE
       )
@@ -636,11 +636,11 @@ estimate_R_func <- function(incid,
       shape = a_posterior,
       scale = b_posterior, lower.tail = TRUE, log.p = FALSE
     )
-    quantile_0.25_posterior <- qgamma(0.75,
+    quantile_0.75_posterior <- qgamma(0.75,
       shape = a_posterior,
       scale = b_posterior, lower.tail = TRUE, log.p = FALSE
     )
-    quantile_0.25_posterior <- qgamma(0.95,
+    quantile_0.95_posterior <- qgamma(0.95,
       shape = a_posterior,
       scale = b_posterior, lower.tail = TRUE, log.p = FALSE
     )
@@ -653,8 +653,8 @@ estimate_R_func <- function(incid,
   results <- list(R = as.data.frame(cbind(
     config$t_start, config$t_end, mean_posterior,
     std_posterior, quantile_0.025_posterior, quantile_0.05_posterior,
-    quantile_0.25_posterior, median_posterior, quantile_0.25_posterior,
-    quantile_0.25_posterior, quantile_0.975_posterior
+    quantile_0.25_posterior, median_posterior, quantile_0.75_posterior,
+    quantile_0.95_posterior, quantile_0.975_posterior
   )))
 
   names(results$R) <- c(

diff --git a/tests/expected_output/Example1.rda b/tests/expected_output/Example1.rda
diff --git a/tests/expected_output/Example2.rda b/tests/expected_output/Example2.rda
diff --git a/tests/expected_output/Example3.rda b/tests/expected_output/Example3.rda
diff --git a/tests/expected_output/Example4.rda b/tests/expected_output/Example4.rda
diff --git a/tests/figs/flu2009-incidence-import.svg b/tests/figs/flu2009-incidence-import.svg
diff --git a/tests/figs/flu2009-instantaneous-no-legend.svg b/tests/figs/flu2009-instantaneous-no-legend.svg
diff --git a/tests/figs/flu2009-rc.svg b/tests/figs/flu2009-rc.svg