From 3886bc75439a7bff4756d375c192d728df300982 Mon Sep 17 00:00:00 2001
From: "Gregory R. Warnes" <greg@warnes.net>
Date: Thu, 9 Nov 2023 16:22:48 -0500
Subject: [PATCH] * Add `fixed_params` argument to `spec_barplot` to allow user
 to control whether vector arguments are `map`ped to rows, or held fixed for
 all rows. * Add examples to `spec_barplot`. * Correct documentation for some
 `spec_barplot` parameters.

---
 R/mini_plots.R      | 139 ++++++++++++++++++++++++++++++--------------
 man/spec_barplot.Rd |  92 ++++++++++++++++++++---------
 2 files changed, 160 insertions(+), 71 deletions(-)

diff --git a/R/mini_plots.R b/R/mini_plots.R
index 137446e..9cf7cb6 100644
--- a/R/mini_plots.R
+++ b/R/mini_plots.R
@@ -196,70 +196,117 @@ spec_boxplot <- function(x, width = 200, height = 50, res = 300,
     del = TRUE)
   return(out)
 }
+
 #' Helper functions to generate inline sparklines
 #'
 #' @description These functions helps you quickly generate sets of sparkline
-#' style plots using base R plotting system. Currently, we support histogram,
-#' boxplot, line, scatter, pointrange, barplot plots. You can use them together with
-#' `column_spec` to generate inline plot in tables. By default, this function
-#' will save images in a folder called "kableExtra" and return the address of
-#' the file.
+#'   style plots using base R plotting system. Currently, we support histogram,
+#'   boxplot, line, scatter, pointrange, barplot plots. You can use them
+#'   together with `column_spec` to generate inline plot in tables. By default,
+#'   this function will save images in a folder called "kableExtra" and return
+#'   the address of the file.
 #'
 #' @param x Vector of values or List of vectors of values.
-#' @param width The width of the plot in pixel
-#' @param height The height of the plot in pixel
 #' @param res The resolution of the plot. Default is 300.
-#' @param add_label For boxplot. T/F to add labels for min, mean and max.
-#' @param label_digits If T for add_label, rounding digits for the label.
-#' Default is 2.
 #' @param same_lim T/F. If x is a list of vectors, should all the plots be
-#' plotted in the same range? Default is True.
-#' @param lim Manually specify plotting range in the form of
-#' `c(0, 10)`.
-#' @param xaxt On/Off for xaxis text
-#' @param yaxt On/Off for yaxis text
+#'   plotted in the same range? Default is True.
+#' @param lim Manually specify plotting range in the form of `c(0, 10)`.
+#' @param xaxt On/Off for xaxis text ('n'=off, 's'=on).
+#' @param yaxt On/Off for yaxis text ('n'=off, 's'=on).
 #' @param ann On/Off for annotations (titles and axis titles)
 #' @param col Color for the fill of the histogram bar/boxplot box.
 #' @param border Color for the border.
-#' @param boxlty Boxplot - box boarder type
-#' @param medcol Boxplot - median line color
-#' @param medlwd Boxplot - median line width
 #' @param dir Directory of where the images will be saved.
 #' @param file File name. If not provided, a random name will be used
-#' @param file_type Graphic device. Can be character (e.g., `"pdf"`)
-#'   or a graphics device function (`grDevices::pdf`). This defaults
-#'   to `"pdf"` if the rendering is in LaTeX and `"svg"` otherwise.
-#' @param ... extraparameters passing to boxplot
+#' @param file_type Graphic device. Can be character (e.g., `"pdf"`) or a
+#'   graphics device function (`grDevices::pdf`). This defaults to `"pdf"` if
+#'   the rendering is in LaTeX and `"svg"` otherwise.
+#' @param fixed_params Character vector of parameter names that should be kept
+#'   constant across calls to `barplot`. See details.
+#' @param devwidth,devheight image width and height
+#' @inheritParams graphics::barplot
+#' @inheritDotParams graphics::barplot -height
+#'
+#' @details Normally, the parameters that control the attributes of the
+#' `barplot` are processed to ensure they have the same number of elements as
+#' rows in `x` (scalars are recycled to create vectors), and the call to
+#' `barplot` uses the corresponding values from the parameter vectors.  This
+#' allows providing a vector of values with one value for each row (e.g. to
+#' specify a different color for each row).
+#'
+#' When it is desirable to specify that the same vector is passed to all calls
+#' to `barplot`,  this can be prevented by providing the name of the
+#' parameter(s) in `fixed_params` (e.g. to specify color for the individual bars
+#' within a barplot).
+#'
+#' @examples
+#'
+#' df <- data.frame(a=letters[1:3], b=1:3, bars="")
+#' df
+#'
+#' counts <- list(
+#'    'a' = c(red=3, blue=5, green=0),
+#'    'b' = c(red=1, blue=5, green=3),
+#'    'c' = c(red=0, blue=4, green=4)
+#'  )
+#'
+#' # Set color in each row
+#' kbl(df) |>
+#'   column_spec(3, image=spec_barplot(counts,
+#'               col=c('red','green','blue'), beside=TRUE, space=0.2)
+#'               )
+#'
+#' # Set color of each bar
+#' kbl(df) |>
+#'   column_spec(3,
+#'               image=spec_barplot(counts, col=c('red','green','blue'),
+#'                                  beside=TRUE, space=0.2, fixed_params='col')
+#'               )
 #'
 #' @export
-spec_barplot <- function(x, devwidth = 200, devheight = 40, res = 300,
-                      beside = F,
-                      horiz = F,
-                      same_lim = TRUE, lim = NULL,
-                      xaxt = 'n', yaxt = 'n', ann = FALSE,
-                      col = NULL, border = NA,
-                      dir = if (is_latex()) rmd_files_dir() else tempdir(),
-                      file = NULL,
-                      file_type = if (is_latex()) "pdf" else svglite::svglite,
-                      ...) {
+spec_barplot <- function(
+    x,
+    devwidth = 200,
+    devheight = 40,
+    res = 300,
+    beside = F,
+    horiz = F,
+    same_lim = TRUE, lim = NULL,
+    xaxt = 'n', yaxt = 'n', ann = FALSE,
+    col = NULL, border = NA,
+    dir = if (is_latex()) rmd_files_dir() else tempdir(),
+    file = NULL,
+    file_type = if (is_latex()) "pdf" else svglite::svglite,
+    fixed_params = NULL,
+    ...
+) {
   if (is.list(x)) {
     if (same_lim & is.null(lim)) {
       lim <- base::range(unlist(x), na.rm=TRUE)
     }
-    
-    dots <- listify_args(x, devwidth, devheight, res, beside,horiz,
-                         lim, xaxt, yaxt, ann, col, border,
-                         dir, file, file_type,
-                         lengths = c(1, length(x)))
-    return(do.call(Map, c(list(f = spec_barplot), dots)))
+
+    # Arguments that should be iterated over
+    row_dots <- listify_args(x, devwidth, devheight, res, beside,horiz,
+                             lim, xaxt, yaxt, ann, col, border,
+                             dir, file, file_type, ...,
+                             lengths = c(1, length(x)),
+                             ignore = fixed_params)
+
+    # 'static' arguments for the function
+    if(length(fixed_params)>0)
+      static_dots <- mget(fixed_params)
+    else
+      static_dots <- NULL
+
+    return(.mapply(spec_barplot, dots=row_dots, MoreArgs = static_dots))
   }
-  
+
   if (is.null(x)) return(NULL)
-  
+
   if (is.null(lim)) {
     lim <- base::range(x, na.rm=TRUE)
   }
-  
+
   if (!dir.exists(dir)) {
     dir.create(dir)
   }
@@ -271,16 +318,18 @@ spec_barplot <- function(x, devwidth = 200, devheight = 40, res = 300,
       tempfile(pattern = "barplot_", tmpdir = dir, fileext = paste0(".", file_ext)),
       winslash = "/", mustWork = FALSE)
   }
-  
+
   graphics_dev(filename = file, dev = file_type,
                width = devwidth, height = devheight, res = res,
                bg = "transparent")
   curdev <- grDevices::dev.cur()
   on.exit(grDevices::dev.off(curdev), add = TRUE)
-  
+
   graphics::par(mar = c(0, 0, 0, 0), lwd=0.5)
-  graphics::barplot(height=height, beside = beside,horiz = horiz, col = col, border = border,xaxt = xaxt, yaxt = yaxt, ann = ann)#,xlim = lim, ann = ann, ...)
-  
+  graphics::barplot(height=height, beside = beside,horiz = horiz, col = col,
+                    border = border,xaxt = xaxt, yaxt = yaxt, ann = ann,
+                    ...)
+
   grDevices::dev.off(curdev)
 
   out <- make_inline_plot(
diff --git a/man/spec_barplot.Rd b/man/spec_barplot.Rd
index 7b11fdd..9d2c9cf 100644
--- a/man/spec_barplot.Rd
+++ b/man/spec_barplot.Rd
@@ -21,23 +21,33 @@ spec_barplot(
   dir = if (is_latex()) rmd_files_dir() else tempdir(),
   file = NULL,
   file_type = if (is_latex()) "pdf" else svglite::svglite,
+  fixed_params = NULL,
   ...
 )
 }
 \arguments{
 \item{x}{Vector of values or List of vectors of values.}
 
+\item{devwidth, devheight}{image width and height}
+
 \item{res}{The resolution of the plot. Default is 300.}
 
+\item{beside}{a logical value.  If \code{FALSE}, the columns of
+    \code{height} are portrayed as stacked bars, and if \code{TRUE}
+    the columns are portrayed as juxtaposed bars.}
+
+\item{horiz}{a logical value.  If \code{FALSE}, the bars are drawn
+    vertically with the first bar to the left.  If \code{TRUE}, the
+    bars are drawn horizontally with the first at the bottom.}
+
 \item{same_lim}{T/F. If x is a list of vectors, should all the plots be
 plotted in the same range? Default is True.}
 
-\item{lim}{Manually specify plotting range in the form of
-\code{c(0, 10)}.}
+\item{lim}{Manually specify plotting range in the form of \code{c(0, 10)}.}
 
-\item{xaxt}{On/Off for xaxis text}
+\item{xaxt}{On/Off for xaxis text ('n'=off, 's'=on).}
 
-\item{yaxt}{On/Off for yaxis text}
+\item{yaxt}{On/Off for yaxis text ('n'=off, 's'=on).}
 
 \item{ann}{On/Off for annotations (titles and axis titles)}
 
@@ -49,32 +59,62 @@ plotted in the same range? Default is True.}
 
 \item{file}{File name. If not provided, a random name will be used}
 
-\item{file_type}{Graphic device. Can be character (e.g., \code{"pdf"})
-or a graphics device function (\code{grDevices::pdf}). This defaults
-to \code{"pdf"} if the rendering is in LaTeX and \code{"svg"} otherwise.}
-
-\item{...}{extraparameters passing to boxplot}
-
-\item{width}{The width of the plot in pixel}
-
-\item{height}{The height of the plot in pixel}
+\item{file_type}{Graphic device. Can be character (e.g., \code{"pdf"}) or a
+graphics device function (\code{grDevices::pdf}). This defaults to \code{"pdf"} if
+the rendering is in LaTeX and \code{"svg"} otherwise.}
 
-\item{add_label}{For boxplot. T/F to add labels for min, mean and max.}
+\item{fixed_params}{Character vector of parameter names that should be kept
+constant across calls to \code{barplot}. See details.}
 
-\item{label_digits}{If T for add_label, rounding digits for the label.
-Default is 2.}
-
-\item{boxlty}{Boxplot - box boarder type}
-
-\item{medcol}{Boxplot - median line color}
-
-\item{medlwd}{Boxplot - median line width}
+\item{...}{
+  Arguments passed on to \code{\link[graphics:barplot]{graphics::barplot}}
+  \describe{
+    \item{\code{}}{}
+  }}
 }
 \description{
 These functions helps you quickly generate sets of sparkline
 style plots using base R plotting system. Currently, we support histogram,
-boxplot, line, scatter, pointrange, barplot plots. You can use them together with
-\code{column_spec} to generate inline plot in tables. By default, this function
-will save images in a folder called "kableExtra" and return the address of
-the file.
+boxplot, line, scatter, pointrange, barplot plots. You can use them
+together with \code{column_spec} to generate inline plot in tables. By default,
+this function will save images in a folder called "kableExtra" and return
+the address of the file.
+}
+\details{
+Normally, the parameters that control the attributes of the
+\code{barplot} are processed to ensure they have the same number of elements as
+rows in \code{x} (scalars are recycled to create vectors), and the call to
+\code{barplot} uses the corresponding values from the parameter vectors.  This
+allows providing a vector of values with one value for each row (e.g. to
+specify a different color for each row).
+
+When it is desirable to specify that the same vector is passed to all calls
+to \code{barplot},  this can be prevented by providing the name of the
+parameter(s) in \code{fixed_params} (e.g. to specify color for the individual bars
+within a barplot).
+}
+\examples{
+
+df <- data.frame(a=letters[1:3], b=1:3, bars="")
+df
+
+counts <- list(
+   'a' = c(red=3, blue=5, green=0),
+   'b' = c(red=1, blue=5, green=3),
+   'c' = c(red=0, blue=4, green=4)
+ )
+
+# Set color in each row
+kbl(df) |>
+  column_spec(3, image=spec_barplot(counts,
+              col=c('red','green','blue'), beside=TRUE, space=0.2)
+              )
+
+# Set color of each bar
+kbl(df) |>
+  column_spec(3,
+              image=spec_barplot(counts, col=c('red','green','blue'),
+                                 beside=TRUE, space=0.2, fixed_params='col')
+              )
+
 }