Merge pull request #15 from ThomUK/development

v0.1.3

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: SPCreporter
 Title: Creates Metric Reports using Statistical Process Control in the NHS style
-Version: 0.1.2
+Version: 0.1.3
 Authors@R: 
     person("Tom", "Smith", , "[email protected]", role = c("aut", "cre"))
 Description: Takes a dataset file and a configuration file to produce an html

NEWS.md

@@ -1,11 +1,19 @@
+# SPCreporter 0.1.3
+
+## Useability improvements
+
+* Significant improvements to error messages relating to measure_data, report_config, and measure_config.  Error messages now explicitly name any required columns which the user has not supplied.  This is intended to make troubleshooting simpler to do.  
+* The data source for metrics is now named in charts as a caption.  
+* Other minor useability improvements intended to make working with real-world config documents easier to do.  
+
 # 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.
+* 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
 

R/spcr_calculate_row.R

@@ -3,7 +3,7 @@
 #' also handles rounding, capitalisation, and the addition of percentage
 #' symbols where appropriate.
 #'
-#' @param ref character. The reference number for the measure.
+#' @param ref_no character. The reference number for the measure.
 #' @param aggregation character. The aggregation level required in the report.
 #' @param measure_data dataframe. The data to be reported.
 #' @param measure_config dataframe. The config information for each measure.
@@ -13,11 +13,12 @@
 #'
 #' @noRd
 #'
-spcr_calculate_row <- function(ref, aggregation, measure_data, measure_config, report_config) {
+spcr_calculate_row <- function(ref_no, aggregation, measure_data, measure_config, report_config) {
   # subset down to the measure of interest
-  subset_config <- measure_config[measure_config$ref == ref, ]
-  subset_report_config <- report_config[report_config$ref == ref & report_config$aggregation == aggregation, ]
-  subset_measure_data <- measure_data[measure_data$ref == ref & measure_data$frequency == aggregation, ]
+  subset_config <- measure_config |>
+      dplyr::filter(ref == ref_no)
+  subset_report_config <- report_config[report_config$ref == ref_no & report_config$aggregation == aggregation, ]
+  subset_measure_data <- measure_data[measure_data$ref == ref_no & measure_data$frequency == aggregation, ]
 
   # separate out the information required
   measure_name <- subset_config$measure_name
@@ -40,7 +41,7 @@ spcr_calculate_row <- function(ref, aggregation, measure_data, measure_config, r
 
   # throw a warning if the unit is "integer", but the data contains decimals
   if (unit == "integer" & any(subset_measure_data$value %% 1 != 0)) {
-    warning("spcr_calculate_row: Measure ", ref, " is configured as an integer, but has been supplied with decimal data.")
+    warning("spcr_calculate_row: Measure ", ref_no, " is configured as an integer, but has been supplied with decimal data.")
   }
 
   # calculate the updated_to date string
@@ -86,13 +87,16 @@ spcr_calculate_row <- function(ref, aggregation, measure_data, measure_config, r
   plot <- spc |> NHSRplotthedots::ptd_create_ggplot(
     point_size = 5,
     percentage_y_axis = is_percentage,
-    main_title = paste0("#", ref, " - ", measure_name),
+    main_title = paste0("#", ref_no, " - ", measure_name),
     x_axis_label = NULL,
     y_axis_label = NULL,
     x_axis_date_format = x_date_format,
     icons_position = "none",
     break_lines = "limits"
   ) +
+    ggplot2::labs(
+      caption = paste0("Data source: ", data_source)
+    ) +
     ggplot2::theme(
       text = ggplot2::element_text(size = 16),
       axis.text.x = ggplot2::element_text(angle = 45, hjust = 1),
@@ -105,7 +109,7 @@ spcr_calculate_row <- function(ref, aggregation, measure_data, measure_config, r
 
   # assemble the result
   result <- tibble::tibble(
-    Ref = as.character(ref),
+    Ref = as.character(ref_no),
     Measure_Name = measure_name,
     Domain = domain,
     Aggregation = aggregation,

R/spcr_check_measure_config.R

@@ -11,7 +11,8 @@ spcr_check_measure_config <- function(.data) {
     msg = "spcr_check_measure_config: config_data must be a data.frame"
   )
 
-  mandatory_columns <- c(
+  # check for column names, and provide a helpful error message if needed
+  required_columns <- c(
     "ref",
     "measure_name",
     "data_source",
@@ -27,13 +28,17 @@ spcr_check_measure_config <- function(.data) {
     "rebase_comment"
   )
 
-  assertthat::assert_that(
-    all(mandatory_columns %in% names(.data)),
-    msg = "spcr_check_measure_config: config_data is missing a mandatory column.  Check the input spreadsheet."
-  )
+  # check required cols are present
+  spcr_check_for_required_columns(.data, "measure_config", required_columns)
 
   # convert refs to character vectors
   .data$ref <- as.character(.data$ref)
 
+  # convert target to numeric
+  # warnings for coercing "-" to NA are surpressed
+  suppressWarnings(
+    .data$target <- as.numeric(.data$target)
+  )
+
   return(.data)
 }

R/spcr_check_measure_data.R

@@ -7,7 +7,7 @@
 #'
 spcr_check_measure_data <- function(.data) {
   assertthat::assert_that(
-    class(.data) == "list",
+    inherits(.data, "list"),
     msg = "spcr_check_measure_data: The data must be a list."
   )
 
@@ -19,9 +19,47 @@ spcr_check_measure_data <- function(.data) {
     msg = "spcr_check_measure_data: Data for either 'week' or 'month' is required."
   )
 
+  # check for column names, and provide a helpful error message if needed
+  required_columns <- c("ref", "measure_name", "comment")
+
+  # check required cols are present
+  if("week" %in% names(.data)) spcr_check_for_required_columns(.data[["week"]], "measure_data", required_columns)
+  if("month" %in% names(.data)) spcr_check_for_required_columns(.data[["month"]], "measure_data", required_columns)
+
   # convert refs to character vectors
   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)
 }
+
+
+#' Check that required columns are present in a user-supplied dataframe
+#'
+#' @param dtf dataframe. The dataframe to check
+#' @param name_of_dataframe_being_checked character. The dataframe name to use in the error message
+#' @param required_columns character. A vector of the required column names
+#'
+#' @return logical. TRUE if all are present, or error if not
+#' @noRd
+#'
+spcr_check_for_required_columns <- function(dtf, name_of_dataframe_being_checked, required_columns){
+  missing_columns <- required_columns[!required_columns %in% names(dtf)]
+
+  if(length(missing_columns)){
+
+    # find the name of the first missing col for the error message
+    first_missing_column <- missing_columns[1]
+
+    # throw the error
+    stop(
+      "spcr_check_for_required_columns: Column '",
+      first_missing_column,
+      "' is missing from the ",
+      name_of_dataframe_being_checked,
+      ". Check for typos in the column names."
+    )
+  }
+
+  return(TRUE)
+}

R/spcr_check_measure_names.R

@@ -1,34 +1,37 @@
 #' (internal function) Check measure names to avoid mismatches
 #' Returns errors messages in cases of mismatch
 #'
-#' @param ref A single reference number to check
+#' @param ref_no A single ref_noerence number to check
 #' @param measure_data Dataframe of measure data
 #' @param measure_config Dataframe of config data
 #'
 #' @return NULL
 #' @noRd
 #'
-spcr_check_measure_names <- function(ref, measure_data, measure_config) {
-  # check that the config table includes this ref number
+spcr_check_measure_names <- function(ref_no, measure_data, measure_config) {
+  # check that the config table includes this ref_no number
   assertthat::assert_that(
-    length(measure_config[measure_config$ref == ref, ]$ref) > 0,
+    length(measure_config[measure_config$ref == ref_no, ]$ref) > 0,
     msg = paste0(
       "spcr_check_measure_names: Config data for ref ",
-      ref,
+      ref_no,
       " is missing from the measure_config dataframe."
     )
   )
 
   # 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_no, ]$measure_name |> unique()
+  c_title <- measure_config |>
+    dplyr::filter(measure_config$ref == ref_no) |>
+    dplyr::pull(measure_name) |>
+    unique()
 
   # check that the titles match
   assertthat::assert_that(
     isTRUE(m_title == c_title),
     msg = paste0(
       "spcr_check_measure_names: There is a name mismatch for measure ref: ",
-      ref,
+      ref_no,
       ". Check for typos or mismatching refs or data."
     )
   )

R/spcr_check_report_config.R

@@ -4,17 +4,16 @@ spcr_check_report_config <- function(report_config) {
     msg = "spcr_check_report_config: The report config must be a dataframe."
   )
 
-  mandatory_columns <- c(
+  # check for column names, and provide a helpful error message if needed
+  required_columns <- c(
     "ref",
     "measure_name",
     "domain",
     "aggregation"
   )
 
-  assertthat::assert_that(
-    all(mandatory_columns %in% names(report_config)),
-    msg = "spcr_check_report_config: report_config is missing a mandatory column.  Check the input spreadsheet."
-  )
+  # check required cols are present
+  spcr_check_for_required_columns(report_config, "report_config", required_columns)
 
   # convert refs to character vectors
   report_config$ref <- as.character(report_config$ref)

tests/testthat/test-spcr_calculate_row.R

@@ -134,3 +134,20 @@ test_that("it returns the 'updated to' string correctly", {
     "31-Dec-2020"
   )
 })
+
+"it ignores NAs in the ref column of the measure_config" |>
+test_that({
+
+  # create the error condition
+  measure_config <- measure_config |>
+    dplyr::bind_rows(
+      tibble::tibble(
+        ref = NA
+      )
+    )
+
+  expect_no_error(
+    spcr_calculate_row("1", "week", measure_data_long, measure_config, report_config)
+  )
+
+})

tests/testthat/test-spcr_check_measure_config.R

@@ -26,3 +26,22 @@ test_that("it coerces refs to character vectors", {
     c("1", "2", "3")
   )
 })
+
+"it errors helpfully when column names are missing or mis-spelled" |>
+  test_that({
+    # create the error by removing a required column
+    measure_config$unit <- NULL
+
+    expect_error(
+      spcr_check_measure_config(measure_config),
+      "spcr_check_for_required_columns: Column 'unit' is missing from the measure_config. Check for typos in the column names."
+    )
+
+    # error persists when the column is mis-spelled
+    measure_config$Unit <- c("Integer", "Decimal", "%")
+
+    expect_error(
+      spcr_check_measure_config(measure_config),
+      "spcr_check_for_required_columns: Column 'unit' is missing from the measure_config. Check for typos in the column names."
+    )
+  })

tests/testthat/test-spcr_check_measure_data.R

@@ -1,7 +1,7 @@
 "it errors if the data is not a list" |>
   test_that({
     expect_error(
-      spcr_check_measure_data("not a list"),
+      spcr_check_measure_data(tibble::tibble(this_is = "not a list")),
       "spcr_check_measure_data: The data must be a list."
     )
   })
@@ -18,9 +18,9 @@
   test_that({
     expect_no_error(
       list(
-        week = data.frame(ref = 1),
-        month = data.frame(ref = 2),
-        asdf = data.frame(ref = 3) # extra element
+        week = data.frame(ref = 1, measure_name = "M1", comment = NA),
+        month = data.frame(ref = 2, measure_name = "M2", comment = NA),
+        asdf = data.frame(some = "other data") # extra element
       ) |>
         spcr_check_measure_data()
     )
@@ -31,7 +31,7 @@
 
     expect_no_error(
       list(
-        week = data.frame(ref = 1)
+        week = data.frame(ref = 1, measure_name = "M1", comment = NA)
         # month list item is not provided
       ) |>
         spcr_check_measure_data()
@@ -40,7 +40,7 @@
     expect_no_error(
       list(
         # week list item is not provided
-        month = data.frame(ref = 2)
+        month = data.frame(ref = 2, measure_name = "M2", comment = NA)
       ) |>
         spcr_check_measure_data()
     )
@@ -50,7 +50,7 @@
   test_that({
     expect_no_error(
       list(
-        Week = data.frame(ref = 1) # Week not week
+        Week = data.frame(ref = 1, measure_name = "M1", comment = NA) # Week not week
       ) |>
         spcr_check_measure_data()
     )
@@ -106,3 +106,22 @@ measure_data <- list(
       c("1", "2", "3")
     )
   })
+
+"it errors helpfully when column names are missing or mis-spelled" |>
+  test_that({
+    # create the error by removing a required column
+    measure_data[["week"]]$ref <- NULL
+
+    expect_error(
+      spcr_check_measure_data(measure_data),
+      "spcr_check_for_required_columns: Column 'ref' is missing from the measure_data. Check for typos in the column names."
+    )
+
+    # error persists when the column is mis-spelled
+    measure_data[["week"]]$Reference <- c(1, 2, 3)
+
+    expect_error(
+      spcr_check_measure_data(measure_data),
+      "spcr_check_for_required_columns: Column 'ref' is missing from the measure_data. Check for typos in the column names."
+    )
+  })