Fix: colour usage for flatplot and pieplot

Author: quantixed

NAMESPACE

@@ -3,6 +3,7 @@
 export(add_sp_bars)
 export(flatplot)
 export(get_fp_colour)
+export(get_fp_colours)
 export(get_sp_colours)
 export(get_sp_shapes)
 export(get_sp_stats)
@@ -14,6 +15,7 @@ import(cowplot)
 import(dplyr)
 import(ggforce)
 import(ggplot2)
+importFrom(grDevices,colors)
 importFrom(rlang,":=")
 importFrom(stats,TukeyHSD)
 importFrom(stats,kruskal.test)

R/flatplot.R

@@ -71,15 +71,15 @@ flatplot <- function(df,
     df[[cond]] <- as.character(df[[cond]])
   }
 
-  fp_colour <- get_fp_colour(colour)
+  fp_colour <- get_fp_colours(colour)
 
   # how many unique values in cond?
   ncond <- df %>%
     pull(!!sym(cond)) %>%
     unique() %>%
     length()
 
-  # make superplot ----
+  # make flatplot ----
   # we may have an existing ggplot object to add to
   if (is.null(gg)) {
     p <- ggplot()
@@ -89,23 +89,49 @@ flatplot <- function(df,
 
   # 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
-      )
+    if (length(fp_colour) == 1) {
+      # Single color - use as fixed aesthetic
+      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 {
+      # Multiple colors - map to condition levels
+      p <- p +
+        geom_sina(
+          data = df,
+          aes(x = !!sym(cond), y = !!sym(meas), colour = !!sym(cond)),
+          alpha = alpha, shape = 16, jitter_y = FALSE,
+          size = size, maxwidth = 0.8
+        ) +
+        scale_colour_manual(values = fp_colour)
+    }
   } 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
-      )
+    if (length(fp_colour) == 1) {
+      # Single color - use as fixed aesthetic
+      p <- p +
+        geom_jitter(
+          data = df,
+          aes(x = !!sym(cond), y = !!sym(meas)),
+          colour = fp_colour,
+          alpha = alpha, shape = 16,
+          size = size
+        )
+    } else {
+      # Multiple colors - map to condition levels
+      p <- p +
+        geom_jitter(
+          data = df,
+          aes(x = !!sym(cond), y = !!sym(meas), colour = !!sym(cond)),
+          alpha = alpha, shape = 16,
+          size = size
+        ) +
+        scale_colour_manual(values = fp_colour)
+    }
   } else {
     warning("datadist must be one of 'sina' or 'jitter'")
   }

R/get_fp_colour.R

@@ -1,9 +1,26 @@
-#' FlatPlot Colour Selection
+#' FlatPlot Colour Selection (Multiple Colors)
+#'
+#' @param keys character vector of color names/codes, can be "rl_green", "rl_red", "rl_blue",
+#' "rl_yellow", "rl_purple", "rl_orange", "rl_magenta", hex colours, or valid R color names
+#'
+#' @return character vector of hex colours
+#' @export
+#'
+#' @examples
+#' get_fp_colours(c("rl_green", "#FF0000", "blue"))
+#' get_fp_colours("rl_green")
+get_fp_colours <- function(keys) {
+  # Apply get_fp_colour to each element in the vector
+  sapply(keys, get_fp_colour, USE.NAMES = FALSE)
+}
+
+#' FlatPlot Colour Selection (Single Color)
 #'
 #' @param key character name, can be "rl_green", "rl_red", "rl_blue",
-#' "rl_purple", "rl_orange", "rl_magenta", or a hex colour
+#' "rl_yellow", "rl_purple", "rl_orange", "rl_magenta", or a hex colour
 #'
 #' @return character of hex colour
+#' @importFrom grDevices colors
 #' @export
 #'
 #' @examples
@@ -15,10 +32,16 @@ get_fp_colour <- function(key) {
   if (grepl("^#([A-Fa-f0-9]{6}|[A-Fa-f0-9]{3})$", key)) {
     return(key)
   }
+  valid_r_colours <- colors()
+  # if the key is a valid R colour, return it
+  if (key %in% valid_r_colours) {
+    return(key)
+  }
   colour <- switch(key,
          "rl_green" = "#00a651",
          "rl_red" = "#ed1c24",
          "rl_blue" = "#2276b9",
+         "rl_yellow" = "#ffc620",
          "rl_purple" = "#64318e",
          "rl_orange" = "#f59331",
          "rl_magenta" = "#da70d6")

R/pieplot.R

@@ -1,8 +1,8 @@
 #' Make a pie chart using ggplot2
 #'
 #' @description
-#' The function \code{pie_maker} creates a pie chart using
-#' \code{ggplot2}. It takes two vectors of values and optionally a
+#' The function \code{pie_maker} creates a pie chart using \code{ggplot2}.
+#' It takes two vectors of values and optionally a
 #' second vector of values to create a pie chart with two layers.
 #' @param x1 A numeric vector containing the values for the first
 #'     layer of the pie chart.
@@ -13,12 +13,11 @@
 #' @param label An optional character string to be used as the title
 #' @param ... Currently not used.
 #' @examples
-#' pieplot(x1 = c(143, 459),
+#' pieplot(x1 = c(123, 456),
 #'   cols = c("#44aa99", "#117733"))
 #'
-#' pieplot(x1 = c(61 - 9, 9, 593, 3595 - 593),
-#'   cols = c("#bbbbbb", "#44aa99", "#117733", "#dddddd"),
-#'   x2 = c(61, 3595))
+#' pieplot(x1 = c(50 - 20, 20, 80, 180 - 80),
+#'   cols = c("#bbbbbb", "#44aa99", "#117733", "#dddddd"), x2 = c(100,130))
 #'
 #' @return ggplot object
 #' @import ggplot2
@@ -28,21 +27,51 @@
 
 pieplot <- function(x1, cols, x2 = NULL, label = NULL, ...) {
   pcolours <- ymin <- ymax <- NULL
+  # validate args
+  if (!is.numeric(x1)) {
+    stop("x1 must be a numeric vector")
+  }
+  if (!is.null(x2) && !is.numeric(x2)) {
+    stop("x2 must be a numeric vector or NULL")
+  }
+  # check that x1 and optionally x2 are non-negative
+  if (any(x1 < 0)) {
+    stop("x1 must be a non-negative numeric vector")
+  }
+  if (!is.null(x2) && any(x2 < 0)) {
+    stop("x2 must be a non-negative numeric vector or NULL")
+  }
+  if (length(x1) == 0) {
+    stop("x1 must be a non-empty numeric vector")
+  }
+  if (!is.null(x2) && length(x2) == 0) {
+    stop("x2 must be a non-empty numeric vector or NULL")
+  }
+  # colour check
+  check_colour(cols)
+  if (!is.character(cols) || length(cols) != length(x1)) {
+    stop("cols must be a character vector of the same length as x1")
+  }
+  cols <- get_fp_colours(cols)
+
   df <- data.frame(
     pvalues = x1,
     pcolours = as.factor(seq_along(cols))
   )
-  cs <- cumsum(x1)
-  df$ymin <- c(0, cs[seq_along(cs) - 1])
-  df$ymax <- cs
+  cs1 <- cumsum(x1)
+  df$ymin <- c(0, cs1[seq_along(cs1) - 1])
+  df$ymax <- cs1
   if (is.null(x2)) {
+    # if x2 is NULL, we only have one layer
+    # so df2 makes the outline over the pie chart
     df2 <- df
   } else {
-    cs <- cumsum(x2)
+    x2 <- x2 / sum(x2) * sum(x1)  # scale x2 to match x1
+    cs2 <- cumsum(x2)
     df2 <- data.frame(
       pvalues = x2,
-      ymin = c(0, cs[seq_along(cs) - 1]),
-      ymax = cs
+      ymin = c(0, cs2[seq_along(cs2) - 1]),
+      ymax = cs2
     )
   }
 

R/validate.R

@@ -69,20 +69,34 @@ check_pal <- function(arg) {
 #'
 #' @param arg argument passed as colour
 #' @returns none
+#' @importFrom grDevices colors
 #' @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)
+  # colour should be character vector, each element one of the following:
+  # "rl_green", "rl_red", "rl_blue", "rl_yellow", "rl_purple", "rl_orange",
+  # "rl_magenta", or a hex colour
+
+  # Check if arg is a character vector
+  if (!is.character(arg)) {
+    stop("'colour' must be a character vector", call. = FALSE)
+  }
+
+  # Define valid named colours
+  valid_colours <- c(colors(), "rl_green", "rl_red", "rl_blue", "rl_yellow",
+                     "rl_purple", "rl_orange", "rl_magenta")
+
+  # Check each element in the vector
+  for (i in seq_along(arg)) {
+    colour <- arg[i]
+
+    # Check if it's a valid named colour
+    if (!colour %in% valid_colours) {
+      # If not a named colour, check if it's a valid hex colour
+      if (!grepl("^#([A-Fa-f0-9]{6}|[A-Fa-f0-9]{3})$", colour)) {
+        stop("'colour[", i, "]' must be a hex colour, a named colour or one of
+        rl_green, rl_red, rl_blue, rl_yellow, rl_purple, rl_orange,
+             or rl_magenta", call. = FALSE)
+      }
     }
   }
 }

_pkgdown.yml

@@ -1,4 +1,15 @@
 url: https://quantixed.github.io/SuperPlotR/
+
 template:
   bootstrap: 5
   bootswatch: flatly
+
+articles:
+- title: How to...
+  navbar: ~
+  contents:
+  - SuperPlotR
+  - advanced
+  - limitations
+  - flatplot
+  - pieplot

man/get_fp_colour.Rd

@@ -37,18 +37,27 @@ flatplot(lord_jcb, "Speed", "Treatment", ylab = "Speed (um/min)",
          colour = "rl_green")
 ```
 
-The control of colour is by a single colour, which can be a hex code or one of
-our lab's publication colour palette.
+The control of colour is usually by a single colour, which can be a hex code or
+one of our lab's publication colour palette.
 
 ```{r flatplot3}
 flatplot(lord_jcb, "Speed", "Treatment", ylab = "Speed (um/min)",
          colour = "rl_red", stats = TRUE)
 ```
 
+It is also possible to specify a vector of colours, which will be used for each
+condition. Any extra colours are ignored, and valid inputs are R colors, hex
+codes or our lab's colour palette.
+
+```{r flatplot4}
+flatplot(lord_jcb, "Speed", "Treatment", ylab = "Speed (um/min)",
+         colour = c("rl_red", "rl_blue", "rl_green"))
+```
+
 We can request statistical testing as for SuperPlots, but the p-values will be
 calculated for the whole dataset, not for each replicate.
 
-```{r flatplot4}
+```{r flatplot5}
 flatplot(lord_jcb, "Speed", "Treatment", ylab = "Speed (um/min)",
          colour = "rl_red", size = 4, alpha = 0.25,
          bars = "mean_ci")