v0.2.0

Author: quantixed

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(autoplot,superplot_spec)
 export(add_sp_bars)
 export(flatplot)
 export(get_fp_color)
@@ -14,7 +15,9 @@ export(get_sp_summary)
 export(pieplot)
 export(representative)
 export(setup_rproj)
+export(sp_modify)
 export(superplot)
+export(superplot_spec)
 import(cowplot)
 import(dplyr)
 import(ggforce)

NEWS.md

@@ -1,4 +1,12 @@
+# SuperPlotR 0.2.0
+
+* SuperPlotting is now done using `superplot_spec()` behind the scenes, which 
+  allows for greater flexibility in the future.
+* Better handling of colour and shape aesthetics, including the ability to specify
+  them in the `superplot()` function.
+
 # SuperPlotR 0.1.2
+
 * Ability to facet superplots
 * Added text description of colours used in information output
 * Documentation improvements

R/add_sp_bars.R

@@ -5,35 +5,53 @@
 #' @param df data frame of summary data (supplied by superplot())
 #' @param cond character string of the condition column
 #' @param rep_summary character string of the replicate summary column
+#' @param bar_params named list of additional parameters passed to the
+#'   errorbar `stat_summary` layer
+#' @param crossbar_params named list of additional parameters passed to the
+#'   crossbar `stat_summary` layer
 #'
 #' @return ggplot object
 #' @export
-add_sp_bars <- function(p, bars, df, cond, rep_summary) {
+add_sp_bars <- function(p, bars, df, cond, rep_summary,
+                        bar_params = list(),
+                        crossbar_params = list()) {
+  base_bar <- list(
+    data = df,
+    mapping = aes(x = !!sym(cond), y = !!sym(rep_summary)),
+    geom = "errorbar",
+    linewidth = 0.2,
+    width = 0
+  )
+
   if (bars == "mean_sd") {
-    p <- p + stat_summary(
-      data = df,
-      aes(x = !!sym(cond), y = !!sym(rep_summary)),
-      fun.data = trio_sd,
-      geom = "errorbar", linewidth = 0.2, width = 0)
+    p <- p + do.call(stat_summary, utils::modifyList(
+      c(base_bar, list(fun.data = trio_sd)),
+      bar_params
+    ))
   } else if (bars == "mean_sem") {
-    p <- p + stat_summary(
-      data = df,
-      aes(x = !!sym(cond), y = !!sym(rep_summary)),
-      fun.data = trio_sem,
-      geom = "errorbar", linewidth = 0.2, width = 0)
+    p <- p + do.call(stat_summary, utils::modifyList(
+      c(base_bar, list(fun.data = trio_sem)),
+      bar_params
+    ))
   } else if (bars == "mean_ci") {
-    p <- p + stat_summary(
-      data = df,
-      aes(x = !!sym(cond), y = !!sym(rep_summary)),
-      fun.data = trio_ci,
-      geom = "errorbar", linewidth = 0.2, width = 0)
+    p <- p + do.call(stat_summary, utils::modifyList(
+      c(base_bar, list(fun.data = trio_ci)),
+      bar_params
+    ))
   }
+
   # whatever the user enters, we also want to show the crossbars
-  p <- p + stat_summary(
-    data = df,
-    aes(x = !!sym(cond), y = !!sym(rep_summary)),
-    fun.data = trio_mean,
-    geom = "crossbar", linewidth = 0.4, width = 0.8)
+  p <- p + do.call(stat_summary, utils::modifyList(
+    list(
+      data = df,
+      mapping = aes(x = !!sym(cond), y = !!sym(rep_summary)),
+      fun.data = trio_mean,
+      geom = "crossbar",
+      linewidth = 0.4,
+      width = 0.8
+    ),
+    crossbar_params
+  ))
 
   return(p)
 }

R/superplot.R

@@ -1,7 +1,7 @@
 #' Make a SuperPlot
 #'
 #' @description
-#' The function \code{superplot} creates a SuperPlot using \code{ggplot2}.
+#' The function \code{superplot()} creates a SuperPlot using \code{ggplot2}.
 #'
 #' @param df data frame with at least three columns: meas, cond, repl
 #' @param meas character name of column with measurement (e.g. intensity)
@@ -33,6 +33,8 @@
 #'   ("para_unpaired", "para_paired", "nonpara_unpaired", or "nonpara_paired")
 #' @param info logical for whether to print information about the plot (default
 #'   is FALSE)
+#' @param options optional named list for advanced layer customization. See
+#'   `superplot_spec()` and `sp_modify()` for available options.
 #'
 #' @return ggplot object
 #' @import ggplot2
@@ -64,179 +66,31 @@ superplot <- function(df,
                       gg = NULL,
                       stats = FALSE,
                       stats_test = "para_unpaired",
-                      info = FALSE) {
-  ncond <- nrepl <- NULL
-  rep_mean <- rep_median <- NULL
-
-  # validate args
-  validate_args(pal = pal, xlab = xlab, ylab = ylab, datadist = datadist,
-                size = size, alpha = alpha, bars = bars, linking = linking,
-                rep_summary = rep_summary, shapes = shapes, fsize = fsize,
-                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, facet) == FALSE) {
-    return(NULL)
-  }
-
-  # if the cond column is not character, convert it
-  # but only if it is not already a factor
-  if (!is.factor(df[[cond]]) && !is.character(df[[cond]])) {
-    df[[cond]] <- as.character(df[[cond]])
-  }
-
-  # if the repl column is not character, convert it
-  # but only if it is not already a factor
-  if (!is.character(df[[repl]]) && !is.factor(df[[repl]])) {
-    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)) %>%
-    unique() %>%
-    length()
-  nrepl <- 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,
-                               facet = facet)
-
-  # generate a warning if NROW of summary_df doesn't equal the product of
-  # unique values in cond and repl
-  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)
-  sp_shapes <- get_sp_shapes(nrepl, shapes)
-
-  # if info is TRUE, print information about the plot
-  if (info == TRUE) {
-    get_sp_info(df = df,
-                meas = meas, cond = cond, repl = repl, facet = facet,
-                pal = pal, xlab = xlab, ylab = ylab,
-                datadist = datadist, size = size, alpha = alpha,
-                bars = bars, linking = linking,
-                rep_summary = rep_summary, shapes = shapes,
-                fsize = fsize, gg = gg,
-                stats = stats, stats_test = stats_test
-    )
-  }
-
-  # make superplot ----
-  # we may have an existing ggplot object to add to
-  if (is.null(gg)) {
-    p <- ggplot()
-  } else {
-    p <- gg
-  }
-
-  # data points get plotted here
-  if (datadist == "sina") {
-    p <- p +
-      geom_sina(
-        data = df,
-        aes(x = !!sym(cond), y = !!sym(meas),
-            colour = !!sym(repl), fill = !!sym(repl), shape = !!sym(repl)),
-        alpha = alpha[1], stroke = 0, jitter_y = FALSE, position = "auto",
-        size = size[1], maxwidth = 0.3
-      )
-  } else if (datadist == "jitter") {
-    p <- p +
-      geom_jitter(
-        data = df,
-        aes(x = !!sym(cond), y = !!sym(meas),
-            colour = !!sym(repl), fill = !!sym(repl), shape = !!sym(repl)),
-        alpha = alpha[1], stroke = 0,
-        size = size[1]
-      )
-  } else if (datadist == "violin") {
-    p <- p +
-      geom_violin(
-        data = df,
-        aes(x = !!sym(cond), y = !!sym(meas), group = !!sym(cond)),
-        fill = "grey", width = 0.5, alpha = alpha[1]
-      )
-  } else {
-    warning("datadist must be one of 'sina', 'jitter', or 'violin'")
-  }
-  if (linking == TRUE) {
-    p <- p + geom_path(
-      data = summary_df,
-      aes(x = !!sym(cond), y = !!sym(rep_summary), group = !!sym(repl)),
-      linetype = "dashed", alpha = 0.5
-    )
-  }
-  # add mean and error bars here if requested
-  if (bars != "") {
-    p <- add_sp_bars(p, bars, summary_df, cond, rep_summary)
-  }
-  # add summary points here
-  p <- p + geom_point(
-    data = summary_df,
-    aes(x = !!sym(cond), y = !!sym(rep_summary),
-        fill = !!sym(repl), shape = !!sym(repl)),
-    size = size[2], stroke = 0.5, alpha = alpha[2]
+                      info = FALSE,
+                      options = NULL) {
+  spec <- superplot_spec(
+    df = df,
+    meas = meas,
+    cond = cond,
+    repl = repl,
+    facet = facet,
+    pal = pal,
+    xlab = xlab,
+    ylab = ylab,
+    datadist = datadist,
+    size = size,
+    alpha = alpha,
+    bars = bars,
+    linking = linking,
+    rep_summary = rep_summary,
+    shapes = shapes,
+    fsize = fsize,
+    gg = gg,
+    stats = stats,
+    stats_test = stats_test,
+    info = info,
+    options = options
   )
-  # colours, shapes, and labels
-  p <- p + scale_color_manual(values = sp_colours) +
-    scale_shape_manual(values = sp_shapes) +
-    scale_fill_manual(values = sp_colours) +
-    labs(x = xlab, y = ylab)
-  # limits
-  if (min(df[[meas]], na.rm = TRUE) > 0) {
-    p <- p + lims(y = c(0, NA))
-  } 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
-  if (info == TRUE) {
-    p <- p + theme(legend.position = "right")
-  }
-  p <- p + theme(legend.position = "none")
-
-  # add stats if requested
-  if (stats == TRUE) {
-    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)
+  autoplot(spec)
 }