From cc81ad051913ee8b4873b7cd6cb9be37d3ab67b1 Mon Sep 17 00:00:00 2001 From: "Gregory R. Warnes" Date: Sat, 4 Nov 2023 13:23:43 -0400 Subject: [PATCH 1/7] Enable specification of individual column attributes in `row_spec` by providing a vector of values. --- R/row_spec.R | 196 +++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 152 insertions(+), 44 deletions(-) diff --git a/R/row_spec.R b/R/row_spec.R index 60d2a7c..87b6eeb 100644 --- a/R/row_spec.R +++ b/R/row_spec.R @@ -6,38 +6,52 @@ #' @param kable_input Output of `knitr::kable()` with `format` specified #' @param row A numeric value or vector indicating which row(s) to be selected. You don't #' need to count in header rows or group labeling rows. -#' @param bold A T/F value to control whether the text of the selected row +#' @param bold A T/F vector to control whether the cells of the selected row #' need to be bolded. -#' @param italic A T/F value to control whether the text of the selected row +#' @param italic A T/F vector to control whether the cells of the selected row #' need to be emphasized. -#' @param monospace A T/F value to control whether the text of the selected row +#' @param monospace A T/F vector to control whether the cells of the selected row #' need to be monospaced (verbatim) -#' @param underline A T/F value to control whether the text of the selected row +#' @param underline A T/F vector to control whether the cells of the selected row #' need to be underlined -#' @param strikeout A T/F value to control whether the text of the selected row -#' need to be stricked out. -#' @param color A character string for row text color. For example, "red" or +#' @param strikeout A T/F vector to control whether the cells of the selected row +#' need to be struck out out. +#' @param color A character vector for column text color. For example, "red" or #' "#BBBBBB". -#' @param background A character string for row background color. Here please +#' @param background A character vector for cell background colors. Here please #' pay attention to the differences in color codes between HTML and LaTeX. -#' @param align A character string for cell alignment. For HTML, possible values could +#' @param align A character vector for column cell alignment. For HTML, possible values could #' be `l`, `c`, `r` plus `left`, `center`, `right`, `justify`, `initial` and `inherit` #' while for LaTeX, you can only choose from `l`, `c` & `r`. -#' @param font_size A numeric input for font size. For HTML, you can also use +#' @param font_size A numeric vector for cell font sizes. For HTML, you can also use #' options including `xx-small`, `x-small`, `small`, `medium`, `large`, #' `x-large`, `xx-large`, `smaller`, `larger`, `initial` and `inherit`. -#' @param angle 0-360, degree that the text will rotate. +#' @param angle 0-360, a numeric vector of cell text rotation in degrees. #' @param extra_css Extra css text to be passed into the cells of the row. Note #' that it's not for the whole row. #' @param hline_after T/F. A replicate of `hline.after` in xtable. It -#' addes a hline after ther row +#' addes a hline after the row #' @param extra_latex_after Extra LaTeX text to be added after the row. Similar -#' with `add.to.row` in xtable +#' with `add.to.row` in `xtable::xtable` #' #' @examples #' \dontrun{ -#' x <- knitr::kable(head(mtcars), "html") -#' row_spec(x, 1:2, bold = TRUE, italic = TRUE) +#' x <- head(mtcars) +#' k <- knitr::kable(x, "html") +#' +#' # First two rows bold and italic +#' row_spec(k, 1:2, bold = TRUE, italic = TRUE) +#' +#' # Color columns of header alternating grey and green, via recycling +#' row_spec(k, 0, color=c('grey','green')) +#' +#' # Color columns alternating grey and green in all rows, via recycling +#' row_spec(k, 0:nrow(x), color=c('grey','green')) +#' +#' # Same thing using `column_spec`: +#' k |> +#' column_spec(seq(1, ncol(x)+1, by=2), color='grey') |> +#' column_spec(seq(2, ncol(x)+1, by=2), color='green') #' } #' #' @export @@ -78,9 +92,36 @@ row_spec_html <- function(kable_input, row, bold, italic, monospace, kable_attrs <- attributes(kable_input) kable_xml <- read_kable_as_xml(kable_input) + table_info <- magic_mirror(kable_input) + ncol <- table_info$ncol + + # Convert scalar parameters to vector with the same length as the number of + # columns, recycling or trimming if needed + expand_values <- function(x, ncol) + { + if(!is.null(x)) + rep(x, ncol, length.out=ncol) + else + x + } + + bold <- expand_values(bold, ncol) + italic <- expand_values(italic, ncol) + monospace <- expand_values(monospace, ncol) + underline <- expand_values(underline, ncol) + strikeout <- expand_values(strikeout, ncol) + color <- expand_values(color, ncol) + background <- expand_values(background, ncol) + align <- expand_values(align, ncol) + font_size <- expand_values(font_size, ncol) + angle <- expand_values(angle , ncol) + extra_css <- expand_values(extra_css, ncol) + + if (!is.null(align)) { - if (align %in% c("l", "c", "r")) { - align <- switch(align, r = "right", c = "center", l = "left") + # Convert any single-char alignment to string + if (any(align %in% c("l", "c", "r"))) { + align <- sapply(align, switch, r = "right", c = "center", l = "left") } } @@ -89,9 +130,20 @@ row_spec_html <- function(kable_input, row, bold, italic, monospace, original_header_row <- xml_child(kable_thead, length(xml_children(kable_thead))) for (theader_i in 1:length(xml_children(original_header_row))) { target_header_cell <- xml_child(original_header_row, theader_i) - xml_cell_style(target_header_cell, bold, italic, monospace, - underline, strikeout, color, background, - align, font_size, angle, extra_css) + xml_cell_style( + target_header_cell, + bold [theader_i], + italic [theader_i], + monospace [theader_i], + underline [theader_i], + strikeout [theader_i], + color [theader_i], + background[theader_i], + align [theader_i], + font_size [theader_i], + angle [theader_i], + extra_css [theader_i] + ) } row <- row[row != 0] } @@ -109,9 +161,20 @@ row_spec_html <- function(kable_input, row, bold, italic, monospace, target_row <- xml_child(kable_tbody, j) for (i in 1:length(xml_children(target_row))) { target_cell <- xml_child(target_row, i) - xml_cell_style(target_cell, bold, italic, monospace, - underline, strikeout, color, background, - align, font_size, angle, extra_css) + xml_cell_style( + target_cell, + bold[i], + italic[i], + monospace[i], + underline[i], + strikeout[i], + color[i], + background[i], + align[i], + font_size[i], + angle[i], + extra_css[i] + ) } } } @@ -210,7 +273,7 @@ row_spec_latex <- function(kable_input, row, bold, italic, monospace, table_info$contents[i] <- new_row } else { out <- temp_sub(paste0(target_row, "\\\\\\\\"), - paste(new_row, collapse = ""), out, perl = T) + paste(new_row, collapse = ""), out, perl = T) table_info$contents[i] <- new_row[1] } } @@ -226,29 +289,53 @@ latex_new_row_builder <- function(target_row, table_info, color, background, align, font_size, angle, hline_after, extra_latex_after) { new_row <- latex_row_cells(target_row) - if (bold) { + + ncol <- table_info$ncol + + # Convert scalar parameters to vector with the same length as the number of + # columns, recycling or trimming if needed + expand_values <- function(x, ncol) + { + if(!is.null(x)) + rep(x, ncol, length.out=ncol) + else + x + } + + italic <- expand_values(italic, ncol) + monospace <- expand_values(monospace, ncol) + underline <- expand_values(underline, ncol) + strikeout <- expand_values(strikeout, ncol) + color <- expand_values(color, ncol) + background <- expand_values(background, ncol) + align <- expand_values(align, ncol) + font_size <- expand_values(font_size, ncol) + angle <- expand_values(angle , ncol) + + + if (any(bold)) { new_row <- lapply(new_row, function(x) { - paste0("\\\\textbf\\{", x, "\\}") + ifelse(bold, paste0("\\\\textbf\\{", x, "\\}"), x) }) } - if (italic) { + if (any(italic)) { new_row <- lapply(new_row, function(x) { - paste0("\\\\em\\{", x, "\\}") + ifelse(italic, paste0("\\\\em\\{", x, "\\}"), x) }) } - if (monospace) { + if (any(monospace)) { new_row <- lapply(new_row, function(x) { - paste0("\\\\ttfamily\\{", x, "\\}") + ifelse(monospace, paste0("\\\\ttfamily\\{", x, "\\}"), x) }) } - if (underline) { + if (any(underline)) { new_row <- lapply(new_row, function(x) { - paste0("\\\\underline\\{", x, "\\}") + ifelse(underline, paste0("\\\\underline\\{", x, "\\}"), x) }) } - if (strikeout) { + if (any(strikeout)) { new_row <- lapply(new_row, function(x) { - paste0("\\\\sout\\{", x, "\\}") + ifelse(strikeout, paste0("\\\\sout\\{", x, "\\}"), x) }) } if (!is.null(color)) { @@ -259,7 +346,11 @@ latex_new_row_builder <- function(target_row, table_info, } new_row <- lapply(new_row, function(x) { x <- clear_color_latex(x) - paste0("\\\\textcolor", latex_color(color), "\\{", x, "\\}") + ifelse( + nchar(color), + paste0("\\\\textcolor", latex_color(color), "\\{", x, "\\}"), + x + ) }) } if (!is.null(background)) { @@ -270,36 +361,53 @@ latex_new_row_builder <- function(target_row, table_info, } new_row <- lapply(new_row, function(x) { x <- clear_color_latex(x, background = TRUE) - paste0("\\\\cellcolor", latex_color(background), "\\{", x, "\\}") + ifelse( + nchar(background), + paste0("\\\\cellcolor", latex_color(background), "\\{", x, "\\}"), + x + ) }) } if (!is.null(font_size)) { new_row <- lapply(new_row, function(x) { - paste0("\\\\begingroup\\\\fontsize\\{", font_size, "\\}\\{", - as.numeric(font_size) + 2, - "\\}\\\\selectfont ", x, "\\\\endgroup")}) + ifelse( + nchar(font_size), + paste0("\\\\begingroup\\\\fontsize\\{", font_size, "\\}\\{", + as.numeric(font_size) + 2, + "\\}\\\\selectfont ", x, "\\\\endgroup"), + x + ) + }) } if (!is.null(align)) { if (!is.null(table_info$column_width)) { - p_align <- switch(align, + p_align <- sapply(align, switch, "l" = "\\\\raggedright\\\\arraybackslash", "c" = "\\\\centering\\\\arraybackslash", "r" = "\\\\raggedleft\\\\arraybackslash") - align <- rep(align, table_info$ncol) p_cols <- as.numeric(sub("column_", "", names(table_info$column_width))) + align <- expand_values("", ncol) for (i in 1:length(p_cols)) { - align[p_cols[i]] <- paste0("\\>\\{", p_align, "\\}p\\{", + align[p_cols[i]] <- paste0("\\>\\{", p_align[i], "\\}p\\{", table_info$column_width[[i]], "\\}") } } new_row <- lapply(new_row, function(x) { - paste0("\\\\multicolumn\\{1\\}\\{", align, "\\}\\{", x, "\\}") + ifelse( + nchar(align), + paste0("\\\\multicolumn\\{1\\}\\{", align, "\\}\\{", x, "\\}"), + x + ) }) } if (!is.null(angle)) { new_row <- lapply(new_row, function(x) { - paste0("\\\\rotatebox\\{", angle, "\\}\\{", x, "\\}") + ifelse( + nchar(angle), + paste0("\\\\rotatebox\\{", angle, "\\}\\{", x, "\\}"), + x + ) }) } From a1b2920e415b5979ddba97d8e9a9311902039a9a Mon Sep 17 00:00:00 2001 From: "Gregory R. Warnes" Date: Sat, 4 Nov 2023 13:36:43 -0400 Subject: [PATCH 2/7] Update `row_spec` man page. --- man/row_spec.Rd | 44 +++++++++++++++++++++++++++++--------------- 1 file changed, 29 insertions(+), 15 deletions(-) diff --git a/man/row_spec.Rd b/man/row_spec.Rd index 70d070b..b7229c8 100644 --- a/man/row_spec.Rd +++ b/man/row_spec.Rd @@ -28,45 +28,45 @@ row_spec( \item{row}{A numeric value or vector indicating which row(s) to be selected. You don't need to count in header rows or group labeling rows.} -\item{bold}{A T/F value to control whether the text of the selected row +\item{bold}{A T/F vector to control whether the cells of the selected row need to be bolded.} -\item{italic}{A T/F value to control whether the text of the selected row +\item{italic}{A T/F vector to control whether the cells of the selected row need to be emphasized.} -\item{monospace}{A T/F value to control whether the text of the selected row +\item{monospace}{A T/F vector to control whether the cells of the selected row need to be monospaced (verbatim)} -\item{underline}{A T/F value to control whether the text of the selected row +\item{underline}{A T/F vector to control whether the cells of the selected row need to be underlined} -\item{strikeout}{A T/F value to control whether the text of the selected row -need to be stricked out.} +\item{strikeout}{A T/F vector to control whether the cells of the selected row +need to be struck out out.} -\item{color}{A character string for row text color. For example, "red" or +\item{color}{A character vector for column text color. For example, "red" or "#BBBBBB".} -\item{background}{A character string for row background color. Here please +\item{background}{A character vector for cell background colors. Here please pay attention to the differences in color codes between HTML and LaTeX.} -\item{align}{A character string for cell alignment. For HTML, possible values could +\item{align}{A character vector for column cell alignment. For HTML, possible values could be \code{l}, \code{c}, \code{r} plus \code{left}, \code{center}, \code{right}, \code{justify}, \code{initial} and \code{inherit} while for LaTeX, you can only choose from \code{l}, \code{c} & \code{r}.} -\item{font_size}{A numeric input for font size. For HTML, you can also use +\item{font_size}{A numeric vector for cell font sizes. For HTML, you can also use options including \code{xx-small}, \code{x-small}, \code{small}, \code{medium}, \code{large}, \code{x-large}, \code{xx-large}, \code{smaller}, \code{larger}, \code{initial} and \code{inherit}.} -\item{angle}{0-360, degree that the text will rotate.} +\item{angle}{0-360, a numeric vector of cell text rotation in degrees.} \item{extra_css}{Extra css text to be passed into the cells of the row. Note that it's not for the whole row.} \item{hline_after}{T/F. A replicate of \code{hline.after} in xtable. It -addes a hline after ther row} +addes a hline after the row} \item{extra_latex_after}{Extra LaTeX text to be added after the row. Similar -with \code{add.to.row} in xtable} +with \code{add.to.row} in \code{xtable::xtable}} } \description{ This function allows users to select a row and then specify @@ -74,8 +74,22 @@ its look. It can also specify the format of the header row when \code{row} = 0. } \examples{ \dontrun{ -x <- knitr::kable(head(mtcars), "html") -row_spec(x, 1:2, bold = TRUE, italic = TRUE) +x <- head(mtcars) +k <- knitr::kable(x, "html") + +# First two rows bold and italic +row_spec(k, 1:2, bold = TRUE, italic = TRUE) + +# Color columns of header alternating grey and green, via recycling +row_spec(k, 0, color=c('grey','green')) + +# Color columns alternating grey and green in all rows, via recycling +row_spec(k, 0:nrow(x), color=c('grey','green')) + +# Same thing using `column_spec`: +k |> +column_spec(seq(1, ncol(x)+1, by=2), color='grey') |> +column_spec(seq(2, ncol(x)+1, by=2), color='green') } } From 3886bc75439a7bff4756d375c192d728df300982 Mon Sep 17 00:00:00 2001 From: "Gregory R. Warnes" Date: Thu, 9 Nov 2023 16:22:48 -0500 Subject: [PATCH 3/7] * 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') + ) + } From d91f0a8f0c63132d990807fbf1c17587a45ff5a1 Mon Sep 17 00:00:00 2001 From: "Gregory R. Warnes" Date: Sat, 2 Dec 2023 15:29:12 -0500 Subject: [PATCH 4/7] Don't add zero-height bar. --- R/mini_plots.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/mini_plots.R b/R/mini_plots.R index 9cf7cb6..f3a23ed 100644 --- a/R/mini_plots.R +++ b/R/mini_plots.R @@ -311,7 +311,8 @@ spec_barplot <- function( dir.create(dir) } height<-matrix(x) - height<-cbind(height,0) + #height<-cbind(height,0) + file_ext <- dev_chr(file_type) if (is.null(file)) { file <- normalizePath( From d33cb1cbd0948c742830e154d034446aa1a1de3e Mon Sep 17 00:00:00 2001 From: "Gregory R. Warnes" Date: Sat, 2 Dec 2023 15:41:35 -0500 Subject: [PATCH 5/7] Exclude renv files & dir from git. --- .Rbuildignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.Rbuildignore b/.Rbuildignore index 3d4cccf..a29b64f 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,3 +1,5 @@ +^renv$ +^renv\.lock$ ^.*\.Rproj$ ^\.Rproj\.user$ ^tests$ From e8a54751e2da233cc2b4ce8b32bcc3fcbb76021a Mon Sep 17 00:00:00 2001 From: "Gregory R. Warnes" Date: Wed, 17 Jan 2024 10:56:37 -0500 Subject: [PATCH 6/7] Remove `spec_barplot` from `mini_plots.R`. --- R/mini_plots.R | 109 ------------------------------------------------- 1 file changed, 109 deletions(-) diff --git a/R/mini_plots.R b/R/mini_plots.R index 2c842c8..3614c45 100644 --- a/R/mini_plots.R +++ b/R/mini_plots.R @@ -88,115 +88,6 @@ spec_hist <- function(x, width = 200, height = 50, res = 300, 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 and pointrange 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 -#' @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 ... extra parameters passing to boxplot -#' -#' @export -spec_boxplot <- function(x, width = 200, height = 50, res = 300, - add_label = FALSE, label_digits = 2, - same_lim = TRUE, lim = NULL, - xaxt = 'n', yaxt = 'n', ann = FALSE, - col = "lightgray", border = NULL, - boxlty = 0, medcol = "red", medlwd = 1, - dir = if (is_latex()) rmd_files_dir() else tempdir(), - file = NULL, - file_type = if (is_latex()) "pdf" else svglite::svglite, - ...) { - if (is.list(x)) { - if (same_lim & is.null(lim)) { - lim <- base::range(unlist(x), na.rm=TRUE) - } - - dots <- listify_args(x, width, height, res, - add_label, label_digits, - lim, xaxt, yaxt, ann, col, border, - dir, file, file_type, - lengths = c(1, length(x))) - return(do.call(Map, c(list(f = spec_boxplot), dots))) - } - - if (is.null(x)) return(NULL) - - if (is.null(lim)) { - lim <- base::range(x, na.rm=TRUE) - lim[1] <- lim[1] - (lim[2] - lim[1]) / 10 - lim[2] <- (lim[2] - lim[1]) / 10 + lim[2] - } - - if (!dir.exists(dir)) { - dir.create(dir) - } - - file_ext <- dev_chr(file_type) - if (is.null(file)) { - file <- normalizePath( - tempfile(pattern = "boxplot_", tmpdir = dir, fileext = paste0(".", file_ext)), - winslash = "/", mustWork = FALSE) - } - - graphics_dev(filename = file, dev = file_type, - width = width, height = height, res = res, - bg = "transparent") - curdev <- grDevices::dev.cur() - on.exit(grDevices::dev.off(curdev), add = TRUE) - - graphics::par(mar = c(0, 0, 0, 0)) - - graphics::boxplot(x, horizontal = TRUE, ann = ann, frame = FALSE, bty = 'n', ylim = lim, - col = col, border = border, - boxlty = boxlty, medcol = medcol, medlwd = medlwd, - axes = FALSE, outcex = 0.2, whisklty = 1, - ...) - if (add_label) { - x_median <- round(median(x, na.rm = T), label_digits) - x_min <- round(min(x, na.rm = T), label_digits) - x_max <- round(max(x, na.rm = T), label_digits) - graphics::text(x_median, y = 1.4, labels = x_median, cex = 0.5) - graphics::text(x_min, y = 0.6, labels = x_min, cex = 0.5) - graphics::text(x_max, y = 0.6, labels = x_max, cex = 0.5) - } - - grDevices::dev.off(curdev) - - out <- make_inline_plot( - file, file_ext, file_type, - width, height, res, - del = TRUE) - return(out) -} - #' Helper functions to generate inline sparklines #' #' @description These functions helps you quickly generate sets of sparkline From c8f65d8330e7453c897a901b855f36c04aea2649 Mon Sep 17 00:00:00 2001 From: "Gregory R. Warnes" Date: Wed, 17 Jan 2024 13:30:32 -0500 Subject: [PATCH 7/7] - Add myself (Greg Warnes) to contributors - Regenerate man pages. --- DESCRIPTION | 3 +- NAMESPACE | 1 - man/kableExtra-package.Rd | 32 +++++++++++++++ man/spec_boxplot.Rd | 83 --------------------------------------- 4 files changed, 34 insertions(+), 85 deletions(-) delete mode 100644 man/spec_boxplot.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 7c99c85..000ad94 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -18,7 +18,8 @@ Authors@R: c( person('Yeliang', 'Fan', role = 'ctb'), person('Duncan', 'Murdoch', role = 'ctb'), person('Vincent', 'Arel-Bundock', role = 'ctb'), - person('Bill', 'Evans', role = 'ctb') + person('Bill', 'Evans', role = 'ctb'), + person('Greg', 'Warnes', email='greg@warnes.net', role='ctb') ) Description: Build complex HTML or 'LaTeX' tables using 'kable()' from 'knitr' and the piping syntax from 'magrittr'. Function 'kable()' is a light weight diff --git a/NAMESPACE b/NAMESPACE index 32bdc49..35410c8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -44,7 +44,6 @@ export(save_kable) export(scroll_box) export(spec_angle) export(spec_barplot) -export(spec_boxplot) export(spec_color) export(spec_font_size) export(spec_hist) diff --git a/man/kableExtra-package.Rd b/man/kableExtra-package.Rd index 776f653..797eb63 100644 --- a/man/kableExtra-package.Rd +++ b/man/kableExtra-package.Rd @@ -66,4 +66,36 @@ align the table, \code{kable_styling(kable(...), position = "left")} will work in both HTML and PDF. } +\seealso{ +Useful links: +\itemize{ + \item \url{http://haozhu233.github.io/kableExtra/} + \item \url{https://github.com/haozhu233/kableExtra} + \item Report bugs at \url{https://github.com/haozhu233/kableExtra/issues} +} + +} +\author{ +\strong{Maintainer}: Hao Zhu \email{haozhu233@gmail.com} (\href{https://orcid.org/0000-0002-3386-6076}{ORCID}) + +Other contributors: +\itemize{ + \item Thomas Travison [contributor] + \item Timothy Tsai [contributor] + \item Will Beasley \email{wibeasley@hotmail.com} [contributor] + \item Yihui Xie \email{xie@yihui.name} [contributor] + \item GuangChuang Yu \email{guangchuangyu@gmail.com} [contributor] + \item Stéphane Laurent [contributor] + \item Rob Shepherd [contributor] + \item Yoni Sidi [contributor] + \item Brian Salzer [contributor] + \item George Gui [contributor] + \item Yeliang Fan [contributor] + \item Duncan Murdoch [contributor] + \item Vincent Arel-Bundock [contributor] + \item Bill Evans [contributor] + \item Greg Warnes \email{greg@warnes.net} [contributor] +} + +} \keyword{package} diff --git a/man/spec_boxplot.Rd b/man/spec_boxplot.Rd deleted file mode 100644 index 191ddde..0000000 --- a/man/spec_boxplot.Rd +++ /dev/null @@ -1,83 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mini_plots.R -\name{spec_boxplot} -\alias{spec_boxplot} -\title{Helper functions to generate inline sparklines} -\usage{ -spec_boxplot( - x, - width = 200, - height = 50, - res = 300, - add_label = FALSE, - label_digits = 2, - same_lim = TRUE, - lim = NULL, - xaxt = "n", - yaxt = "n", - ann = FALSE, - col = "lightgray", - border = NULL, - boxlty = 0, - medcol = "red", - medlwd = 1, - dir = if (is_latex()) rmd_files_dir() else tempdir(), - file = NULL, - file_type = if (is_latex()) "pdf" else svglite::svglite, - ... -) -} -\arguments{ -\item{x}{Vector of values or List of vectors of values.} - -\item{width}{The width of the plot in pixel} - -\item{height}{The height of the plot in pixel} - -\item{res}{The resolution of the plot. Default is 300.} - -\item{add_label}{For boxplot. T/F to add labels for min, mean and max.} - -\item{label_digits}{If T for add_label, rounding digits for the label. -Default is 2.} - -\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{xaxt}{On/Off for xaxis text} - -\item{yaxt}{On/Off for yaxis text} - -\item{ann}{On/Off for annotations (titles and axis titles)} - -\item{col}{Color for the fill of the histogram bar/boxplot box.} - -\item{border}{Color for the border.} - -\item{boxlty}{Boxplot - box boarder type} - -\item{medcol}{Boxplot - median line color} - -\item{medlwd}{Boxplot - median line width} - -\item{dir}{Directory of where the images will be saved.} - -\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{...}{extra parameters passing to boxplot} -} -\description{ -These functions helps you quickly generate sets of sparkline -style plots using base R plotting system. Currently, we support histogram, -boxplot, line, scatter and pointrange 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. -}