diff --git a/DESCRIPTION b/DESCRIPTION index 6d90c16..051f846 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -48,6 +48,6 @@ Suggests: xml2 (>= 1.3.3) Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.1 +RoxygenNote: 7.2.3 Config/testthat/edition: 3 Config/testthat/parallel: true diff --git a/R/gt-bar-html.R b/R/gt-bar-html.R index a1bc100..1e56697 100644 --- a/R/gt-bar-html.R +++ b/R/gt-bar-html.R @@ -2,8 +2,7 @@ #' Add HTML-based bar plots into rows of a `gt` table #' @description #' The `gt_plt_bar_pct` function takes an existing `gt_tbl` object and -#' adds horizontal barplots via native HTML. This is a wrapper around raw HTML -#' strings, `gt::text_transform()` and `gt::cols_align()`. Note that values +#' adds horizontal barplots via native HTML. Note that values #' default to being normalized to the percent of the maximum observed value #' in the specified column. You can turn this off if the values already #' represent a percentage value representing 0-100. @@ -11,9 +10,15 @@ #' @param gt_object An existing gt table object of class `gt_tbl` #' @param column The column wherein the bar plot should replace existing data. #' @param height A number representing the vertical height of the plot in pixels. Defaults to 16 px. +#' @param width A number representing the horizontal width of the plot in pixels. Defaults to 100 px. Importantly, this interacts with the label_cutoff argument, so if you want to change the cutoff, you may need to adjust the width as well. #' @param fill A character representing the fill for the bar, defaults to purple. Accepts a named color (eg 'purple') or a hex color. #' @param background A character representing the background filling out the 100% mark of the bar, defaults to light grey. Accepts a named color (eg 'white') or a hex color. #' @param scaled `TRUE`/`FALSE` logical indicating if the value is already scaled to a percent of max (`TRUE`) or if it needs to be scaled (`FALSE`). Defaults to `FALSE`, meaning the value will be divided by the max value in that column and then multiplied by 100. +#' @param labels `TRUE`/`FALSE` logical representing if labels should be plotted. Defaults to `FALSE`, meaning that no value labels will be plotted. +#' @param label_cutoff A number, 0 to 1, representing where to set the inside/outside label boundary. Defaults to 0.40 (40%) of the column's maximum value. If the value in that row is less than the cutoff, the label will be placed outside the bar, otherwise it will be placed within the bar. This interacts with the overall width of the bar, so if you are not happy with the placement of the labels you may try adjusting the `width` argument as well. +#' @param decimals A number representing how many decimal places to be used in label rounding. Defaults to 1. +#' @param font_style A character representing the font style of the labels. Accepts one of 'bold' (default), 'italic', or 'normal'. +#' @param font_size A character representing the font size of the labels. Defaults to '12px'. #' @return An object of class `gt_tbl`. #' @export #' @section Examples: @@ -41,60 +46,136 @@ #' 3-5 gt_plt_bar_pct <- function( - gt_object, - column, - height = 16, - fill = "purple", - background = "#e1e1e1", - scaled = FALSE -) { - stopifnot("'gt_object' must be a 'gt_tbl', have you accidentally passed raw data?" = "gt_tbl" %in% class(gt_object)) + gt_object, + column, + height = 16, + width = 100, + fill = "purple", + background = "#e1e1e1", + scaled = FALSE, + labels = FALSE, + label_cutoff = 0.40, + decimals = 1, + font_style = "bold", + font_size = "10px") { - # convert tidyeval column to bare string - #col_bare <- rlang::enexpr(column) %>% rlang::as_string() - # segment data with bare string column name - data_in <- gt_index(gt_object, column = {{ column }}) - #col_number <- which(colnames(gt_object[["_data"]]) == col_bare) + stopifnot(`'gt_object' must be a 'gt_tbl', have you accidentally passed raw data?` = "gt_tbl" %in% + class(gt_object)) + + stopifnot('label_cutoff must be a number between 0 and 1' = dplyr::between(label_cutoff, 0, 1)) + + # ensure font_style is one of the accepted values + stopifnot( + '`font_style` argument must be "bold", "normal", or "italic"' = + font_style %in% c("bold", "normal", "italic") + ) + + all_cols <- gt_index(gt_object, column = {{ column }}, as_vector = FALSE) + + data_in <- all_cols %>% select({{ column }}) %>% pull() + + col_name <- all_cols %>% + select({{ column }}) %>% + names() + + # create a formula for cols_width + col_to_widen <- rlang::new_formula(col_name, px(width)) gt_object %>% + cols_width(col_to_widen) %>% text_transform( locations = cells_body(columns = {{ column }}), fn = function(x) { - - if (length(na.omit(data_in))==0) { + if (length(na.omit(x)) == 0) { return("
") } else { - max_x <- max(as.double(data_in), na.rm = TRUE) + max_x <- max(as.double(x), na.rm = TRUE) } bar <- lapply(data_in, function(x) { - - #if(is.na(x)) x <- 0 - scaled_value <- if (isFALSE(scaled)) { x / max_x * 100 } else { x } - glue::glue( - "
" - ) - }) + if (labels) { + # adjust values for labeling // scale_label + label_values <- if (scaled) { + x + } else { + x / max_x * 100 + } - chart <- lapply(bar, function(bar_pct) { - ext_pct <- gsub(".*width:(.+);height.*", "\\1", bar_pct) + # create label string to print out // add % sign if requested + label <- glue::glue("{round(label_values, decimals)}%") - if (ext_pct == "NA%") { - return("
") + if (x < (label_cutoff * max_x)) { + + css_styles <- paste0( + "background:", fill,";", + "width:", scaled_value, "%;", + "height:", height, "px;", + "display:flex;", + "align-items:center;", + "justify-content:center;", + "color:", ideal_fgnd_color(background),";", + "font-weight:", font_style,";", + "font-size:", font_size, ";", + "position:relative;" + ) + + span_styles <- paste0( + "color:", ideal_fgnd_color(background),";", + "position:absolute;", + "left:0%;", + "margin-left:", scaled_value * width/100, "px;", + "font-weight:", font_style,";", + "font-size:", font_size,";" + ) + + glue::glue( + "
", + "{label}
" + ) + } else { + + css_styles <- paste0( + "background:", fill,";", + "width:", scaled_value, "%;", + "height:", height, "px;", + "display:flex;", + "align-items:center;", + "justify-content:flex-start;", + "position:relative;" + ) + + span_styles <- paste0( + "color:", ideal_fgnd_color(fill),";", + "position:absolute;", + "left:0px;", + "margin-left:5px;", + "font-weight:", font_style,";", + "font-size:", font_size,";" + ) + + glue::glue( + "
", + "{label}
" + ) + } } else { glue::glue( - "
{bar_pct}
" + "
" # no labels added ) } }) + chart <- lapply(bar, function(bar) { + glue::glue("
{bar}
") + }) + chart } ) %>% diff --git a/man/gt_plt_bar_pct.Rd b/man/gt_plt_bar_pct.Rd deleted file mode 100644 index 7aaf710..0000000 --- a/man/gt_plt_bar_pct.Rd +++ /dev/null @@ -1,80 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/gt-bar-html.R -\name{gt_plt_bar_pct} -\alias{gt_plt_bar_pct} -\title{Add HTML-based bar plots into rows of a \code{gt} table} -\usage{ -gt_plt_bar_pct( - gt_object, - column, - height = 16, - fill = "purple", - background = "#e1e1e1", - scaled = FALSE -) -} -\arguments{ -\item{gt_object}{An existing gt table object of class \code{gt_tbl}} - -\item{column}{The column wherein the bar plot should replace existing data.} - -\item{height}{A number representing the vertical height of the plot in pixels. Defaults to 16 px.} - -\item{fill}{A character representing the fill for the bar, defaults to purple. Accepts a named color (eg 'purple') or a hex color.} - -\item{background}{A character representing the background filling out the 100\% mark of the bar, defaults to light grey. Accepts a named color (eg 'white') or a hex color.} - -\item{scaled}{\code{TRUE}/\code{FALSE} logical indicating if the value is already scaled to a percent of max (\code{TRUE}) or if it needs to be scaled (\code{FALSE}). Defaults to \code{FALSE}, meaning the value will be divided by the max value in that column and then multiplied by 100.} -} -\value{ -An object of class \code{gt_tbl}. -} -\description{ -The \code{gt_plt_bar_pct} function takes an existing \code{gt_tbl} object and -adds horizontal barplots via native HTML. This is a wrapper around raw HTML -strings, \code{gt::text_transform()} and \code{gt::cols_align()}. Note that values -default to being normalized to the percent of the maximum observed value -in the specified column. You can turn this off if the values already -represent a percentage value representing 0-100. -} -\section{Examples}{ - - -\if{html}{\out{
}}\preformatted{library(gt) - gt_bar_plot_tab <- mtcars \%>\% - head() \%>\% - dplyr::select(cyl, mpg) \%>\% - dplyr::mutate(mpg_pct_max = round(mpg/max(mpg) * 100, digits = 2), - mpg_scaled = mpg/max(mpg) * 100) \%>\% - dplyr::mutate(mpg_unscaled = mpg) \%>\% - gt() \%>\% - gt_plt_bar_pct(column = mpg_scaled, scaled = TRUE) \%>\% - gt_plt_bar_pct(column = mpg_unscaled, scaled = FALSE, - fill = "blue", background = "lightblue") \%>\% - cols_align("center", contains("scale")) \%>\% - cols_width(4 ~ px(125), - 5 ~ px(125)) -}\if{html}{\out{
}} -} - -\section{Figures}{ - -\if{html}{\figure{gt_bar_plot.png}{options: width=100\%}} -} - -\section{Function ID}{ - -3-5 -} - -\seealso{ -Other Plotting: -\code{\link{gt_plt_bar_stack}()}, -\code{\link{gt_plt_bar}()}, -\code{\link{gt_plt_dist}()}, -\code{\link{gt_plt_percentile}()}, -\code{\link{gt_plt_point}()}, -\code{\link{gt_plt_sparkline}()}, -\code{\link{gt_plt_winloss}()} -} -\concept{Plotting} diff --git a/man/gt_plt_sparkline.Rd b/man/gt_plt_sparkline.Rd deleted file mode 100644 index 79c81e6..0000000 --- a/man/gt_plt_sparkline.Rd +++ /dev/null @@ -1,73 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/gt_plt_sparkline.R -\name{gt_plt_sparkline} -\alias{gt_plt_sparkline} -\title{Add sparklines into rows of a \code{gt} table} -\usage{ -gt_plt_sparkline( - gt_object, - column, - type = "default", - fig_dim = c(5, 30), - palette = c("black", "black", "purple", "green", "lightgrey"), - same_limit = TRUE, - label = TRUE -) -} -\arguments{ -\item{gt_object}{An existing gt table object of class \code{gt_tbl}} - -\item{column}{The column wherein the sparkline plot should replace existing data. Note that the data \emph{must} be represented as a list of numeric values ahead of time.} - -\item{type}{A string indicating the type of plot to generate, accepts \code{"default"}, \code{"points"}, \code{"shaded"}, \code{"ref_median"}, \code{'ref_mean'}, \code{"ref_iqr"}, \code{"ref_last"}. "points" will add points to every observation instead of just the high/low and final. "shaded" will add shading below the sparkline. The "ref_" options add a thin reference line based off the summary statistic chosen} - -\item{fig_dim}{A vector of two numbers indicating the height/width of the plot in mm at a DPI of 25.4, defaults to \code{c(5,30)}} - -\item{palette}{A character string with 5 elements indicating the colors of various components. Order matters, and palette = sparkline color, final value color, range color low, range color high, and 'type' color (eg shading or reference lines). To show a plot with no points (only the line itself), use: \code{palette = c("black", rep("transparent", 4))}.} - -\item{same_limit}{A logical indicating that the plots will use the same axis range (\code{TRUE}) or have individual axis ranges (\code{FALSE}).} - -\item{label}{A logical indicating whether the sparkline will have a numeric label at the end of the plot.} -} -\value{ -An object of class \code{gt_tbl}. -} -\description{ -The \code{gt_plt_sparkline} function takes an existing \code{gt_tbl} object and -adds sparklines via the \code{ggplot2}. Note that if you'd rather plot summary -distributions (ie density/histograms) you can instead use: \code{gtExtras::gt_plt_dist()} -} -\section{Examples}{ - - -\if{html}{\out{
}}\preformatted{ library(gt) - gt_sparkline_tab <- mtcars \%>\% - dplyr::group_by(cyl) \%>\% - # must end up with list of data for each row in the input dataframe - dplyr::summarize(mpg_data = list(mpg), .groups = "drop") \%>\% - gt() \%>\% - gt_plt_sparkline(mpg_data) -}\if{html}{\out{
}} -} - -\section{Figures}{ - -\if{html}{\figure{gt_plt_sparkline.png}{options: width=50\%}} -} - -\section{Function ID}{ - -1-4 -} - -\seealso{ -Other Plotting: -\code{\link{gt_plt_bar_pct}()}, -\code{\link{gt_plt_bar_stack}()}, -\code{\link{gt_plt_bar}()}, -\code{\link{gt_plt_dist}()}, -\code{\link{gt_plt_percentile}()}, -\code{\link{gt_plt_point}()}, -\code{\link{gt_plt_winloss}()} -} -\concept{Plotting}