Merge pull request #162 from mrc-ide/nimue_fitting

Nimue fitting
mrc-ide · Feb 10, 2021 · 432119b · 432119b
2 parents 490eaca + 76def6a
commit 432119b
Show file tree

Hide file tree

Showing 4 changed files with 48 additions and 1 deletion.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: squire
 Type: Package
 Title: SEIR transmission model of COVID-19
-Version: 0.6.2
+Version: 0.6.3
 Authors@R: c(
   person("OJ", "Watson", email = "o.watson15@imperial.ac.uk", role = c("aut", "cre")),
   person("Patrick", "Walker", email = "patrick.walker06@imperial.ac.uk", role = c("aut")),

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,7 @@
+# squire 0.6.3
+
+* `beta_est` accepts `nimue` models
+
 # squire 0.6.2
 
 * Typo in `dur_not_get_mv_survive`

diff --git a/R/beta.R b/R/beta.R
@@ -128,6 +128,18 @@ beta_est <- function(squire_model, model_params, R0) {
                                                 mixing_matrix = mat,
                                                 R0 = R0)
 
+  } else if (class(squire_model)[1] == "nimue_model") {
+
+    mat <- process_contact_matrix_scaled_age(model_params$contact_matrix_set[[1]],
+                                             model_params$population)
+
+    new_beta <- squire_model$generate_beta_func(dur_IMild = 1/model_params$gamma_IMild,
+                                                dur_ICase = 2/model_params$gamma_ICase,
+                                                prob_hosp = model_params$prob_hosp_baseline,
+                                                rel_infectiousness = model_params$rel_infectiousness,
+                                                mixing_matrix = mat,
+                                                R0 = R0)
+
   }
 
   return(new_beta)

diff --git a/tests/testthat/test-beta.R b/tests/testthat/test-beta.R
@@ -89,9 +89,11 @@ test_that("best_est works for apothecary", {
   # mock out the function as we don't have it
   mod_exp$generate_beta_func <- mockery::mock()
 
+
   beta <- beta_est(squire_model = mod_exp,
                    model_params = model_params,
                    R0 = 3)
+
   mockery::expect_args(mod_exp$generate_beta_func,
                        n = 1,
                        dur_IAsymp = 1/model_params$gamma_IAsymp,
@@ -105,3 +107,32 @@ test_that("best_est works for apothecary", {
                        R0 = 3)
 
 })
+
+test_that("best_est works for nimue", {
+
+  mod_exp <- deterministic_model()
+  class(mod_exp) <- c("nimue_model", "squire_model")
+  model_params <- mod_exp$parameter_func("Angola")
+  model_params$rel_infectiousness <- rep(1,17)
+  mat <- process_contact_matrix_scaled_age(model_params$contact_matrix_set[[1]],
+                                           model_params$population)
+  model_params$prob_hosp_baseline <- model_params$prob_hosp
+
+  # mock out the function as we don't have it
+  mod_exp$generate_beta_func <- mockery::mock()
+
+  beta <- beta_est(squire_model = mod_exp,
+                   model_params = model_params,
+                   R0 = 3)
+
+
+  expect_true(mockery::expect_args(mod_exp$generate_beta_func,
+                       n = 1,
+                       dur_IMild = 1/model_params$gamma_IMild,
+                       dur_ICase = 2/model_params$gamma_ICase,
+                       prob_hosp = model_params$prob_hosp_baseline,
+                       rel_infectiousness = model_params$rel_infectiousness,
+                       mixing_matrix = mat,
+                       R0 = 3))
+
+})