Site 2601

.github/workflows/test-coverage.yaml

@@ -4,9 +4,10 @@ on:
   push:
     branches: [main, master]
   pull_request:
-    branches: [main, master]
 
-name: test-coverage
+name: test-coverage.yaml
+
+permissions: read-all
 
 jobs:
   test-coverage:
@@ -15,36 +16,47 @@ jobs:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
 
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
 
       - uses: r-lib/actions/setup-r@v2
         with:
           use-public-rspm: true
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          extra-packages: any::covr
+          extra-packages: any::covr, any::xml2
           needs: coverage
 
       - name: Test coverage
         run: |
-          covr::codecov(
+          cov <- covr::package_coverage(
             quiet = FALSE,
             clean = FALSE,
-            install_path = file.path(Sys.getenv("RUNNER_TEMP"), "package")
+            install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
           )
+          print(cov)
+          covr::to_cobertura(cov)
         shell: Rscript {0}
 
+      - uses: codecov/codecov-action@v5
+        with:
+          # Fail if error if not on PR, or if on PR and token is given
+          fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }}
+          files: ./cobertura.xml
+          plugins: noop
+          disable_search: true
+          token: ${{ secrets.CODECOV_TOKEN }}
+
       - name: Show testthat output
         if: always()
         run: |
           ## --------------------------------------------------------------------
-          find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true
+          find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true
         shell: bash
 
       - name: Upload test results
         if: failure()
-        uses: actions/upload-artifact@v3
+        uses: actions/upload-artifact@v4
         with:
           name: coverage-test-failures
           path: ${{ runner.temp }}/package

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: netz
 Title: All Things Bed Nets
-Version: 1.0.4
+Version: 1.1.2
 Authors@R: c(
     person(
       given = "Pete",
@@ -26,7 +26,7 @@ License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.2
+RoxygenNote: 7.3.3
 Imports:
   stats
 Remotes:

LICENSE

@@ -1,21 +1,2 @@
-MIT License
-
-Copyright (c) 2019 MRC Centre for Outbreak Analysis and Modelling
-
-Permission is hereby granted, free of charge, to any person obtaining a copy
-of this software and associated documentation files (the "Software"), to deal
-in the Software without restriction, including without limitation the rights
-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-copies of the Software, and to permit persons to whom the Software is
-furnished to do so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be included in all
-copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-SOFTWARE.
+YEAR: 2026
+COPYRIGHT HOLDER: YMRC Centre for Outbreak Analysis and Modelling

R/conversion.R

@@ -2,7 +2,7 @@
 #'
 #' @param access A single or vector of access values
 #' @param type The npc to access model to use. This may be:
-#' \itemize{
+#' \describe{
 #'  \item{"loess"}{: a loess fit to observed access-npc data}
 #'  \item{"linear"}{: a linear fit to the observed access-npc data, fitted to the trend for observeation with access < 0.5}
 #' }

R/malariasimulation.R

@@ -1,50 +1,71 @@
-#' Estimate the malaraisimulation input distribution from usage
-#' assumes an exponentially distributed net loss function and randomly 
+#' Estimate the malariasimulation input distribution from usage
+#' assumes a specified net loss function and randomly
 #' correlated net distribution.
 #'
+#'
 #' @param usage Target usage
 #' @param usage_timesteps Target usage time points
 #' @param distribution_timesteps A vector of distribution time steps
 #' @param distribution_lower Lower bound on distributions (default = 0)
 #' @param distribution_upper Upper bound on distribution (default = 1)
-#' @param mean_retention The average duration of net retention (days)
-#' 
+#' @param net_loss_function Function to calculate net retention over time.
+#'   Should take time as first argument and return proportion retained.
+#'   Defaults to net_loss_exp for backward compatibility.
+#' @param... Additional arguments passed to net_loss_function
+#'
+#' @details Note, the estimation works sequentially in time order, so if there
+#' are multiple distribution steps specified between target usage timestep they will
+#' be inferred sequentially. You can mange this behaviour with the `distribution_lower` and
+#' `distribution_upper` arguments.
+#'
 #' @export
 usage_to_model_distribution <- function(
-    usage,
-    usage_timesteps,
-    distribution_timesteps, 
-    distribution_lower = rep(0, length(distribution_timesteps)), 
-    distribution_upper = rep(1, length(distribution_timesteps)),
-    mean_retention = 365 * 5
-){
-  
-  if(any(distribution_lower < 0) | any(distribution_lower > 1)){
+  usage,
+  usage_timesteps,
+  distribution_timesteps,
+  distribution_lower = rep(0, length(distribution_timesteps)),
+  distribution_upper = rep(1, length(distribution_timesteps)),
+  net_loss_function = net_loss_exp,
+  ...
+) {
+  if (any(distribution_lower < 0) | any(distribution_lower > 1)) {
     stop("All distribution lower values must be between 0 and 1")
   }
-  if(any(distribution_upper < 0) | any(distribution_upper > 1)){
+  if (any(distribution_upper < 0) | any(distribution_upper > 1)) {
     stop("All distribution upper values must be between 0 and 1")
   }
-  if(length(distribution_lower) != length(distribution_timesteps) | length(distribution_upper) != length(distribution_timesteps)){
-    stop("distribution_timesteps, distribution_lower and distribution_upper must have equal lengths")
+  if (
+    length(distribution_lower) != length(distribution_timesteps) |
+      length(distribution_upper) != length(distribution_timesteps)
+  ) {
+    stop(
+      "distribution_timesteps, distribution_lower and distribution_upper must have equal lengths"
+    )
   }
-  if(length(usage) != length(usage_timesteps)){
+  if (length(usage) != length(usage_timesteps)) {
     stop("Usage and usage timesteps must be the same length")
   }
-
-  loss_rate <- 1 / mean_retention
+
   distribution <- rep(0, length(distribution_timesteps))
-  for(t in 1:length(distribution_timesteps)){
+  for (t in 1:length(distribution_timesteps)) {
     # Usage at time point of next distribution
-    put <- model_distribution_to_usage(distribution_timesteps[t], distribution, distribution_timesteps, mean_retention)
+    put <- model_distribution_to_usage(
+      usage_timesteps = distribution_timesteps[t],
+      distribution = distribution,
+      distribution_timesteps = distribution_timesteps,
+      net_loss_function = net_loss_function,
+      ...
+    )
+
     # Find next target usage
-    time_offset <- usage_timesteps  - distribution_timesteps[t]
-    if(max(time_offset) < 0){
-      distribution[t] <- NA
+    time_offset <- usage_timesteps - distribution_timesteps[t]
+    if (max(time_offset) < 0) {
+      distribution[t:length(distribution_timesteps)] <- NA
+      break
     } else {
       nearest <- min(time_offset[time_offset >= 0])
       index <- which(time_offset == nearest)
-      start_point <- usage[index] / exp(-loss_rate * time_offset[index])
+      start_point <- usage[index] / net_loss_function(time_offset[index], ...)
       distribution[t] <- 1 - (1 - start_point) / (1 - put)
       distribution[t] <- min(distribution_upper[t], distribution[t])
       distribution[t] <- max(distribution_lower[t], distribution[t])
@@ -54,44 +75,54 @@ usage_to_model_distribution <- function(
 }
 
 #' Estimate the population-level bed net usage at given times for a set of
-#' bed net distributions at given times. This assumes a constant rate of net loss
-#' (as in malariasimulation) and that recipients of multiple rounds are random.
-#' 
+#' bed net distributions at given times. This assumes a specified rate of net loss
+#' and that recipients of multiple rounds are random.
+#'
 #' @inheritParams usage_to_model_distribution
 #' @param distribution Vector of model distribution (% of total population)
+#' @param net_loss_function Function to calculate net retention over time.
+#'   Should take time as first argument and return proportion retained.
+#' @param... Additional arguments passed to net_loss_function
 #'
 #' @return Usage estimates at timepoints
 #' @export
 model_distribution_to_usage <- function(
-    usage_timesteps,
-    distribution,
-    distribution_timesteps,
-    mean_retention = 365 * 5
-){
-  loss_rate <- 1 / mean_retention
-
+  usage_timesteps,
+  distribution,
+  distribution_timesteps,
+  net_loss_function = net_loss_exp,
+  ...
+) {
+  # Deal with zero distributions in inputs
+  zero_dists <- distribution == 0
+  distribution <- distribution[!zero_dists]
+  distribution_timesteps <- distribution_timesteps[!zero_dists]
+  if (length(distribution) == 0) {
+    return(rep(0, length(usage_timesteps)))
+  }
+
   # Estimate the cumulative usage at distribution time points
   cumulative_usage <- distribution[1]
-  if(length(distribution_timesteps) > 1){
-    for(t in 2:length(distribution_timesteps)){
+  if (length(distribution_timesteps) > 1) {
+    for (t in 2:length(distribution_timesteps)) {
       time_offset <- distribution_timesteps[t] - distribution_timesteps[t - 1]
-      remaining <- cumulative_usage[t - 1] * exp(-loss_rate * time_offset)
+      remaining <- cumulative_usage[t - 1] * net_loss_function(time_offset, ...)
       cumulative_usage[t] <- 1 - (1 - remaining) * (1 - distribution[t])
     }
   }
-  
+
   # Estimate the usage at target time points
   usage <- c()
-  for(t in seq_along(usage_timesteps)){
+  for (t in seq_along(usage_timesteps)) {
     time_offset <- usage_timesteps[t] - distribution_timesteps
-    if(max(time_offset) < 0){
+    if (max(time_offset) < 0) {
       usage[t] <- 0
     } else {
       nearest <- min(time_offset[time_offset >= 0])
       index <- which(time_offset == nearest)
-      usage[t] <- cumulative_usage[index] * exp(-loss_rate * time_offset[index])
+      usage[t] <- cumulative_usage[index] *
+        net_loss_function(time_offset[index], ...)
     }
   }
   return(usage)
 }
-

README.Rmd

@@ -17,6 +17,7 @@ knitr::opts_chunk$set(
 [![Project Status: Active – The project has reached a stable, usable state and is being actively developed.](https://www.repostatus.org/badges/latest/active.svg)](https://www.repostatus.org/#active)
 [![R-CMD-check](https://github.com/mrc-ide/netz/workflows/R-CMD-check/badge.svg)](https://github.com/mrc-ide/netz/actions)
 [![Coverage status](https://codecov.io/gh/mrc-ide/peeps/branch/main/graph/badge.svg)](https://codecov.io/github/mrc-ide/netz)
+[![Codecov test coverage](https://codecov.io/gh/mrc-ide/netz/graph/badge.svg)](https://app.codecov.io/gh/mrc-ide/netz)
 <!-- badges: end -->
 
 Netz is here to help setup bed nets in [malariasimulation](https://mrc-ide.github.io/malariasimulation/).
@@ -42,4 +43,4 @@ need to be careful that out model inputs match our desired target usage
 when specifying bed nets. The schematic below will help in understanding how
 each of these elements relate to one another
 
-<img src="man/figures/Schematic.png" />
+<img src="man/figures/Schematic.png" />