Better plots for PCA.

R/Pca.R

@@ -240,6 +240,14 @@ Pca <- R6::R6Class(
             subtitle = stringr::str_interp('${nrow(self$prcomp_results$x)} samples, ${ncol(self$prcomp_results$rotation)} principal components, calculated from ${nrow(self$prcomp_results$rotation)} features'),
             caption = if (top_contributors$show) stringr::str_interp('Top contributors to variance:\nPC1: ${paste0(stringr::str_trunc(names(self$top_rotations$PC1), top_contributors$truncate), collapse = ", ")}\nPC2: ${paste0(stringr::str_trunc(names(self$top_rotations$PC2), top_contributors$truncate), collapse = ", ")}') else NULL
         ) {
+            private$validate_scatter_args(
+                point_default_colour,
+                point_size,
+                point_alpha,
+                point_labels,
+                top_contributors
+            )
+
             pc <- data.table::data.table(
                 self$prcomp_results$x, keep.rownames = "sample"
             )
@@ -263,24 +271,27 @@ Pca <- R6::R6Class(
                 pc[, highlight := point_default_colour]
             }
 
-            self$scatter <- ggplot2::ggplot(
+            plot <- ggplot2::ggplot(
                     pc,
                     ggplot2::aes(
                         x = PC1,
                         y = PC2,
                         colour = highlight
                     )
                 ) +
-                ggplot2::geom_point(size = point_size, alpha = point_alpha) +
-                {if (point_labels$show) {
-                    suppressWarnings(ggrepel::geom_text_repel(
-                        ggplot2::aes(label = sample),
-                        size = point_labels$size,
-                        max.overlaps = point_labels$max_overlaps,
-                        alpha = point_labels$alpha,
-                        fontface = point_labels$font_face
-                    ))
-                }} +
+                ggplot2::geom_point(size = point_size, alpha = point_alpha)
+
+            if (point_labels$show) {
+                plot <- plot + ggrepel::geom_text_repel(
+                    ggplot2::aes(label = sample),
+                    size = point_labels$size,
+                    max.overlaps = point_labels$max_overlaps,
+                    alpha = point_labels$alpha,
+                    fontface = point_labels$font_face
+                )
+            }
+
+            plot <- plot +
                 ggplot2::scale_colour_identity() +
                 ggplot2::labs(
                     title = title,
@@ -292,7 +303,8 @@ Pca <- R6::R6Class(
                 ) +
                 ggplot2::theme(legend.position = "bottom")
 
-            return(self$scatter)
+            self$scatter <- plot
+            return(plot)
         }
     ),
     private = list(
@@ -381,6 +393,50 @@ Pca <- R6::R6Class(
             if (!is.null(self$comparison)) {
                 private$check_comparison(self$comparison)
             }
+        },
+        validate_scatter_args = function(
+            point_default_colour,
+            point_size,
+            point_alpha,
+            point_labels,
+            top_contributors
+        ) {
+            if (!is.character(point_default_colour) || length(point_default_colour) != 1) {
+                stop("point_default_colour must be a single character string")
+            }
+            if (!is.numeric(point_size) || length(point_size) != 1) {
+                stop("point_size must be a single numeric value")
+            }
+            if (!is.numeric(point_alpha) || length(point_alpha) != 1 || point_alpha < 0 || point_alpha > 1) {
+                stop("point_alpha must be a single numeric value between 0 and 1")
+            }
+            if (!is.list(point_labels) || !all(c("show", "size", "max_overlaps", "alpha", "font_face") %in% names(point_labels))) {
+                stop("point_labels must be a list with elements: show, size, max_overlaps, alpha, font_face")
+            }
+            if (!is.logical(point_labels$show) || length(point_labels$show) != 1) {
+                stop("point_labels$show must be a single logical value")
+            }
+            if (!is.numeric(point_labels$size) || length(point_labels$size) != 1) {
+                stop("point_labels$size must be a single numeric value")
+            }
+            if (!is.numeric(point_labels$max_overlaps) || length(point_labels$max_overlaps) != 1) {
+                stop("point_labels$max_overlaps must be a single numeric value")
+            }
+            if (!is.numeric(point_labels$alpha) || length(point_labels$alpha) != 1 || point_labels$alpha < 0 || point_labels$alpha > 1) {
+                stop("point_labels$alpha must be a single numeric value between 0 and 1")
+            }
+            if (!is.character(point_labels$font_face) || length(point_labels$font_face) != 1) {
+                stop("point_labels$font_face must be a single character string")
+            }
+            if (!is.list(top_contributors) || !all(c("show", "truncate") %in% names(top_contributors))) {
+                stop("top_contributors must be a list with elements: show, truncate")
+            }
+            if (!is.logical(top_contributors$show) || length(top_contributors$show) != 1) {
+                stop("top_contributors$show must be a single logical value")
+            }
+            if (!is.numeric(top_contributors$truncate) || length(top_contributors$truncate) != 1) {
+                stop("top_contributors$truncate must be a single numeric value")
+            }
         }
     )
 )

renv.lock

@@ -216,6 +216,18 @@
       ],
       "Hash": "5a295d7d963cc5035284dcdbaf334f4e"
     },
+    "crayon": {
+      "Package": "crayon",
+      "Version": "1.5.3",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "grDevices",
+        "methods",
+        "utils"
+      ],
+      "Hash": "859d96e65ef198fd43e82b9628d593ef"
+    },
     "credentials": {
       "Package": "credentials",
       "Version": "2.0.1",

vignettes/stat_review-principal-component-analysis.Rmd

@@ -124,6 +124,8 @@ To execute the calculations use `Pca$prcomp()`:
 
 ```{r run-generic-pca}
 pca_obj$prcomp()
+
+print(pca_obj)
 ```
 
 If you want to compare groups within your data, you can provide a `Comparison` object. Providing a `Comparison` object will automatically filter your data to only include the samples in the comparison and create plots that highlight samples by group.
@@ -195,14 +197,14 @@ Both `plot_scree()` and `plot_scatter()` methods accept various parameters for c
 
 ```{r plot-arguments}
 scatter_plot <- pca_obj$plot_scatter(
-    point_size = 4,
-    point_alpha = 0.8,
-    point_labels = list(show = TRUE, size = 3),
-    top_contributors = list(show = TRUE, truncate = 20),
-    title = "My Custom PCA Plot"
+   point_size = 4,
+   point_alpha = 0.8,
+   point_labels = list(show = TRUE, size = 3, alpha = 0.75, font_face = "bold", max_overlaps = 10),
+   top_contributors = list(show = TRUE, truncate = 20),
+   title = "My Custom PCA Plot"
 )
 
-scatter_plot
+print(scatter_plot)
 ```
 
 The plotting arguments are provided for ease of use but one can nonetheless use the `ggplot2` object to customise the plot further.