Merge pull request #21 from ThomUK/development

v0.1.4

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: SPCreporter
 Title: Creates Metric Reports using Statistical Process Control in the NHS style
-Version: 0.1.3
+Version: 0.1.4
 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,3 +1,13 @@
+# SPCreporter 0.1.4
+
+## Feature addition
+
+* Add two new optional columns to the measure_config: "Reviewed At", and "Escalated To".  If present the text in these fields is rendered into the final report below each chart.  
+
+## Bugfix
+
+* Fixed an error caused when measure_data contained NAs.  The package will now tolerate NAs in the data.  
+
 # SPCreporter 0.1.3
 
 ## Useability improvements

R/spcr_calculate_row.R

@@ -26,6 +26,8 @@ spcr_calculate_row <- function(ref_no, aggregation, measure_data, measure_config
   data_source <- subset_config$data_source
   data_owner <- subset_config$data_owner
   accountable_person <- subset_config$accountable_person
+  reviewed_at <- ifelse("reviewed_at" %in% colnames(subset_config), subset_config$reviewed_at, NA) # optional column
+  escalated_to <- ifelse("escalated_to" %in% colnames(subset_config), subset_config$escalated_to, NA) # optional column
   unit <- tolower(subset_config$unit)
   improvement_direction <- subset_config$improvement_direction
   target <- subset_config$target[1]
@@ -40,7 +42,7 @@ spcr_calculate_row <- function(ref_no, aggregation, measure_data, measure_config
   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)) {
+  if (unit == "integer" & any(na.omit(subset_measure_data$value) %% 1 != 0)) {
     warning("spcr_calculate_row: Measure ", ref_no, " is configured as an integer, but has been supplied with decimal data.")
   }
 
@@ -119,6 +121,8 @@ spcr_calculate_row <- function(ref_no, aggregation, measure_data, measure_config
     Data_Source = data_source,
     Data_Owner = data_owner,
     Accountable_Person = accountable_person,
+    Reviewed_At = reviewed_at,
+    Escalated_To = escalated_to,
     Unit = unit,
     Improvement_Direction = improvement_direction,
     Target = target,

R/spcr_render_accordion.R

@@ -10,6 +10,8 @@
 #' @param Data_Source string. The name of the data origin
 #' @param Data_Owner string. The person/area who manage the reporting data
 #' @param Accountable_Person string. The person/area who is accountable for the measure
+#' @param Reviewed_At string. The meeting or activity where the measure is reviewed
+#' @param Escalated_To string. The meeting or activity where concerning trends are escalated
 #' @param Unit string. Integer, Decimal, or %
 #' @param Improvement_Direction string. Increase, Decrease, or Neutral
 #' @param Target numeric. The target (or NA)
@@ -41,6 +43,8 @@ spcr_render_accordion <- function(Ref,
                                   Data_Source,
                                   Data_Owner,
                                   Accountable_Person,
+                                  Reviewed_At,
+                                  Escalated_To,
                                   Unit,
                                   Improvement_Direction,
                                   Target,
@@ -121,6 +125,8 @@ spcr_render_accordion <- function(Ref,
       ),
       htmltools::p(if (!is.na(Rebase_Comment)) paste0("Rebase comments: ", Rebase_Comment)),
       htmltools::div(paste0("Accountable Person: ", Accountable_Person)),
+      htmltools::div(if (!is.na(Reviewed_At)) paste0("Reviewed At: ", Reviewed_At)),
+      htmltools::div(if (!is.na(Escalated_To)) paste0("Escalated (if needed) to: ", Escalated_To)),
       htmltools::div(paste0("Data owner: ", Data_Owner))
     ),
     style = glue::glue(

tests/testthat/test-spcr_calculate_row.R

@@ -151,3 +151,21 @@ test_that({
   )
 
 })
+
+"it tolerates NAs in the measure_data" |>
+test_that({
+
+  # create the error condition
+  measure_data_long <- measure_data_long |>
+    dplyr::mutate(
+      value = dplyr::case_when(
+        ref == 1 & frequency == "week" & date == as.Date("2020-01-06") ~ NA_real_,
+        TRUE ~ value
+      )
+    )
+
+  expect_no_error(
+    spcr_calculate_row("1", "week", measure_data_long, measure_config, report_config)
+  )
+
+})

tests/testthat/test-spcr_make_data_bundle.R

@@ -69,7 +69,7 @@ test_that("it returns a dataframe of the expected size", {
 
   expect_equal(
     ncol(r),
-    25
+    27
   )
 })
 
@@ -87,6 +87,30 @@ test_that("it works when no targets are set", {
 
   expect_equal(
     ncol(r),
-    25
+    27
   )
 })
+
+"it accepts optional columns from measure_config" |>
+test_that({
+
+  # add optional columns
+  measure_config$reviewed_at <- "ABC Meeting"
+  measure_config$escalated_to <- "XYZ Meeting"
+
+  r <- spcr_make_data_bundle(measure_data, report_config, measure_config)
+
+  expect_equal(
+    ncol(r),
+    27
+  )
+  expect_equal(
+    "Reviewed_At" %in% names(r),
+    TRUE
+  )
+  expect_equal(
+    "Escalated_To" %in% names(r),
+    TRUE
+  )
+
+})