diff --git a/R/gt_plt_dist.R b/R/gt_plt_dist.R index 50eec7a5..1a4501bc 100644 --- a/R/gt_plt_dist.R +++ b/R/gt_plt_dist.R @@ -7,7 +7,7 @@ #' #' @param gt_object An existing gt table object of class `gt_tbl` #' @param column The column wherein the sparkline plot should replace existing data. Note that the data *must* be represented as a list of numeric values ahead of time. -#' @param type A string indicating the type of plot to generate, accepts `"boxplot"`, `"histogram"`, `"rug_strip"` or `"density"`. +#' @param type A string indicating the type of plot to generate, accepts `"boxplot"`, `"boxplot_identity"`, `"histogram"`, `"rug_strip"` or `"density"`. #' @param fig_dim A vector of two numbers indicating the height/width of the plot in mm at a DPI of 25.4, defaults to `c(5,30)` #' @param line_color Color for the line, defaults to `"black"`. Accepts a named color (eg 'blue') or a hex color. #' @param fill_color Color for the fill of histograms/density plots, defaults to `"grey"`. Accepts a named color (eg `'blue'`) or a hex color. @@ -57,7 +57,7 @@ gt_plt_dist <- function(gt_object, stopifnot("Specified column must contain list of values" = any(class(list_data_in) %in% "list")) stopifnot("Specified column must be numeric" = is.numeric(data_in)) - stopifnot("You must indicate the `type` of plot as one of 'boxplot', 'histogram', 'rug_strip' or 'density'." = isTRUE(type %in% c("boxplot", "rug_strip", "histogram", "density"))) + stopifnot("You must indicate the `type` of plot as one of 'boxplot', 'boxplot_identity', 'histogram', 'rug_strip' or 'density'." = isTRUE(type %in% c("boxplot","boxplot_identity", "rug_strip", "histogram", "density"))) # range to be used for plotting if same axis total_rng <- grDevices::extendrange(data_in, r = range(data_in, na.rm = TRUE), f = 0.02) @@ -117,6 +117,54 @@ gt_plt_dist <- function(gt_object, outlier.size = 0.3, linewidth = 0.3 ) + } else if (type == "boxplot_identity") { + stopifnot("'boxplot_identity' type expected ordered 5 number summary" = length(vals) == 5) + + # Re-define input_data with required 5-num data + input_data <- bind_cols( + as.list(setNames(vals, c("xmin", "lower", "middle", "upper", "xmax"))), + y = 1 + ) + + plot_base <- ggplot(input_data) + + theme_void() + + if (isTRUE(same_limit)) { + plot_base <- plot_base + + scale_x_continuous(expand = expansion(mult = 0.05)) + + coord_cartesian( + clip = "off", + xlim = grDevices::extendrange(total_rng, f = c(0, 0.01)), + ylim = c(0.9, 1.15) + ) + } else { + plot_base <- plot_base + + scale_x_continuous(expand = expansion(mult = 0.05)) + + coord_cartesian( + clip = "off", + xlim = grDevices::extendrange(vals, f = 0.09), + ylim = c(0.9, 1.15) + ) + } + + plot_out <- plot_base + + geom_boxplot( + aes( + xmin = xmin, + xlower = lower, + xmiddle = middle, + xupper = upper, + xmax = xmax, + y = y + ), + stat = "identity", + orientation = "y", + width = 0.15, + color = line_color, + fill = fill_color, + outlier.size = 0.3, + linewidth = 0.3 + ) } else if (type == "rug_strip") { plot_base <- ggplot(input_data) + theme_void() diff --git a/tests/testthat/test-gt_plt_dist.R b/tests/testthat/test-gt_plt_dist.R index 2bb3e933..a69e51ba 100644 --- a/tests/testthat/test-gt_plt_dist.R +++ b/tests/testthat/test-gt_plt_dist.R @@ -7,6 +7,12 @@ test_that("svg is created", { dplyr::summarize(mpg_data = list(mpg), .groups = "drop") %>% gt() + fivenum_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(stats::fivenum(mpg)), .groups = "drop") %>% + gt() + get_svg_len <- function(table){ table %>% gt::as_raw_html() %>% @@ -46,6 +52,9 @@ test_that("svg is created", { gt_box <- base_tab %>% gt_plt_dist(mpg_data, type = "boxplot") + gt_box_manual <- fivenum_tab |> + gt_plt_dist(mpg_data, type = "boxplot_identity") + expect_equal(get_svg_len(gt_dens), 3) expect_equal(get_svg_len(gt_dens_bw), 3) expect_equal(get_svg_len(gt_dens_lim), 3) @@ -55,5 +64,6 @@ test_that("svg is created", { expect_equal(get_svg_len(gt_hist_bw), 3) expect_equal(get_svg_len(gt_hist_lim), 3) expect_equal(get_svg_len(gt_rug), 3) + expect_equal(get_svg_len(gt_box_manual), 3) })