v.0.0.5 addition of FlatPlots

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: SuperPlotR
 Title: Making SuperPlots in R
-Version: 0.0.4
+Version: 0.0.5
 Authors@R:
     person(given = "Stephen J",
            family = "Royle",

NAMESPACE

@@ -1,6 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
 export(add_sp_bars)
+export(flatplot)
+export(get_fp_colour)
 export(get_sp_colours)
 export(get_sp_shapes)
 export(get_sp_stats)

NEWS.md

@@ -1,5 +1,9 @@
 # SuperPlotR (development version)
 
+## SuperPlotR 0.0.5
+
+* Added `plainplot` function for simple plots.
+
 ## SuperPlotR 0.0.4
 
 * Added simple statistical testing for the `superplot` function.

R/flatplot.R

@@ -0,0 +1,137 @@
+#' Make a FlatPlot
+#'
+#' @param df data frame with at least three columns: meas, cond, repl
+#' @param meas character name of column with measurement (e.g. intensity)
+#' @param cond character name of column with condition (e.g. Control, WT)
+#' @param colour string for colour palette to use, select ("rl_green", "rl_red",
+#' "rl_blue", "rl_purple", "rl_orange", "rl_magenta", or a hex colour, default
+#' is black)
+#' @param xlab string for x label (default is empty)
+#' @param ylab string for y label (default is "Measurement")
+#' @param datadist string for data distribution to use, select ("sina" default,
+#' or "jitter")
+#' @param size numeric size of data points (default is 2)
+#' @param alpha numeric vector of alpha range data and summary points (default
+#' is c(0.5, 0.7))
+#' @param bars string for type of error bars to add, select ("none",
+#' "mean_sd" (default), "mean_sem", or "mean_ci")
+#' @param fsize numeric font size for text (default is 12)
+#' @param gg ggplot object to add to (default is NULL)
+#' @param stats logical for whether to add statistical tests (default is FALSE)
+#' @param stats_test string for statistical test to use, select
+#' ("para_unpaired", "para_paired", "nonpara_unpaired", or "nonpara_paired")
+#'
+#' @return ggplot object
+#' @import ggplot2
+#' @import dplyr
+#' @import ggforce
+#' @import cowplot
+#' @importFrom stats sd median
+#'
+#' @export
+#'
+#' @examples
+#' flatplot(lord_jcb, "Speed", "Treatment", ylab = "Speed (um/min)")
+#'
+flatplot <- function(df,
+                      meas, cond,
+                      colour = "#000000",
+                      xlab = "", ylab = "Measurement",
+                      datadist = "sina",
+                      size = 2,
+                      alpha = 0.5,
+                      bars = "mean_sd",
+                      fsize = 12,
+                      gg = NULL,
+                      stats = FALSE,
+                      stats_test = "para_unpaired") {
+  ncond <- nrepl <- NULL
+  rep_mean <- rep_median <- NULL
+
+  # validate args
+  validate_args(colour = colour, xlab = xlab, ylab = ylab, datadist = datadist,
+                bars = bars, fsize = fsize,
+                gg = gg, stats = stats, stats_test = stats_test)
+  # size and alpha should be a single numeric value
+  if (!is.numeric(size) || length(size) != 1) {
+    stop("size must be a single numeric value")
+  }
+  if (!is.numeric(alpha) || length(alpha) != 1) {
+    stop("alpha must be a single numeric value")
+  }
+
+  # verify that the data frame to make sure that it is suitable for SuperPlot
+  if (verify_fp_columns(df, meas, cond) == FALSE) {
+    return(NULL)
+  }
+
+  # if the cond column is not character, convert it
+  if (!is.character(df[[cond]])) {
+    df[[cond]] <- as.character(df[[cond]])
+  }
+
+  fp_colour <- get_fp_colour(colour)
+
+  # how many unique values in cond?
+  ncond <- df %>%
+    pull(!!sym(cond)) %>%
+    unique() %>%
+    length()
+
+  # 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 = fp_colour,
+        alpha = alpha, shape = 16, jitter_y = FALSE,
+        size = size, maxwidth = 0.8
+      )
+  } else if (datadist == "jitter") {
+    p <- p +
+      geom_jitter(
+        data = df,
+        aes(x = !!sym(cond), y = !!sym(meas)),
+        colour = fp_colour,
+        alpha = alpha, shape = 16,
+        size = size
+      )
+  } else {
+    warning("datadist must be one of 'sina' or 'jitter'")
+  }
+  # add mean and error bars here if requested
+  if (bars != "") {
+    p <- add_sp_bars(p, bars, df, cond, meas)
+  }
+  # colours, shapes, and labels
+  p <- p + 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
+  }
+  # theme
+  p <- p + theme_cowplot(fsize) +
+    theme(legend.position = "none")
+  # add stats if requested
+  if (stats == TRUE) {
+    nrepl <- df %>%
+      group_by(!!sym(cond)) %>%
+      summarise(n = n())
+    nrepl <- min(nrepl$n, na.rm = TRUE)
+    get_sp_stats(as.data.frame(df), meas, cond, repl = NULL,
+                 ncond, nrepl, stats_test)
+  }
+
+  return(p)
+}

R/get_fp_colour.R

@@ -0,0 +1,26 @@
+#' FlatPlot Colour Selection
+#'
+#' @param key character name, can be "rl_green", "rl_red", "rl_blue",
+#' "rl_purple", "rl_orange", "rl_magenta", or a hex colour
+#'
+#' @return character of hex colour
+#' @export
+#'
+#' @examples
+#' get_fp_colour("rl_green")
+get_fp_colour <- function(key) {
+  # key has already been validated to be either a single hex value or one of
+  # the allowed strings
+  # so, if it is a hex code, return it
+  if (grepl("^#([A-Fa-f0-9]{6}|[A-Fa-f0-9]{3})$", key)) {
+    return(key)
+  }
+  colour <- switch(key,
+         "rl_green" = "#00a651",
+         "rl_red" = "#ed1c24",
+         "rl_blue" = "#2276b9",
+         "rl_purple" = "#64318e",
+         "rl_orange" = "#f59331",
+         "rl_magenta" = "#da70d6")
+  return(colour)
+}

R/get_sp_stats.R

@@ -12,7 +12,7 @@
 #' @returns nothing, prints results to console
 #' @importFrom stats t.test wilcox.test kruskal.test TukeyHSD
 #' @export
-get_sp_stats <-  function(df, rep_summary, cond, repl, ncond, nrepl,
+get_sp_stats <- function(df, rep_summary, cond, repl, ncond, nrepl,
                           stats_test) {
   # if ncond is 1, then we can't do any tests
   if (ncond == 1) {
@@ -66,15 +66,20 @@ get_sp_stats <-  function(df, rep_summary, cond, repl, ncond, nrepl,
         cat("ANOVA not significant, no Tukey's HSD test performed\n")
       }
     } else {
-      cat("Performing repeated measures ANOVA\n")
-      aov <- aov(df[[rep_summary]] ~ df[[cond]] + Error(df[[repl]]))
-      print(aov)
-      print(summary(aov))
-      # if Pr is < 0.05, then we do Tukey's HSD test
-      if (summary(aov)[[2]][[1]]["Pr(>F)"][[1]][1] < 0.05) {
-        cat("Pr < 0.05, perform multiple comparisons manually\n")
+      if (!is.null(repl)) {
+        cat("Performing repeated measures ANOVA\n")
+        aov <- aov(df[[rep_summary]] ~ df[[cond]] + Error(df[[repl]]))
+        print(aov)
+        print(summary(aov))
+        # if Pr is < 0.05, then we do Tukey's HSD test
+        if (summary(aov)[[2]][[1]]["Pr(>F)"][[1]][1] < 0.05) {
+          cat("Pr < 0.05, perform multiple comparisons manually\n")
+        } else {
+          cat("ANOVA not significant\n")
+        }
       } else {
-        cat("ANOVA not significant\n")
+        cat("Selected para_paired, and there are more than 2 groups. Please
+            consider performing a repeated measures ANOVA manually\n")
       }
     }
   }
@@ -92,7 +97,7 @@ get_sp_stats <-  function(df, rep_summary, cond, repl, ncond, nrepl,
         cat("Kruskal-Wallis test not significant\n")
       }
     } else {
-      cat("Selected nonpara-paired, and there are more than 2 groups. Please
+      cat("Selected nonpara_paired, and there are more than 2 groups. Please
           consider performing a Friedman test manually\n")
     }
   }

R/superplot.R

@@ -11,14 +11,14 @@
 #' @param datadist string for data distribution to use, select ("sina" default,
 #' "jitter", or "violin")
 #' @param size numeric vector of size range data and summary points (default is
-#' c(0.8, 1.5))
+#' c(2, 3))
 #' @param alpha numeric vector of alpha range data and summary points (default
 #' is c(0.5, 0.7))
 #' @param bars string for type of error bars to add, select ("none" default,
 #' "mean_sd", "mean_sem", or "mean_ci")
 #' @param linking logical for whether to link summary points between conditions
 #' (default is FALSE)
-#' @param fsize numeric font size for text (default is 9)
+#' @param fsize numeric font size for text (default is 12)
 #' @param shapes logical for whether to use different shapes for replicates
 #' @param rep_summary string for summary statistic to use for replicates, select
 #' ("rep_mean" default, or "rep_median")
@@ -66,7 +66,7 @@ superplot <- function(df,
                 gg = gg, stats = stats, stats_test = stats_test)
 
   # verify that the data frame to make sure that it is suitable for SuperPlot
-  if (verify_columns(df, meas, cond, repl) == FALSE) {
+  if (verify_sp_columns(df, meas, cond, repl) == FALSE) {
     return(NULL)
   }
 

R/validate.R

@@ -1,6 +1,7 @@
 #' Validate SuperPlot Arguments
 #'
 #' @param pal argument passed to pal
+#' @param colour argument passed to colour
 #' @param xlab argument passed to xlab
 #' @param ylab argument passed to ylab
 #' @param datadist argument passed to datadist
@@ -17,12 +18,13 @@
 #'
 #' @returns none
 #' @keywords internal
-validate_args <- function(pal = NULL, xlab = NULL, ylab = NULL, datadist = NULL,
-                          size = NULL, alpha = NULL, bars = NULL,
-                          linking = NULL, rep_summary = NULL, shapes = NULL,
-                          fsize = NULL, gg = NULL, stats = NULL,
+validate_args <- function(pal = NULL, colour = NULL, xlab = NULL, ylab = NULL,
+                          datadist = NULL, size = NULL, alpha = NULL,
+                          bars = NULL, linking = NULL, rep_summary = NULL,
+                          shapes = NULL, fsize = NULL, gg = NULL, stats = NULL,
                           stats_test = NULL) {
   if (!is.null(pal)) check_pal(pal)
+  if (!is.null(colour)) check_colour(colour)
   if (!is.null(xlab)) check_xlab(xlab)
   if (!is.null(ylab)) check_ylab(ylab)
   if (!is.null(datadist)) check_datadist(datadist)
@@ -62,6 +64,28 @@ check_pal <- function(arg) {
   }
 }
 
+#' Check colour argument
+#'
+#' @param arg argument passed as colour
+#' @returns none
+#' @keywords internal
+check_colour <- function(arg) {
+  # colour should be character, one of the following:
+  # "rl_green", "rl_red", "rl_blue", "rl_purple", "rl_orange", "rl_magenta", or
+  # a hex colour
+  # first test if it is a character vector of length 1
+  if (length(arg) > 1) {
+    stop("'colour' must be a hex colour or one of rl_green, rl_red, rl_blue,
+         rl_purple, rl_orange, or rl_magenta", call. = FALSE)
+  } else if (!arg %in% c("rl_green", "rl_red", "rl_blue", "rl_purple",
+                         "rl_orange", "rl_magenta")) {
+    if (!grepl("^#([A-Fa-f0-9]{6}|[A-Fa-f0-9]{3})$", arg)) {
+      stop("'colour' must be a hex colour or one of rl_green, rl_red, rl_blue,
+           rl_purple, rl_orange, or rl_magenta", call. = FALSE)
+    }
+  }
+}
+
 #' Check xlab argument
 #'
 #' @param arg argument passed as xlab

R/verify.R

@@ -8,7 +8,7 @@
 #'
 #' @return logical to allow plot to go ahead
 #' @keywords internal
-verify_columns <- function(df, meas, cond, repl) {
+verify_sp_columns <- function(df, meas, cond, repl) {
   # 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")
@@ -26,3 +26,30 @@ verify_columns <- function(df, meas, cond, repl) {
   }
   return(TRUE)
 }
+
+#' Verify the data frame used for FlatPlot
+#'
+#' @param df data frame with at least three columns: meas, cond, repl
+#' @param meas character name of column with measurement (e.g. intensity)
+#' @param cond character name of column with condition (e.g. Control, WT)
+#'
+#' @return logical to allow plot to go ahead
+#' @keywords internal
+verify_fp_columns <- function(df, meas, cond) {
+  # check that meas, cond and repl are character
+  if (!is.character(meas) | !is.character(cond)) {
+    message("meas and cond must be character")
+    return(FALSE)
+  }
+  # verify the data frame - check if the required columns are present
+  if (!cond %in% colnames(df) | !meas %in% colnames(df)) {
+    message("The data frame does not contain the required columns")
+    return(FALSE)
+  }
+  # check that column meas is numeric
+  if (!is.numeric(df[[meas]])) {
+    message("The column ", meas, " is not numeric")
+    return(FALSE)
+  }
+  return(TRUE)
+}