Feat: facet support, colour description

Author: quantixed

.Rbuildignore

@@ -6,3 +6,5 @@
 ^docs$
 ^pkgdown$
 ^\.github$
+^\.positai$
+^\.claude$

.gitignore

@@ -6,3 +6,4 @@
 .quarto
 inst/doc
 docs
+.positai

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: SuperPlotR
 Title: Making SuperPlots in R
-Version: 0.1.1
+Version: 0.1.2
 Authors@R:
     person(given = "Stephen J",
            family = "Royle",
@@ -22,10 +22,12 @@ Depends:
 Config/rcmdcheck/ignore-inconsequential-notes: true
 LazyData: true
 Imports:
-    ggplot2,
+    ColorNameR,
+    cowplot,
     dplyr,
     ggforce,
-    cowplot,
+    ggplot2,
+    patchwork,
     rlang
 URL: https://github.com/quantixed/SuperPlotR, https://quantixed.github.io/SuperPlotR/
 BugReports: https://github.com/quantixed/SuperPlotR/issues

NAMESPACE

@@ -19,9 +19,12 @@ import(cowplot)
 import(dplyr)
 import(ggforce)
 import(ggplot2)
+importFrom(ColorNameR,name)
+importFrom(grDevices,col2rgb)
 importFrom(grDevices,colors)
 importFrom(rlang,":=")
 importFrom(stats,TukeyHSD)
+importFrom(stats,as.formula)
 importFrom(stats,kruskal.test)
 importFrom(stats,median)
 importFrom(stats,qt)

NEWS.md

@@ -1,5 +1,10 @@
 # SuperPlotR
 
+## SuperPlotR 0.1.2
+* Ability to facet superplots
+* Added text description of colours used in information output
+* Documentation improvements
+
 ## SuperPlotR 0.1.1
 
 * Use of mean ± sd bars is now the default

R/get_sp_info.R

@@ -27,18 +27,20 @@
 #' @import dplyr
 #' @importFrom stats sd median
 #' @importFrom rlang :=
+#' @importFrom ColorNameR name
+#' @importFrom grDevices col2rgb
 #'
 #' @returns none
 #' @keywords internal
 
 # this function will take all the arguments sent from superplot
 get_sp_info <- function(df,
-                      meas, cond, repl,
+                      meas, cond, repl, facet,
                       pal, xlab, ylab, datadist, size, alpha, bars,
                       linking, rep_summary, shapes, fsize, gg,
                       stats, stats_test,
                       ...) {
-  ncond <- nrepl <- NULL
+  ncond <- nrepl <- nfacet <- NULL
   rep_mean <- rep_median <- NULL
 
   # args are already validated
@@ -52,13 +54,21 @@ get_sp_info <- function(df,
     pull(!!sym(repl)) %>%
     unique() %>%
     length()
+  if (!is.null(facet)) {
+    nfacet <- df %>%
+      pull(!!sym(facet)) %>%
+      unique() %>%
+      length()
+  }
 
   # calculate summary statistics
   summary_df <- get_sp_summary(df = df,
-                             meas = meas, cond = cond, repl = repl)
+                             meas = meas, cond = cond, repl = repl, facet = facet)
 
   # get colour values for the repl column
   sp_colours <- get_sp_colours(nrepl, pal)
+  sp_colours_words <- ColorNameR::name(t(col2rgb(sp_colours)) / 255,
+                                       colorspace = "sRGB")
   sp_shapes <- get_sp_shapes(nrepl, shapes)
 
   # add repl from summary_df to sp_colour and sp_shapes
@@ -84,6 +94,9 @@ get_sp_info <- function(df,
   message("Number of replicates: ", nrepl)
   message("Number of data points: ", nrow(df))
   message("Number of summary points: ", nrow(summary_df))
+  if( !is.null(facet)) {
+    message("Number of facets: ", nfacet)
+  }
   message("=====================")
   message("Colour palette: ", pal)
   message("Data distribution: ", datadist)
@@ -112,8 +125,12 @@ get_sp_info <- function(df,
     message("No statistics")
   }
   message("=====================")
-  message("Colours for replicates: ", paste(sp_colours, collapse = ", "))
-  message("Shapes for replicates: ", paste(sp_shapes, collapse = ", "))
+  message("Colours for replicates: ",
+          paste(sp_colours, collapse = ", "))
+  message("Colour names for replicates: ",
+          paste(sp_colours_words, collapse = ", "))
+  message("Shapes for replicates: ",
+          paste(sp_shapes, collapse = ", "))
 
   if (nrow(summary_df) != ncond * nrepl) {
     s_summary_df <- summary_df %>%

R/get_sp_summary.R

@@ -9,12 +9,14 @@
 #' get the correct data frame to work with.
 #'
 #' @param df A data frame containing the experimental data
-#' @param meas Character string specifying the name of the column containing
-#'   the measurements/values to summarize (e.g., "intensity", "speed")
-#' @param cond Character string specifying the name of the column containing
-#'   the experimental conditions (e.g., "Treatment", "Genotype")
-#' @param repl Character string specifying the name of the column containing
-#'   the replicate identifiers (e.g., "Replicate", "Experiment")
+#' @param meas Character string specifying the name of the column containing the
+#'   measurements/values to summarize (e.g., "intensity", "speed")
+#' @param cond Character string specifying the name of the column containing the
+#'   experimental conditions (e.g., "Treatment", "Genotype")
+#' @param repl Character string specifying the name of the column containing the
+#'   replicate identifiers (e.g., "Replicate", "Experiment")
+#' @param facet Character string specifying the name of the column to facet by
+#'   (e.g. further grouping variable, default is NULL)
 #' @param ... Additional arguments (ignored)
 #'
 #' @return A data frame with columns for condition, replicate, rep_mean
@@ -29,7 +31,7 @@
 #' # Using the built-in dataset
 #' get_sp_summary(lord_jcb, "Speed", "Treatment", "Replicate")
 #'
-get_sp_summary <- function(df, meas, cond, repl, ...) {
+get_sp_summary <- function(df, meas, cond, repl, facet = NULL, ...) {
   # Validate inputs
   if (!is.data.frame(df)) {
     stop("df must be a data frame")
@@ -47,14 +49,28 @@ get_sp_summary <- function(df, meas, cond, repl, ...) {
     stop("repl column '", repl, "' not found in data frame")
   }
 
+  if (!is.null(facet) && !facet %in% names(df)) {
+    stop("facet column '", facet, "' not found in data frame")
+  }
+
   # Calculate summary statistics grouped by condition and replicate
+  if (is.null(facet)) {
+    sdf <- df %>%
+      group_by(!!sym(cond), !!sym(repl)) %>%
+      summarise(
+        rep_mean = mean(!!sym(meas), na.rm = TRUE),
+        rep_median = median(!!sym(meas), na.rm = TRUE),
+        .groups = "drop"
+      )
+  } else {
   sdf <- df %>%
-    group_by(!!sym(cond), !!sym(repl)) %>%
+    group_by(!!sym(cond), !!sym(repl), !!sym(facet)) %>%
     summarise(
       rep_mean = mean(!!sym(meas), na.rm = TRUE),
       rep_median = median(!!sym(meas), na.rm = TRUE),
       .groups = "drop"
     )
+  }
 
   return(sdf)
 }

R/superplot.R

@@ -8,6 +8,7 @@
 #' @param cond character name of column with condition (e.g. Control, WT)
 #' @param repl character name of column with replicate (e.g. unique experiment
 #'   identifiers)
+#' @param facet character name of column to facet by (default is NULL)
 #' @param pal name of colour palette to use (default is "tol_bright")
 #' @param xlab string for x label (default is empty)
 #' @param ylab string for y label (default is "Measurement")
@@ -38,7 +39,7 @@
 #' @import dplyr
 #' @import ggforce
 #' @import cowplot
-#' @importFrom stats sd median
+#' @importFrom stats sd median as.formula
 #'
 #' @export
 #'
@@ -49,6 +50,7 @@
 #'
 superplot <- function(df,
                       meas, cond, repl,
+                      facet = NULL,
                       pal = "tol_bright",
                       xlab = "", ylab = "Measurement",
                       datadist = "sina",
@@ -73,7 +75,7 @@ superplot <- function(df,
                 gg = gg, stats = stats, stats_test = stats_test, info = info)
 
   # verify that the data frame to make sure that it is suitable for SuperPlot
-  if (verify_sp_columns(df, meas, cond, repl) == FALSE) {
+  if (verify_sp_columns(df, meas, cond, repl, facet) == FALSE) {
     return(NULL)
   }
 
@@ -89,6 +91,13 @@ superplot <- function(df,
     df[[repl]] <- as.character(df[[repl]])
   }
 
+  # if facet is not NULL, check that it is character and convert to factor if not already
+  if (!is.null(facet)) {
+    if (!is.character(df[[facet]]) && !is.factor(df[[facet]])) {
+      df[[facet]] <- as.character(df[[facet]])
+    }
+  }
+
   # how many unique values in cond and repl?
   ncond <- df %>%
     pull(!!sym(cond)) %>%
@@ -98,17 +107,32 @@ superplot <- function(df,
     pull(!!sym(repl)) %>%
     unique() %>%
     length()
+  if (!is.null(facet)) {
+    nfacet <- df %>%
+      pull(!!sym(facet)) %>%
+      unique() %>%
+      length()
+  }
 
   # calculate summary statistics
   summary_df <- get_sp_summary(df = df,
-                               meas = meas, cond = cond, repl = repl)
+                               meas = meas, cond = cond, repl = repl,
+                               facet = facet)
 
   # generate a warning if NROW of summary_df doesn't equal the product of
   # unique values in cond and repl
-  if (nrow(summary_df) != ncond * nrepl && info == FALSE) {
-    warning("Summary statistics were not calculated for all combinations of
+  if (!is.null(facet)) {
+    if (nrow(summary_df) != ncond * nrepl * nfacet & info == FALSE) {
+      warning("Summary statistics were not calculated for all combinations of
+              condition, replicate, and facet.\nCheck for missing data.\n
+              Call again with `info = TRUE` to see more details.")
+    }
+  } else {
+    if (nrow(summary_df) != ncond * nrepl & info == FALSE) {
+      warning("Summary statistics were not calculated for all combinations of
             condition and replicate.\nCheck for missing data.\n
             Call again with `info = TRUE` to see more details.")
+    }
   }
   # get colour values for the repl column
   sp_colours <- get_sp_colours(nrepl, pal)
@@ -117,7 +141,7 @@ superplot <- function(df,
   # if info is TRUE, print information about the plot
   if (info == TRUE) {
     get_sp_info(df = df,
-                meas = meas, cond = cond, repl = repl,
+                meas = meas, cond = cond, repl = repl, facet = facet,
                 pal = pal, xlab = xlab, ylab = ylab,
                 datadist = datadist, size = size, alpha = alpha,
                 bars = bars, linking = linking,
@@ -193,6 +217,10 @@ superplot <- function(df,
   } else {
     # plot is scaled automatically
   }
+  # facet if requested
+  if (!is.null(facet)) {
+    p <- p + facet_wrap(as.formula(paste("~", facet)))
+  }
   # theme
   p <- p + theme_cowplot(fsize)
   # info is FALSE hide legend
@@ -203,7 +231,11 @@ superplot <- function(df,
 
   # add stats if requested
   if (stats == TRUE) {
-    get_sp_stats(as.data.frame(summary_df), rep_summary, cond, repl, ncond, nrepl, stats_test)
+    if (!is.null(facet)) {
+      warning("Statistical tests are not currently implemented for faceted SuperPlots.")
+    } else {
+      get_sp_stats(as.data.frame(summary_df), rep_summary, cond, repl, ncond, nrepl, stats_test)
+    }
   }
 
   return(p)

R/verify.R

@@ -4,21 +4,33 @@
 #' @param meas character name of column with measurement (e.g. intensity)
 #' @param cond character name of column with condition (e.g. Control, WT)
 #' @param repl character name of column with replicate (e.g. unique experiment
-#' identifiers)
+#'   identifiers)
+#' @param facet character name of column to facet by (e.g. further grouping
+#'   variable, default is NULL)
 #'
 #' @return logical to allow plot to go ahead
 #' @keywords internal
-verify_sp_columns <- function(df, meas, cond, repl) {
+verify_sp_columns <- function(df, meas, cond, repl, facet = NULL) {
   # check that meas, cond and repl are character
   if (!is.character(meas) | !is.character(cond) | !is.character(repl)) {
     message("meas, cond and repl must be character")
     return(FALSE)
   }
+  # check that facet is character or NULL
+  if (!is.null(facet) & !is.character(facet)) {
+    message("facet must be character or NULL")
+    return(FALSE)
+  }
   # verify the data frame - check if the required columns are present
   if (!cond %in% colnames(df) | !repl %in% colnames(df) | !meas %in% colnames(df)) {
     message("The data frame does not contain the required columns")
     return(FALSE)
   }
+  # if facet was not NULL, check that the facet column is present
+  if (!is.null(facet) && !facet %in% colnames(df)) {
+    message("The data frame does not contain the facet column")
+    return(FALSE)
+  }
   # check that column meas is numeric
   if (!is.numeric(df[[meas]])) {
     message("The column ", meas, " is not numeric")
@@ -53,3 +65,15 @@ verify_fp_columns <- function(df, meas, cond) {
   }
   return(TRUE)
 }
+
+
+#' Ignore unused imports
+#'
+#' Currently patchwork is used in the documentation but not in the package
+#' itself. This function is a workaround to avoid warnings about unused imports
+#' when building the package.
+#'
+#' @keywords keyword
+ignore_unused_imports <- function() {
+  patchwork::wrap_plots
+}

_pkgdown.yml

@@ -10,6 +10,7 @@ articles:
   contents:
   - SuperPlotR
   - advanced
+  - facets
   - limitations
   - flatplot
   - pieplot