This report is automatically generated with the R
package knitr
(version 1.40
)
.
# Main function ----------------------------------------------------------- #' Force a facetted plot to have specified panel sizes #' #' Takes a ggplot and modifies its facet drawing behaviour such that the widths #' and heights of panels are set by the user. #' #' @param rows a `numeric` or `unit` vector for setting panel heights. #' @param cols a `numeric` or `unit` vector for setting panel widths. #' @param respect a `logical` value. If `TRUE`, widths and heights #' specified in `"null" unit`s are proportional. If `FALSE`, #' `"null" unit`s in x- and y-direction vary independently. #' #' @details Forcing the panel sizes should in theory work regardless of what #' facetting choice was made, as long as this function is called after the #' facet specification. Even when no facets are specified, ggplot2 defaults to #' the [ggplot2::facet_null()] specification; a single panel. #' `force_panelsizes` works by wrapping the original panel drawing #' function inside a function that modifies the widths and heights of panel #' grobs in the original function's output gtable. #' #' When `rows` or `cols` are `numeric` vectors, panel sizes are #' defined as ratios i.e. relative `"null" unit`s. `rows` and #' `cols` vectors are repeated or shortened to fit the number of panels #' in their direction. When `rows` or `cols` are `NULL`, no #' changes are made in that direction. #' #' When `respect = NULL`, default behaviour specified elsewhere is #' inherited. #' #' No attempt is made to guarantee that the plot fits the output device. The #' `space` argument in [ggplot2::facet_grid()] will be #' overruled. When individual panels span multiple rows or columns, this #' function may not work as intended. #' @export #' #' @seealso [ggplot2::facet_grid()] [ggplot2::facet_wrap()] #' [ggplot2::facet_null()] [grid::unit()] #' #' @return A `forcedsize` S3 object that can be added to a plot. #' #' @examples #' ggplot(mtcars, aes(disp, mpg)) + #' geom_point() + #' facet_grid(vs ~ am) + #' force_panelsizes(rows = c(2, 1), #' cols = c(2, 1)) force_panelsizes <- function(rows = NULL, cols = NULL, respect = NULL) { if (!is.null(rows) & !is.unit(rows)) { rows <- unit(rows, "null") } if (!is.null(cols) & !is.unit(cols)) { cols <- unit(cols, "null") } structure(list(rows = rows, cols = cols, respect = respect), class = "forcedsize") } # S3 add method ----------------------------------------------------------- #' @usage NULL #' @format NULL #' @noRd #' @export #' @keywords internal ggplot_add.forcedsize <- function(object, plot, object_name) { # Simply return plot if no changes are needed if (is.null(object$rows) & is.null(object$cols) & is.null(object$respect)){ return(plot) } # Grab old facet stuffs old.facet <- plot$facet old.draw_panels <- old.facet$draw_panels old.args <- formals(environment(old.draw_panels)$f) old.params <- old.facet$params # Make new panel drawing function new.fun <- function(params){ # Format old function arguments pass_args <- names(formals()) pass_args <- pass_args[pass_args != "self"] pass_args <- lapply(pass_args, as.symbol) # Call the old function to make panels panel_table <- do.call(old.draw_panels, pass_args) # Grab panel positions prows <- panel_rows(panel_table) pcols <- panel_cols(panel_table) # Override row heights if (!is.null(params$force.rows)) { rowheights <- rep(params$force.rows, length.out = nrow(prows)) panel_table$heights[prows$t] <- rowheights } # Override col widths if (!is.null(params$force.cols)) { colwidths <- rep(params$force.cols, length.out = nrow(pcols)) panel_table$widths[pcols$l] <- colwidths } # Override respect if (!is.null(params$force.respect)) { panel_table$respect <- params$force.respect } return(panel_table) } # Force new fun to take old fun's arguments formals(new.fun) <- as.list(old.args) # Make new params new_params <- c(old.params, force = object) # Make new facet class new_facet <- ggproto(paste0("Forced", class(old.facet)[[1]]), old.facet, draw_panels = new.fun, params = new_params) # Pass new facet to plot plot$facet <- new_facet return(plot) }
The R session information (including the OS info, R version and all packages used):
sessionInfo()
## R version 4.2.2 (2022-10-31 ucrt) ## Platform: x86_64-w64-mingw32/x64 (64-bit) ## Running under: Windows 10 x64 (build 22621) ## ## Matrix products: default ## ## locale: ## [1] LC_COLLATE=English_United States.utf8 LC_CTYPE=C ## [3] LC_MONETARY=English_United States.utf8 LC_NUMERIC=C ## [5] LC_TIME=English_United States.utf8 ## system code page: 65001 ## ## attached base packages: ## [1] stats graphics grDevices utils datasets methods base ## ## other attached packages: ## [1] lubridate_1.8.0 plotly_4.10.0 readxl_1.4.1 actuar_3.3-0 ## [5] NADA_1.6-1.1 forcats_0.5.2 stringr_1.4.1 dplyr_1.0.9 ## [9] purrr_0.3.4 readr_2.1.2 tidyr_1.2.0 tibble_3.1.8 ## [13] ggplot2_3.3.6 tidyverse_1.3.2 fitdistrplus_1.1-8 survival_3.4-0 ## [17] MASS_7.3-58.1 ## ## loaded via a namespace (and not attached): ## [1] lattice_0.20-45 assertthat_0.2.1 digest_0.6.29 utf8_1.2.2 ## [5] R6_2.5.1 cellranger_1.1.0 backports_1.4.1 reprex_2.0.2 ## [9] evaluate_0.16 highr_0.9 httr_1.4.4 pillar_1.8.1 ## [13] rlang_1.0.5 lazyeval_0.2.2 googlesheets4_1.0.1 data.table_1.14.2 ## [17] rstudioapi_0.14 Matrix_1.5-1 rmarkdown_2.16 splines_4.2.2 ## [21] googledrive_2.0.0 htmlwidgets_1.5.4 munsell_0.5.0 broom_1.0.1 ## [25] compiler_4.2.2 modelr_0.1.9 xfun_0.32 pkgconfig_2.0.3 ## [29] htmltools_0.5.3 tidyselect_1.1.2 viridisLite_0.4.1 fansi_1.0.3 ## [33] crayon_1.5.1 tzdb_0.3.0 dbplyr_2.2.1 withr_2.5.0 ## [37] grid_4.2.2 jsonlite_1.8.0 gtable_0.3.1 lifecycle_1.0.1 ## [41] DBI_1.1.3 magrittr_2.0.3 scales_1.2.1 writexl_1.4.0 ## [45] cli_3.3.0 stringi_1.7.8 fs_1.5.2 xml2_1.3.3 ## [49] ellipsis_0.3.2 generics_0.1.3 vctrs_0.4.1 expint_0.1-7 ## [53] tools_4.2.2 glue_1.6.2 hms_1.1.2 fastmap_1.1.0 ## [57] yaml_2.3.5 colorspace_2.0-3 gargle_1.2.0 rvest_1.0.3 ## [61] knitr_1.40 haven_2.5.1
Sys.time()
## [1] "2023-12-29 08:45:25 PST"