This report is automatically generated with the R
package knitr
(version 1.40
)
.
# Rudolf Cardinal, March 2011 # Simple extensions to ggplot2 (v0.8.7); see http://pobox.com/~rudolf/statistics/R # Modified 5 Jan 2013 for ggplot2 0.9.3 (NB: use sessionInfo() to find current package versions) # - fetch ggplot2 source with: git clone https://github.com/hadley/ggplot2.git # Changes, because ggplot2 has changed its internal calling mechanisms: # - opts() deprecated in favour of theme() # - "Element panel.border must be an element_rect object" (error from validate_element() in theme-elements.r) # ... so change all class = "theme" to class = c("element_rect", "element") # - "cannot coerce type 'closure' to vector of type 'list'" # ... a closure is a function (see ?typeof) # ... change class to be of class c("MYCLASS", "element_rect", "element") # - then element_grob.MYCLASS not called by element_render()/element_grob()/UseMethod()... environment/namespace problem # tried setMethod("element_grob", "theme_border", function(STUFF) { STUFF} , where = as.environment("package:ggplot2") # but the environment is locked # ggplot2's theme-elements.r defines e.g. element_rect (exported) and element_grob.element_rect (not exported, does the work) # However, we can't override an internal function: # ... e.g. rewrite "validate_element" to crash # set environment(validate_element) <- as.environment("package:ggplot2") -- doesn't break the plotting. # - Upshot: now impossible to hack through this way (locked environment). # - http://obeautifulcode.com/R/How-R-Searches-And-Finds-Stuff/ # - http://stackoverflow.com/questions/8204008/redirect-intercept-function-calls-within-a-package-function # - These don't fix it: # library(proto) # theme <- with(proto(environment(ggplot2::theme), theme = ggplot2::theme, element_grob.theme_border = my.element_grob.theme_border), theme) --- doesn't work # ggplot <- with(proto(environment(ggplot2::ggplot), ggplot = ggplot2::ggplot, element_grob.theme_border = my.element_grob.theme_border), ggplot) --- breaks! # - Fix by Baptiste Auguie 8/1/2013: inherit from element_blank instead; then it works fine.
# Requirements
library(grid) # for gpar
# Code duplicated from ggplot2 source (not exposed to wider namespace) for convenience
.pt <- 1 / 0.352777778 len0_null <- function(x) { if (length(x) == 0) NULL else x }
# Generic panel border (can set any combination of left/right/top/bottom)
theme_border <- function( type = c("left", "right", "bottom", "top", "none"), colour = "black", size = 1, linetype = 1) { # use with e.g.: ggplot(...) + opts( panel.border=theme_border(type=c("bottom","left")) ) + ... type <- match.arg(type, several.ok=TRUE) structure( list(type = type, colour = colour, size = size, linetype = linetype), class = c("theme_border", "element_blank", "element") ) } element_grob.theme_border <- function( element, x = 0, y = 0, width = 1, height = 1, type = NULL, colour = NULL, size = NULL, linetype = NULL, ...) { if (is.null(type)) type = element$type xlist <- c() ylist <- c() idlist <- c() if ("bottom" %in% type) { # bottom xlist <- append(xlist, c(x, x+width)) ylist <- append(ylist, c(y, y)) idlist <- append(idlist, c(1,1)) } if ("top" %in% type) { # top xlist <- append(xlist, c(x, x+width)) ylist <- append(ylist, c(y+height, y+height)) idlist <- append(idlist, c(2,2)) } if ("left" %in% type) { # left xlist <- append(xlist, c(x, x)) ylist <- append(ylist, c(y, y+height)) idlist <- append(idlist, c(3,3)) } if ("right" %in% type) { # right xlist <- append(xlist, c(x+width, x+width)) ylist <- append(ylist, c(y, y+height)) idlist <- append(idlist, c(4,4)) } if (length(type)==0 || "none" %in% type) { # blank; cannot pass absence of coordinates, so pass a single point and use an invisible line xlist <- c(x,x) ylist <- c(y,y) idlist <- c(5,5) linetype <- "blank" } gp <- gpar(lwd = len0_null(size * .pt), col = colour, lty = linetype) element_gp <- gpar(lwd = len0_null(element$size * .pt), col = element$colour, lty = element$linetype) polylineGrob( x = xlist, y = ylist, id = idlist, ..., default.units = "npc", gp = modifyList(element_gp, gp), ) }
# For convenience: "L" (left + bottom) border
theme_L_border <- function(colour = "black", size = 1, linetype = 1) { # use with e.g.: ggplot(...) + theme( panel.border=theme_L_border() ) + ... structure( list(colour = colour, size = size, linetype = linetype), class = c("theme_L_border", "element_blank", "element") ) } element_grob.theme_L_border <- function( element, x = 0, y = 0, width = 1, height = 1, colour = NULL, size = NULL, linetype = NULL, ...) { gp <- gpar(lwd = len0_null(size * .pt), col = colour, lty = linetype) element_gp <- gpar(lwd = len0_null(element$size * .pt), col = element$colour, lty = element$linetype) polylineGrob( x = c(x+width, x, x), y = c(y,y,y+height), ..., default.units = "npc", gp = modifyList(element_gp, gp), ) }
# For convenience: bottom border only
theme_bottom_border <- function(colour = "black", size = 1, linetype = 1) { # use with e.g.: ggplot(...) + theme( panel.border=theme_bottom_border() ) + ... structure( list(colour = colour, size = size, linetype = linetype), class = c("theme_bottom_border", "element_blank", "element") ) } element_grob.theme_bottom_border <- function( element, x = 0, y = 0, width = 1, height = 1, colour = NULL, size = NULL, linetype = NULL, ...) { gp <- gpar(lwd = len0_null(size * .pt), col = colour, lty = linetype) element_gp <- gpar(lwd = len0_null(element$size * .pt), col = element$colour, lty = element$linetype) polylineGrob( x = c(x, x+width), y = c(y,y), ..., default.units = "npc", gp = modifyList(element_gp, gp), ) }
# For convenience: left border only
theme_left_border <- function(colour = "black", size = 1, linetype = 1) { # use with e.g.: ggplot(...) + theme( panel.border=theme_left_border() ) + ... structure( list(colour = colour, size = size, linetype = linetype), class = c("theme_left_border", "element_blank", "element") ) } element_grob.theme_left_border <- function( element, x = 0, y = 0, width = 1, height = 1, colour = NULL, size = NULL, linetype = NULL, ...) { gp <- gpar(lwd = len0_null(size * .pt), col = colour, lty = linetype) element_gp <- gpar(lwd = len0_null(element$size * .pt), col = element$colour, lty = element$linetype) polylineGrob( x = c(x, x), y = c(y, y+height), ..., default.units = "npc", gp = modifyList(element_gp, gp), ) }
# Border selection by number
theme_border_numerictype <- function(type, colour = "black", size = 1, linetype = 1) { # use with e.g.: ggplot(...) + theme( panel.border=theme_border(type=9) ) + ... structure( list(type = type, colour = colour, size = size, linetype = linetype), class = c("theme_border_numerictype", "element_blank", "element") ) } element_grob.theme_border_numerictype <- function( element, x = 0, y = 0, width = 1, height = 1, type = NULL, colour = NULL, size = NULL, linetype = NULL, ...) { if (is.null(type)) type = element$type # numerical types from: library(gridExtra); example(borderGrob) # 1=none, 2=bottom, 3=right, 4=top, 5=left, 6=B+R, 7=T+R, 8=T+L, 9=B+L, 10=T+B, 11=L+R, 12=T+B+R, 13=T+L+R, 14=T+B+L, 15=B+L+R, 16=T+B+L+R xlist <- c() ylist <- c() idlist <- c() if (type==2 || type==6 || type==9 || type==10 || type==12 || type==14 || type==15 || type==16) { # bottom xlist <- append(xlist, c(x, x+width)) ylist <- append(ylist, c(y, y)) idlist <- append(idlist, c(1,1)) } if (type==4 || type==7 || type==8 || type==10 || type==12 || type==13 || type==14 || type==16) { # top xlist <- append(xlist, c(x, x+width)) ylist <- append(ylist, c(y+height, y+height)) idlist <- append(idlist, c(2,2)) } if (type==5 || type==8 || type==9 || type==11 || type==13 || type==14 || type==15 || type==16) { # left xlist <- append(xlist, c(x, x)) ylist <- append(ylist, c(y, y+height)) idlist <- append(idlist, c(3,3)) } if (type==3 || type==6 || type==7 || type==11 || type==12 || type==13 || type==15 || type==16) { # right xlist <- append(xlist, c(x+width, x+width)) ylist <- append(ylist, c(y, y+height)) idlist <- append(idlist, c(4,4)) } if (type==1) { # blank; can't pass absence of coordinates, so pass a single point and use an invisible line xlist <- c(x,x) ylist <- c(y,y) idlist <- c(5,5) linetype <- "blank" } gp <- gpar(lwd = len0_null(size * .pt), col = colour, lty = linetype) element_gp <- gpar(lwd = len0_null(element$size * .pt), col = element$colour, lty = element$linetype) polylineGrob( x = xlist, y = ylist, id = idlist, ..., default.units = "npc", gp = modifyList(element_gp, gp), ) }
# Examples
rnc_ggplot2_border_themes_example_script = ' library(ggplot2) df = data.frame( x=c(1,2,3), y=c(4,5,6) ) source("http://egret.psychol.cam.ac.uk/statistics/R/extensions/rnc_ggplot2_border_themes_2013_01.r") ggplot(data=df, aes(x=x, y=y)) + geom_point() + theme_bw() + theme( panel.border = theme_border( c("bottom","left") ) ) ggplot(data=df, aes(x=x, y=y)) + geom_point() + theme_bw() + theme( panel.border = theme_left_border() ) ggplot(data=df, aes(x=x, y=y)) + geom_point() + theme_bw() + theme( panel.border = theme_bottom_border() ) ggplot(data=df, aes(x=x, y=y)) + geom_point() + theme_bw() + theme( panel.border = theme_L_border() ) ggplot(data=df, aes(x=x, y=y)) + geom_point() + theme_bw() + theme( panel.border = theme_border_numerictype(12) ) # use 1:16 as possible values '
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] grid 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] jsonlite_1.8.0 gtable_0.3.1 lifecycle_1.0.1 DBI_1.1.3 ## [41] magrittr_2.0.3 scales_1.2.1 writexl_1.4.0 cli_3.3.0 ## [45] stringi_1.7.8 fs_1.5.2 xml2_1.3.3 ellipsis_0.3.2 ## [49] generics_0.1.3 vctrs_0.4.1 expint_0.1-7 tools_4.2.2 ## [53] glue_1.6.2 hms_1.1.2 fastmap_1.1.0 yaml_2.3.5 ## [57] colorspace_2.0-3 gargle_1.2.0 rvest_1.0.3 knitr_1.40 ## [61] haven_2.5.1
Sys.time()
## [1] "2023-12-29 09:03:02 PST"