Feature basic annotation 198

.github/workflows/check-full.yaml

@@ -24,13 +24,13 @@ jobs:
 
           - {os: windows-latest, r: 'release'}
           # use 4.0 or 4.1 to check with rtools40's older compiler
-          #- {os: windows-latest, r: 'oldrel-4'}
+          - {os: windows-latest, r: 'oldrel-3'}
 
           - {os: ubuntu-latest,  r: 'devel', http-user-agent: 'release'}
           - {os: ubuntu-latest,  r: 'release'}
           - {os: ubuntu-latest,  r: 'oldrel-1'}
           - {os: ubuntu-latest,  r: 'oldrel-2'}
-          #- {os: ubuntu-latest,  r: 'oldrel-3'}
+          - {os: ubuntu-latest,  r: 'oldrel-3'}
           #- {os: ubuntu-latest,  r: 'oldrel-4'}
 
     env:
@@ -50,7 +50,12 @@ jobs:
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          extra-packages: any::rcmdcheck
+          dependencies: '"hard"'
+          extra-packages:
+            any::rcmdcheck
+            any::testthat
+            any::rmarkdown
+            any::knitr
           needs: check
 
       - uses: r-lib/actions/check-r-package@v2

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: autospc
 Title: Automatically Partitioned SPC Charts
-Version: 0.0.0.9034
+Version: 0.0.0.9035
 Authors@R: c(
     person("Thomas", "Woodcock", , "woodcock.thomas@gmail.com", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-4735-4856")),
@@ -10,13 +10,11 @@ Description: Creates spc charts with control limits and centre line
     calculations partitioned into distinct periods.
 License: GPL-3
 Imports: 
+    cowplot,
     DiagrammeR,
     dplyr (>= 1.1.1),
     fpCompare,
     ggplot2 (>= 3.4.2),
-    ggpp,
-    ggpubr (>= 0.6.0),
-    ggrepel,
     lifecycle (>= 1.0.3),
     magrittr (>= 2.0.3),
     rlang (>= 1.1.0),
@@ -28,13 +26,15 @@ Imports:
 Suggests: 
     knitr,
     rmarkdown,
-    testthat (>= 3.1.7)
+    testthat (>= 3.1.7),
+    ggrepel,
+    ggpp
 Config/testthat/edition: 3
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2
 Depends: 
-    R (>= 4.3.0)
+    R (>= 4.2.0)
 VignetteBuilder: knitr
 URL: https://horridtom.github.io/autospc/

R/add_annotation_data.R

@@ -33,24 +33,30 @@ add_annotation_data <- function(df,
       chartType = chartType,
       align_labels = align_labels,
       flip_labels = flip_labels,
-      upper_annotation_level = dplyr::if_else(align_labels,
-                                              max(ucl, na.rm = TRUE) * upper_annotation_sf,
-                                              ucl * upper_annotation_sf),
-      lower_level = dplyr::if_else(align_labels,
-                                   min(lcl, na.rm = TRUE) * lower_annotation_sf,
-                                   lcl * lower_annotation_sf),
-      lower_annotation_level = dplyr::if_else(chartType == "MR" | !flip_labels,
-                                              upper_annotation_level,
-                                              lower_level),
+      upper_annotation_level = dplyr::if_else(
+        align_labels,
+        max(ucl,
+            na.rm = TRUE) * upper_annotation_sf,
+        ucl * upper_annotation_sf),
+      lower_level = dplyr::if_else(
+        align_labels,
+        min(lcl, na.rm = TRUE) * lower_annotation_sf,
+        lcl * lower_annotation_sf),
+      lower_annotation_level = dplyr::if_else(
+        chartType == "MR" | !flip_labels,
+        upper_annotation_level,
+        lower_level),
       annotation_level = dplyr::case_when(
-        dplyr::row_number() == (1L + (chartType == "MR")) ~ upper_annotation_level,
+        dplyr::row_number() == (1L + (chartType == "MR")) ~
+          upper_annotation_level,
         breakPoint == FALSE ~ 0,
         cl_change == 1 ~ upper_annotation_level,
         cl_change == 0 ~ upper_annotation_level,
         cl_change == -1 ~ lower_annotation_level
       ),
       annotation_curvature = dplyr::case_when(
-        dplyr::row_number() == (1L + (chartType == "MR")) ~ annotation_arrow_curve,
+        dplyr::row_number() == (1L + (chartType == "MR")) ~
+          annotation_arrow_curve,
         breakPoint == FALSE ~ 0,
         cl_change == 1 ~ annotation_arrow_curve,
         cl_change == -1 & flip_labels ~ -annotation_arrow_curve,
@@ -72,49 +78,121 @@ add_annotation_data <- function(df,
 
 add_annotations_to_plot <- function(p,
                                     df,
+                                    basicAnnotations,
                                     annotation_size,
                                     annotation_arrows,
                                     annotation_curvature) {
 
+  useBasicAnnotations <- basicAnnotations
+
+  if(!basicAnnotations &
+     !(rlang::is_installed("ggrepel") & rlang::is_installed("ggpp"))) {
+    warning(
+      paste(
+        "Packages ggrepel and ggpp are required for basicAnnotations",
+        "= FALSE. Using basicAnnotations = TRUE. To use",
+        "basicAnnotations = FALSE, please ensure both packages are installed."))
+    useBasicAnnotations <- TRUE
+  }
+
+  if(!useBasicAnnotations) {
+    p_annotated <- add_annotations_to_plot_pp(
+      p = p,
+      df = df,
+      annotation_size = annotation_size,
+      annotation_arrows = annotation_arrows,
+      annotation_curvature = annotation_curvature
+    )
+  } else {
+    p_annotated <- add_annotations_to_plot_basic(
+      p = p,
+      df = df,
+      annotation_size = annotation_size,
+      annotation_arrows = annotation_arrows,
+      annotation_curvature = annotation_curvature
+    )
+  }
+
+  return(p_annotated)
+
+}
+
+
+add_annotations_to_plot_pp <- function(p,
+                                       df,
+                                       annotation_size,
+                                       annotation_arrows,
+                                       annotation_curvature) {
+
   if(annotation_arrows) {
 
-    p_annotated <- p + ggrepel::geom_text_repel(ggplot2::aes(x = x,
-                                                             y = cl,
-                                                             label = cl_label),
-                                                position = ggpp::position_nudge_to(y = df %>%
-                                                                                     dplyr::filter(!is.na(y)) %>%
-                                                                                     dplyr::pull(annotation_level)),
-                                                color = "grey40",
-                                                size = annotation_size,
-                                                fontface = "bold",
-                                                segment.color = "grey40",
-                                                segment.linetype = 1L,
-                                                force             = 0,
-                                                hjust             = 0,
-                                                segment.size      = 0.75,
-                                                segment.curvature = df %>%
-                                                  dplyr::filter(!is.na(y)) %>%
-                                                  dplyr::pull(annotation_curvature),
-                                                segment.ncp = 4,
-                                                segment.inflect = FALSE,
-                                                segment.square = FALSE,
-                                                arrow = grid::arrow(length = grid::unit(0.015, "npc")),
-                                                na.rm = TRUE)
+    p_annotated <- p + ggrepel::geom_text_repel(
+      ggplot2::aes(x = x,
+                   y = cl,
+                   label = cl_label),
+      position = ggpp::position_nudge_to(y = df %>%
+                                           dplyr::filter(!is.na(y)) %>%
+                                           dplyr::pull(annotation_level)),
+      color = "grey40",
+      size = annotation_size,
+      fontface = "bold",
+      segment.color = "grey40",
+      segment.linetype = 1L,
+      force             = 0,
+      hjust             = 0,
+      segment.size      = 0.75,
+      segment.curvature = df %>%
+        dplyr::filter(!is.na(y)) %>%
+        dplyr::pull(annotation_curvature),
+      segment.ncp = 4,
+      segment.inflect = FALSE,
+      segment.square = FALSE,
+      arrow = grid::arrow(length = grid::unit(0.015, "npc")),
+      na.rm = TRUE,
+      max.overlaps = Inf)
   } else {
-    p_annotated <- p + ggrepel::geom_text_repel(ggplot2::aes(x = x,
-                                                             y = cl,
-                                                             label = cl_label),
-                                                position = ggpp::position_nudge_to(y = df %>%
-                                                                                     dplyr::filter(!is.na(y)) %>%
-                                                                                     dplyr::pull(annotation_level)),
-                                                color = "grey40",
-                                                size = annotation_size,
-                                                fontface = "bold",
-                                                force             = 0,
-                                                hjust             = 0,
-                                                min.segment.length = Inf,
-                                                na.rm = TRUE)
+    p_annotated <- p + ggrepel::geom_text_repel(
+      ggplot2::aes(x = x,
+                   y = cl,
+                   label = cl_label),
+      position = ggpp::position_nudge_to(y = df %>%
+                                           dplyr::filter(!is.na(y)) %>%
+                                           dplyr::pull(annotation_level)),
+      color = "grey40",
+      size = annotation_size,
+      fontface = "bold",
+      force             = 0,
+      hjust             = 0,
+      min.segment.length = Inf,
+      na.rm = TRUE,
+      max.overlaps = Inf)
   }
 
   return(p_annotated)
+
 }
+
+
+add_annotations_to_plot_basic <- function(p,
+                                          df,
+                                          annotation_size,
+                                          annotation_arrows,
+                                          annotation_curvature) {
+
+  x_range <- max(df$x, na.rm = TRUE) - min(df$x, na.rm = TRUE)
+  x_nudge <- x_range/25
+
+  p_annotated <- p +
+    ggplot2::geom_text(mapping = ggplot2::aes(x = x,
+                                              y = annotation_level,
+                                              label = cl_label),
+                       nudge_x = x_nudge,
+                       na.rm = TRUE,
+                       color = "grey40",
+                       size = annotation_size,
+                       fontface = "bold")
+
+  return(p_annotated)
+
+}
+

R/plot_code.R

@@ -118,6 +118,10 @@
 #' @param line_width_sf Numeric scale factor for plot line widths. 
 #' @param includeAnnotations Boolean specifying whether to show centre line
 #' labels
+#' @param basicAnnotations Boolean specifying whether to force use of basic
+#' annotation positioning. When TRUE, suggested packages ggrepel
+#' and ggpp are not required, but annotation arrows are not supported. Defaults
+#' to TRUE for R versions prior to 4.3, FALSE otherwise.
 #' @param annotation_size Text size for centre line labels
 #' @param align_labels Boolean specifying whether or not to align centre line
 #' labels at a fixed vertical position
@@ -207,6 +211,7 @@ plot_auto_SPC <- function(df,
                           point_size = 2,
                           line_width_sf = 1,
                           includeAnnotations = TRUE,
+                          basicAnnotations = getRversion() < '4.3.0',
                           annotation_size = 3,
                           align_labels = FALSE,
                           flip_labels = FALSE,
@@ -350,6 +355,7 @@ plot_auto_SPC <- function(df,
         point_size = point_size,
         line_width_sf = line_width_sf,
         includeAnnotations = includeAnnotations,
+        basicAnnotations = basicAnnotations,
         annotation_size = annotation_size,
         annotation_arrows = annotation_arrows,
         annotation_curvature = annotation_arrow_curve,

R/visualisation.R

@@ -19,6 +19,7 @@ create_spc_plot <- function(df,
                             point_size = 2,
                             line_width_sf = 1,
                             includeAnnotations = TRUE,
+                            basicAnnotations = FALSE,
                             annotation_size = 3,
                             annotation_arrows = FALSE,
                             annotation_curvature = 0.3,
@@ -68,6 +69,7 @@ create_spc_plot <- function(df,
 
     p <- add_annotations_to_plot(p = p,
                                  df = df,
+                                 basicAnnotations = basicAnnotations,
                                  annotation_size = annotation_size,
                                  annotation_arrows = annotation_arrows,
                                  annotation_curvature = annotation_curvature)
@@ -126,12 +128,20 @@ create_spc_plot <- function(df,
     p_mr <- p_mr + 
       ggplot2::labs(caption = caption)
 
-    p <- ggpubr::ggarrange(p, p_mr,
-                           ncol = 1,
-                           nrow = 2,
-                           legend = "right",
-                           common.legend = TRUE,
-                           align = "v")
+    legend <- cowplot::get_legend(p)
+
+    p_no_legend <- p + ggplot2::theme(legend.position = "none")
+    p_mr_no_legend <- p_mr + ggplot2::theme(legend.position = "none")
+
+    p <- cowplot::plot_grid(
+      cowplot::plot_grid(p_no_legend, p_mr_no_legend, 
+                         ncol = 1, 
+                         align = "v"),
+      legend,
+      ncol = 2,
+      rel_widths = c(1, 0.2)
+    )
+
   }
 
   return(p)
@@ -157,7 +167,7 @@ create_timeseries_plot <- function(df,
     ggplot2::theme(panel.grid.major.y = ggplot2::element_blank(),
                    panel.grid.major.x = ggplot2::element_line(
                      colour = "grey80"
-                     ),
+                   ),
                    panel.grid.minor = ggplot2::element_blank(),
                    panel.background = ggplot2::element_blank(),
                    axis.text.x = ggplot2::element_text(angle = 45,
@@ -257,18 +267,18 @@ format_SPC <- function(cht,
                                       override.aes = list(
                                         alpha = if(
                                           !is.na(first_display_period)
-                                          ) {
-                                        c(1, 0.4)
-                                      } else {
-                                        c(1)
-                                      }
+                                        ) {
+                                          c(1, 0.4)
+                                        } else {
+                                          c(1)
+                                        }
                                       )
                                     )
       ) +
       ggplot2::theme(panel.grid.major.y = ggplot2::element_blank(),
                      panel.grid.major.x = ggplot2::element_line(
                        colour = "grey80"
-                       ),
+                     ),
                      panel.grid.minor = ggplot2::element_blank(),
                      panel.background = ggplot2::element_blank(),
                      axis.text.x = ggplot2::element_text(angle = 45,

data-raw/algorithm_documentation_data.R

@@ -117,8 +117,8 @@ get_log_explanation_table <- function() {
 algorithm_flow_chart_string <- get_algorithm_flow_chart_string()
 log_explanation_table <- get_log_explanation_table()
 
-usethis::use_data(algorithm_flow_chart_string,
-                  log_explanation_table,
-                  internal = TRUE,
-                  overwrite = TRUE)
+# usethis::use_data(algorithm_flow_chart_string,
+#                   log_explanation_table,
+#                   internal = TRUE,
+#                   overwrite = TRUE)