Merge branch 'main' into render_rmd_v3

nhs-r-community · Aug 6, 2024 · 0e88fe0 · 0e88fe0
2 parents d5a4ad6 + 5c37e5d
commit 0e88fe0
Show file tree

Hide file tree

Showing 13 changed files with 313 additions and 305 deletions.
diff --git a/.github/workflows/render-rmarkdown.yml b/.github/workflows/render-rmarkdown.yml
@@ -5,7 +5,6 @@ on:
     paths: ['README.Rmd']
 
 name: render-rmarkdown.yml
-
 permissions: read-all
 
 jobs:
@@ -27,9 +26,9 @@ jobs:
 
       - uses: r-lib/actions/setup-renv@v2
 
-      - name: Render Rmarkdown files and Commit Results
+      - name: Render README.Rmd and Commit Results
         run: |
-          RMD_PATH=($(git diff --name-only ${{ github.event.before }} ${{ github.sha }} | grep '[.]Rmd$'))
+          RMD_PATH=($(git diff --name-only ${{ github.event.before }} ${{ github.sha }} | grep 'README[.]Rmd$'))
           Rscript -e 'for (f in commandArgs(TRUE)) if (file.exists(f)) rmarkdown::render(f)' ${RMD_PATH[*]}
           git config --local user.name "$GITHUB_ACTOR"
           git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com"

diff --git a/.lintr b/.lintr
@@ -2,10 +2,12 @@ linters: linters_with_defaults(
   line_length_linter(120),
   cyclocomp_linter(23),
   indentation_linter(hanging_indent_style = "tidy"),
-  object_name_linter("snake_case"))
+  object_name_linter("snake_case"),
+  trailing_blank_lines_linter = NULL
+  )
 exclusions: list(
-  "R/ptd_spc_colours.R" = 5)
+  "R/ptd_spc_colours.R" = 5
+  )
 exclude: "# Exclude Linting|#\\s?nolint"
 exclude_start: "# Begin Exclude Linting|#\\s?nolint-start"
 exclude_end: "# End Exclude Linting|#\\s?nolint-end"
-encoding: "ISO-8859-1"
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -3,26 +3,32 @@ Type: Package
 Title: Draw XmR Charts for NHSE/I 'Making Data Count' Programme
 Version: 0.1.0.9000
 Authors@R: c(
-          person("Christopher", "Reading", ,"christopher.reading1@nhs.net", c("cre", "aut")),
-          person("Simon", "Wellesley-Miller", ,"simon.wellesley-miller@nhs.net", "aut"),
-          person("Zoë", "Turner", , "Zoe.Turner2@nottshc.nhs.uk", "aut", comment = c(ORCID = "0000-0003-1033-9158")),
-          person("Tom", "Jemmett", ,"thomas.jemmett@nhs.net", "aut", comment = c(ORCID="0000-0002-6943-2990")),
-          person("Tom", "Smith", ,"thomas.smith5@nuh.nhs.uk", "aut"),
-          person("Chris", "Mainey", ,"c.mainey@nhs.net", "aut", comment = c(ORCID ="0000-0002-3018-6171")),
-          person("John", "MacKintosh", ,"john.mackintosh3@nhs.scot", "aut"),
-          person("Marcos", "Fabietti", ,"marcos.fabietti@nuh.nhs.uk", "aut"),
-          person("NHS-R community", email = "nhs.rcommunity@nhs.net", role = "cph")
+        person("Christopher", "Reading", ,"christopher.reading1@nhs.net", c("cre", "aut")),
+        person("Simon", "Wellesley-Miller", ,"simon.wellesley-miller@nhs.net", "aut"),
+        person("Zoë", "Turner", , "Zoe.Turner2@nottshc.nhs.uk", "aut", comment = c(ORCID = "0000-0003-1033-9158")),
+        person("Tom", "Jemmett", ,"thomas.jemmett@nhs.net", "aut", comment = c(ORCID="0000-0002-6943-2990")),
+        person("Tom", "Smith", ,"thomas.smith5@nuh.nhs.uk", "aut"),
+        person("Chris", "Mainey", ,"c.mainey@nhs.net", "aut", comment = c(ORCID ="0000-0002-3018-6171")),
+        person("John", "MacKintosh", ,"john.mackintosh3@nhs.scot", "aut"),
+        person("Marcos", "Fabietti", ,"marcos.fabietti@nuh.nhs.uk", "aut"),
+        person("Fran", "Barton",
+            email = "francis.barton@nhs.net",
+            role = "aut",
+            comment = c(ORCID = "0000-0002-5650-1176")
+          ),
+          person("NHS-R community",
+            email = "nhs.rcommunity@nhs.net",
+            role = "cph"
           )
+        )
 Maintainer: Christopher Reading <christopher.reading1@nhs.net>
-Description: Provides tools for drawing Statistical Process Control (SPC) charts. This package supports the NHSE/I
-  programme 'Making Data Count', and allows users to draw XmR charts, use change points and apply rules with summary
-  indicators for when rules are breached.
+Description: Provides tools for drawing Statistical Process Control (SPC) charts. This package supports the NHSE/I programme 'Making Data Count', and allows users to draw XmR charts, use change points and apply rules with summary indicators for when rules are breached.
 URL: https://nhs-r-community.github.io/NHSRplotthedots,
     https://github.com/nhs-r-community/NHSRplotthedots
 BugReports: https://nhs-r-community.github.io/NHSRplotthedots/issues
 License: MIT + file LICENSE
 Encoding: UTF-8
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
 Roxygen: list(markdown = TRUE)
 Imports: 
     assertthat,
@@ -55,4 +61,4 @@ Suggests:
 Depends: R (>= 4.1.0)
 VignetteBuilder: knitr
 Config/testthat/edition: 3
-Language: en-US
+Language: en-GB
diff --git a/NAMESPACE b/NAMESPACE
@@ -6,6 +6,9 @@ S3method(print,ptd_spc_options)
 S3method(ptd_spc,SharedData)
 S3method(ptd_spc,data.frame)
 S3method(summary,ptd_spc_df)
+S3method(to_datetime,Date)
+S3method(to_datetime,POSIXt)
+S3method(to_datetime,character)
 export(GeomPTDIcon)
 export(geom_ptd_icon)
 export(ptd_create_ggplot)

diff --git a/R/ptd_create_ggplot.R b/R/ptd_create_ggplot.R
@@ -238,7 +238,7 @@ ptd_create_ggplot <- function(
   sec_breaks <- .data |>
     # should already be sorted in date order but just in case
     dplyr::arrange(x) |>
-    dplyr::select(all_of(c("lpl", "mean_col", "upl"))) |>
+    dplyr::select(c("lpl", "mean_col", "upl")) |>
     dplyr::slice_tail(n = 1) |>
     unlist() |>
     unname()
@@ -248,93 +248,53 @@ ptd_create_ggplot <- function(
     start <- floor(min(yaxis, na.rm = TRUE) / y_axis_breaks) * y_axis_breaks
     end <- max(yaxis, na.rm = TRUE)
     y_axis_labels <- seq(from = start, to = end, by = y_axis_breaks)
+  } else {
+    # if no y-axis breaks supplied by user, we just use the built-in heuristic
+    y_axis_labels <- ggplot2::waiver()
   }
 
-  # Nested combinations of 3 binary options = 2^3 (8) possible plot designs
   if (percentage_y_axis) {
-    if (!is.null(y_axis_breaks)) {
-      if (label_limits) {
-        # %age axes + specified breaks + sec labelling axis
-        plot <- plot +
-          ggplot2::scale_y_continuous(
-            breaks = y_axis_labels,
-            labels = scales::label_percent(accuracy = y_axis_breaks),
-            sec.axis = ggplot2::sec_axis(
-              trans = identity,
-              name = NULL,
-              breaks = sec_breaks,
-              labels = scales::label_percent(accuracy = y_axis_breaks)
-            )
-          )
-      } else {
-        # %age axes + specified breaks - no sec labelling axis
-        plot <- plot +
-          ggplot2::scale_y_continuous(
-            breaks = y_axis_labels,
-            labels = scales::label_percent(accuracy = y_axis_breaks)
-          )
-      }
-    } else if (label_limits) {
-      # %age axes + sec labelling axis - no specified breaks
-      plot <- plot +
-        ggplot2::scale_y_continuous(
-          labels = scales::label_percent(accuracy = y_axis_breaks),
-          sec.axis = ggplot2::sec_axis(
-            trans = identity,
-            name = NULL,
-            breaks = sec_breaks,
-            labels = scales::label_percent(accuracy = y_axis_breaks)
-          )
-        )
-    } else {
-      # %age axes - no specified breaks - no sec labelling axis
-      plot <- plot +
-        ggplot2::scale_y_continuous(
-          labels = scales::label_percent(accuracy = y_axis_breaks)
-        )
-    }
-  } else if (!is.null(y_axis_breaks)) {
     if (label_limits) {
-      # integer axes + specified breaks + sec labelling axis
+      # percentage y-axis, secondary labelling axis
       plot <- plot +
         ggplot2::scale_y_continuous(
-          breaks = y_axis_labels,
-          labels = scales::label_number(accuracy = y_axis_breaks),
+          breaks = y_axis_labels, # see above - can mean "just use waiver()"
+          labels = scales::label_percent(),
           sec.axis = ggplot2::sec_axis(
-            trans = identity,
+            transform = identity,
             name = NULL,
             breaks = sec_breaks,
-            labels = scales::label_number(accuracy = 0.01)
+            labels = scales::label_percent(accuracy = 0.1)
           )
         )
     } else {
-      # integer axes + specified breaks - no sec labelling axis
+      # percentage y-axis, no secondary labelling axis
       plot <- plot +
         ggplot2::scale_y_continuous(
           breaks = y_axis_labels,
-          labels = scales::label_number(accuracy = y_axis_breaks)
+          labels = scales::label_percent()
         )
     }
-  } else {
-    if (label_limits) {
-      # integer axes + sec labelling axis - no specified breaks
-      plot <- plot +
-        ggplot2::scale_y_continuous(
-          labels = scales::label_number(accuracy = y_axis_breaks),
-          sec.axis = ggplot2::sec_axis(
-            trans = identity,
-            name = NULL,
-            breaks = sec_breaks,
-            labels = scales::label_number(accuracy = 0.01)
-          )
-        )
-    } else {
-      # integer axes - no specified breaks - no sec labelling axis
-      plot <- plot +
-        ggplot2::scale_y_continuous(
-          labels = scales::label_number(accuracy = y_axis_breaks)
+  } else if (label_limits) {
+    # integer y-axis, secondary labelling axis
+    plot <- plot +
+      ggplot2::scale_y_continuous(
+        breaks = y_axis_labels,
+        labels = scales::label_number(),
+        sec.axis = ggplot2::sec_axis(
+          transform = identity,
+          name = NULL,
+          breaks = sec_breaks,
+          labels = scales::label_number()
         )
-    }
+      )
+  } else {
+    # integer y-axis, no secondary axis
+    plot <- plot +
+      ggplot2::scale_y_continuous(
+        breaks = y_axis_labels,
+        labels = scales::label_number()
+      )
   }
 
 

diff --git a/R/to_datetime.R b/R/to_datetime.R
@@ -7,13 +7,15 @@ to_datetime <- function(x) {
   UseMethod("to_datetime")
 }
 
+#' @export
 to_datetime.Date <- function(x) {
   as.POSIXct(x)
 }
 
+#' @export
 to_datetime.POSIXt <- identity
 
-
+#' @export
 to_datetime.character <- function(x) {
   as.POSIXct(x)
 }