Moved F definition to F .

.Rbuildignore

@@ -9,3 +9,4 @@ cran-comments.md
 ^docs$
 ^pkgdown$
 ^\.github$
+^codecov\.yml$

.github/workflows/R-CMD-check.yaml

@@ -0,0 +1,49 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+    branches: [main, master]
+
+name: R-CMD-check
+
+jobs:
+  R-CMD-check:
+    runs-on: ${{ matrix.config.os }}
+
+    name: ${{ matrix.config.os }} (${{ matrix.config.r }})
+
+    strategy:
+      fail-fast: false
+      matrix:
+        config:
+          - {os: macos-latest,   r: 'release'}
+          - {os: windows-latest, r: 'release'}
+          - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
+          - {os: ubuntu-latest,   r: 'release'}
+          - {os: ubuntu-latest,   r: 'oldrel-1'}
+
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      R_KEEP_PKG_SOURCE: yes
+
+    steps:
+      - uses: actions/checkout@v3
+
+      - uses: r-lib/actions/setup-pandoc@v2
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          r-version: ${{ matrix.config.r }}
+          http-user-agent: ${{ matrix.config.http-user-agent }}
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::rcmdcheck
+          needs: check
+
+      - uses: r-lib/actions/check-r-package@v2
+        with:
+          upload-snapshots: true

.github/workflows/test-coverage.yaml

@@ -0,0 +1,50 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+    branches: [main, master]
+
+name: test-coverage
+
+jobs:
+  test-coverage:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
+    steps:
+      - uses: actions/checkout@v3
+
+      - 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
+          needs: coverage
+
+      - name: Test coverage
+        run: |
+          covr::codecov(
+            quiet = FALSE,
+            clean = FALSE,
+            install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
+          )
+        shell: Rscript {0}
+
+      - name: Show testthat output
+        if: always()
+        run: |
+          ## --------------------------------------------------------------------
+          find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true
+        shell: bash
+
+      - name: Upload test results
+        if: failure()
+        uses: actions/upload-artifact@v3
+        with:
+          name: coverage-test-failures
+          path: ${{ runner.temp }}/package

DESCRIPTION

@@ -12,13 +12,15 @@ Authors@R: c(
           person("NHS-R community", email = "[email protected]", role = "cph")
           )
 Maintainer: Tom Smith <[email protected]>
-Description: R-package to implement the waiting list management approach described in this paper by Fong et al 2022
+Description: R-package to implement the waiting list management approach described in this paper by Fong et al 2022.
 License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.2.3
 Suggests: 
     knitr,
-    rmarkdown
+    rmarkdown,
+    testthat (>= 3.0.0)
 VignetteBuilder: knitr
 URL: https://nhs-r-community.github.io/NHSRwaitinglist/
+Config/testthat/edition: 3

R/relief_capacity.R

@@ -1,10 +1,10 @@
 #' @title Relief Capacity
 #'
 #' @description
-#' Calculates required relief capacity to achieve target queue size in a given period of time as a function of demand, queue size, target queue size and time period. 
-#' 
+#' Calculates required relief capacity to achieve target queue size in a given period of time as a function of demand, queue size, target queue size and time period.
+#'
 #' Relief Capacity is required if Queue Size > 2 * Target Queue Size.
-#' 
+#'
 #' Relief Capacity = Current Demand + (Queue Size - Target Queue Size)/Time Steps
 #'
 #' @param demand Numeric value of rate of demand in same units as target wait - e.g. if target wait is weeks, then demand in units of patients/week.
@@ -15,11 +15,12 @@
 #' @return A numeric value of the required rate of capacity to achieve a target queue size in a given period of time.
 #' @export
 #'
-#' @examples 
-#' # If demand is 30 patients per week, the current queue size is 1200 and the target is to achieve a queue size of 390 in 26 weeks, then 
-#' 
+#' @examples
+#' # If demand is 30 patients per week, the current queue size is 1200 and the
+#' # target is to achieve a queue size of 390 in 26 weeks, then
+#'
 #' # Relief Capacity = 30 + (1200 - 390)/26 = 61.15 patients per week.
-#' 
+#'
 #' relief_capacity(30, 1200, 390, 26)
 #'
 relief_capacity <- function(demand, queue_size, target_queue_size, weeks_to_target) {

R/target_capacity.R

@@ -1,26 +1,23 @@
 #' @title Target Capacity
 #'
 #' @description
-#' Calculates the target capacity to achieve a given target waiting time as a function of observed demand, target waiting time and a variability of demand parameter F.
+#' Calculates the target capacity to achieve a given target waiting time as a function of observed demand, target waiting time and a variability coefficient F.
 #' 
 #' Target Capacity = Demand + 2 * ( 1 + 4 * F ) / Target Wait
-#' 
-#' where F = V/C * (D/C)^2
-#' where C is the current number of operations per week; V is the current variance in the number of operations per week; D is the observed demand.
-#' 
 #' F defaults to 1.
 #'
 #' @param demand Numeric value of rate of demand in same units as target wait - e.g. if target wait is weeks, then demand in units of patients/week.
 #' @param target_wait Numeric value of number of weeks that has been set as the target within which the patient should be seen.
+#' @param F Variability coefficient, F = V/C * (D/C)^2 where C is the current number of operations per week; V is the current variance in the number of operations per week; D is the observed demand. Defaults to 1.
 #'
 #' @return A numeric value of target capacity required to achieve a target waiting time.
 #' @export
 #'
 #' @examples
-#' 
+#'
 #' # If the target wait is 52 weeks, demand is 30 patients per week and F = 3 then
 #' # Target capacity = 30 + 2*(1+4*3)/52 = 30.5 patients per week.
-#' 
+#'
 #' target_capacity(30,52,3)
 #'
 target_capacity <- function(demand, target_wait, F = 1) {

README.md

@@ -1,5 +1,21 @@
-# NHSRwaitinglist
-R-package to implement the waiting list management approach described in this paper by Fong et al https://www.medrxiv.org/content/10.1101/2022.08.23.22279117v1
+<!-- badges: start -->
+[![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental)
+[![R-CMD-check](https://github.com/nhs-r-community/NHSRwaitinglist/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/nhs-r-community/NHSRwaitinglist/actions/workflows/R-CMD-check.yaml)
+[![Codecov test coverage](https://codecov.io/gh/nhs-r-community/NHSRwaitinglist/branch/main/graph/badge.svg)](https://app.codecov.io/gh/nhs-r-community/NHSRwaitinglist?branch=main)
+
+
+<!-- badges: end -->
+
+
+# NHSRwaitinglist <a alt="NHS-R Community's logo" href='https://nhsrcommunity.com/'><img src='https://nhs-r-community.github.io/assets/logo/nhsr-logo.png' align="right" height="80" /></a>
+
+An R-package to implement the waiting list management approach described in this paper by Fong et al https://www.medrxiv.org/content/10.1101/2022.08.23.22279117v1
+
+
+## To install the package, run:
+``` r
+remotes::install_github("nhs-r-community/NHSRwaitinglist", build_vignettes = TRUE)
+```
 
 
 ## Contribution
@@ -19,4 +35,4 @@ You are welcome to also submit Pull Requests and, as the `main` branch is protec
 * Commit to the new branch (add code or delete code or make changes)
 * Push the commits 
 * Create a pull-request in GitHub to signal that your work is ready to be merged
-* Tag one or more reviewers so that your contribution can be reviewed and merged into `main`
+* Tag one or more reviewers so that your contribution can be reviewed and merged into `main`

codecov.yml

@@ -0,0 +1,14 @@
+comment: false
+
+coverage:
+  status:
+    project:
+      default:
+        target: auto
+        threshold: 1%
+        informational: true
+    patch:
+      default:
+        target: auto
+        threshold: 1%
+        informational: true

tests/testthat.R

@@ -0,0 +1,12 @@
+# This file is part of the standard setup for testthat.
+# It is recommended that you do not modify it.
+#
+# Where should you do additional test configuration?
+# Learn more about the roles of various files in:
+# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
+# * https://testthat.r-lib.org/articles/special-files.html
+
+library(testthat)
+library(NHSRwaitinglist)
+
+test_check("NHSRwaitinglist")

tests/testthat/test-average_wait.R

@@ -0,0 +1,54 @@
+# # Anticipated test from the error handling that Matt Dray is drafting
+# test_that("function catches null values and reports error", {
+#   em <- "target_wait(): no error message when function is run with no inputs."
+#   expect_error(target_wait(), em)
+# })
+#
+# # Anticipated test from the error handling that Matt Dray is drafting
+# test_that("function catches mismatched input lengths", {
+#   em <- "target_wait(): no error message when functions inputs are of different length."
+#   expect_error(target_wait(c(22,25,26), c(4, 3)), em)
+# })
+#
+# # Anticipated test from the error handling that Matt Dray is drafting
+# test_that("it returns an error if either input aren't numeric", {
+#   in1 <- Sys.Date()
+#   in2 <- 4
+#
+#   em <- "target_wait(): all inputs must be numeric."
+#   expect_error(target_wait(in1, in2), em)
+# })
+
+test_that("it returns an expected result with fixed single values, against arithmetic", {
+  em <- "average_wait(): arithmetic error with single value inputs."
+  expect_equal(average_wait(52, 4), 52/4)
+})
+
+test_that("it returns an expected result with fixed single values", {
+  em <- "average_wait(): arithmetic error with single value inputs."
+  expect_equal(average_wait(52, 4), 13)
+})
+
+
+
+test_that("it returns an expected result with vector of fixed values", {
+  em <- "average_wait(): aritmetic error with vector of values as inputs."
+  expect_equal(
+    average_wait(
+      c(35, 30, 52),
+      c(4,4,6)
+    )
+    , c(8.75, 7.5, 8.6666667)
+  )
+})
+
+
+test_that("it returns the same length output as provided on input", {
+  n <- round(runif(1, 0,30))
+  in1 <- rnorm(n = n, 50, 20)
+  in2 <- rnorm(n = n, 4, 2)
+  em <- "target_queue_size(): output vector length != input vector length."
+  expect_length(average_wait(in1, in2), length(in1))
+})
+
+

tests/testthat/test-queue_load.R

@@ -0,0 +1,53 @@
+# # Anticipated test from the error handling that Matt Dray is drafting
+# test_that("function catches null values and reports error", {
+#   em <- "queue_load(): no error message when function is run with no inputs."
+#   expect_error(queue_load(), em)
+# })
+#
+# # Anticipated test from the error handling that Matt Dray is drafting
+# test_that("function catches mismatched input lengths", {
+#   em <- "queue_load(): no error message when functions inputs are of different length."
+#   expect_error(queue_load(c(22,25,26), c(15, 20)), em)
+# })
+#
+# # Anticipated test from the error handling that Matt Dray is drafting
+# test_that("it returns an error if either input aren't numeric", {
+#   in1 <- Sys.Date()
+#   in2 <- 27
+#
+#   em <- "queue_load(): all inputs must be numeric."
+#   expect_error(queue_load(in1, in2), em)
+# })
+
+test_that("it returns an expected result with fixed single values, against arithmetic", {
+  em <- "queue_load(): arithmetic error with single value inputs."
+  expect_equal(queue_load(30, 27), 30/27)
+})
+
+test_that("it returns an expected result with fixed single values", {
+  em <- "queue_load(): arithmetic error with single value inputs."
+  expect_equal(queue_load(30, 27), 1.11111111)
+})
+
+
+test_that("it returns an expected result with vector of fixed values", {
+  em <- "queue_load(): arithmetic error with vector of values as inputs."
+  expect_equal(
+    queue_load(
+      c(35, 30, 52),
+      c(27,25,42)
+    )
+    , c( 1.2962963, 1.2, 1.23809524)
+  )
+})
+
+
+test_that("it returns the same length output as provided on input", {
+  n <- round(runif(1, 0,30))
+  in1 <- rnorm(n = n, 50, 20)
+  in2 <- rnorm(n = n, 30, 5)
+  em <- "target_queue_size(): output vector length != input vector length."
+  expect_length(queue_load(in1, in2), length(in1))
+})
+
+