Merge pull request #10 from pythonhealthdatascience/dev

Dev

Author: amyheather

.github/workflows/r_tests.yaml

@@ -0,0 +1,33 @@
+name: r_tests
+run-name: Run R tests
+
+on:
+  push:
+    branches: [main]
+  workflow_dispatch:
+
+jobs:
+  tests:
+    runs-on: ubuntu-latest
+
+    env:
+      RENV_CONFIG_PAK_ENABLED: true
+
+    steps:
+      - uses: actions/checkout@v4
+
+      - name: Set up R
+        uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+          r-version: 4.4.1
+
+      - name: Restore renv from root
+        run: |
+          Rscript -e 'renv::restore(project = ".")'
+
+      - name: Run testthat tests
+        run: |
+          Rscript -e 'renv::activate()'
+          Rscript -e 'devtools::load_all("examples/r_package")'
+          Rscript -e 'testthat::test_dir("examples/r_package/tests/testthat")'

CONTRIBUTING.md

@@ -4,11 +4,21 @@ This file is for contributors. It describes how the `hdruk_tests` site is set-up
 
 ## Example code
 
-The example code is contained in `examples/python_package/`.
+The example code is contained in `examples`.
 
-We want to be able to show individual functions without imports in the quarto website, so we have a script `tools/extract_snippets.py` which extracts each function without imports into individual `.py` files within `pages/code/`.
+We want to be able to show individual functions without imports in the quarto website, so we have a script `tools/extract_snippets.py` which extracts each function without imports into individual `.py` files within `pages/code/`. This is run each time the site is built via Quarto's `pre-render` hook.
 
-This is run each time the site is built via Quarto's `pre-render` hook.
+Example commands for the python package:
+
+* `pip install -e examples/python_package`
+* `pytest examples/python_package`
+
+Example commands for the R package (having first opened R console by running `R` - escaped with `quit()`):
+
+* `devtools::document("examples/r_package")`
+* `devtools::check("examples/r_package")`
+* `withr::with_dir("examples/r_package", {usethis::use_mit_license()})`
+* ` devtools::test("examples/r_package")`
 
 ## Rendering the quarto site
 

DESCRIPTION

@@ -1,6 +1,9 @@
 Title: hdruk_tests
 Imports:
+    covr
+    devtools
     knitr
+    patrick
     reticulate
     rmarkdown
     testthat

_quarto.yml

@@ -2,6 +2,7 @@ project:
   type: website
   pre-render:
     - python tools/extract_snippets.py
+    - python tools/extract_rsnippets.py
 
 website:
   title: "Testing in Research Workflows"

examples/r_package/.Rbuildignore

@@ -0,0 +1 @@
+^LICENSE\.md$

examples/r_package/DESCRIPTION

@@ -0,0 +1,20 @@
+Package: waitingtimes
+Title: waitingtimes
+Version: 0.0.0.9000
+Authors@R: 
+    person("Amy", "Heather", , "a.heather2@exeter.ac.uk", role = c("aut", "cre"))
+Description: Writing tests for a simple waiting times analysis.
+License: MIT + file LICENSE
+Encoding: UTF-8
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.3.3
+Imports:
+    devtools,
+    dplyr,
+    lubridate,
+    readr,
+    roxygen2,
+    usethis
+Suggests: 
+    testthat (>= 3.0.0)
+Config/testthat/edition: 3

examples/r_package/LICENSE

@@ -0,0 +1,2 @@
+YEAR: 2026
+COPYRIGHT HOLDER: Amy Heather and Tom Monks

examples/r_package/LICENSE.md

@@ -0,0 +1,21 @@
+# MIT License
+
+Copyright (c) 2026 Amy Heather and Tom Monks
+
+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.

examples/r_package/NAMESPACE

@@ -0,0 +1,5 @@
+# Generated by roxygen2: do not edit by hand
+
+export(calculate_wait_times)
+export(import_patient_data)
+export(summary_stats)

examples/r_package/R/patient_analysis.R

@@ -0,0 +1,125 @@
+# Functions to import, process, and summarise patient waiting time data.
+
+library(readr)
+library(dplyr)
+library(lubridate)
+
+
+#' Import raw patient data and check that required columns are present.
+#'
+#' Raises an error if the CSV file does not contain exactly the expected 
+#' columns in the expected order.
+#'
+#' @param path Character string giving path to the CSV file containing the 
+#'   patient data.
+#'
+#' @return A data frame containing the raw patient-level data.
+#'
+#' @export
+import_patient_data <- function(path) {
+  df <- readr::read_csv(path, show_col_types = FALSE)
+  
+  # Expected columns in the raw data (names and order must match)
+  expected <- c(
+    "PATIENT_ID",
+    "ARRIVAL_DATE", "ARRIVAL_TIME",
+    "SERVICE_DATE", "SERVICE_TIME"
+  )
+  if (!identical(colnames(df), expected)) {
+    stop(
+      sprintf(
+        "Unexpected columns: %s (expected %s)",
+        paste(colnames(df), collapse = ", "),
+        paste(expected, collapse = ", ")
+      )
+    )
+  }
+  
+  return(df)
+}
+
+
+#' Add arrival/service datetimes and waiting time in minutes.
+#'
+#' @param df Data frame with patient-level data containing `ARRIVAL_DATE`, 
+#'   `ARRIVAL_TIME`, `SERVICE_DATE`, and `SERVICE_TIME` columns.
+#'
+#' @return A copy of the input data frame with additional columns:
+#'   `arrival_datetime`, `service_datetime`, and `waittime`.
+#'
+#' @export
+calculate_wait_times <- function(df) {
+  df <- df |>
+    dplyr::mutate(
+      arrival_datetime = lubridate::ymd_hm(
+        paste(
+          as.character(ARRIVAL_DATE),
+          sprintf("%04d", as.integer(ARRIVAL_TIME))
+        )
+      ),
+      service_datetime = lubridate::ymd_hm(
+        paste(
+          as.character(SERVICE_DATE),
+          sprintf("%04d", as.integer(SERVICE_TIME))
+        )
+      )
+    )
+
+  if (any(is.na(df$arrival_datetime) | is.na(df$service_datetime))) {
+    stop(
+      "Failed to parse arrival or service datetimes; ",
+      "check for missing or invalid dates/times."
+    )
+  }
+
+  df <- df |>
+    dplyr::mutate(
+      waittime = as.numeric(
+        difftime(service_datetime, arrival_datetime, units = "mins")
+      )
+    )
+
+  df
+}
+
+
+#' Calculate mean, standard deviation and 95% confidence interval (CI).
+#'
+#' CI is calculated using the t-distribution, which is appropriate for
+#' small samples and converges to the normal distribution as the sample
+#' size increases.
+#'
+#' @param data Numeric vector of data to use in the calculation.
+#'
+#' @return A named list with elements `mean`, `std_dev`, `ci_lower` and 
+#'   `ci_upper`. Each value is a numeric, or `NA` if it can't be computed.
+#'
+#' @export
+summary_stats <- function(data) {
+  tibble::tibble(value = data) |>
+    dplyr::reframe(
+      n_complete = sum(!is.na(value)),
+      mean = mean(value, na.rm = TRUE),
+      std_dev = stats::sd(value, na.rm = TRUE),
+      ci_lower   = {
+        if (n_complete < 2L) {
+          NA_real_
+        } else if (std_dev == 0 || is.na(std_dev)) {
+          mean       # CI collapses to mean when no variation
+        } else {
+          stats::t.test(value)$conf.int[1L]
+        }
+      },
+      ci_upper   = {
+        if (n_complete < 2L) {
+          NA_real_
+        } else if (std_dev == 0 || is.na(std_dev)) {
+          mean       # CI collapses to mean when no variation
+        } else {
+          stats::t.test(value)$conf.int[2L]
+        }
+      }
+    ) |>
+    dplyr::select(-n_complete) |>
+    as.list()
+}