|
| 1 | +#' Make a FlatPlot |
| 2 | +#' |
| 3 | +#' @param df data frame with at least three columns: meas, cond, repl |
| 4 | +#' @param meas character name of column with measurement (e.g. intensity) |
| 5 | +#' @param cond character name of column with condition (e.g. Control, WT) |
| 6 | +#' @param colour string for colour palette to use, select ("rl_green", "rl_red", |
| 7 | +#' "rl_blue", "rl_purple", "rl_orange", "rl_magenta", or a hex colour, default |
| 8 | +#' is black) |
| 9 | +#' @param xlab string for x label (default is empty) |
| 10 | +#' @param ylab string for y label (default is "Measurement") |
| 11 | +#' @param datadist string for data distribution to use, select ("sina" default, |
| 12 | +#' or "jitter") |
| 13 | +#' @param size numeric size of data points (default is 2) |
| 14 | +#' @param alpha numeric vector of alpha range data and summary points (default |
| 15 | +#' is c(0.5, 0.7)) |
| 16 | +#' @param bars string for type of error bars to add, select ("none", |
| 17 | +#' "mean_sd" (default), "mean_sem", or "mean_ci") |
| 18 | +#' @param fsize numeric font size for text (default is 12) |
| 19 | +#' @param gg ggplot object to add to (default is NULL) |
| 20 | +#' @param stats logical for whether to add statistical tests (default is FALSE) |
| 21 | +#' @param stats_test string for statistical test to use, select |
| 22 | +#' ("para_unpaired", "para_paired", "nonpara_unpaired", or "nonpara_paired") |
| 23 | +#' |
| 24 | +#' @return ggplot object |
| 25 | +#' @import ggplot2 |
| 26 | +#' @import dplyr |
| 27 | +#' @import ggforce |
| 28 | +#' @import cowplot |
| 29 | +#' @importFrom stats sd median |
| 30 | +#' |
| 31 | +#' @export |
| 32 | +#' |
| 33 | +#' @examples |
| 34 | +#' flatplot(lord_jcb, "Speed", "Treatment", ylab = "Speed (um/min)") |
| 35 | +#' |
| 36 | +flatplot <- function(df, |
| 37 | + meas, cond, |
| 38 | + colour = "#000000", |
| 39 | + xlab = "", ylab = "Measurement", |
| 40 | + datadist = "sina", |
| 41 | + size = 2, |
| 42 | + alpha = 0.5, |
| 43 | + bars = "mean_sd", |
| 44 | + fsize = 12, |
| 45 | + gg = NULL, |
| 46 | + stats = FALSE, |
| 47 | + stats_test = "para_unpaired") { |
| 48 | + ncond <- nrepl <- NULL |
| 49 | + rep_mean <- rep_median <- NULL |
| 50 | + |
| 51 | + # validate args |
| 52 | + validate_args(colour = colour, xlab = xlab, ylab = ylab, datadist = datadist, |
| 53 | + bars = bars, fsize = fsize, |
| 54 | + gg = gg, stats = stats, stats_test = stats_test) |
| 55 | + # size and alpha should be a single numeric value |
| 56 | + if (!is.numeric(size) || length(size) != 1) { |
| 57 | + stop("size must be a single numeric value") |
| 58 | + } |
| 59 | + if (!is.numeric(alpha) || length(alpha) != 1) { |
| 60 | + stop("alpha must be a single numeric value") |
| 61 | + } |
| 62 | + |
| 63 | + # verify that the data frame to make sure that it is suitable for SuperPlot |
| 64 | + if (verify_fp_columns(df, meas, cond) == FALSE) { |
| 65 | + return(NULL) |
| 66 | + } |
| 67 | + |
| 68 | + # if the cond column is not character, convert it |
| 69 | + if (!is.character(df[[cond]])) { |
| 70 | + df[[cond]] <- as.character(df[[cond]]) |
| 71 | + } |
| 72 | + |
| 73 | + fp_colour <- get_fp_colour(colour) |
| 74 | + |
| 75 | + # how many unique values in cond? |
| 76 | + ncond <- df %>% |
| 77 | + pull(!!sym(cond)) %>% |
| 78 | + unique() %>% |
| 79 | + length() |
| 80 | + |
| 81 | + # make superplot ---- |
| 82 | + # we may have an existing ggplot object to add to |
| 83 | + if (is.null(gg)) { |
| 84 | + p <- ggplot() |
| 85 | + } else { |
| 86 | + p <- gg |
| 87 | + } |
| 88 | + |
| 89 | + # data points get plotted here |
| 90 | + if (datadist == "sina") { |
| 91 | + p <- p + |
| 92 | + geom_sina( |
| 93 | + data = df, |
| 94 | + aes(x = !!sym(cond), y = !!sym(meas)), |
| 95 | + colour = fp_colour, |
| 96 | + alpha = alpha, shape = 16, jitter_y = FALSE, |
| 97 | + size = size, maxwidth = 0.8 |
| 98 | + ) |
| 99 | + } else if (datadist == "jitter") { |
| 100 | + p <- p + |
| 101 | + geom_jitter( |
| 102 | + data = df, |
| 103 | + aes(x = !!sym(cond), y = !!sym(meas)), |
| 104 | + colour = fp_colour, |
| 105 | + alpha = alpha, shape = 16, |
| 106 | + size = size |
| 107 | + ) |
| 108 | + } else { |
| 109 | + warning("datadist must be one of 'sina' or 'jitter'") |
| 110 | + } |
| 111 | + # add mean and error bars here if requested |
| 112 | + if (bars != "") { |
| 113 | + p <- add_sp_bars(p, bars, df, cond, meas) |
| 114 | + } |
| 115 | + # colours, shapes, and labels |
| 116 | + p <- p + labs(x = xlab, y = ylab) |
| 117 | + # limits |
| 118 | + if (min(df[[meas]], na.rm = TRUE) > 0) { |
| 119 | + p <- p + lims(y = c(0, NA)) |
| 120 | + } else { |
| 121 | + # plot is scaled automatically |
| 122 | + } |
| 123 | + # theme |
| 124 | + p <- p + theme_cowplot(fsize) + |
| 125 | + theme(legend.position = "none") |
| 126 | + # add stats if requested |
| 127 | + if (stats == TRUE) { |
| 128 | + nrepl <- df %>% |
| 129 | + group_by(!!sym(cond)) %>% |
| 130 | + summarise(n = n()) |
| 131 | + nrepl <- min(nrepl$n, na.rm = TRUE) |
| 132 | + get_sp_stats(as.data.frame(df), meas, cond, repl = NULL, |
| 133 | + ncond, nrepl, stats_test) |
| 134 | + } |
| 135 | + |
| 136 | + return(p) |
| 137 | +} |
0 commit comments