Merge pull request #30 from mrc-ide/site2

Site2

.Rbuildignore

@@ -7,3 +7,4 @@
 ^docs$
 ^pkgdown$
 add_data_temp.R
+data-raw

.github/workflows/check-standard.yaml

@@ -4,7 +4,7 @@ on:
   push:
     branches: [main, master]
   pull_request:
-    branches: [main, master]
+    branches: [main, master, dev]
 
 name: R-CMD-check
 

.github/workflows/test-coverage.yaml

@@ -4,7 +4,7 @@ on:
   push:
     branches: [main, master]
   pull_request:
-    branches: [main, master]
+    branches: [main, master, dev]
 
 name: test-coverage
 

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: site
 Type: Package
 Title: Site specific malariasimulation modelling
-Version: 0.2.2
+Version: 1.0.4
 Authors@R: c(
     person("Pete", "Winskill", email = "[email protected]", role = c("aut", "cre"))
     )
@@ -11,14 +11,20 @@ License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
 Remotes:
-  mrc-ide/malariasimulation
-Suggests: 
-    testthat (>= 3.0.0)
+    mrc-ide/malariasimulation,
+    mrc-ide/orderly2
 Config/testthat/edition: 3
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
 Depends: 
     R (>= 2.10)
 Imports: 
+    orderly2,
     dplyr,
-    malariasimulation (>= 1.4.1),
-    tidyr
+    malariasimulation,
+    rappdirs,
+    rlang,
+    tidyr,
+    withr
+Suggests:
+    testthat (>= 3.0.0),
+    fs

NAMESPACE

@@ -1,4 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
-export(single_site)
+export(fetch_files)
+export(fetch_site)
 export(site_parameters)
+export(subset_site)

R/burnin.R

@@ -1,6 +1,6 @@
 #' Expand interventions retrospectively for burn in period
 #'
-#' Assumes interventions for burn in period are = to those in year 1.
+#' Assumes interventions for burn in period are = 0 coverage.
 #'
 #' @param interventions Site intervention inputs
 #' @param burnin Burn in period (years)
@@ -10,6 +10,19 @@ burnin_interventions <- function(interventions, burnin){
   start_year <- min(interventions$year) - burnin
   interventions <- interventions |>
     tidyr::complete(year = start_year:(max(interventions$year))) |>
+    tidyr::replace_na(
+      replace = list(
+        itn_use = 0,
+        itn_input_dist = 0,
+        tx_cov = 0,
+        irs_cov = 0,
+        smc_cov = 0,
+        rtss_cov = 0,
+        r21_cov = 0,
+        pmc_cov = 0,
+        lsm_cov = 0
+      )
+    ) |>
     tidyr::fill(dplyr::everything(), .direction = "up")
   return(interventions)
 }

R/data.R

@@ -5,14 +5,20 @@
 #'
 #' @format A list with 10 variables:
 #' \describe{
-#'   \item{country}{The iso3c country code}
-#'   \item{level}{The level of subnational disaggregation}
+#'   \item{country}{The country name}
+#'   \item{version}{Site file version}
+#'   \item{admin_level}{The levels of spatial disaggregation}
 #'   \item{sites}{Unique sites}
-#'   \item{epi}{Epidemiological site data}
+#'   \item{shape}{Sptial boundaries (set to NA in testing shapefile)}
+#'   \item{cases_deaths}{Epidemiological site data}
+#'   \item{prevalence}{Prevalence data}
 #'   \item{interventions}{Intervention coverage and specification}
-#'   \item{population}{Population and population at risk projections}
+#'   \item{population}{Population, population at risk mand age-disaggregated population projections}
 #'   \item{demography}{Demographic projections}
-#'   \item{vectors}{Vector proportions}
-#'   \item{seasonality}{Seasonal profile parameters}
+#'   \item{vectors}{Vector specieis and pyrethroid resistance}
+#'   \item{seasonality}{Seasonal profile parameters, monthly rainfall and fourier predictions}
+#'   \item{blood_disorders}{Blood disorder data}
+#'   \item{accessibility}{Accessibility data}
+#'   \item{eir}{Calibrated eir}
 #' }
 "example_site"

R/demography.R

@@ -8,11 +8,8 @@ add_demography <- function(p, demography){
 
   # Age group upper
   ages <- round(unique(demography$age_upper) * 365)
-  # Single demography currently
   timesteps <- 365 * (unique(demography$year) - p$baseline_year)
-  # Take demography is first year as static demography
-  deathrates <- demography$mortality_rate / 365
-  # Create matrix of death rates
+  deathrates <- demography$adjusted_mortality_rates / 365
   deathrates_matrix <- matrix(deathrates, nrow = length(timesteps), byrow = TRUE)
   # Add parameters
   p <- malariasimulation::set_demography(

R/fetch.R

@@ -0,0 +1,163 @@
+LOCATION_NAME <- "malariaverse-sitefiles"
+
+location_configuration <- function() {
+  token <- Sys.getenv("GITHUB_TOKEN")
+  if (token == "") {
+    token <- NULL
+  }
+
+  getOption("site.orderly_location", list(
+    type = "packit",
+    args = list(
+      url = "https://packit.dide.ic.ac.uk/malariaverse-sitefiles",
+      token = token)
+  ))
+}
+
+#' Add or update an Orderly location.
+#'
+#' If a location with the given name already exists and its configuration does
+#' not match the given parameters, it is removed first before being added with
+#' the new parameters. If it exists and has the same parameters already nothing
+#' happens.
+#'
+#' This functionality could probably be moved to the orderly2 package.
+#' @noRd
+location_add_or_update <- function(name, type, args, root) {
+  locations <- orderly2::orderly_location_list(root = root, verbose = TRUE)
+  locations <- locations[locations$name == name,]
+
+  if (nrow(locations) == 0) {
+    orderly2::orderly_location_add(name, type, args, root = root)
+  } else if (locations[[1, "type"]] != type ||
+             !identical(locations[[1, "args"]], args)) {
+    orderly2::orderly_location_remove(name, root = root)
+    orderly2::orderly_location_add(name, type, args, root = root)
+  }
+}
+
+
+#' Configure the orderly root used to fetch sitefiles.
+#' 
+#' This creates a folder in the user's home directory used to download and cache
+#' site files. The location of the cache folder is determined by
+#' [rappdirs::user_cache_dir()] and depends on the OS.
+#'
+#' A remote location from which the sitefiles will be fetched is configured on
+#' the root. By default this is the malariaverse Packit instance hosted at
+#' `https://packit.dide.ic.ac.uk/malariaverse-sitefiles`. This can be customized
+#' by setting the `site.orderly_location` option.
+#'
+#' Users shouldn't need to call this function, as it is called implicitly by
+#' [fetch_files] already.
+#'
+#' @return the path to the orderly root.
+#' @noRd
+configure_orderly <- function() {
+  root <- file.path(rappdirs::user_cache_dir("malariaverse-sitefiles"), "store")
+
+  orderly2::orderly_init(root, use_file_store = TRUE)
+
+  cfg <- location_configuration()
+  location_add_or_update(LOCATION_NAME, type = cfg$type, args = cfg$args,
+                         root = root)
+
+  root
+}
+
+
+#' Get files from the malariaverse sitefile server.
+#'
+#' @param name The name of the orderly report.
+#' @param parameters A named list of parameters to use when searching for the
+#'   orderly packet. If a query expression `expr` is specified, these parameters
+#'   are substituted into the query using the this: prefix. If no expression is
+#'   specified, the latest packet matching these parameters exactly is selected.
+#' @param dest A directory into which the files should be copied.
+#' @param files An optionally-named character vector of files to copy from the
+#'   packet and into the destination directory. If the vector is named, these
+#'   names are used as the destination file path.
+#' @param expr The query expression to filter packets. This may be an arbitrary
+#'   orderly query, including a literal packet ID. If absent or NULL, the
+#'   specified list of parameters is used and matched exactly.
+#' @return the id of the orderly packet the files were copied from.
+#' @export
+fetch_files <- function(name, parameters, dest, files, expr = NULL) {
+  root <- configure_orderly()
+
+  if (is.null(expr)) {
+    filter <- paste(sprintf("parameter:%1$s == this:%1$s", names(parameters)),
+                    collapse = " && ")
+    expr <- sprintf("latest(%s)", filter)
+  }
+
+  options <- orderly2::orderly_search_options(
+    location = LOCATION_NAME,
+    allow_remote = TRUE,
+    pull_metadata = TRUE)
+
+  plan <- orderly2::orderly_copy_files(
+    name = name,
+    expr = expr,
+    parameters = parameters,
+    dest = dest,
+    files = files,
+    options = options,
+    root = root)
+
+  plan$id
+}
+
+#' Fetch a site file for a country from the malariaverse sitefile server.
+#'
+#' The site file is identified by its country code, and optionally the
+#' admin_level, urban/rural setting and version of the site files. The latest
+#' packet from the server matching these parameters is used.
+#'
+#' Alternatively, a packet ID can be specified in order to pick an exact file
+#' set.
+#'
+#' @param iso3c the ISO country code, a scalar character.
+#' @param version the dataset version, a scalar character.
+#' @param admin_level a scalar number.
+#' @param urban_rural a scalar logical.
+#' @param id a packet ID used to select an exact packet.
+#' @return The contents of the site file.
+#' @examples
+#' \dontrun{
+#' fetch_site("NGA")
+#' fetch_site("NGA", admin_level = 1)
+#' fetch_site(id = "20240801-062621-6f95851a")
+#' }
+#' @export
+fetch_site <- function(iso3c = NULL, version = NULL,
+                       admin_level = NULL, urban_rural = NULL,
+                       id = NULL)
+{
+  dest <- withr::local_tempdir()
+  if (!xor(is.null(iso3c), is.null(id))) {
+    rlang::abort("Exactly one of `iso3c` and `id` must be supplied")
+  }
+
+  if (!is.null(iso3c)) {
+    parameters <- list(
+      iso3c = iso3c,
+      version = version,
+      admin_level = admin_level,
+      urban_rural = urban_rural)
+    parameters <- parameters[!sapply(parameters, is.null)]
+    expr <- NULL
+  } else {
+    parameters <- list()
+    expr <- id
+  }
+
+  fetch_files(name = "calibration_diagnostics",
+              files = "calibrated_scaled_site.rds",
+              expr = expr,
+              parameters = parameters,
+              dest = dest)
+
+
+  readRDS(file.path(dest, "calibrated_scaled_site.rds"))
+}