Allow setting p_HCW

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: mpoxseir
 Title: Stochastic compartmental model of mpox transmission
-Version: 0.2.22
+Version: 0.2.23
 Authors@R: c(person("Lilith", "Whittles", role = c("aut", "cre"),
                     email = "[email protected]"),
              person("Ruth", "McCabe", role = c("aut")),

R/parameters.R

@@ -11,6 +11,9 @@
 ##'   e.g. a value of 0.01 means 1% of all SW-age groups are sex workers and not
 ##'   just 1% of women in those groups. Default is NULL, in which case we use
 ##'   the default value for the region given in the package
+##' @param p_HCW The proportion of HCW-age groups that are healthcare workers.
+##'   Default is NULL, in which case we use the default value for the region
+##'   given in the package
 ##' @return A list containing all the demographic parameters
 ##'   
 ##' @export
@@ -21,7 +24,7 @@
 ##' 
 ##' @export
 parameters_demographic <- function(region, mixing_matrix = "Zimbabwe",
-                                   p_SW = NULL) {
+                                   p_SW = NULL, p_HCW = NULL) {
   age_bins <- get_age_bins()
   squire_age_bins <- create_age_bins(start = seq(0, 75, 5))
   group_bins <- get_group_bins()
@@ -101,10 +104,12 @@ parameters_demographic <- function(region, mixing_matrix = "Zimbabwe",
 
   ## HCW
   if(region %in% c("equateur","sudkivu")){
-    p_HCW <- 136606 / sum(N_age)
+    p_HCW_default <- 136606 / sum(N_age)
   } else if(region %in% c("burundi","bujumbura","bujumbura_mairie")){
-    p_HCW <- 11911 / sum(N_age)
+    p_HCW_default <- 11911 / sum(N_age)
   }
+
+  p_HCW <- p_HCW %||% p_HCW_default
 
    # possibly want to reduce this further to account for fact that not every HCW will have contact with mpox patients? 
   N_HCW <- round(p_HCW * N_HCW)
@@ -440,7 +445,7 @@ assign_seeds <- function(N, w) {
 #' @export
 parameters_fixed <- function(region, initial_infections, use_ve_D = FALSE,
                              mixing_matrix = "Zimbabwe", p_SW = NULL,
-                             overrides = list()) {
+                             p_HCW = NULL, overrides = list()) {
 
   ## Checking region
   if (!(region %in% c("equateur", "sudkivu",
@@ -451,7 +456,8 @@ parameters_fixed <- function(region, initial_infections, use_ve_D = FALSE,
   ## Initialising variable that other parameters depend on
   demographic_params <- parameters_demographic(region = region,
                                                mixing_matrix = mixing_matrix,
-                                               p_SW = p_SW)
+                                               p_SW = p_SW,
+                                               p_HCW = p_HCW)
   age_bins <- get_age_bins()
   idx_compartment <- get_compartment_indices()
 
@@ -468,7 +474,6 @@ parameters_fixed <- function(region, initial_infections, use_ve_D = FALSE,
   ## VE against onward transmission
   ve_T <- rep(0, n_vax)
 
-
   N <- demographic_params$province_pop[[region]]
   N0 <- round(N * demographic_params$N0 / sum(demographic_params$N0)) # total number in each age-group
   RR_z <- c(0.977, 1, 0.444, rep(0.078, n_group - 3)) # Jezek 1988 zoonotic + Jezek 1987

tests/testthat/test-parameters.R

@@ -177,3 +177,41 @@ test_that("Can change proportion of SW population", {
   test_p_SW("burundi", 0.028 * 0.5)
 
 })
+
+
+test_that("Can change proportion of HCW population", {
+
+  test_p_HCW <- function(region) {
+    ## Just use default
+    p1 <- parameters_fixed(region, initial_infections = 10)
+
+    if (region %in% c("equateur","sudkivu")){
+      p_HCW_default <- 136606 / 89561404
+    } else if(region %in% c("burundi", "bujumbura", "bujumbura_mairie")){
+      p_HCW_default <- 11911 / 11890781
+    } 
+
+
+    ## Specify default (should be same as above)
+    p2 <- parameters_fixed(region, initial_infections = 10, 
+                           p_HCW = p_HCW_default)
+
+    expect_equal(p1$N0, p2$N0)
+
+    ## Should be different
+    p3 <- parameters_fixed(region, initial_infections = 10,
+                           p_HCW = 0.5 * p_HCW_default)
+    expect_false(all(p3$N0 == p1$N0))
+
+    ## Should have zero HCWs
+    p4 <- parameters_fixed(region, initial_infections = 10,
+                           p_HCW = 0)
+    expect_true(p4$N0["HCW"] == 0)
+  }
+
+  test_p_HCW("equateur")
+  test_p_HCW("sudkivu")
+  test_p_HCW("burundi")
+
+})
+