Merge pull request #11 from ThomUK/v0.1.2

V0.1.2  merge community contribution and further useability improvements.

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: SPCreporter
 Title: Creates Metric Reports using Statistical Process Control in the NHS style
-Version: 0.1.1
+Version: 0.1.2
 Authors@R: 
     person("Tom", "Smith", , "tomsmith_uk@hotmail.com", role = c("aut", "cre"))
 Description: Takes a dataset file and a configuration file to produce an html
@@ -25,7 +25,6 @@ Imports:
     glue,
     htmltools,
     lubridate,
-    magrittr,
     NHSRplotthedots,
     purrr,
     rlang,

NAMESPACE

@@ -1,7 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
-export("%>%")
+export(spcr_check_dataset_is_complete)
 export(spcr_make_data_bundle)
 export(spcr_make_report)
-importFrom(magrittr,"%>%")
 importFrom(utils,browseURL)

NEWS.md

@@ -1,3 +1,12 @@
+# SPCreporter 0.1.2
+
+## Useability improvements
+
+* measure_data requires data for only one (or more) of "week" or "month".
+* measure_data tolerates capitalised list (worksheet) names.
+* use the base pipe |> in place of %>%.
+* throw a helpful error if insufficient data items have been provided for a given report.
+
 # SPCreporter 0.1.1
 
 ## Bugfix

R/spcr_calculate_row.R

@@ -34,9 +34,9 @@ spcr_calculate_row <- function(ref, aggregation, measure_data, measure_config, r
   baseline_period <- subset_config$baseline_period
   rebase_dates <- subset_config$rebase_dates
   rebase_comment <- subset_config$rebase_comment
-  first_date <- subset_measure_data$date %>% min()
-  last_date <- subset_measure_data$date %>% max()
-  last_data_point <- subset_measure_data$value %>% utils::tail(n = 1)
+  first_date <- subset_measure_data$date |> min()
+  last_date <- subset_measure_data$date |> max()
+  last_data_point <- subset_measure_data$value |> utils::tail(n = 1)
 
   # throw a warning if the unit is "integer", but the data contains decimals
   if (unit == "integer" & any(subset_measure_data$value %% 1 != 0)) {
@@ -45,10 +45,10 @@ spcr_calculate_row <- function(ref, aggregation, measure_data, measure_config, r
 
   # calculate the updated_to date string
   if (aggregation == "week") {
-    updated_to <- (lubridate::ceiling_date(last_date, unit = "week", week_start = 1) - lubridate::days(1)) %>%
+    updated_to <- (lubridate::ceiling_date(last_date, unit = "week", week_start = 1) - lubridate::days(1)) |>
       format.Date("%d-%b-%Y")
   } else if (aggregation == "month") {
-    updated_to <- (lubridate::ceiling_date(last_date, unit = "month") - lubridate::days(1)) %>%
+    updated_to <- (lubridate::ceiling_date(last_date, unit = "month") - lubridate::days(1)) |>
       format.Date("%d-%b-%Y")
   } else {
     updated_to <- "-"
@@ -83,7 +83,7 @@ spcr_calculate_row <- function(ref, aggregation, measure_data, measure_config, r
     #      fix_after_n_points = #TODO
     improvement_direction = tolower(improvement_direction)
   )
-  plot <- spc %>% NHSRplotthedots::ptd_create_ggplot(
+  plot <- spc |> NHSRplotthedots::ptd_create_ggplot(
     point_size = 5,
     percentage_y_axis = is_percentage,
     main_title = paste0("#", ref, " - ", measure_name),

R/spcr_check_dataset_is_complete.R

@@ -0,0 +1,38 @@
+#' Check all required data items are provided
+#'
+#' @param report_config dataframe. The report config detailing required report items
+#' @param measure_data list. The data items to check
+#'
+#' @return logical
+#' @export
+#'
+spcr_check_dataset_is_complete <- function(report_config, measure_data) {
+
+  required_data <- report_config |>
+    dplyr::distinct(ref, measure_name, aggregation)
+
+  supplied_data <- measure_data |>
+    dplyr::bind_rows(.id = "aggregation") |>
+    dplyr::select(ref, measure_name, aggregation)
+
+  missing <- dplyr::setdiff(required_data, supplied_data)
+
+  # build an error message if there are missing data items
+  assertthat::assert_that(
+    nrow(missing) == 0,
+    msg = paste0(
+      "spcr_check_dataset_is_complete: Data is missing for ",
+      nrow(missing),
+      " report items. The first is ref ",
+      missing[1,][["ref"]],
+      ", ",
+      missing[1,][["measure_name"]],
+      ", ",
+      missing[1,][["aggregation"]],
+      "ly."
+    )
+  )
+
+  return(TRUE)
+
+}

R/spcr_check_measure_data.R

@@ -11,14 +11,17 @@ spcr_check_measure_data <- function(.data) {
     msg = "spcr_check_measure_data: The data must be a list."
   )
 
+  # convert list names to lower case
+  names(.data) <- names(.data) |> tolower()
+
   assertthat::assert_that(
-    all(names(.data) %in% c("week", "month")),
-    msg = "spcr_check_measure_data: The list items must be from 'week' or 'month'."
+    any(c("week", "month") %in% names(.data)),
+    msg = "spcr_check_measure_data: Data for either 'week' or 'month' is required."
   )
 
   # convert refs to character vectors
-  .data[["week"]]$ref <- as.character(.data[["week"]]$ref)
-  .data[["month"]]$ref <- as.character(.data[["month"]]$ref)
+  if("week" %in% names(.data)) .data[["week"]]$ref <- as.character(.data[["week"]]$ref)
+  if("month" %in% names(.data)) .data[["month"]]$ref <- as.character(.data[["month"]]$ref)
 
   return(.data)
 }

R/spcr_check_measure_names.R

@@ -20,8 +20,8 @@ spcr_check_measure_names <- function(ref, measure_data, measure_config) {
   )
 
   # find the titles to compare
-  m_title <- measure_data[measure_data$ref == ref, ]$measure_name %>% unique()
-  c_title <- measure_config[measure_config$ref == ref, ]$measure_name %>% unique()
+  m_title <- measure_data[measure_data$ref == ref, ]$measure_name |> unique()
+  c_title <- measure_config[measure_config$ref == ref, ]$measure_name |> unique()
 
   # check that the titles match
   assertthat::assert_that(

R/spcr_lengthen_measure_data.R

@@ -13,18 +13,18 @@ spcr_lengthen_measure_data <- function(.data, frequency) {
   )
 
   # pivot incoming measure_data from wide to long
-  long_data <- .data %>%
+  long_data <- .data |>
     tidyr::pivot_longer(
       -c("ref", "measure_name", "comment"),
       names_to = "date", values_to = "value"
-    ) %>%
-    dplyr::mutate(frequency = frequency) %>%
-    dplyr::select(-"comment") %>%
+    ) |>
+    dplyr::mutate(frequency = frequency) |>
+    dplyr::select(-"comment") |>
     dplyr::filter(!is.na("value"))
 
   # handle varying date column heading formats
   suppressWarnings(
-    long_data <- long_data %>%
+    long_data <- long_data |>
       dplyr::mutate(
         date = dplyr::case_when(
 

R/spcr_make_data_bundle.R

@@ -11,17 +11,23 @@ spcr_make_data_bundle <- function(measure_data, report_config, measure_config) {
   # check report_config
   report_config <- spcr_check_report_config(report_config)
 
-  # check measure_data, and lengthen the different aggregation levels into a single long dataframe
-  # adding the frequency in as a column
-  measure_data <- spcr_check_measure_data(measure_data) %>%
-    purrr::map2_df(.y = names(measure_data), .f = spcr_lengthen_measure_data)
+  # check measure_data
+  measure_data <- spcr_check_measure_data(measure_data)
 
   # check measure_config
   measure_config <- spcr_check_measure_config(measure_config)
 
+  # check all required data is supplied
+  spcr_check_dataset_is_complete(report_config, measure_data)
+
+  # lengthen the measure data aggregation levels into a single long dataframe
+  # adding the frequency in as a column
+  measure_data <- measure_data |>
+    purrr::map2_df(.y = names(measure_data), .f = spcr_lengthen_measure_data)
+
   # make a vector of the ref numbers to create charts for
-  refs <- report_config %>%
-    dplyr::pull("ref") %>%
+  refs <- report_config |>
+    dplyr::pull("ref") |>
     unique()
 
   # check reference numbers and measure names agree across both data frames
@@ -37,10 +43,10 @@ spcr_make_data_bundle <- function(measure_data, report_config, measure_config) {
     measure_data = measure_data,
     measure_config = measure_config,
     report_config = report_config
-  ) %>%
+  ) |>
     # add a column to control whether Domain titles are printed
     dplyr::mutate(
-      Needs_Domain_Heading = dplyr::if_else(Domain != dplyr::lag(Domain, default = "TRUE"), TRUE, FALSE)
+      Needs_Domain_Heading = dplyr::if_else("Domain" != dplyr::lag("Domain", default = "TRUE"), TRUE, FALSE)
     )
 
   return(result)

tests/testthat/test-spcr_calculate_row.R

@@ -37,7 +37,7 @@ measure_data <- list(
 )
 
 # process info to get it into the same shape as spcr_make_data_bundle does
-measure_data_long <- spcr_check_measure_data(measure_data) %>%
+measure_data_long <- spcr_check_measure_data(measure_data) |>
   purrr::map2_df(.y = names(measure_data), .f = spcr_lengthen_measure_data)
 
 measure_config <- tibble::tibble(
@@ -84,8 +84,8 @@ test_that("it throws a warning if any measure is labelled as integer but has dec
   measure_data_decimals <- measure_data
 
   # process info to get it into the same shape as spcr_make_data_bundle does
-  measure_data_decimals <- spcr_check_measure_data(measure_data_decimals) %>%
-    purrr::map2_df(.y = names(measure_data_decimals), .f = spcr_lengthen_measure_data) %>%
+  measure_data_decimals <- spcr_check_measure_data(measure_data_decimals) |>
+    purrr::map2_df(.y = names(measure_data_decimals), .f = spcr_lengthen_measure_data) |>
     dplyr::mutate(
       value = dplyr::case_when(
         measure_name == "M1" ~ value + 0.5,

tests/testthat/test-spcr_check_dataset_is_complete.R

@@ -0,0 +1,63 @@
+measure_data <- list(
+  week = tibble::tibble(
+    ref = c("1", "2", "3"),
+    measure_name = c("M1", "M2", "M3"),
+    comment = c("comment", "comment", "comment"),
+    `43836` = c(1, 3.2, 0.5),
+    `43843` = c(2, 4.2, 0.6),
+    `43850` = c(1, 3.2, 0.5),
+    `43857` = c(2, 4.2, 0.6),
+    `43864` = c(1, 3.2, 0.5),
+    `43871` = c(2, 4.2, 0.6),
+    `43878` = c(1, 3.2, 0.5),
+    `43885` = c(2, 4.2, 0.6),
+    `43892` = c(1, 3.2, 0.5),
+    `43899` = c(2, 4.2, 0.6),
+    `43906` = c(1, 3.2, 0.5),
+    `43913` = c(2, 4.2, 0.6)
+  ),
+  month = tibble::tibble(
+    ref = c("1", "2", "3"),
+    measure_name = c("M1", "M2", "M3"),
+    comment = c("comment", "comment", "comment"),
+    `43831` = c(1, 3.2, 0.5),
+    `43862` = c(2, 4.2, 0.6),
+    `43891` = c(1, 3.2, 0.5),
+    `43922` = c(2, 4.2, 0.6),
+    `43952` = c(1, 3.2, 0.5),
+    `43983` = c(2, 4.2, 0.6),
+    `44013` = c(1, 3.2, 0.5),
+    `44044` = c(2, 4.2, 0.6),
+    `44075` = c(1, 3.2, 0.5),
+    `44105` = c(2, 4.2, 0.6),
+    `44136` = c(1, 3.2, 0.5),
+    `44166` = c(2, 4.2, 0.6)
+  )
+)
+
+report_config <- tibble::tibble(
+  ref = c("1", "2", "3", "1", "2", "3"),
+  measure_name = c("M1", "M2", "M3", "M1", "M2", "M3"),
+  domain = c("D1", "D1", "D1", "D2", "D2", "D2"),
+  aggregation = c("week", "week", "week", "month", "month", "month")
+)
+
+
+"it returns true when all required data is present" |>
+  test_that({
+    expect_equal(
+      spcr_check_dataset_is_complete(report_config, measure_data),
+      TRUE
+    )
+  })
+
+"it errors when insufficient data has been supplied" |>
+  test_that({
+    # remove the monthly data
+    measure_data[["month"]] <- NULL
+
+    expect_error(
+      spcr_check_dataset_is_complete(report_config, measure_data),
+      "spcr_check_dataset_is_complete: Data is missing for 3 report items. The first is ref 1, M1, monthly."
+    )
+  })