Merge pull request #79 from pythonhealthdatascience/dev

Dev

Author: amyheather

.github/workflows/test-coverage.yaml

@@ -0,0 +1,62 @@
+# 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]
+  workflow_dispatch:
+
+name: test-coverage.yaml
+
+permissions: read-all
+
+jobs:
+  test-coverage:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
+    steps:
+      - 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, any::xml2
+          needs: coverage
+
+      - name: Test coverage
+        run: |
+          cov <- covr::package_coverage(
+            quiet = FALSE,
+            clean = FALSE,
+            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
+        shell: bash
+
+      - name: Upload test results
+        if: failure()
+        uses: actions/upload-artifact@v4
+        with:
+          name: coverage-test-failures
+          path: ${{ runner.temp }}/package

CITATION.cff

@@ -3,7 +3,7 @@
 
 cff-version: 1.2.0
 title: >-
-  R DES RAP Template
+  Simple M/M/s queuing model: R DES RAP
 message: >-
   If you use this software, please cite it using the
   metadata from this file.
@@ -17,7 +17,7 @@ authors:
 repository-code: >-
   https://github.com/pythonhealthdatascience/rdesrap_mms
 abstract: >-
-  A template for creating discrete-event simulation (DES) models in R
-  within a reproducible analytical pipeline (RAP).
+  Reproducible analytical pipeline (RAP) for R discrete-event simulation (DES)
+  implementing a simple M/M/s queueing model.
 version: 0.4.0
 date-released: '2025-06-04'

DESCRIPTION

@@ -10,8 +10,8 @@ Authors@R: c(
     )
   )
 URL: https://github.com/pythonhealthdatascience/rdesrap_mms
-Description: Template reproducible analytical pipeline (RAP) for simple R
-    discrete-event simulation (DES) model.
+Description: Reproducible analytical pipeline (RAP) for R discrete-event
+  simulation (DES) implementing a simple M/M/s queueing model.
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
@@ -40,5 +40,7 @@ Suggests:
     mockery,
     fitdistrplus,
     lubridate,
-    plotly
+    plotly,
+    covr,
+    DT
 Config/testthat/edition: 3

NEWS.md

@@ -1,3 +1,7 @@
+# Simple M/M/s queuing model: R DES RAP (unreleased)
+
+TBC.
+
 # R DES RAP Template 0.4.0
 
 Major changes include: addition of two new metrics (queue length and patients in service); input modelling; and synthetic data. Also, enabled solutions below the defined initial replications for the replications algorithm.

R/choose_replications.R

@@ -574,9 +574,9 @@ confidence_interval_method <- function(replications, desired_precision,
   )
   if (nrow(compare) > 0L) {
     # Get minimum number
-    n_reps <- compare %>%
-      dplyr::slice_head() %>%
-      dplyr::select(replications) %>%
+    n_reps <- compare |>
+      dplyr::slice_head() |>
+      dplyr::select(replications) |>
       dplyr::pull()
     message("Reached desired precision (", desired_precision, ") in ",
             n_reps, " replications.")

R/choose_warmup.R

@@ -27,23 +27,23 @@ time_series_inspection <- function(result, file_path, warm_up = NULL) {
   metrics <- list()
 
   # Wait time of each patient at each time point
-  metrics[[1L]] <- result[["arrivals"]] %>%
-    rename(time = .data[["serve_start"]]) %>%
+  metrics[[1L]] <- result[["arrivals"]] |>
+    rename(time = .data[["serve_start"]]) |>
     select(.data[["replication"]],
            .data[["time"]],
            .data[["wait_time"]])
 
   # Service length of each patient at each time point
-  metrics[[2L]] <- result[["arrivals"]] %>%
-    rename(time = .data[["serve_start"]]) %>%
+  metrics[[2L]] <- result[["arrivals"]] |>
+    rename(time = .data[["serve_start"]]) |>
     select(.data[["replication"]],
            .data[["time"]],
            .data[["serve_length"]])
 
   # Utilisation at each time point
   metrics[[3L]] <- calc_utilisation(result[["resources"]],
                                     groups = c("resource", "replication"),
-                                    summarise = FALSE) %>%
+                                    summarise = FALSE) |>
     select(.data[["replication"]],
            .data[["time"]],
            .data[["utilisation"]])
@@ -55,18 +55,18 @@ time_series_inspection <- function(result, file_path, warm_up = NULL) {
     metric <- setdiff(names(metrics[[i]]), c("time", "replication"))
 
     # Calculate cumulative mean for the current metric
-    cumulative <- metrics[[i]] %>%
-      arrange(.data[["replication"]], .data[["time"]]) %>%
-      group_by(.data[["replication"]]) %>%
+    cumulative <- metrics[[i]] |>
+      arrange(.data[["replication"]], .data[["time"]]) |>
+      group_by(.data[["replication"]]) |>
       mutate(cumulative_mean = cumsum(.data[[metric]]) /
-               seq_along(.data[[metric]])) %>%
+               seq_along(.data[[metric]])) |>
       ungroup()
 
     # Repeat calculation, but including all replications in one
-    overall_cumulative <- metrics[[i]] %>%
-      arrange(.data[["time"]]) %>%
+    overall_cumulative <- metrics[[i]] |>
+      arrange(.data[["time"]]) |>
       mutate(cumulative_mean = cumsum(.data[[metric]]) /
-               seq_along(.data[[metric]])) %>%
+               seq_along(.data[[metric]])) |>
       ungroup()
 
     # Create plot

R/get_run_results.R

@@ -59,8 +59,8 @@ calc_arrivals <- function(arrivals, groups = NULL) {
     arrivals <- group_by(arrivals, across(all_of(groups)))
   }
   # Calculate number of arrivals
-  arrivals %>%
-    summarise(arrivals = n_distinct(.data[["name"]])) %>%
+  arrivals |>
+    summarise(arrivals = n_distinct(.data[["name"]])) |>
     ungroup()
 }
 
@@ -79,11 +79,11 @@ calc_mean_patients_in_service <- function(patient_count, groups = NULL) {
     patient_count <- group_by(patient_count, across(all_of(groups)))
   }
   # Calculate the time-weighted number of patients in the service
-  patient_count %>%
+  patient_count |>
     # Sort by time
-    arrange(.data[["time"]]) %>%
+    arrange(.data[["time"]]) |>
     # Calculate time between this row and the next
-    mutate(interval_duration = (lead(.data[["time"]]) - .data[["time"]])) %>%
+    mutate(interval_duration = (lead(.data[["time"]]) - .data[["time"]])) |>
     # Multiply each patient count by its own unique duration. The total of
     # those is then divided by the total duration of all intervals.
     # Hence, we are calculated a time-weighted average patient count.
@@ -92,7 +92,7 @@ calc_mean_patients_in_service <- function(patient_count, groups = NULL) {
         sum(.data[["count"]] * .data[["interval_duration"]], na.rm = TRUE) /
           sum(.data[["interval_duration"]], na.rm = TRUE)
       )
-    ) %>%
+    ) |>
     ungroup()
 }
 
@@ -110,14 +110,14 @@ calc_mean_queue <- function(arrivals, groups = NULL) {
   group_vars <- c("resource", groups)
 
   # Calculate mean queue length for each resource
-  arrivals %>%
-    group_by(across(all_of(group_vars))) %>%
+  arrivals |>
+    group_by(across(all_of(group_vars))) |>
     # Sort by arrival time
-    arrange(.data[["start_time"]]) %>%
+    arrange(.data[["start_time"]]) |>
     # Calculate time between this row and the next
     mutate(
       interval_duration = (lead(.data[["start_time"]]) - .data[["start_time"]])
-    ) %>%
+    ) |>
     # Multiply each queue length by its own unique duration. The total of
     # those is then divided by the total duration of all intervals.
     # Hence, we are calculated a time-weighted average queue length.
@@ -126,11 +126,11 @@ calc_mean_queue <- function(arrivals, groups = NULL) {
             .data[["interval_duration"]], na.rm = TRUE) /
         sum(.data[["interval_duration"]], na.rm = TRUE)
     )
-    ) %>%
+    ) |>
     # Reshape dataframe
     pivot_wider(names_from = "resource",
                 values_from = "mean_queue_length",
-                names_glue = "mean_queue_length_{resource}") %>%
+                names_glue = "mean_queue_length_{resource}") |>
     ungroup()
 }
 
@@ -156,12 +156,12 @@ calc_mean_wait <- function(arrivals, resources, groups = NULL) {
     group_vars <- c("resource", groups)
 
     # Calculate mean wait time for each resource
-    complete_arrivals %>%
-      group_by(across(all_of(group_vars))) %>%
-      summarise(mean_waiting_time = mean(.data[["wait_time"]])) %>%
+    complete_arrivals |>
+      group_by(across(all_of(group_vars))) |>
+      summarise(mean_waiting_time = mean(.data[["wait_time"]])) |>
       pivot_wider(names_from = "resource",
                   values_from = "mean_waiting_time",
-                  names_glue = "mean_waiting_time_{resource}") %>%
+                  names_glue = "mean_waiting_time_{resource}") |>
       ungroup()
   } else {
     # But if no patients are seen, create same tibble with values set to NA
@@ -195,12 +195,12 @@ calc_mean_serve_length <- function(arrivals, resources, groups = NULL) {
     group_vars <- c("resource", groups)
 
     # Calculate mean serve time for each resource
-    complete_arrivals %>%
-      group_by(across(all_of(group_vars))) %>%
-      summarise(mean_serve_time = mean(.data[["serve_length"]])) %>%
+    complete_arrivals |>
+      group_by(across(all_of(group_vars))) |>
+      summarise(mean_serve_time = mean(.data[["serve_length"]])) |>
       pivot_wider(names_from = "resource",
                   values_from = "mean_serve_time",
-                  names_glue = "mean_serve_time_{resource}") %>%
+                  names_glue = "mean_serve_time_{resource}") |>
       ungroup()
   } else {
     # But if no patients are seen, create same tibble with values set to NA
@@ -239,8 +239,8 @@ calc_utilisation <- function(resources, groups = NULL, summarise = TRUE) {
   group_vars <- c("resource", groups)
 
   # Calculate utilisation
-  util_df <- resources %>%
-    group_by(across(all_of(group_vars))) %>%
+  util_df <- resources |>
+    group_by(across(all_of(group_vars))) |>
     mutate(
       # Time between this row and the next
       interval_duration = lead(.data[["time"]]) - .data[["time"]],
@@ -256,18 +256,18 @@ calc_utilisation <- function(resources, groups = NULL, summarise = TRUE) {
 
   # If summarise = TRUE, find total utilisation
   if (summarise) {
-    util_df %>%
+    util_df |>
       summarise(
         # Multiply each utilisation by its own unique duration. The total of
         # those is then divided by the total duration of all intervals.
         # Hence, we are calculated a time-weighted average utilisation.
         utilisation = (sum(.data[["utilisation"]] *
                              .data[["interval_duration"]], na.rm = TRUE) /
                          sum(.data[["interval_duration"]], na.rm = TRUE))
-      ) %>%
+      ) |>
       pivot_wider(names_from = "resource",
                   values_from = "utilisation",
-                  names_glue = "utilisation_{resource}") %>%
+                  names_glue = "utilisation_{resource}") |>
       ungroup()
   } else {
     # If summarise = FALSE, just return the util_df with no further processing
@@ -288,12 +288,12 @@ calc_unseen_n <- function(arrivals, groups = NULL) {
   # Create list of grouping variables (always "resource", but can add others)
   group_vars <- c("resource", groups)
   # Calculate number of patients waiting
-  arrivals %>%
-    group_by(across(all_of(group_vars))) %>%
-    summarise(value = sum(!is.na(.data[["wait_time_unseen"]]))) %>%
+  arrivals |>
+    group_by(across(all_of(group_vars))) |>
+    summarise(value = sum(!is.na(.data[["wait_time_unseen"]]))) |>
     pivot_wider(names_from = "resource",
                 values_from = "value",
-                names_glue = "count_unseen_{resource}") %>%
+                names_glue = "count_unseen_{resource}") |>
     ungroup()
 }
 
@@ -311,11 +311,11 @@ calc_unseen_mean <- function(arrivals, groups = NULL) {
   # Create list of grouping variables (always "resource", but can add others)
   group_vars <- c("resource", groups)
   # Calculate wait time of unseen patients
-  arrivals %>%
-    group_by(across(all_of(group_vars))) %>%
-    summarise(value = mean(.data[["wait_time_unseen"]], na.rm = TRUE)) %>%
+  arrivals |>
+    group_by(across(all_of(group_vars))) |>
+    summarise(value = mean(.data[["wait_time_unseen"]], na.rm = TRUE)) |>
     pivot_wider(names_from = "resource",
                 values_from = "value",
-                names_glue = "mean_waiting_time_unseen_{resource}") %>%
+                names_glue = "mean_waiting_time_unseen_{resource}") |>
     ungroup()
 }