From 1ed79ef7bfce881c927d7a031920a3632c0b5e04 Mon Sep 17 00:00:00 2001 From: sarahcmap Date: Tue, 24 Nov 2020 17:26:02 -0600 Subject: [PATCH 001/173] svgfix initial changes --- R/finalize_plot.R | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/R/finalize_plot.R b/R/finalize_plot.R index 6ec23196..92bd2d7b 100644 --- a/R/finalize_plot.R +++ b/R/finalize_plot.R @@ -616,12 +616,23 @@ save_plot <- function(final_plot, # add required cairo prefix to function name for pdf and ps (see `?cairo`) mode <- ifelse (mode == "pdf" | mode == "ps", paste0("cairo_" , mode), mode) + # correct svg function to call for svg + mode <- ifelse (mode == "svg", "svglite", mode) + # if file exists and overwrite == FALSE, do not write if (file.exists(arglist$filename) & !overwrite) { message(paste0(fname, ": SKIPPED (try `overwrite = TRUE`?)")) return() } + # prepare the arglist for svg + if (mode == 'svglite') { + + arglist$file <- arglist$filename + arglist$filename <- NULL; + + } + # Write to device ----------------------------------------------- tryCatch( { From d9ababc9d35d50391d6e16bc99c16f859ab5ef84 Mon Sep 17 00:00:00 2001 From: sarahcmap Date: Wed, 25 Nov 2020 11:07:36 -0600 Subject: [PATCH 002/173] import svglite --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index a504429e..359dc91c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -50,7 +50,8 @@ Imports: rlang, scales, stringr, - sysfonts + sysfonts, + svglite Suggests: knitr, lubridate, From 4b80dad101cd3d3b2a18dac0f3ef5fb86166ae04 Mon Sep 17 00:00:00 2001 From: sarahcmap Date: Thu, 3 Dec 2020 15:35:51 -0600 Subject: [PATCH 003/173] import svglite --- NAMESPACE | 1 + R/finalize_plot.R | 1 + 2 files changed, 2 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 20579f40..46905153 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -49,5 +49,6 @@ importFrom(purrr,map) importFrom(purrr,walk2) importFrom(stringr,str_replace) importFrom(stringr,str_trunc) +importFrom(svglite,svglite) importFrom(sysfonts,font_files) importFrom(utils,modifyList) diff --git a/R/finalize_plot.R b/R/finalize_plot.R index 92bd2d7b..9fe7b828 100644 --- a/R/finalize_plot.R +++ b/R/finalize_plot.R @@ -64,6 +64,7 @@ #'@importFrom ggpubr get_legend #'@importFrom purrr compact #'@importFrom stringr str_replace +#'@importFrom svglite svglite #' #'@examples #' \dontrun{ From 3d53a48b00114fb8a774d366e52b107cc1f257c5 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux Date: Wed, 17 Mar 2021 16:37:31 -0500 Subject: [PATCH 004/173] Fixes bug, allows for current recessions Also updates documentation. Passes check() --- NAMESPACE | 1 + R/geom_recessions.R | 149 +++++++++++++++++++++++++-------------- R/sysdata.rda | Bin 1222 -> 1101 bytes man/geom_recessions.Rd | 27 ++++--- man/update_recessions.Rd | 4 +- 5 files changed, 116 insertions(+), 65 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 20579f40..af757ab0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -51,3 +51,4 @@ importFrom(stringr,str_replace) importFrom(stringr,str_trunc) importFrom(sysfonts,font_files) importFrom(utils,modifyList) +importFrom(utils,read.csv) diff --git a/R/geom_recessions.R b/R/geom_recessions.R index 6fb64e88..2f1cf56f 100644 --- a/R/geom_recessions.R +++ b/R/geom_recessions.R @@ -29,11 +29,16 @@ #' rectangle and text geoms, respectively. #'@param update_recessions Logical or data frame. \code{FALSE}, the default, #' relies on the package's built in recessions table. \code{TRUE} calls the -#' function \code{update_recessions}, which attempts to fetch the -#' current recessions table from the NBER website. A custom data table of -#' recessions can also be passed to this argument, but it must be structured -#' identically to the six-column data table described in the the documentation -#' file for the function \code{update_recessions}. +#' function \code{update_recessions}, which attempts to fetch the current +#' recessions table from the NBER website. A custom data table of recessions +#' can also be passed to this argument, but it must be structured identically +#' to the seven-column data table described in the the documentation file for +#' the function \code{update_recessions}. +#'@param show_ongoing Logical. \code{TRUE}, the default, will display an ongoing +#' recession that does not yet have a defined end date. If an ongoing recession +#' exists, it will be displayed as extending through the maximum extent of the +#' graph's data (up to 2200). \code{FALSE} will remove the ongoing recession +#' from the graph. #'@param ... additional aesthetics to send to BOTH the rectangle and text geoms. #' #'@section Important notes: If \code{show.legend = TRUE} you must place any @@ -58,6 +63,10 @@ #' the hints found here: #' \url{https://stackoverflow.com/questions/6672374/convert-rgb-to-rgba-over-white}. #' +#' +#' +#' +#' #'@section Under the hood: This function calls two custom geoms, constructed #' with ggproto. The custom GeomRecessions and GeomRecessionsText are modified #' versions of GeomRect and GeomText, respectively. The only variations to each @@ -111,13 +120,12 @@ #' scale_x_date() + #' theme_minimal() #' -#'@seealso -#' \itemize{ -#' \item \url{https://ggplot2-book.org/extensions.html} -#' \item \url{https://github.com/brodieG/ggbg/blob/development/inst/doc/extensions.html#stat-compute} -#' \item \url{https://rpubs.com/hadley/97970} -#' \item \url{https://ggplot2.tidyverse.org/articles/extending-ggplot2.html} -#' } +#'@importFrom utils read.csv +#' +#'@seealso \itemize{ \item \url{https://ggplot2-book.org/extensions.html} \item +#' \url{https://github.com/brodieG/ggbg/blob/development/inst/doc/extensions.html#stat-compute} +#' \item \url{https://rpubs.com/hadley/97970} \item +#' \url{https://ggplot2.tidyverse.org/articles/extending-ggplot2.html} } #' #'@export geom_recessions <- function(xformat = "numeric", @@ -132,11 +140,19 @@ geom_recessions <- function(xformat = "numeric", rect_aes = NULL, text_aes = NULL, update_recessions = FALSE, + show_ongoing = TRUE, ...) { + # Local binding for ongoing + ongoing <- NULL + + # Generate recessions table, filtering out ongoing recessions if specified + recessions_for_plot <- build_recessions(update_recessions) + if (!show_ongoing) {recessions_for_plot <- recessions_for_plot %>% filter(ongoing == F)} + # build recessions table for use in function, but hide it in a list # because of ggplot's requirement that parameters be of length 1 - recess_table <- list(build_recessions(update_recessions)) + recess_table <- list(recessions_for_plot) # return a series of gg objects to ggplot list( @@ -196,25 +212,32 @@ geom_recessions <- function(xformat = "numeric", # internal function used to define recessions table for use build_recessions <- function(update_recessions){ if(is.logical(update_recessions)){ + # if TRUE if(update_recessions){ message("Trying to update recessions...") - return( - tryCatch( - suppressWarnings(update_recessions(quietly = TRUE)), - error = function(cond){ - message("Could not update recessions. Using built-in recessions table...") - return(recessions) - }) - ) + updated_recessions <- suppressWarnings(update_recessions(quietly = TRUE)) + + # If updated_recessions is returned as NA, its length is 1. In that case, + # use default table. + if (length(updated_recessions) == 1) { + message("Could not update recessions. Using built-in recessions table...") + return(recessions) + } + + message("Successfully fetched from NBER") + return(updated_recessions) + # if FALSE } else { return(recessions) } + # if DATAFRAME }else if(is.data.frame(update_recessions)){ # confirm that table has correct structure if(!identical(update_recessions[NA,][1,], recessions[NA,][1,])){ message("Recession table may not have correct format (See `?update_recessions`). Attempting anyway...") } return(update_recessions) + # OTHERWISE }else{ message("`update_recessions` must be TRUE, FALSE, or a data table. Using built-in recessions table...") return(recessions) @@ -416,11 +439,11 @@ GeomRecessionsText <- ggproto( #' @return A tibble with the following variables: \itemize{ \item #' \code{start_char, end_char}: Chr. Easily readable labels for the beginning #' and end of the recession \item \code{start_num, end_num}: Double. Dates -#' expressed as years, with decimels referring to months. (e.g. April = 4/12 = +#' expressed as years, with decimals referring to months. (e.g. April = 4/12 = #' .333) \item \code{start_date, end_date}: Date. Dates expressed in R #' datetime format, using the first day of the specified month. } #' -#' @source \url{https://www.nber.org/cycles/NBER chronology.xlsx} +#' @source \url{https://www.nber.org/data/cycles 'cycle dates pasted.csv'} #' #' @examples #' recessions <- update_recessions() @@ -435,41 +458,63 @@ GeomRecessionsText <- ggproto( #'@export update_recessions <- function(url = NULL, quietly = FALSE){ - pkgs <- c("RCurl", "readxl", "tibble", "lubridate") + pkgs <- c("RCurl", "tibble", "lubridate") if(FALSE %in% lapply(pkgs, requireNamespace, quietly = TRUE)){ stop(paste("This function requires the following packages:", paste(pkgs, collapse = ", ")), call. = FALSE) } + # best known URL for machine readable NBER file if (is_null(url)) { - url <- "https://www.nber.org/sites/default/files/2021-01/NBER%20chronology_062020.xlsx" + url <- "http://data.nber.org/data/cycles/cycle%20dates%20pasted.csv" } # locally bind variable names - start_char <- end_char <- start_date <- end_date <- NULL - - temp.file <- paste(tempfile(),".xlsx",sep = "") - utils::download.file(url, temp.file, mode = "wb", quiet = quietly) - - recessions <- readxl::read_excel(temp.file, skip = 2) %>% - # drop end matter - dplyr::slice(1:(n()-7)) %>% - # drop first row trough - dplyr::slice(-1) %>% - tibble::as_tibble() %>% - # rename character values - dplyr::rename(start_char = 1, end_char = 2) %>% - dplyr::mutate( - # convert character dates to R date - start_date = as.Date(stringr::str_replace(start_char, " ", " 1, "), format = "%B %d, %Y"), - end_date = as.Date(stringr::str_replace(end_char, " ", " 1, "), format = "%B %d, %Y"), - # convert R dates to numeric dates - start_num = lubridate::decimal_date(start_date), - end_num = lubridate::decimal_date(end_date) - ) %>% - dplyr::select(-3:-8) - - message("Successfully fetched from NBER") - - return(recessions) + start_char <- end_char <- start_date <- end_date <- ongoing <- index <- NULL + + return( + tryCatch({ + temp.file <- paste0(tempfile(),".csv") + utils::download.file(url, temp.file, mode = "wb", quiet = quietly) + + recessions <- read.csv(temp.file) %>% + # drop first row trough + dplyr::slice(-1) %>% + tibble::as_tibble() %>% + # rename character values + dplyr::rename(start_char = 1, end_char = 2) %>% + dplyr::mutate( + # convert character dates to R date + start_date = as.Date(start_char), + end_date = as.Date(end_char)) %>% + dplyr::arrange(start_date) %>% + # Add a row number for identifying the last recession + mutate(index = row_number()) %>% + # Flag unfinished recessions + mutate(ongoing = case_when( + is.na(end_date) & index == max(.$index) ~ T, + TRUE ~ F + )) %>% + # If there is an ongoing recession in the last row, add January 2200 for + # graphing purposes + mutate(end_date = case_when( + ongoing ~ as.Date("2200-01-01"), + TRUE ~ end_date)) %>% + mutate( + # convert R dates to numeric dates + start_num = lubridate::decimal_date(start_date), + end_num = lubridate::decimal_date(end_date)) %>% + # eliminate index + select(-index) + + if (!quietly) {message("Successfully fetched from NBER")} + + # Return recessions + recessions + }, + error = function(cond){ + if (!quietly) message("WARMING: Fetch or processing failed. `NULL` returned.") + return(NA) + } + ) + ) } - diff --git a/R/sysdata.rda b/R/sysdata.rda index bc1d4cbada627648b1eba66647d8a307045e1898..636a299999c25a17b8985e9577d21e3b675fc26d 100644 GIT binary patch literal 1101 zcmV-T1hV@diwFP!000002F+DnY!p=#9@=e7tAL`7QH+>Ij3JpizdLh7A~$gnHBku` zM8K4_-4zD-~MY((>ekB>^=Q zTJOv`YkSYccek1SdcJ$kx#xW6-r2Q@4Q9=T8bwjcm6-S|uMqz#m5;B{4ckzZSedZq z3BFojO(xZp%4WB=* zsG2D=4rQ1KabzZNkQrOm4Vj_4Gfg-!nGtDii3!V-8M+tKT~%`>#)w22Ce3WbN$<>H zG>;jn#}cL?Gp?%3d)X$@hXwPJGmCl2(_vydvSKWlj-1(z^yTVwFFGAV3qnkpapb)W zEl@0EqG!#elZ@+;)8|khM~g5laCS-R{a82R1@FTsVu2`fz8{a|1f#$PXnc=?Nt5XUAt;PNdY{?-8e=sRI_VPq57 z7k3syywC>ts|s<$FDMBLHvnl0l)7D{QPz?IM)|DXu?`EJ0TR>1Eb1MFV`c@p}znJ zdw~D>Q)u>F9g6r2*k_@s!kJpYldB=Fe>aMVe&1dJJh~aM=Lf*q%*#(d0QR-Fw#Dl#9z}Zv;%3xg2lm&2`n`+xK8))^{1W5(p8q5MUJv&Mx)X0tRC2F~di;*-HzBWI zf&JZi%k0Y><^EFa$HMieAg|wodhJBqgL-`gbM*J4Zl^GQ1mmw_-YMYo_oE)G(N01B zk2O3p@=GF}+@31EB&tg9+-xqH$u%}@O=ggppGr5+wb7$FxD<0d=Gay3>DKmb=~gtW zAt1eDducuJ4@|k9>P-7<^`)8?h^MSWe9g?vTp|~<90MwIFSj)|x1d!ntWt@hm}GrR TM&wf9-cJ7m;*9|aMhgG{s(L2+ literal 1222 zcmV;%1UdUcT4*^jL0KkKS$_pJ#M`PFTd*5@P z|Ns67=ikr+y7uhFJ18R9G$bK4Jxu|ogVY1m2dMo?>SzPfG}AyfpwI(GnhiZhnhz=J z2dFdwplP)k0j8P*MvqW>Mwryul@NKAJv~!Q$^oWe0|*S622C<(Vlrd~fCENA#L18V00w{pNlB9_nF~_6 z%`r{f1eXy67Xf1d2tYD{GZGO{j5v&rFaS{CFi}J;3}it8Vnh|P2Xbf;Hh@D308=sq z;Ft?b2uPb`%~pmn40ETPF)VbzU^NVo3Za2bFc0}01fXId_dpe@5!C=g1odRlj{YY~ zGXNH`rHuU*#2O`1H{*_6sOJzyQJAAM*ai&D=P3j^;aMK2rBs*63G9nTo%9h--2|?k z`2cY0q+4ZQZ({K%%5&NP9uyJ}p`7PDvx3qg49F1~(fQ||1{4%9$G^E0aIw)@5u`r@ z?uC=wRB%%C7(LI(t76=rOM2EpY13-`x6tLog6|TWCc|M zDMCOc5R^hj9I5Va@^}_PFK*u2J``2zDJe#;W!+0fA-H3-Dow-XPC0U5n@~%tdC*CmsMw4T$Qb;svg$#K(PQzgj|gNV)`4y zIA)X-?o(HoacoW)4=L~=hR`tZw{{FO12Z!)pDEHMz^*!c#8Jsoo=_6ZI)b#b0S$T{ zZz#+SggW)s0EmaDCh=dXob=#6BH<(_rX+cRqrR8ziAgGzX12yoptn3JMXeE73SyJU z5Wp}ZslYBhu%wKw0|A9AAhk5?sL|b;2#9ARgp~V>lc$Um5|I3aKs3ltq~ORbz{CQP zf=6%7(U=H^Xo!Icmu-vRL)bYs=(g6iJ$uizIp5#{dhRkUp|P)2ctIby3AH5w?Eo1O z5h`Wa0f$5^lGjx$9oD9}!Mv`UprhtRyn8NH$Sq81UoD06Q6l#y_mTAZ$l}XV;yDCi znlQfb1AkuI0iSjOrDACF^;ry!mapypzjBarfs->PU1tqI74 kzkZd*T4PPRYt3BU3k}1N3gZO1UKno-YB>(^b diff --git a/man/geom_recessions.Rd b/man/geom_recessions.Rd index 5650df02..f76a58e4 100644 --- a/man/geom_recessions.Rd +++ b/man/geom_recessions.Rd @@ -17,6 +17,7 @@ geom_recessions( rect_aes = NULL, text_aes = NULL, update_recessions = FALSE, + show_ongoing = TRUE, ... ) } @@ -54,11 +55,17 @@ rectangle and text geoms, respectively.} \item{update_recessions}{Logical or data frame. \code{FALSE}, the default, relies on the package's built in recessions table. \code{TRUE} calls the -function \code{update_recessions}, which attempts to fetch the -current recessions table from the NBER website. A custom data table of -recessions can also be passed to this argument, but it must be structured -identically to the six-column data table described in the the documentation -file for the function \code{update_recessions}.} +function \code{update_recessions}, which attempts to fetch the current +recessions table from the NBER website. A custom data table of recessions +can also be passed to this argument, but it must be structured identically +to the seven-column data table described in the the documentation file for +the function \code{update_recessions}.} + +\item{show_ongoing}{Logical. \code{TRUE}, the default, will display an ongoing +recession that does not yet have a defined end date. If an ongoing recession +exists, it will be displayed as extending through the maximum extent of the +graph's data (up to 2200). \code{FALSE} will remove the ongoing recession +from the graph.} \item{...}{additional aesthetics to send to BOTH the rectangle and text geoms.} } @@ -150,10 +157,8 @@ ggplot(df, mapping = aes(x = year_date, y = value)) + } \seealso{ -\itemize{ - \item \url{https://ggplot2-book.org/extensions.html} - \item \url{https://github.com/brodieG/ggbg/blob/development/inst/doc/extensions.html#stat-compute} - \item \url{https://rpubs.com/hadley/97970} - \item \url{https://ggplot2.tidyverse.org/articles/extending-ggplot2.html} -} +\itemize{ \item \url{https://ggplot2-book.org/extensions.html} \item + \url{https://github.com/brodieG/ggbg/blob/development/inst/doc/extensions.html#stat-compute} + \item \url{https://rpubs.com/hadley/97970} \item + \url{https://ggplot2.tidyverse.org/articles/extending-ggplot2.html} } } diff --git a/man/update_recessions.Rd b/man/update_recessions.Rd index 3780a8d7..5c1d7186 100644 --- a/man/update_recessions.Rd +++ b/man/update_recessions.Rd @@ -4,7 +4,7 @@ \alias{update_recessions} \title{Update recessions table} \source{ -\url{https://www.nber.org/cycles/NBER chronology.xlsx} +\url{https://www.nber.org/data/cycles 'cycle dates pasted.csv'} } \usage{ update_recessions(url = NULL, quietly = FALSE) @@ -21,7 +21,7 @@ the package development team.} A tibble with the following variables: \itemize{ \item \code{start_char, end_char}: Chr. Easily readable labels for the beginning and end of the recession \item \code{start_num, end_num}: Double. Dates - expressed as years, with decimels referring to months. (e.g. April = 4/12 = + expressed as years, with decimals referring to months. (e.g. April = 4/12 = .333) \item \code{start_date, end_date}: Date. Dates expressed in R datetime format, using the first day of the specified month. } } From 4720b8335313341ce622215d03013bccc9c472f5 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux Date: Thu, 18 Mar 2021 09:13:22 -0500 Subject: [PATCH 005/173] Addresses Matt's comments Passes check() --- R/geom_recessions.R | 46 ++++++++++++++++++++-------------------- man/update_recessions.Rd | 19 +++++++++-------- 2 files changed, 33 insertions(+), 32 deletions(-) diff --git a/R/geom_recessions.R b/R/geom_recessions.R index 2f1cf56f..0bcc02a0 100644 --- a/R/geom_recessions.R +++ b/R/geom_recessions.R @@ -217,9 +217,8 @@ build_recessions <- function(update_recessions){ message("Trying to update recessions...") updated_recessions <- suppressWarnings(update_recessions(quietly = TRUE)) - # If updated_recessions is returned as NA, its length is 1. In that case, - # use default table. - if (length(updated_recessions) == 1) { + # If updated_recessions is returned as NULL, use the default table + if (is.null(updated_recessions)) { message("Could not update recessions. Using built-in recessions table...") return(recessions) } @@ -422,28 +421,29 @@ GeomRecessionsText <- ggproto( ) -#' Update recessions table +#'Update recessions table #' -#' The \code{cmapplot} package contains an internal dataset of all recessions in -#' American history as recorded by the National Bureau of Economic Research -#' (NBER). However, users may need to replace the built-in data, such as in the -#' event of new recessions and/or changes to the NBER consensus on recession -#' dates. This function fetches and reformats this data from the NBER website. +#'The \code{cmapplot} package contains an internal dataset of all recessions in +#'American history as recorded by the National Bureau of Economic Research +#'(NBER). However, users may need to replace the built-in data, such as in the +#'event of new recessions and/or changes to the NBER consensus on recession +#'dates. This function fetches and interprets this data from the NBER website. #' -#' @param url Char, the web location of the NBER machine-readable Excel file. -#' The default, \code{NULL}, uses the most recently identified URL known to -#' the package development team. -#' @param quietly Logical, suppresses messages produced by -#' \code{utils::download.file}. +#'@param url Char, the web location of the NBER machine-readable CSV file. The +#' default, \code{NULL}, uses the most recently identified URL known to the +#' package development team, which appears to be the most stable location for +#' updates over time. +#'@param quietly Logical, suppresses messages produced by +#' \code{utils::download.file}. #' -#' @return A tibble with the following variables: \itemize{ \item -#' \code{start_char, end_char}: Chr. Easily readable labels for the beginning -#' and end of the recession \item \code{start_num, end_num}: Double. Dates -#' expressed as years, with decimals referring to months. (e.g. April = 4/12 = -#' .333) \item \code{start_date, end_date}: Date. Dates expressed in R -#' datetime format, using the first day of the specified month. } +#'@return A tibble with the following variables: \itemize{ \item +#' \code{start_char, end_char}: Chr. Easily readable labels for the beginning +#' and end of the recession \item \code{start_num, end_num}: Double. Dates +#' expressed as years, with decimals referring to months. (e.g. April = 4/12 = +#' .333) \item \code{start_date, end_date}: Date. Dates expressed in R datetime +#' format, using the first day of the specified month. } #' -#' @source \url{https://www.nber.org/data/cycles 'cycle dates pasted.csv'} +#'@source \url{https://www.nber.org/data/cycles 'cycle dates pasted.csv'} #' #' @examples #' recessions <- update_recessions() @@ -512,8 +512,8 @@ update_recessions <- function(url = NULL, quietly = FALSE){ recessions }, error = function(cond){ - if (!quietly) message("WARMING: Fetch or processing failed. `NULL` returned.") - return(NA) + if (!quietly) message("WARNING: Fetch or processing failed. `NULL` returned.") + return(NULL) } ) ) diff --git a/man/update_recessions.Rd b/man/update_recessions.Rd index 5c1d7186..0a043017 100644 --- a/man/update_recessions.Rd +++ b/man/update_recessions.Rd @@ -10,27 +10,28 @@ update_recessions(url = NULL, quietly = FALSE) } \arguments{ -\item{url}{Char, the web location of the NBER machine-readable Excel file. -The default, \code{NULL}, uses the most recently identified URL known to -the package development team.} +\item{url}{Char, the web location of the NBER machine-readable CSV file. The +default, \code{NULL}, uses the most recently identified URL known to the +package development team, which appears to be the most stable location for +updates over time.} \item{quietly}{Logical, suppresses messages produced by \code{utils::download.file}.} } \value{ A tibble with the following variables: \itemize{ \item - \code{start_char, end_char}: Chr. Easily readable labels for the beginning - and end of the recession \item \code{start_num, end_num}: Double. Dates - expressed as years, with decimals referring to months. (e.g. April = 4/12 = - .333) \item \code{start_date, end_date}: Date. Dates expressed in R - datetime format, using the first day of the specified month. } + \code{start_char, end_char}: Chr. Easily readable labels for the beginning + and end of the recession \item \code{start_num, end_num}: Double. Dates + expressed as years, with decimals referring to months. (e.g. April = 4/12 = + .333) \item \code{start_date, end_date}: Date. Dates expressed in R datetime + format, using the first day of the specified month. } } \description{ The \code{cmapplot} package contains an internal dataset of all recessions in American history as recorded by the National Bureau of Economic Research (NBER). However, users may need to replace the built-in data, such as in the event of new recessions and/or changes to the NBER consensus on recession -dates. This function fetches and reformats this data from the NBER website. +dates. This function fetches and interprets this data from the NBER website. } \examples{ recessions <- update_recessions() From 654736a919ea4e4cdd52ff957f7aa4829a47c7d5 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux Date: Thu, 18 Mar 2021 09:36:06 -0500 Subject: [PATCH 006/173] Shift date numeric calculation into function --- R/geom_recessions.R | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/R/geom_recessions.R b/R/geom_recessions.R index 0bcc02a0..b19196ba 100644 --- a/R/geom_recessions.R +++ b/R/geom_recessions.R @@ -252,6 +252,12 @@ filter_recessions <- function(min, max, xformat, recess_table){ # unwrap recess_table from list recess_table <- recess_table[[1]] + # Add numeric version of dates + recess_table <- recess_table %>% + mutate( + start_num = lubridate::decimal_date(start_date), + end_num = lubridate::decimal_date(end_date)) + # filter recessions correctly, based on xformat if (xformat == "numeric") { recessions <- dplyr::rename(recess_table, end = end_num, start = start_num) @@ -499,10 +505,6 @@ update_recessions <- function(url = NULL, quietly = FALSE){ mutate(end_date = case_when( ongoing ~ as.Date("2200-01-01"), TRUE ~ end_date)) %>% - mutate( - # convert R dates to numeric dates - start_num = lubridate::decimal_date(start_date), - end_num = lubridate::decimal_date(end_date)) %>% # eliminate index select(-index) From 23a02cd0ce946bdc4eaa28cf124fb9ad4ed7f3bb Mon Sep 17 00:00:00 2001 From: Daniel Comeaux Date: Thu, 18 Mar 2021 10:05:47 -0500 Subject: [PATCH 007/173] Clarify recessions table Convert dates into a more readable "Month Year" format for the character column, and update the default table to accommodate new format. --- R/geom_recessions.R | 26 ++++++++++++++++++-------- R/sysdata.rda | Bin 1101 -> 798 bytes man/geom_recessions.Rd | 2 +- man/update_recessions.Rd | 7 +++---- 4 files changed, 22 insertions(+), 13 deletions(-) diff --git a/R/geom_recessions.R b/R/geom_recessions.R index b19196ba..b1930f73 100644 --- a/R/geom_recessions.R +++ b/R/geom_recessions.R @@ -32,7 +32,7 @@ #' function \code{update_recessions}, which attempts to fetch the current #' recessions table from the NBER website. A custom data table of recessions #' can also be passed to this argument, but it must be structured identically -#' to the seven-column data table described in the the documentation file for +#' to the five-column data table described in the the documentation file for #' the function \code{update_recessions}. #'@param show_ongoing Logical. \code{TRUE}, the default, will display an ongoing #' recession that does not yet have a defined end date. If an ongoing recession @@ -444,10 +444,9 @@ GeomRecessionsText <- ggproto( #' #'@return A tibble with the following variables: \itemize{ \item #' \code{start_char, end_char}: Chr. Easily readable labels for the beginning -#' and end of the recession \item \code{start_num, end_num}: Double. Dates -#' expressed as years, with decimals referring to months. (e.g. April = 4/12 = -#' .333) \item \code{start_date, end_date}: Date. Dates expressed in R datetime -#' format, using the first day of the specified month. } +#' and end of the recession. \item \code{start_date, end_date}: Date. Dates +#' expressed in R datetime format, using the first day of the specified month. +#' } #' #'@source \url{https://www.nber.org/data/cycles 'cycle dates pasted.csv'} #' @@ -493,6 +492,11 @@ update_recessions <- function(url = NULL, quietly = FALSE){ start_date = as.Date(start_char), end_date = as.Date(end_char)) %>% dplyr::arrange(start_date) %>% + # Convert character columns to 'Month Year' format + mutate( + start_char = format(start_date, "%b %Y"), + end_char = format(end_date, "%b %Y") + ) %>% # Add a row number for identifying the last recession mutate(index = row_number()) %>% # Flag unfinished recessions @@ -502,9 +506,15 @@ update_recessions <- function(url = NULL, quietly = FALSE){ )) %>% # If there is an ongoing recession in the last row, add January 2200 for # graphing purposes - mutate(end_date = case_when( - ongoing ~ as.Date("2200-01-01"), - TRUE ~ end_date)) %>% + mutate( + end_date = case_when( + ongoing ~ as.Date("2200-01-01"), + TRUE ~ end_date), + # Flag that recession as "Ongoing" in this case + end_char = case_when( + ongoing ~ "Ongoing", + TRUE ~ end_char + )) %>% # eliminate index select(-index) diff --git a/R/sysdata.rda b/R/sysdata.rda index 636a299999c25a17b8985e9577d21e3b675fc26d..67306a22f8fb9e487ec1a862be19b507126ac7fc 100644 GIT binary patch literal 798 zcmV+(1L6E1iwFP!000002F+DVNK{c6zB;3(^nz*|;wpmVKIYE7hoDB10zr*3k{;-F zyiUS2BQv8BZKRcpwk?Ae6@(QQ^jMTkiwsIk%_;MhI<;?Mv~xQ5e)siXXx|KXzWL7i zU*|jjIrmI!x6;tvAP7Q4i1KfwhW{06Pn?!yRThM3HD^_Pyq;r2&PvD)|zJHo?=EZL_ zta!}xZ#9z^59MQCzO&{~qr}8O{OcCiNIWKqA@0R*8BSSTr}MH%<`PEUuIFGc{C?ufMG~^Yyp&V7}gn=j)C7b&>?hyi))^ z-U2@B1Wrnhh|le~iRpvjTQ_@s5vwcz)=jY9gH6K!@u>=Ldd9eFx|?3(zLN6=BUk82 zUNLg+(K0jrLGD=eTZ;@>1bAK6J$xizeJ*>g+0D6&Kh>lBr&6h`g@lYa4z-28bWi_) c!y=ryCGccM^FWTr5}@<;UlMnX<#z}G0Pta(VE_OC literal 1101 zcmV-T1hV@diwFP!000002F+DnY!p=#9@=e7tAL`7QH+>Ij3JpizdLh7A~$gnHBku` zM8K4_-4zD-~MY((>ekB>^=Q zTJOv`YkSYccek1SdcJ$kx#xW6-r2Q@4Q9=T8bwjcm6-S|uMqz#m5;B{4ckzZSedZq z3BFojO(xZp%4WB=* zsG2D=4rQ1KabzZNkQrOm4Vj_4Gfg-!nGtDii3!V-8M+tKT~%`>#)w22Ce3WbN$<>H zG>;jn#}cL?Gp?%3d)X$@hXwPJGmCl2(_vydvSKWlj-1(z^yTVwFFGAV3qnkpapb)W zEl@0EqG!#elZ@+;)8|khM~g5laCS-R{a82R1@FTsVu2`fz8{a|1f#$PXnc=?Nt5XUAt;PNdY{?-8e=sRI_VPq57 z7k3syywC>ts|s<$FDMBLHvnl0l)7D{QPz?IM)|DXu?`EJ0TR>1Eb1MFV`c@p}znJ zdw~D>Q)u>F9g6r2*k_@s!kJpYldB=Fe>aMVe&1dJJh~aM=Lf*q%*#(d0QR-Fw#Dl#9z}Zv;%3xg2lm&2`n`+xK8))^{1W5(p8q5MUJv&Mx)X0tRC2F~di;*-HzBWI zf&JZi%k0Y><^EFa$HMieAg|wodhJBqgL-`gbM*J4Zl^GQ1mmw_-YMYo_oE)G(N01B zk2O3p@=GF}+@31EB&tg9+-xqH$u%}@O=ggppGr5+wb7$FxD<0d=Gay3>DKmb=~gtW zAt1eDducuJ4@|k9>P-7<^`)8?h^MSWe9g?vTp|~<90MwIFSj)|x1d!ntWt@hm}GrR TM&wf9-cJ7m;*9|aMhgG{s(L2+ diff --git a/man/geom_recessions.Rd b/man/geom_recessions.Rd index f76a58e4..a94fed38 100644 --- a/man/geom_recessions.Rd +++ b/man/geom_recessions.Rd @@ -58,7 +58,7 @@ relies on the package's built in recessions table. \code{TRUE} calls the function \code{update_recessions}, which attempts to fetch the current recessions table from the NBER website. A custom data table of recessions can also be passed to this argument, but it must be structured identically -to the seven-column data table described in the the documentation file for +to the five-column data table described in the the documentation file for the function \code{update_recessions}.} \item{show_ongoing}{Logical. \code{TRUE}, the default, will display an ongoing diff --git a/man/update_recessions.Rd b/man/update_recessions.Rd index 0a043017..909c0402 100644 --- a/man/update_recessions.Rd +++ b/man/update_recessions.Rd @@ -21,10 +21,9 @@ updates over time.} \value{ A tibble with the following variables: \itemize{ \item \code{start_char, end_char}: Chr. Easily readable labels for the beginning - and end of the recession \item \code{start_num, end_num}: Double. Dates - expressed as years, with decimals referring to months. (e.g. April = 4/12 = - .333) \item \code{start_date, end_date}: Date. Dates expressed in R datetime - format, using the first day of the specified month. } + and end of the recession. \item \code{start_date, end_date}: Date. Dates + expressed in R datetime format, using the first day of the specified month. + } } \description{ The \code{cmapplot} package contains an internal dataset of all recessions in From cc908ab4c8bdfde53c10cdb1213a953a1899a896 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Thu, 18 Mar 2021 21:57:00 -0500 Subject: [PATCH 008/173] `update_recessions()` tweaks read.csv can read a url directly, while read_excel() can't. So, the transition read.csv eliminates the need for the temp file download... and therefore for the RCurl package. --- R/geom_recessions.R | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/R/geom_recessions.R b/R/geom_recessions.R index b1930f73..604ccc89 100644 --- a/R/geom_recessions.R +++ b/R/geom_recessions.R @@ -463,7 +463,7 @@ GeomRecessionsText <- ggproto( #'@export update_recessions <- function(url = NULL, quietly = FALSE){ - pkgs <- c("RCurl", "tibble", "lubridate") + pkgs <- c("tibble", "lubridate") if(FALSE %in% lapply(pkgs, requireNamespace, quietly = TRUE)){ stop(paste("This function requires the following packages:", paste(pkgs, collapse = ", ")), call. = FALSE) } @@ -478,17 +478,14 @@ update_recessions <- function(url = NULL, quietly = FALSE){ return( tryCatch({ - temp.file <- paste0(tempfile(),".csv") - utils::download.file(url, temp.file, mode = "wb", quiet = quietly) - - recessions <- read.csv(temp.file) %>% + recessions <- read.csv(url) %>% # drop first row trough dplyr::slice(-1) %>% tibble::as_tibble() %>% # rename character values dplyr::rename(start_char = 1, end_char = 2) %>% + # convert character dates to R date dplyr::mutate( - # convert character dates to R date start_date = as.Date(start_char), end_date = as.Date(end_char)) %>% dplyr::arrange(start_date) %>% From e72736fd75d9092f6a86fbf226cbe8b9ed12436b Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Thu, 18 Mar 2021 22:40:17 -0500 Subject: [PATCH 009/173] tweak update_recessoins() - function now does not need any special packages. @dlcomeaux 's new work already eliminated the need for lubridate, and there was no actual reason to store the data `as_tibble()`. -rearranged some dplyr commands to eliminate some steps ... same actions are being taken, just fewer pipes. - sysdata.rda is now updated with the new recessions table--it's the same, just a df now, not a tibble - caught a few typos in the man file for this function. --- R/geom_recessions.R | 72 +++++++++++++++++---------------------- R/sysdata.rda | Bin 798 -> 776 bytes man/update_recessions.Rd | 20 ++++++----- 3 files changed, 43 insertions(+), 49 deletions(-) diff --git a/R/geom_recessions.R b/R/geom_recessions.R index 604ccc89..fb380c7b 100644 --- a/R/geom_recessions.R +++ b/R/geom_recessions.R @@ -429,11 +429,12 @@ GeomRecessionsText <- ggproto( #'Update recessions table #' -#'The \code{cmapplot} package contains an internal dataset of all recessions in -#'American history as recorded by the National Bureau of Economic Research -#'(NBER). However, users may need to replace the built-in data, such as in the -#'event of new recessions and/or changes to the NBER consensus on recession -#'dates. This function fetches and interprets this data from the NBER website. +#'The cmapplot package contains an internal dataset \code{recessions} of all +#'recessions in American history as recorded by the National Bureau of Economic +#'Research (NBER). However, users may need to replace the built-in data, such as +#'in the event of new recessions and/or changes to the NBER consensus on +#'recession dates. This function fetches and interprets this data from the NBER +#'website. #' #'@param url Char, the web location of the NBER machine-readable CSV file. The #' default, \code{NULL}, uses the most recently identified URL known to the @@ -442,13 +443,14 @@ GeomRecessionsText <- ggproto( #'@param quietly Logical, suppresses messages produced by #' \code{utils::download.file}. #' -#'@return A tibble with the following variables: \itemize{ \item +#'@return A data frame with the following variables: \itemize{ \item #' \code{start_char, end_char}: Chr. Easily readable labels for the beginning #' and end of the recession. \item \code{start_date, end_date}: Date. Dates #' expressed in R datetime format, using the first day of the specified month. -#' } +#' \item \code{ongoing}: Logical. Whether or not the recession is ongoing as of +#' the latest available NBER data. } #' -#'@source \url{https://www.nber.org/data/cycles 'cycle dates pasted.csv'} +#'@source \url{https://www.nber.org/data/cycles/cycle dates pasted.csv} #' #' @examples #' recessions <- update_recessions() @@ -457,19 +459,14 @@ GeomRecessionsText <- ggproto( #' # package by running the following code: #' \dontrun{ #' recessions <- update_recessions() -#' usethis::use_data(recessions, internal = TRUE) +#' usethis::use_data(recessions, internal = TRUE, overwrite = TRUE) #' } #' #'@export update_recessions <- function(url = NULL, quietly = FALSE){ - pkgs <- c("tibble", "lubridate") - if(FALSE %in% lapply(pkgs, requireNamespace, quietly = TRUE)){ - stop(paste("This function requires the following packages:", paste(pkgs, collapse = ", ")), call. = FALSE) - } - - # best known URL for machine readable NBER file - if (is_null(url)) { + # Use default URL if user does not override + if (is_null(url) | missing(url)) { url <- "http://data.nber.org/data/cycles/cycle%20dates%20pasted.csv" } @@ -477,43 +474,38 @@ update_recessions <- function(url = NULL, quietly = FALSE){ start_char <- end_char <- start_date <- end_date <- ongoing <- index <- NULL return( + # attempt to download and format recessions table tryCatch({ recessions <- read.csv(url) %>% # drop first row trough dplyr::slice(-1) %>% - tibble::as_tibble() %>% - # rename character values - dplyr::rename(start_char = 1, end_char = 2) %>% - # convert character dates to R date + # convert peaks and troughs... dplyr::mutate( - start_date = as.Date(start_char), - end_date = as.Date(end_char)) %>% - dplyr::arrange(start_date) %>% - # Convert character columns to 'Month Year' format - mutate( + # ...to R dates + start_date = as.Date(peak), + end_date = as.Date(trough), + # ... and clean char strings start_char = format(start_date, "%b %Y"), - end_char = format(end_date, "%b %Y") - ) %>% - # Add a row number for identifying the last recession + end_char = format(end_date, "%b %Y")) %>% + # confirm ascending and create row number + dplyr::arrange(start_date) %>% mutate(index = row_number()) %>% - # Flag unfinished recessions - mutate(ongoing = case_when( - is.na(end_date) & index == max(.$index) ~ T, - TRUE ~ F - )) %>% - # If there is an ongoing recession in the last row, add January 2200 for - # graphing purposes mutate( + # Flag unfinished recessions + ongoing = case_when( + is.na(end_date) & index == max(.$index) ~ T, + TRUE ~ F), + # set ongoing recession to arbitrary future date end_date = case_when( ongoing ~ as.Date("2200-01-01"), TRUE ~ end_date), - # Flag that recession as "Ongoing" in this case + # mark ongoing recession in char field end_char = case_when( ongoing ~ "Ongoing", - TRUE ~ end_char - )) %>% - # eliminate index - select(-index) + TRUE ~ end_char) + ) %>% + # clean up + select(start_char, end_char, start_date, end_date, ongoing) if (!quietly) {message("Successfully fetched from NBER")} diff --git a/R/sysdata.rda b/R/sysdata.rda index 67306a22f8fb9e487ec1a862be19b507126ac7fc..b99888361f40bbe9662c92f0031389e6ce66cd0b 100644 GIT binary patch literal 776 zcmV+j1NZzwT4*^jL0KkKS+Aq_761bv|Ns8?&H+$Uf9d6up5FiG->6tb0s==bbH`(y z|Ns5~MuETrXJsmApwOg%0000D42`G&Vj2TL14BlD00w|G8Zv0nr>W`$O*Cp~kTd`Q z&}aYv4FCWD0000000008FeaEyF)=h`z!LyX1_Eh-0%X7d2*DVbi~?w488l##NFWsT z9!(*jGypUJ^#efA4GjQ2KnJJ+qerMT(U4>VYI>Q3IK^NyG&2Yg1O|w0R6|gE>Ca=S zm7=qog;=XUPvZBJ0q5GSx>Fa5&r|QB0Tjr!6gCi(^3afnVuVl%7+@97psOn%6UW0BHnJDSqOKAYq*hLr zrwo{-6NwfPrL{Jq7T82UwlI{IiHtJJet$$+K_CDS4!{5q4GAvu5D*hVQK1NJHnLbG zg9+4O@ECCQNFhIcotAnTPm=7CBtfbnpp}Be2F2o(0HQKAi&}h_ww7_doovx>Ltkn%7p$-an&c8Pj1dS>&;lP2P=>pN{C2ZPJL@=x zyMEAoFVVYE&I#~%0E##>vjZa*5HESm@gjj%GJZ2yihvaF3sRhHOudaG92p^wSdA#H z;HZ;e!M8fG_%&hL=98#Zb+9?uBFrpf83Zlbo z0anC)Gv`VD>ec)h5g}l}!uriy7ML#e*XynWiyJtIpg9B!nt;~4t$q8wz`2L~w`Rf& z@HE>^fHn)XQ#c(;kv1`^Od!=ji(+EF{GVQ<%Ou3@DM+ZMtHH8u%@pmLsg$WA! GKXG8pQ9}>_ literal 798 zcmV+(1L6E1iwFP!000002F+DVNK{c6zB;3(^nz*|;wpmVKIYE7hoDB10zr*3k{;-F zyiUS2BQv8BZKRcpwk?Ae6@(QQ^jMTkiwsIk%_;MhI<;?Mv~xQ5e)siXXx|KXzWL7i zU*|jjIrmI!x6;tvAP7Q4i1KfwhW{06Pn?!yRThM3HD^_Pyq;r2&PvD)|zJHo?=EZL_ zta!}xZ#9z^59MQCzO&{~qr}8O{OcCiNIWKqA@0R*8BSSTr}MH%<`PEUuIFGc{C?ufMG~^Yyp&V7}gn=j)C7b&>?hyi))^ z-U2@B1Wrnhh|le~iRpvjTQ_@s5vwcz)=jY9gH6K!@u>=Ldd9eFx|?3(zLN6=BUk82 zUNLg+(K0jrLGD=eTZ;@>1bAK6J$xizeJ*>g+0D6&Kh>lBr&6h`g@lYa4z-28bWi_) c!y=ryCGccM^FWTr5}@<;UlMnX<#z}G0Pta(VE_OC diff --git a/man/update_recessions.Rd b/man/update_recessions.Rd index 909c0402..d649cbfc 100644 --- a/man/update_recessions.Rd +++ b/man/update_recessions.Rd @@ -4,7 +4,7 @@ \alias{update_recessions} \title{Update recessions table} \source{ -\url{https://www.nber.org/data/cycles 'cycle dates pasted.csv'} +\url{https://www.nber.org/data/cycles/cycle dates pasted.csv} } \usage{ update_recessions(url = NULL, quietly = FALSE) @@ -19,18 +19,20 @@ updates over time.} \code{utils::download.file}.} } \value{ -A tibble with the following variables: \itemize{ \item +A data frame with the following variables: \itemize{ \item \code{start_char, end_char}: Chr. Easily readable labels for the beginning and end of the recession. \item \code{start_date, end_date}: Date. Dates expressed in R datetime format, using the first day of the specified month. - } + \item \code{ongoing}: Logical. Whether or not the recession is ongoing as of + the latest available NBER data. } } \description{ -The \code{cmapplot} package contains an internal dataset of all recessions in -American history as recorded by the National Bureau of Economic Research -(NBER). However, users may need to replace the built-in data, such as in the -event of new recessions and/or changes to the NBER consensus on recession -dates. This function fetches and interprets this data from the NBER website. +The cmapplot package contains an internal dataset \code{recessions} of all +recessions in American history as recorded by the National Bureau of Economic +Research (NBER). However, users may need to replace the built-in data, such as +in the event of new recessions and/or changes to the NBER consensus on +recession dates. This function fetches and interprets this data from the NBER +website. } \examples{ recessions <- update_recessions() @@ -39,7 +41,7 @@ recessions <- update_recessions() # package by running the following code: \dontrun{ recessions <- update_recessions() - usethis::use_data(recessions, internal = TRUE) + usethis::use_data(recessions, internal = TRUE, overwrite = TRUE) } } From 7c376feea2dddbb08f328d2609c574d661790e3e Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Thu, 18 Mar 2021 23:17:24 -0500 Subject: [PATCH 010/173] shift `show_ongoing` work into `filter_recessions` subfn I forgot the elegant hell of ggproto objects. Seems to work. Would appreciate some additional testing @dlcomeaux --- DESCRIPTION | 1 - R/geom_recessions.R | 39 ++++++++++++++++++++++----------------- 2 files changed, 22 insertions(+), 18 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8125ddec..79a10af5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -55,7 +55,6 @@ Suggests: knitr, lubridate, readxl, - RCurl, rmarkdown, testthat, tibble, diff --git a/R/geom_recessions.R b/R/geom_recessions.R index fb380c7b..92dda3bb 100644 --- a/R/geom_recessions.R +++ b/R/geom_recessions.R @@ -143,16 +143,9 @@ geom_recessions <- function(xformat = "numeric", show_ongoing = TRUE, ...) { - # Local binding for ongoing - ongoing <- NULL - - # Generate recessions table, filtering out ongoing recessions if specified - recessions_for_plot <- build_recessions(update_recessions) - if (!show_ongoing) {recessions_for_plot <- recessions_for_plot %>% filter(ongoing == F)} - # build recessions table for use in function, but hide it in a list # because of ggplot's requirement that parameters be of length 1 - recess_table <- list(recessions_for_plot) + recess_table <- list(build_recessions(update_recessions)) # return a series of gg objects to ggplot list( @@ -171,6 +164,7 @@ geom_recessions <- function(xformat = "numeric", ymin = ymin, ymax = ymax, recess_table = recess_table, + show_ongoing = show_ongoing, ... ), rect_aes @@ -193,6 +187,7 @@ geom_recessions <- function(xformat = "numeric", # Because ymax is Inf by default, adjustments to this setting # require manually setting `ymax` in the call to `geom_recessions` recess_table = recess_table, + show_ongoing = show_ongoing, ... ), text_aes @@ -238,16 +233,16 @@ build_recessions <- function(update_recessions){ return(update_recessions) # OTHERWISE }else{ - message("`update_recessions` must be TRUE, FALSE, or a data table. Using built-in recessions table...") + message("`update_recessions` must be TRUE, FALSE, or a data frame. Using built-in recessions table...") return(recessions) } } # Internal function designed to filter the built-in recessions table -filter_recessions <- function(min, max, xformat, recess_table){ +filter_recessions <- function(min, max, xformat, show_ongoing, recess_table){ # Bind local variables to function - end_num <- start_num <- end_date <- start_date <- end <- start <- NULL + end_num <- start_num <- end_date <- start_date <- end <- start <- ongoing <- NULL # unwrap recess_table from list recess_table <- recess_table[[1]] @@ -258,7 +253,11 @@ filter_recessions <- function(min, max, xformat, recess_table){ start_num = lubridate::decimal_date(start_date), end_num = lubridate::decimal_date(end_date)) - # filter recessions correctly, based on xformat + + # Filtering out ongoing recessions if specified + if (!show_ongoing) {recess_table <- dplyr::filter(recess_table, ongoing == F)} + + # set up recessions table correctly, based on xformat if (xformat == "numeric") { recessions <- dplyr::rename(recess_table, end = end_num, start = start_num) } else if (xformat == "date") { @@ -293,12 +292,15 @@ GeomRecessions <- ggproto( "GeomRecessions", Geom, default_aes = aes(colour = NA, alpha = 0.11, size = 0.5, linetype = 1, na.rm = TRUE), - required_aes = c("xformat", "ymin", "ymax", "recess_table" ,"fill"), + required_aes = c("xformat", "ymin", "ymax", "show_ongoing", "recess_table" ,"fill"), # replace `data` with `recessions`, filtered by `data` setup_data = function(data, params) { #filter recessions based on date parameters from `data` and return it. This overwrites `data`. - data <- filter_recessions(min = min(data$x), max = max(data$x), xformat = params$xformat, recess_table = params$recess_table) + data <- filter_recessions(min = min(data$x), max = max(data$x), + xformat = params$xformat, + show_ongoing = params$show_ongoing, + recess_table = params$recess_table) # set up data for GeomRect data <- dplyr::transmute( @@ -365,7 +367,7 @@ GeomRecessions <- ggproto( GeomRecessionsText <- ggproto( "GeomRecessionsText", Geom, - required_aes = c("xformat", "label", "recess_table", "y"), + required_aes = c("xformat", "label", "show_ongoing", "recess_table", "y"), default_aes = aes( colour = "black", size = 3.88, alpha = NA, family = "", fontface = 1, lineheight = 1.2, @@ -377,7 +379,10 @@ GeomRecessionsText <- ggproto( # replace `data` with `recessions`, filtered by `data` setup_data = function(data, params) { #filter recessions based on date parameters from `data` and return it. This overwrites `data`. - data <- filter_recessions(min = min(data$x), max = max(data$x), xformat = params$xformat, recess_table = params$recess_table) + data <- filter_recessions(min = min(data$x), max = max(data$x), + xformat = params$xformat, + show_ongoing = params$show_ongoing, + recess_table = params$recess_table) # set up data for GeomRect data <- dplyr::transmute( @@ -471,7 +476,7 @@ update_recessions <- function(url = NULL, quietly = FALSE){ } # locally bind variable names - start_char <- end_char <- start_date <- end_date <- ongoing <- index <- NULL + start_char <- end_char <- start_date <- end_date <- ongoing <- index <- peak <- trough <- NULL return( # attempt to download and format recessions table From ac28c4de9b55767d7eecee1bf1e2655052d3eb27 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Fri, 19 Mar 2021 14:24:58 -0500 Subject: [PATCH 011/173] address open issues creation of numeric dates only occurs if numeric axis specified. lubridate import established and package marked as required. readxl removed from suggests. --- DESCRIPTION | 3 +-- NAMESPACE | 1 + R/geom_recessions.R | 28 ++++++++++++++-------------- 3 files changed, 16 insertions(+), 16 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 79a10af5..d9b92bf0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -45,6 +45,7 @@ Imports: grid, gridExtra, gridtext, + lubridate, magrittr, purrr, rlang, @@ -53,8 +54,6 @@ Imports: sysfonts Suggests: knitr, - lubridate, - readxl, rmarkdown, testthat, tibble, diff --git a/NAMESPACE b/NAMESPACE index af757ab0..9494d632 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -44,6 +44,7 @@ importFrom(ggpubr,get_legend) importFrom(glue,glue) importFrom(glue,glue_collapse) importFrom(gridExtra,arrangeGrob) +importFrom(lubridate,decimal_date) importFrom(purrr,compact) importFrom(purrr,map) importFrom(purrr,walk2) diff --git a/R/geom_recessions.R b/R/geom_recessions.R index 92dda3bb..f9691fd6 100644 --- a/R/geom_recessions.R +++ b/R/geom_recessions.R @@ -238,6 +238,7 @@ build_recessions <- function(update_recessions){ } } +#' @importFrom lubridate decimal_date # Internal function designed to filter the built-in recessions table filter_recessions <- function(min, max, xformat, show_ongoing, recess_table){ @@ -247,24 +248,23 @@ filter_recessions <- function(min, max, xformat, show_ongoing, recess_table){ # unwrap recess_table from list recess_table <- recess_table[[1]] - # Add numeric version of dates - recess_table <- recess_table %>% - mutate( - start_num = lubridate::decimal_date(start_date), - end_num = lubridate::decimal_date(end_date)) - - # Filtering out ongoing recessions if specified if (!show_ongoing) {recess_table <- dplyr::filter(recess_table, ongoing == F)} - # set up recessions table correctly, based on xformat - if (xformat == "numeric") { - recessions <- dplyr::rename(recess_table, end = end_num, start = start_num) - } else if (xformat == "date") { - recessions <- dplyr::rename(recess_table, end = end_date, start = start_date) + # use xformat to create correct "start" and "end" vars... + if (xformat == "date") { + # ... by renaming existing date fields (for date axis) + recessions <- dplyr::rename(recess_table, start = start_date, end = end_date) } else { - warning("geom_recessions currently only supports x axes in the numeric and date formats. Using numeric") - recessions <- dplyr::rename(recess_table, end = end_num, start = start_num) + # ... or by creating decimal dates (for numeric axis) + if (xformat != "numeric") { + warning("geom_recessions currently only supports x axes in the numeric and date formats. Using numeric.") + } + recessions <- dplyr::mutate( + recess_table, + start = lubridate::decimal_date(start_date), + end = lubridate::decimal_date(end_date) + ) } # Remove recessions outside of range From dd326f7149d9902f0212b4e199fff4b94ff6a322 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Fri, 19 Mar 2021 14:26:44 -0500 Subject: [PATCH 012/173] rm unnecessary space in file --- R/geom_recessions.R | 4 ---- 1 file changed, 4 deletions(-) diff --git a/R/geom_recessions.R b/R/geom_recessions.R index f9691fd6..8542579e 100644 --- a/R/geom_recessions.R +++ b/R/geom_recessions.R @@ -63,10 +63,6 @@ #' the hints found here: #' \url{https://stackoverflow.com/questions/6672374/convert-rgb-to-rgba-over-white}. #' -#' -#' -#' -#' #'@section Under the hood: This function calls two custom geoms, constructed #' with ggproto. The custom GeomRecessions and GeomRecessionsText are modified #' versions of GeomRect and GeomText, respectively. The only variations to each From 0639606f8df561a07ee4e667acc384532b2c0299 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux Date: Tue, 23 Mar 2021 14:01:48 -0500 Subject: [PATCH 013/173] Replace deprecated arguments --- R/finalize_plot.R | 2 +- vignettes/cookbook.Rmd | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/finalize_plot.R b/R/finalize_plot.R index b8740ee0..b24906bd 100644 --- a/R/finalize_plot.R +++ b/R/finalize_plot.R @@ -96,7 +96,7 @@ #' mode = "window", #' height = 6, #' width = 8, -#' title_width = 2.5, +#' sidebar_width = 2.5, #' overrides = list(margin_plot_r = 30)) #' #' transit_plot <- transit_ridership %>% diff --git a/vignettes/cookbook.Rmd b/vignettes/cookbook.Rmd index da1798c8..d3f16052 100644 --- a/vignettes/cookbook.Rmd +++ b/vignettes/cookbook.Rmd @@ -91,7 +91,7 @@ finalize_plot( # Tweak plot layout height = 4.5, - title_width = 2.6, + sidebar_width = 2.6, overrides = list( margin_plot_r = 0, # Eliminate distance btwn plot and right side of image margin_legend_b = 25 # Larger than usual gap between legend and plot @@ -398,7 +398,7 @@ finalize_plot( (as of August 19, 2020).", # Note that we used two "
" tags to create a line break and empty line # between sources and notes. - title_width = 2.4, # Manually specify title width + sidebar_width = 2.4, # Manually specify sidebar width overrides = list(margin_legend_b = 50) # Increase margin below legend ) ``` @@ -621,7 +621,7 @@ finalize_plot( plot = p, title = "Regional emissions by sector, 2015", caption = "Source: Chicago Metropolitan Agency for Planning.", - caption_valign = "top") + caption_align = 1) ``` #### Original graphic From ae4e11e8948b7a89ee42b0365a8b7f82635163fe Mon Sep 17 00:00:00 2001 From: Daniel Comeaux Date: Tue, 23 Mar 2021 14:02:21 -0500 Subject: [PATCH 014/173] Add explanation of ongoing recessions --- vignettes/plots.Rmd | 2 ++ 1 file changed, 2 insertions(+) diff --git a/vignettes/plots.Rmd b/vignettes/plots.Rmd index c4744c98..6b01131c 100644 --- a/vignettes/plots.Rmd +++ b/vignettes/plots.Rmd @@ -126,6 +126,8 @@ The function `geom_recessions()`, allows for the addition of rectangles (and tex `ggplot()` always draws geoms *on top* of base plot elements like gridlines. The default fill and alpha values for `geom_recessions()` are the most transparent way possible to achieve CMAP palette color `#002d49` when drawn on a white background — thus impacting the color of the gridlines as little as possible. +Unless otherwise specified, this function relies on the National Bureau of Economic Research's definitions of recessions (see the `geom_recessions()` for more details on how to update that data or replace it with your own). If the NBER has announced the beginning of a recession but not yet declared its end (as is the case in March 2021), the function will default to displaying this ongoing recession from its beginning through the end of the visualized data. If this is not desired (for example, if the visualization is of a projection far into the future), users can remove this ongoing recession by setting `show_ongoing = FALSE`. + ```{r recessions, message = FALSE} q <- ggplot(data = df, mapping = aes(x = year, y = ridership, color = system)) + From 97bb7efa92780faabc4bde21cf5ca1b9287345fb Mon Sep 17 00:00:00 2001 From: Daniel Comeaux Date: Tue, 23 Mar 2021 14:08:19 -0500 Subject: [PATCH 015/173] Update man file --- man/finalize_plot.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/finalize_plot.Rd b/man/finalize_plot.Rd index 2b51dc12..4eea1e89 100644 --- a/man/finalize_plot.Rd +++ b/man/finalize_plot.Rd @@ -137,7 +137,7 @@ finalize_plot(econ_plot, mode = "window", height = 6, width = 8, - title_width = 2.5, + sidebar_width = 2.5, overrides = list(margin_plot_r = 30)) transit_plot <- transit_ridership \%>\% From bc7a4284894b17c8c937f008f2b5ea902edc563f Mon Sep 17 00:00:00 2001 From: Daniel Comeaux Date: Tue, 23 Mar 2021 14:28:19 -0500 Subject: [PATCH 016/173] Rewording section on recessions --- vignettes/plots.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/plots.Rmd b/vignettes/plots.Rmd index 6b01131c..39224d85 100644 --- a/vignettes/plots.Rmd +++ b/vignettes/plots.Rmd @@ -126,7 +126,7 @@ The function `geom_recessions()`, allows for the addition of rectangles (and tex `ggplot()` always draws geoms *on top* of base plot elements like gridlines. The default fill and alpha values for `geom_recessions()` are the most transparent way possible to achieve CMAP palette color `#002d49` when drawn on a white background — thus impacting the color of the gridlines as little as possible. -Unless otherwise specified, this function relies on the National Bureau of Economic Research's definitions of recessions (see the `geom_recessions()` for more details on how to update that data or replace it with your own). If the NBER has announced the beginning of a recession but not yet declared its end (as is the case in March 2021), the function will default to displaying this ongoing recession from its beginning through the end of the visualized data. If this is not desired (for example, if the visualization is of a projection far into the future), users can remove this ongoing recession by setting `show_ongoing = FALSE`. +This function relies on the National Bureau of Economic Research's definitions of recessions. Details on how to update these dates, as well as how to provide your own, can be found in `geom_recessions()` and `update_recessions()`. If the most recent recession has not yet been declared over (as is the case in March 2021), the function will default to displaying this ongoing recession from its beginning through the end of the visualized data. If this is not desired (for example, if the visualization is of a projection far into the future), users can remove this ongoing recession by setting `show_ongoing = FALSE`. ```{r recessions, message = FALSE} q <- ggplot(data = df, From 9323c7effde40f47fe10771d7d0b9700a8cedf30 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux Date: Tue, 23 Mar 2021 14:31:04 -0500 Subject: [PATCH 017/173] Update to documentation Notes the location of the recessions table --- R/geom_recessions.R | 15 +++++++++------ man/geom_recessions.Rd | 14 ++++++++------ 2 files changed, 17 insertions(+), 12 deletions(-) diff --git a/R/geom_recessions.R b/R/geom_recessions.R index 8542579e..33976481 100644 --- a/R/geom_recessions.R +++ b/R/geom_recessions.R @@ -28,12 +28,14 @@ #'@param rect_aes,text_aes Named list, additional aesthetics to send to the #' rectangle and text geoms, respectively. #'@param update_recessions Logical or data frame. \code{FALSE}, the default, -#' relies on the package's built in recessions table. \code{TRUE} calls the -#' function \code{update_recessions}, which attempts to fetch the current -#' recessions table from the NBER website. A custom data table of recessions -#' can also be passed to this argument, but it must be structured identically -#' to the five-column data table described in the the documentation file for -#' the function \code{update_recessions}. +#' relies on the package's built in recessions table, which was last updated in +#' March 2021 and is loaded into the \code{sysdata.R} file located in the +#' \code{R} directory. \code{TRUE} calls the function +#' \code{update_recessions}, which attempts to fetch the current recessions +#' table from the NBER website. A custom data table of recessions can also be +#' passed to this argument, but it must be structured identically to the +#' five-column data table described in the the documentation file for the +#' function \code{update_recessions}. #'@param show_ongoing Logical. \code{TRUE}, the default, will display an ongoing #' recession that does not yet have a defined end date. If an ongoing recession #' exists, it will be displayed as extending through the maximum extent of the @@ -63,6 +65,7 @@ #' the hints found here: #' \url{https://stackoverflow.com/questions/6672374/convert-rgb-to-rgba-over-white}. #' +#' #'@section Under the hood: This function calls two custom geoms, constructed #' with ggproto. The custom GeomRecessions and GeomRecessionsText are modified #' versions of GeomRect and GeomText, respectively. The only variations to each diff --git a/man/geom_recessions.Rd b/man/geom_recessions.Rd index a94fed38..de95e2c7 100644 --- a/man/geom_recessions.Rd +++ b/man/geom_recessions.Rd @@ -54,12 +54,14 @@ Defaults to \code{FALSE}.} rectangle and text geoms, respectively.} \item{update_recessions}{Logical or data frame. \code{FALSE}, the default, -relies on the package's built in recessions table. \code{TRUE} calls the -function \code{update_recessions}, which attempts to fetch the current -recessions table from the NBER website. A custom data table of recessions -can also be passed to this argument, but it must be structured identically -to the five-column data table described in the the documentation file for -the function \code{update_recessions}.} +relies on the package's built in recessions table, which was last updated in +March 2021 and is loaded into the \code{sysdata.R} file located in the +\code{R} directory. \code{TRUE} calls the function +\code{update_recessions}, which attempts to fetch the current recessions +table from the NBER website. A custom data table of recessions can also be +passed to this argument, but it must be structured identically to the +five-column data table described in the the documentation file for the +function \code{update_recessions}.} \item{show_ongoing}{Logical. \code{TRUE}, the default, will display an ongoing recession that does not yet have a defined end date. If an ongoing recession From 1f2f08f02ffd4229766cfa22bf45b45d387f3249 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux Date: Tue, 23 Mar 2021 18:18:24 -0500 Subject: [PATCH 018/173] Initial code Doesn't work quite yet. --- R/axis_handling.R | 84 +++++++++++++++++++++++++++++++++++++++++++ man/integer_breaks.Rd | 25 +++++++++++-- 2 files changed, 107 insertions(+), 2 deletions(-) create mode 100644 R/axis_handling.R diff --git a/R/axis_handling.R b/R/axis_handling.R new file mode 100644 index 00000000..34dd62c0 --- /dev/null +++ b/R/axis_handling.R @@ -0,0 +1,84 @@ +#'Axis handling helper functions +#' +#'This file includes two helper functions that improve axis handling. +#' +#'@importFrom stringr str_length + + +#'A function factory for getting integer x- and y-axis values. +#' +#'This function can be supplied as the value for the \code{breaks} argument in +#'the \code{scale_*_continuous} ggplot elements. It forces labels to be +#'displayed as integers with even spacing between them, which is particularly +#'important for time series with years on the X or Y axis. The code was +#'developed by Joshua Cook. +#' +#'@source \url{https://joshuacook.netlify.app/post/integer-values-ggplot-axis/} +#' +#'@param n Integer, the desired number of breaks on the axis. +#'@param ... Pass additional arguments to the base \code{pretty()} function. +#' +#' @examples +#' # Standard implementation +#' ggplot(grp_over_time, aes(x = year, y = realgrp, color = cluster)) + +#' geom_line() + +#' scale_x_continuous(breaks = integer_breaks()) +#' +#' # Adjusted to add a total of 11 intervals +#' ggplot(grp_over_time, aes(x = year, y = realgrp, color = cluster)) + +#' geom_line() + +#' scale_x_continuous(breaks = integer_breaks(n = 11)) +#' +#'@export +integer_breaks <- function(n = 5, ...) { + fxn <- function(x) { + breaks <- floor(pretty(x, n, ...)) + names(breaks) <- attr(breaks, "labels") + breaks + } + return(fxn) +} + +#'A function for abbreviating year labels in time series graphs +#' +#'This function can be supplied as the value for the \code{labels} argument in +#'\code{scale_*_continuous} and +#'\code{scale_*_date}. It will return a set of labels that abbreviates any years +#'to their two-digit representation (e.g., 2008 to '08), but not abbreviating +#'any specified breaks. +#' +#'@param full_by_pos Vector of integers, the position of breaks that should not +#' be abbreviated. +#'@param full_by_value Vector of integers, the value of breaks that should not +#' be abbreviated. +#' +#'@export +abbreviate_dates <- function(breaks, + full_by_pos = c(1),full_by_date = NULL + ) { + # Determine length of each break + lengths <- stringr::str_length(as.integer(breaks)) + + # Stop if the breaks are not in a four-digit format + if (!(min(lengths == 4) & max(lengths == 4))) { + stop("Breaks are not in a four-digit format. Cannot abbreviate.") + } + + # Stop if breaks cannot be coerced to a number + tryCatch({as.integer(breaks)}, + warning = function(w){stop("Breaks cannot be coerced to a year. Cannot abbreviate.")}) + + # Abbreviate all values + abbr <- paste0("'",substr(breaks,3,4)) + + # Add back any specified non-abbreviations + if(!is.null(full_by_date)) { + full_by_pos <- arrange(distinct(c(full_by_pos,match(breaks,full_by_date)))) + } + + if(!is.null(full_by_pos)) { + abbr[full_by_pos] <- breaks[full_by_pos] + } + + return(abbr) + } diff --git a/man/integer_breaks.Rd b/man/integer_breaks.Rd index c0f8f6e0..a0cab96d 100644 --- a/man/integer_breaks.Rd +++ b/man/integer_breaks.Rd @@ -1,9 +1,14 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/integer_breaks.R +% Please edit documentation in R/cmapplot.R, R/integer_breaks.R \name{integer_breaks} \alias{integer_breaks} -\title{clean up integer axis breaks} +\title{A function factory for getting integer x- and y-axis values.} +\source{ +\url{https://joshuacook.netlify.app/post/integer-values-ggplot-axis/} +} \usage{ +integer_breaks(n = 5, ...) + integer_breaks(n = 5, ...) } \arguments{ @@ -12,11 +17,27 @@ integer_breaks(n = 5, ...) \item{...}{other arguments passed on to \code{\link[base]{pretty}}} } \description{ +This function can be supplied as the value for the \code{breaks} argument in +the \code{scale_*_continuous} ggplot elements. It forces labels to be +displayed as integers with even spacing between them, which is particularly +important for time series with years on the X or Y axis. The code was +developed by Joshua Cook. + Where n = desired number of ticks. Function uses \code{floor(pretty())} to generate good breaks for the x or y axis of a ggplot. Borrowed with respect from \url{https://joshuacook.netlify.com/post/integer-values-ggplot-axis/} } \examples{ +# Standard implementation +ggplot(grp_over_time, aes(x = year, y = realgrp, color = cluster)) + + geom_line() + + scale_x_continuous(breaks = integer_breaks()) + +# Adjusted to add a total of 11 intervals +ggplot(grp_over_time, aes(x = year, y = realgrp, color = cluster)) + + geom_line() + + scale_x_continuous(breaks = integer_breaks(n = 11)) + ggplot(data = dplyr::filter(grp_over_time, category == "Goods-Producing"), mapping = aes(x = year, y = realgrp, color = cluster)) + From 1a3f2708b16499446c2af3a06bab72e40029b94b Mon Sep 17 00:00:00 2001 From: Daniel Comeaux Date: Tue, 23 Mar 2021 18:28:50 -0500 Subject: [PATCH 019/173] Delete integer_breaks Replaced by pretty_breaks --- R/axis_handling.R | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/R/axis_handling.R b/R/axis_handling.R index 34dd62c0..833c21e5 100644 --- a/R/axis_handling.R +++ b/R/axis_handling.R @@ -59,23 +59,23 @@ abbreviate_dates <- function(breaks, # Determine length of each break lengths <- stringr::str_length(as.integer(breaks)) - # Stop if the breaks are not in a four-digit format - if (!(min(lengths == 4) & max(lengths == 4))) { - stop("Breaks are not in a four-digit format. Cannot abbreviate.") - } - - # Stop if breaks cannot be coerced to a number - tryCatch({as.integer(breaks)}, - warning = function(w){stop("Breaks cannot be coerced to a year. Cannot abbreviate.")}) + # # Stop if the breaks are not in a four-digit format - this seems to cause errors with pretty breaks + # if (!(min(lengths == 4) & max(lengths == 4))) { + # stop("Breaks are not in a four-digit format. Cannot abbreviate.") + # } + # + # # Stop if breaks cannot be coerced to a number + # tryCatch({as.integer(breaks)}, + # warning = function(w){stop("Breaks cannot be coerced to a year. Cannot abbreviate.")}) # Abbreviate all values abbr <- paste0("'",substr(breaks,3,4)) # Add back any specified non-abbreviations if(!is.null(full_by_date)) { - full_by_pos <- arrange(distinct(c(full_by_pos,match(breaks,full_by_date)))) + full_by_pos <- sort(unique(c(full_by_pos,match(breaks,full_by_date)))) } - + ##### NOTE - there are issues with pretty breaks, it increments the adjusted labels up by one. Not sure what's going on. if(!is.null(full_by_pos)) { abbr[full_by_pos] <- breaks[full_by_pos] } From bcc025aaca706a194adf0c2fd2644a6c03e2e4a8 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux Date: Tue, 23 Mar 2021 18:29:11 -0500 Subject: [PATCH 020/173] Delete integer breaks Replaced by pretty_breaks --- R/axis_handling.R | 36 +----------------------------------- 1 file changed, 1 insertion(+), 35 deletions(-) diff --git a/R/axis_handling.R b/R/axis_handling.R index 833c21e5..4ccae5cf 100644 --- a/R/axis_handling.R +++ b/R/axis_handling.R @@ -1,44 +1,10 @@ #'Axis handling helper functions #' -#'This file includes two helper functions that improve axis handling. +#'This file includes helper functions that improve axis handling. #' #'@importFrom stringr str_length -#'A function factory for getting integer x- and y-axis values. -#' -#'This function can be supplied as the value for the \code{breaks} argument in -#'the \code{scale_*_continuous} ggplot elements. It forces labels to be -#'displayed as integers with even spacing between them, which is particularly -#'important for time series with years on the X or Y axis. The code was -#'developed by Joshua Cook. -#' -#'@source \url{https://joshuacook.netlify.app/post/integer-values-ggplot-axis/} -#' -#'@param n Integer, the desired number of breaks on the axis. -#'@param ... Pass additional arguments to the base \code{pretty()} function. -#' -#' @examples -#' # Standard implementation -#' ggplot(grp_over_time, aes(x = year, y = realgrp, color = cluster)) + -#' geom_line() + -#' scale_x_continuous(breaks = integer_breaks()) -#' -#' # Adjusted to add a total of 11 intervals -#' ggplot(grp_over_time, aes(x = year, y = realgrp, color = cluster)) + -#' geom_line() + -#' scale_x_continuous(breaks = integer_breaks(n = 11)) -#' -#'@export -integer_breaks <- function(n = 5, ...) { - fxn <- function(x) { - breaks <- floor(pretty(x, n, ...)) - names(breaks) <- attr(breaks, "labels") - breaks - } - return(fxn) -} - #'A function for abbreviating year labels in time series graphs #' #'This function can be supplied as the value for the \code{labels} argument in From e1bba87dcc2d71b11afde9604452db0277e893cc Mon Sep 17 00:00:00 2001 From: Daniel Comeaux Date: Tue, 23 Mar 2021 18:29:14 -0500 Subject: [PATCH 021/173] Revert "Delete integer_breaks" This reverts commit 1a3f2708b16499446c2af3a06bab72e40029b94b. --- R/axis_handling.R | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/R/axis_handling.R b/R/axis_handling.R index 4ccae5cf..190ec743 100644 --- a/R/axis_handling.R +++ b/R/axis_handling.R @@ -25,23 +25,23 @@ abbreviate_dates <- function(breaks, # Determine length of each break lengths <- stringr::str_length(as.integer(breaks)) - # # Stop if the breaks are not in a four-digit format - this seems to cause errors with pretty breaks - # if (!(min(lengths == 4) & max(lengths == 4))) { - # stop("Breaks are not in a four-digit format. Cannot abbreviate.") - # } - # - # # Stop if breaks cannot be coerced to a number - # tryCatch({as.integer(breaks)}, - # warning = function(w){stop("Breaks cannot be coerced to a year. Cannot abbreviate.")}) + # Stop if the breaks are not in a four-digit format + if (!(min(lengths == 4) & max(lengths == 4))) { + stop("Breaks are not in a four-digit format. Cannot abbreviate.") + } + + # Stop if breaks cannot be coerced to a number + tryCatch({as.integer(breaks)}, + warning = function(w){stop("Breaks cannot be coerced to a year. Cannot abbreviate.")}) # Abbreviate all values abbr <- paste0("'",substr(breaks,3,4)) # Add back any specified non-abbreviations if(!is.null(full_by_date)) { - full_by_pos <- sort(unique(c(full_by_pos,match(breaks,full_by_date)))) + full_by_pos <- arrange(distinct(c(full_by_pos,match(breaks,full_by_date)))) } - ##### NOTE - there are issues with pretty breaks, it increments the adjusted labels up by one. Not sure what's going on. + if(!is.null(full_by_pos)) { abbr[full_by_pos] <- breaks[full_by_pos] } From 1eb63609656a8624d244807abd793fb04d546afc Mon Sep 17 00:00:00 2001 From: Daniel Comeaux Date: Tue, 23 Mar 2021 18:29:25 -0500 Subject: [PATCH 022/173] Revert "Revert "Delete integer_breaks"" This reverts commit e1bba87dcc2d71b11afde9604452db0277e893cc. --- R/axis_handling.R | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/R/axis_handling.R b/R/axis_handling.R index 190ec743..4ccae5cf 100644 --- a/R/axis_handling.R +++ b/R/axis_handling.R @@ -25,23 +25,23 @@ abbreviate_dates <- function(breaks, # Determine length of each break lengths <- stringr::str_length(as.integer(breaks)) - # Stop if the breaks are not in a four-digit format - if (!(min(lengths == 4) & max(lengths == 4))) { - stop("Breaks are not in a four-digit format. Cannot abbreviate.") - } - - # Stop if breaks cannot be coerced to a number - tryCatch({as.integer(breaks)}, - warning = function(w){stop("Breaks cannot be coerced to a year. Cannot abbreviate.")}) + # # Stop if the breaks are not in a four-digit format - this seems to cause errors with pretty breaks + # if (!(min(lengths == 4) & max(lengths == 4))) { + # stop("Breaks are not in a four-digit format. Cannot abbreviate.") + # } + # + # # Stop if breaks cannot be coerced to a number + # tryCatch({as.integer(breaks)}, + # warning = function(w){stop("Breaks cannot be coerced to a year. Cannot abbreviate.")}) # Abbreviate all values abbr <- paste0("'",substr(breaks,3,4)) # Add back any specified non-abbreviations if(!is.null(full_by_date)) { - full_by_pos <- arrange(distinct(c(full_by_pos,match(breaks,full_by_date)))) + full_by_pos <- sort(unique(c(full_by_pos,match(breaks,full_by_date)))) } - + ##### NOTE - there are issues with pretty breaks, it increments the adjusted labels up by one. Not sure what's going on. if(!is.null(full_by_pos)) { abbr[full_by_pos] <- breaks[full_by_pos] } From 643903c39bdb20b02aeb02864827000fc2a788ec Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Wed, 24 Mar 2021 13:49:43 -0500 Subject: [PATCH 023/173] Improvements and date case Addresses outstanding issues, adds ability for date scales, and adds documentation --- NAMESPACE | 3 + R/axis_handling.R | 134 ++++++++++++++++++++++++++++++++++------- man/abbr_years_cont.Rd | 68 +++++++++++++++++++++ man/integer_breaks.Rd | 25 +------- 4 files changed, 184 insertions(+), 46 deletions(-) create mode 100644 man/abbr_years_cont.Rd diff --git a/NAMESPACE b/NAMESPACE index 9494d632..155adbd3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,8 @@ export(GeomPointLast) export(GeomRecessions) export(GeomRecessionsText) export(GeomTextLast) +export(abbr_years_cont) +export(abbr_years_date) export(apply_cmap_default_aes) export(cmap_color_continuous) export(cmap_color_discrete) @@ -48,6 +50,7 @@ importFrom(lubridate,decimal_date) importFrom(purrr,compact) importFrom(purrr,map) importFrom(purrr,walk2) +importFrom(stringr,str_length) importFrom(stringr,str_replace) importFrom(stringr,str_trunc) importFrom(sysfonts,font_files) diff --git a/R/axis_handling.R b/R/axis_handling.R index 4ccae5cf..ddc051f7 100644 --- a/R/axis_handling.R +++ b/R/axis_handling.R @@ -1,35 +1,70 @@ #'Axis handling helper functions #' -#'This file includes helper functions that improve axis handling. +#'`abbr_years_cont()` and `abbr_years_date()` are helper functions that allow +#'users to abbreviate year labels to their two-digit representation (e.g., 2008 +#'to '08), but not abbreviating any specified breaks. #' #'@importFrom stringr str_length - - -#'A function for abbreviating year labels in time series graphs #' -#'This function can be supplied as the value for the \code{labels} argument in -#'\code{scale_*_continuous} and -#'\code{scale_*_date}. It will return a set of labels that abbreviates any years -#'to their two-digit representation (e.g., 2008 to '08), but not abbreviating -#'any specified breaks. #' +#'@examples +#'\dontrun{ +#' # Default implementation - this will abbreviate all labels except the first +#' ggplot(transit_ridership %>% filter(year >= 2000), +#' aes(x = year, y = ridership, color = system)) + +#' geom_line() + +#' scale_x_continuous(labels = abbr_years_cont) +#' +#' # If customizations are desired, the function should be input using the format +#' # displayed below: \code{function(i) abbr_years_cont(i,full_by_pos = *, +#' # full_by_year = *)}. +#' +#' # This example shows the use of \code{full_by_year} to maintain full labels on +#' # the first entry (the default) and add a full label to the year 2000, the first +#' # of the 21st century. +#' ggplot(transit_ridership, +#' aes(x = year, y = ridership, color = system)) + +#' geom_line() + +#' scale_x_continuous(labels = function(i) abbr_years_cont(i,full_by_year = c(2000))) +#' +#' # You can also remove the default maintenance of the first label and only +#' # specify specific years. +#' ggplot(grp_over_time, aes(x = year, y = realgrp, color = cluster)) + +#' geom_line() + +#' scale_x_continuous(breaks = scales::breaks_pretty(5), +#' labels = function(i) abbr_years_cont(i,full_by_pos = NULL, +#' full_by_year = c(2018)) +#' ) +#'} +#'@param breaks Vector, the input break values to be abbreviated. This will be +#' automatically supplied to the function by setting \code{labels = +#' abbr_years_cont} or \code{labels = abbr_years_date} inside the +#' \code{scale_*_continuous} argument (for \code{abbr_years_cont()} or inside +#' the \code{scale_*_date} argument (for \code{abbr_years_date}). #'@param full_by_pos Vector of integers, the position of breaks that should not -#' be abbreviated. -#'@param full_by_value Vector of integers, the value of breaks that should not -#' be abbreviated. +#' be abbreviated. This defaults to \code{c(1)}, which retains the original +#' first label and abbreviates subsequent ones. If all breaks should be +#' abbreviated, this can be set to NULL. +#'@param full_by_year Vector of integers, the value of breaks that should not be +#' abbreviated. Defaults to NULL. #' +#'@describeIn abbr_years_cont For continuous scales #'@export -abbreviate_dates <- function(breaks, - full_by_pos = c(1),full_by_date = NULL - ) { - # Determine length of each break - lengths <- stringr::str_length(as.integer(breaks)) +abbr_years_cont <- function(breaks, + full_by_pos = c(1), + full_by_year = NULL) { + + # Determine length of each break. Note that when breaks have been modified, + # ggplot sometimes adds an additional NA break in the first and last + # positions. We check whether this is the case and, if so, remove those for + # testing purposes. + lengths <- stringr::str_length(as.integer(breaks[which(!is.na(breaks))])) - # # Stop if the breaks are not in a four-digit format - this seems to cause errors with pretty breaks + # # Stop if the breaks are not in a four-digit format. # if (!(min(lengths == 4) & max(lengths == 4))) { # stop("Breaks are not in a four-digit format. Cannot abbreviate.") # } - # + # # Stop if breaks cannot be coerced to a number # tryCatch({as.integer(breaks)}, # warning = function(w){stop("Breaks cannot be coerced to a year. Cannot abbreviate.")}) @@ -37,14 +72,67 @@ abbreviate_dates <- function(breaks, # Abbreviate all values abbr <- paste0("'",substr(breaks,3,4)) - # Add back any specified non-abbreviations - if(!is.null(full_by_date)) { - full_by_pos <- sort(unique(c(full_by_pos,match(breaks,full_by_date)))) + # Account for leading NAs and increment up positions accordingly + leading_na <- which.min(is.na(breaks)) - 1 + full_by_pos <- full_by_pos + leading_na + + # Now convert referenced dates into positions + if(!is.null(full_by_year)) { + full_by_pos <- sort(unique(c(full_by_pos,match(full_by_year,breaks)))) } - ##### NOTE - there are issues with pretty breaks, it increments the adjusted labels up by one. Not sure what's going on. + + # Add back full years for specified positions if(!is.null(full_by_pos)) { abbr[full_by_pos] <- breaks[full_by_pos] } return(abbr) } + + +#'@describeIn abbr_years_cont For date scales +#' +#'@export +abbr_years_date <- function(breaks, + full_by_pos = c(1), + full_by_year = NULL) { + + # Convert given year integers into the number of days since 1970 (note this is + # how the breaks are handled internally by ggplot - they live in the following + # location of a ggplot chart 'a' that has been passed to ggplot_build() + # ggplot_build(a)$layout$panel_params[[1]]$x$breaks + # Note that breaks for the y axis can be accessed similarly. + if (!is.null(full_by_year)) + {full_by_year <- as.numeric(as.Date(paste0(full_by_year,"-01-01")))} + + # Stop if breaks cannot be coerced to a date + tryCatch({as.Date(breaks)}, + warning = function(w){stop("Breaks cannot be coerced to a date. Cannot abbreviate.")}) + + # Abbreviate all values - ggplot appears to correctly use the names of the + # breaks (which are the year values) when performing this operation on the + # breaks. + abbr <- paste0("'",substr(breaks,3,4)) + + # Account for leading NAs (see 'cont' variant for explanation) and increment + # up positions accordingly + leading_na <- which.min(is.na(breaks)) - 1 + if(!is.null(full_by_pos)) {full_by_pos <- full_by_pos + leading_na} + + # Now convert referenced dates into positions, adding them and removing duplicates + if(!is.null(full_by_year)) { + full_by_pos <- sort( + unique( + c(full_by_pos, + match(full_by_year,breaks)))) + } + + # Add back full years for specified positions + if(!is.null(full_by_pos)) { + # Extract the name of the break in ggplot's named list of numbers, which is + # the 4-digit year + abbr[full_by_pos] <- names(breaks)[full_by_pos] + } + + return(abbr) +} diff --git a/man/abbr_years_cont.Rd b/man/abbr_years_cont.Rd new file mode 100644 index 00000000..0154f0cc --- /dev/null +++ b/man/abbr_years_cont.Rd @@ -0,0 +1,68 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/axis_handling.R +\name{abbr_years_cont} +\alias{abbr_years_cont} +\alias{abbr_years_date} +\title{Axis handling helper functions} +\usage{ +abbr_years_cont(breaks, full_by_pos = c(1), full_by_year = NULL) + +abbr_years_date(breaks, full_by_pos = c(1), full_by_year = NULL) +} +\arguments{ +\item{breaks}{Vector, the input break values to be abbreviated. This will be +automatically supplied to the function by setting \code{labels = +abbr_years_cont} or \code{labels = abbr_years_date} inside the +\code{scale_*_continuous} argument (for \code{abbr_years_cont()} or inside +the \code{scale_*_date} argument (for \code{abbr_years_date}).} + +\item{full_by_pos}{Vector of integers, the position of breaks that should not +be abbreviated. This defaults to \code{c(1)}, which retains the original +first label and abbreviates subsequent ones. If all breaks should be +abbreviated, this can be set to NULL.} + +\item{full_by_year}{Vector of integers, the value of breaks that should not be +abbreviated. Defaults to NULL.} +} +\description{ +`abbr_years_cont()` and `abbr_years_date()` are helper functions that allow +users to abbreviate year labels to their two-digit representation (e.g., 2008 +to '08), but not abbreviating any specified breaks. +} +\section{Functions}{ +\itemize{ +\item \code{abbr_years_cont}: For continuous scales + +\item \code{abbr_years_date}: For date scales +}} + +\examples{ +\dontrun{ +# Default implementation - this will abbreviate all labels except the first +ggplot(transit_ridership \%>\% filter(year >= 2000), + aes(x = year, y = ridership, color = system)) + + geom_line() + + scale_x_continuous(labels = abbr_years_cont) + +# If customizations are desired, the function should be input using the format +# displayed below: \code{function(i) abbr_years_cont(i,full_by_pos = *, +# full_by_year = *)}. + +# This example shows the use of \code{full_by_year} to maintain full labels on +# the first entry (the default) and add a full label to the year 2000, the first +# of the 21st century. +ggplot(transit_ridership, + aes(x = year, y = ridership, color = system)) + + geom_line() + + scale_x_continuous(labels = function(i) abbr_years_cont(i,full_by_year = c(2000))) + +# You can also remove the default maintenance of the first label and only +# specify specific years. +ggplot(grp_over_time, aes(x = year, y = realgrp, color = cluster)) + + geom_line() + + scale_x_continuous(breaks = scales::breaks_pretty(5), + labels = function(i) abbr_years_cont(i,full_by_pos = NULL, + full_by_year = c(2018)) + ) +} +} diff --git a/man/integer_breaks.Rd b/man/integer_breaks.Rd index a0cab96d..c0f8f6e0 100644 --- a/man/integer_breaks.Rd +++ b/man/integer_breaks.Rd @@ -1,14 +1,9 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/cmapplot.R, R/integer_breaks.R +% Please edit documentation in R/integer_breaks.R \name{integer_breaks} \alias{integer_breaks} -\title{A function factory for getting integer x- and y-axis values.} -\source{ -\url{https://joshuacook.netlify.app/post/integer-values-ggplot-axis/} -} +\title{clean up integer axis breaks} \usage{ -integer_breaks(n = 5, ...) - integer_breaks(n = 5, ...) } \arguments{ @@ -17,27 +12,11 @@ integer_breaks(n = 5, ...) \item{...}{other arguments passed on to \code{\link[base]{pretty}}} } \description{ -This function can be supplied as the value for the \code{breaks} argument in -the \code{scale_*_continuous} ggplot elements. It forces labels to be -displayed as integers with even spacing between them, which is particularly -important for time series with years on the X or Y axis. The code was -developed by Joshua Cook. - Where n = desired number of ticks. Function uses \code{floor(pretty())} to generate good breaks for the x or y axis of a ggplot. Borrowed with respect from \url{https://joshuacook.netlify.com/post/integer-values-ggplot-axis/} } \examples{ -# Standard implementation -ggplot(grp_over_time, aes(x = year, y = realgrp, color = cluster)) + - geom_line() + - scale_x_continuous(breaks = integer_breaks()) - -# Adjusted to add a total of 11 intervals -ggplot(grp_over_time, aes(x = year, y = realgrp, color = cluster)) + - geom_line() + - scale_x_continuous(breaks = integer_breaks(n = 11)) - ggplot(data = dplyr::filter(grp_over_time, category == "Goods-Producing"), mapping = aes(x = year, y = realgrp, color = cluster)) + From f9faddadea87338cf100cd5f24b1895df4ef7492 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Wed, 24 Mar 2021 14:04:48 -0500 Subject: [PATCH 024/173] Add date scale examples --- R/axis_handling.R | 32 ++++++++++++++++++++++---------- man/abbr_years_cont.Rd | 31 ++++++++++++++++++++++--------- 2 files changed, 44 insertions(+), 19 deletions(-) diff --git a/R/axis_handling.R b/R/axis_handling.R index ddc051f7..6c4deb60 100644 --- a/R/axis_handling.R +++ b/R/axis_handling.R @@ -6,15 +6,27 @@ #' #'@importFrom stringr str_length #' -#' #'@examples #'\dontrun{ #' # Default implementation - this will abbreviate all labels except the first -#' ggplot(transit_ridership %>% filter(year >= 2000), +#' # for both continuous and date scales, using their respective abbreviation +#' # function. +#' +#' df2 <- dplyr::mutate(transit_ridership,year2 = as.Date(lubridate::date_decimal(year))) +#' +#' df2 <- dplyr::mutate(transit_ridership,year2 = as.Date(lubridate::date_decimal(year))) +#' df1 <- filter(df2,year >= 2000) +#' +#' ggplot(df1, #' aes(x = year, y = ridership, color = system)) + #' geom_line() + #' scale_x_continuous(labels = abbr_years_cont) #' +#' ggplot(df1, +#' aes(x = year2, y = ridership, color = system)) + +#' geom_line() + +#' scale_x_date(labels = abbr_years_date) +#' #' # If customizations are desired, the function should be input using the format #' # displayed below: \code{function(i) abbr_years_cont(i,full_by_pos = *, #' # full_by_year = *)}. @@ -22,20 +34,20 @@ #' # This example shows the use of \code{full_by_year} to maintain full labels on #' # the first entry (the default) and add a full label to the year 2000, the first #' # of the 21st century. -#' ggplot(transit_ridership, -#' aes(x = year, y = ridership, color = system)) + +#' ggplot(df2, +#' aes(x = year2, y = ridership, color = system)) + #' geom_line() + -#' scale_x_continuous(labels = function(i) abbr_years_cont(i,full_by_year = c(2000))) +#' scale_x_date(labels = function(i) abbr_years_date(i,full_by_year = c(2000))) #' #' # You can also remove the default maintenance of the first label and only #' # specify specific years. -#' ggplot(grp_over_time, aes(x = year, y = realgrp, color = cluster)) + +#' ggplot(df2, +#' aes(x = year, y = ridership, color = system)) + #' geom_line() + -#' scale_x_continuous(breaks = scales::breaks_pretty(5), -#' labels = function(i) abbr_years_cont(i,full_by_pos = NULL, -#' full_by_year = c(2018)) -#' ) +#' scale_x_continuous(labels = function(i) abbr_years_cont(i,full_by_pos = NULL, +#' full_by_year = c(1990,2020))) #'} +#' #'@param breaks Vector, the input break values to be abbreviated. This will be #' automatically supplied to the function by setting \code{labels = #' abbr_years_cont} or \code{labels = abbr_years_date} inside the diff --git a/man/abbr_years_cont.Rd b/man/abbr_years_cont.Rd index 0154f0cc..5c7068d2 100644 --- a/man/abbr_years_cont.Rd +++ b/man/abbr_years_cont.Rd @@ -39,11 +39,24 @@ to '08), but not abbreviating any specified breaks. \examples{ \dontrun{ # Default implementation - this will abbreviate all labels except the first -ggplot(transit_ridership \%>\% filter(year >= 2000), +# for both continuous and date scales, using their respective abbreviation +# function. + +df2 <- dplyr::mutate(transit_ridership,year2 = as.Date(lubridate::date_decimal(year))) + +df2 <- dplyr::mutate(transit_ridership,year2 = as.Date(lubridate::date_decimal(year))) +df1 <- filter(df2,year >= 2000) + +ggplot(df1, aes(x = year, y = ridership, color = system)) + geom_line() + scale_x_continuous(labels = abbr_years_cont) +ggplot(df1, + aes(x = year2, y = ridership, color = system)) + + geom_line() + + scale_x_date(labels = abbr_years_date) + # If customizations are desired, the function should be input using the format # displayed below: \code{function(i) abbr_years_cont(i,full_by_pos = *, # full_by_year = *)}. @@ -51,18 +64,18 @@ ggplot(transit_ridership \%>\% filter(year >= 2000), # This example shows the use of \code{full_by_year} to maintain full labels on # the first entry (the default) and add a full label to the year 2000, the first # of the 21st century. -ggplot(transit_ridership, - aes(x = year, y = ridership, color = system)) + +ggplot(df2, + aes(x = year2, y = ridership, color = system)) + geom_line() + - scale_x_continuous(labels = function(i) abbr_years_cont(i,full_by_year = c(2000))) + scale_x_date(labels = function(i) abbr_years_date(i,full_by_year = c(2000))) # You can also remove the default maintenance of the first label and only # specify specific years. -ggplot(grp_over_time, aes(x = year, y = realgrp, color = cluster)) + +ggplot(df2, + aes(x = year, y = ridership, color = system)) + geom_line() + - scale_x_continuous(breaks = scales::breaks_pretty(5), - labels = function(i) abbr_years_cont(i,full_by_pos = NULL, - full_by_year = c(2018)) - ) + scale_x_continuous(labels = function(i) abbr_years_cont(i,full_by_pos = NULL, + full_by_year = c(1990,2020))) } + } From 48952dd543471d005e6bd940c51d98f66a1739cc Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Thu, 1 Apr 2021 08:29:36 -0500 Subject: [PATCH 025/173] Implements function factory Follow's Matt's suggestion. Updates documentation and passes `check`. --- R/axis_handling.R | 119 +++++++++++++++++++++-------------------- man/abbr_years_cont.Rd | 41 ++++++-------- 2 files changed, 77 insertions(+), 83 deletions(-) diff --git a/R/axis_handling.R b/R/axis_handling.R index 6c4deb60..92fcecf0 100644 --- a/R/axis_handling.R +++ b/R/axis_handling.R @@ -2,7 +2,10 @@ #' #'`abbr_years_cont()` and `abbr_years_date()` are helper functions that allow #'users to abbreviate year labels to their two-digit representation (e.g., 2008 -#'to '08), but not abbreviating any specified breaks. +#'to '08), but not abbreviating any specified breaks. They do so by creating a +#'new function that takes the breaks supplied by \code{ggplot} as their only +#'argument. These functions were modeled after the syntax and approach of the +#'labeling functions in the \code{scales::label_*} family. #' #'@importFrom stringr str_length #' @@ -10,49 +13,40 @@ #'\dontrun{ #' # Default implementation - this will abbreviate all labels except the first #' # for both continuous and date scales, using their respective abbreviation -#' # function. +#' # function. Note the syntax - this function actually produces another +#' # function, and so you must include the opening and closing parentheses +#' # following the function's name (i.e., \code{abbr_years_cont()}). #' -#' df2 <- dplyr::mutate(transit_ridership,year2 = as.Date(lubridate::date_decimal(year))) -#' -#' df2 <- dplyr::mutate(transit_ridership,year2 = as.Date(lubridate::date_decimal(year))) +#' df2 <- dplyr::mutate(transit_ridership,year2 = as.Date(paste0(year,"-01-01"))) #' df1 <- filter(df2,year >= 2000) #' #' ggplot(df1, #' aes(x = year, y = ridership, color = system)) + #' geom_line() + -#' scale_x_continuous(labels = abbr_years_cont) +#' scale_x_continuous(labels = abbr_years_cont()) #' #' ggplot(df1, #' aes(x = year2, y = ridership, color = system)) + #' geom_line() + -#' scale_x_date(labels = abbr_years_date) +#' scale_x_date(labels = abbr_years_date()) #' -#' # If customizations are desired, the function should be input using the format -#' # displayed below: \code{function(i) abbr_years_cont(i,full_by_pos = *, -#' # full_by_year = *)}. +#' # If customizations are desired, users can use \code{full_by_pos} and/or +#' # \code{full_by_year} to maintain the full version of the specified labels. #' -#' # This example shows the use of \code{full_by_year} to maintain full labels on -#' # the first entry (the default) and add a full label to the year 2000, the first -#' # of the 21st century. #' ggplot(df2, #' aes(x = year2, y = ridership, color = system)) + #' geom_line() + -#' scale_x_date(labels = function(i) abbr_years_date(i,full_by_year = c(2000))) +#' scale_x_date(labels = abbr_years_date(full_by_year = c(2000))) #' #' # You can also remove the default maintenance of the first label and only #' # specify specific years. #' ggplot(df2, #' aes(x = year, y = ridership, color = system)) + #' geom_line() + -#' scale_x_continuous(labels = function(i) abbr_years_cont(i,full_by_pos = NULL, -#' full_by_year = c(1990,2020))) +#' scale_x_continuous(labels = abbr_years_cont(full_by_pos = NULL, +#' full_by_year = c(1990,2020))) #'} #' -#'@param breaks Vector, the input break values to be abbreviated. This will be -#' automatically supplied to the function by setting \code{labels = -#' abbr_years_cont} or \code{labels = abbr_years_date} inside the -#' \code{scale_*_continuous} argument (for \code{abbr_years_cont()} or inside -#' the \code{scale_*_date} argument (for \code{abbr_years_date}). #'@param full_by_pos Vector of integers, the position of breaks that should not #' be abbreviated. This defaults to \code{c(1)}, which retains the original #' first label and abbreviates subsequent ones. If all breaks should be @@ -62,10 +56,11 @@ #' #'@describeIn abbr_years_cont For continuous scales #'@export -abbr_years_cont <- function(breaks, - full_by_pos = c(1), +abbr_years_cont <- function(full_by_pos = c(1), full_by_year = NULL) { + fxn <- function(breaks) { + # Determine length of each break. Note that when breaks have been modified, # ggplot sometimes adds an additional NA break in the first and last # positions. We check whether this is the case and, if so, remove those for @@ -101,50 +96,56 @@ abbr_years_cont <- function(breaks, return(abbr) } + return(fxn) +} #'@describeIn abbr_years_cont For date scales #' #'@export -abbr_years_date <- function(breaks, - full_by_pos = c(1), +abbr_years_date <- function(full_by_pos = c(1), full_by_year = NULL) { + fxn <- function(breaks) { # Convert given year integers into the number of days since 1970 (note this is - # how the breaks are handled internally by ggplot - they live in the following - # location of a ggplot chart 'a' that has been passed to ggplot_build() - # ggplot_build(a)$layout$panel_params[[1]]$x$breaks - # Note that breaks for the y axis can be accessed similarly. - if (!is.null(full_by_year)) - {full_by_year <- as.numeric(as.Date(paste0(full_by_year,"-01-01")))} - - # Stop if breaks cannot be coerced to a date - tryCatch({as.Date(breaks)}, - warning = function(w){stop("Breaks cannot be coerced to a date. Cannot abbreviate.")}) - - # Abbreviate all values - ggplot appears to correctly use the names of the - # breaks (which are the year values) when performing this operation on the - # breaks. - abbr <- paste0("'",substr(breaks,3,4)) - - # Account for leading NAs (see 'cont' variant for explanation) and increment - # up positions accordingly - leading_na <- which.min(is.na(breaks)) - 1 - if(!is.null(full_by_pos)) {full_by_pos <- full_by_pos + leading_na} - - # Now convert referenced dates into positions, adding them and removing duplicates - if(!is.null(full_by_year)) { - full_by_pos <- sort( - unique( - c(full_by_pos, - match(full_by_year,breaks)))) - } + # how the breaks are handled internally by ggplot - they live in the following + # location of a ggplot chart 'a' that has been passed to ggplot_build() + # ggplot_build(a)$layout$panel_params[[1]]$x$breaks + # Note that breaks for the y axis can be accessed similarly. + if (!is.null(full_by_year)) + {full_by_year <- as.numeric(as.Date(paste0(full_by_year,"-01-01")))} + + # Stop if breaks cannot be coerced to a date + tryCatch({as.Date(breaks)}, + warning = function(w){stop("Breaks cannot be coerced to a date. Cannot abbreviate.")}) + + # Abbreviate all values - ggplot appears to correctly use the names of the + # breaks (which are the year values) when performing this operation on the + # breaks. + abbr <- paste0("'",substr(breaks,3,4)) + + # Account for leading NAs (see 'cont' variant for explanation) and increment + # up positions accordingly + leading_na <- which.min(is.na(breaks)) - 1 + if(!is.null(full_by_pos)) {full_by_pos <- full_by_pos + leading_na} + + # Now convert referenced dates into positions, adding them and removing duplicates + if(!is.null(full_by_year)) { + full_by_pos <- sort( + unique( + c(full_by_pos, + match(full_by_year,breaks)))) + } + + # Add back full years for specified positions + if(!is.null(full_by_pos)) { + # Extract the name of the break in ggplot's named list of numbers, which is + # the 4-digit year + abbr[full_by_pos] <- names(breaks)[full_by_pos] + } - # Add back full years for specified positions - if(!is.null(full_by_pos)) { - # Extract the name of the break in ggplot's named list of numbers, which is - # the 4-digit year - abbr[full_by_pos] <- names(breaks)[full_by_pos] + return(abbr) } - return(abbr) + return(fxn) } + diff --git a/man/abbr_years_cont.Rd b/man/abbr_years_cont.Rd index 5c7068d2..f509be46 100644 --- a/man/abbr_years_cont.Rd +++ b/man/abbr_years_cont.Rd @@ -5,17 +5,11 @@ \alias{abbr_years_date} \title{Axis handling helper functions} \usage{ -abbr_years_cont(breaks, full_by_pos = c(1), full_by_year = NULL) +abbr_years_cont(full_by_pos = c(1), full_by_year = NULL) -abbr_years_date(breaks, full_by_pos = c(1), full_by_year = NULL) +abbr_years_date(full_by_pos = c(1), full_by_year = NULL) } \arguments{ -\item{breaks}{Vector, the input break values to be abbreviated. This will be -automatically supplied to the function by setting \code{labels = -abbr_years_cont} or \code{labels = abbr_years_date} inside the -\code{scale_*_continuous} argument (for \code{abbr_years_cont()} or inside -the \code{scale_*_date} argument (for \code{abbr_years_date}).} - \item{full_by_pos}{Vector of integers, the position of breaks that should not be abbreviated. This defaults to \code{c(1)}, which retains the original first label and abbreviates subsequent ones. If all breaks should be @@ -27,7 +21,10 @@ abbreviated. Defaults to NULL.} \description{ `abbr_years_cont()` and `abbr_years_date()` are helper functions that allow users to abbreviate year labels to their two-digit representation (e.g., 2008 -to '08), but not abbreviating any specified breaks. +to '08), but not abbreviating any specified breaks. They do so by creating a +new function that takes the breaks supplied by \code{ggplot} as their only +argument. These functions were modeled after the syntax and approach of the +labeling functions in the \code{scales::label_*} family. } \section{Functions}{ \itemize{ @@ -40,42 +37,38 @@ to '08), but not abbreviating any specified breaks. \dontrun{ # Default implementation - this will abbreviate all labels except the first # for both continuous and date scales, using their respective abbreviation -# function. - -df2 <- dplyr::mutate(transit_ridership,year2 = as.Date(lubridate::date_decimal(year))) +# function. Note the syntax - this function actually produces another +# function, and so you must include the opening and closing parentheses +# following the function's name (i.e., \code{abbr_years_cont()}). -df2 <- dplyr::mutate(transit_ridership,year2 = as.Date(lubridate::date_decimal(year))) +df2 <- dplyr::mutate(transit_ridership,year2 = as.Date(paste0(year,"-01-01"))) df1 <- filter(df2,year >= 2000) ggplot(df1, aes(x = year, y = ridership, color = system)) + geom_line() + - scale_x_continuous(labels = abbr_years_cont) + scale_x_continuous(labels = abbr_years_cont()) ggplot(df1, aes(x = year2, y = ridership, color = system)) + geom_line() + - scale_x_date(labels = abbr_years_date) + scale_x_date(labels = abbr_years_date()) -# If customizations are desired, the function should be input using the format -# displayed below: \code{function(i) abbr_years_cont(i,full_by_pos = *, -# full_by_year = *)}. +# If customizations are desired, users can use \code{full_by_pos} and/or +# \code{full_by_year} to maintain the full version of the specified labels. -# This example shows the use of \code{full_by_year} to maintain full labels on -# the first entry (the default) and add a full label to the year 2000, the first -# of the 21st century. ggplot(df2, aes(x = year2, y = ridership, color = system)) + geom_line() + - scale_x_date(labels = function(i) abbr_years_date(i,full_by_year = c(2000))) + scale_x_date(labels = abbr_years_date(full_by_year = c(2000))) # You can also remove the default maintenance of the first label and only # specify specific years. ggplot(df2, aes(x = year, y = ridership, color = system)) + geom_line() + - scale_x_continuous(labels = function(i) abbr_years_cont(i,full_by_pos = NULL, - full_by_year = c(1990,2020))) + scale_x_continuous(labels = abbr_years_cont(full_by_pos = NULL, + full_by_year = c(1990,2020))) } } From 8b4a879a05127da7f2648d0e298f57c9d9195a86 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Thu, 1 Apr 2021 16:57:14 -0500 Subject: [PATCH 026/173] Consolidates functions Addresses some (not all) of Matt's comments --- NAMESPACE | 3 +- R/axis_handling.R | 131 +++++++++------------- man/{abbr_years_cont.Rd => abbr_years.Rd} | 45 ++++---- 3 files changed, 74 insertions(+), 105 deletions(-) rename man/{abbr_years_cont.Rd => abbr_years.Rd} (57%) diff --git a/NAMESPACE b/NAMESPACE index 155adbd3..d6cfd7fa 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,8 +5,7 @@ export(GeomPointLast) export(GeomRecessions) export(GeomRecessionsText) export(GeomTextLast) -export(abbr_years_cont) -export(abbr_years_date) +export(abbr_years) export(apply_cmap_default_aes) export(cmap_color_continuous) export(cmap_color_discrete) diff --git a/R/axis_handling.R b/R/axis_handling.R index 92fcecf0..0c71e64c 100644 --- a/R/axis_handling.R +++ b/R/axis_handling.R @@ -1,11 +1,11 @@ #'Axis handling helper functions #' -#'`abbr_years_cont()` and `abbr_years_date()` are helper functions that allow -#'users to abbreviate year labels to their two-digit representation (e.g., 2008 -#'to '08), but not abbreviating any specified breaks. They do so by creating a -#'new function that takes the breaks supplied by \code{ggplot} as their only -#'argument. These functions were modeled after the syntax and approach of the -#'labeling functions in the \code{scales::label_*} family. +#'`abbr_years()` is a helper functions that allows users to abbreviate year +#'labels to their two-digit representation (e.g., 2008 to '08), but not +#'abbreviating any specified breaks. It does so by creating a new function that +#'takes the breaks supplied by \code{ggplot} as its only argument. The +#'function was modeled after the syntax and approach of the labeling functions +#'in the \code{scales::label_*} family. #' #'@importFrom stringr str_length #' @@ -15,7 +15,7 @@ #' # for both continuous and date scales, using their respective abbreviation #' # function. Note the syntax - this function actually produces another #' # function, and so you must include the opening and closing parentheses -#' # following the function's name (i.e., \code{abbr_years_cont()}). +#' # following the function's name (i.e., \code{abbr_year()}). #' #' df2 <- dplyr::mutate(transit_ridership,year2 = as.Date(paste0(year,"-01-01"))) #' df1 <- filter(df2,year >= 2000) @@ -23,12 +23,12 @@ #' ggplot(df1, #' aes(x = year, y = ridership, color = system)) + #' geom_line() + -#' scale_x_continuous(labels = abbr_years_cont()) +#' scale_x_continuous(labels = abbr_years()) #' #' ggplot(df1, #' aes(x = year2, y = ridership, color = system)) + #' geom_line() + -#' scale_x_date(labels = abbr_years_date()) +#' scale_x_date(labels = abbr_years(dateaxis = TRUE)) #' #' # If customizations are desired, users can use \code{full_by_pos} and/or #' # \code{full_by_year} to maintain the full version of the specified labels. @@ -36,15 +36,15 @@ #' ggplot(df2, #' aes(x = year2, y = ridership, color = system)) + #' geom_line() + -#' scale_x_date(labels = abbr_years_date(full_by_year = c(2000))) +#' scale_x_date(labels = abbr_years(full_by_year = c(2000), dateaxis = TRUE)) #' #' # You can also remove the default maintenance of the first label and only #' # specify specific years. #' ggplot(df2, #' aes(x = year, y = ridership, color = system)) + #' geom_line() + -#' scale_x_continuous(labels = abbr_years_cont(full_by_pos = NULL, -#' full_by_year = c(1990,2020))) +#' scale_x_continuous(labels = abbr_years(full_by_pos = NULL, +#' full_by_year = c(1990,2020))) #'} #' #'@param full_by_pos Vector of integers, the position of breaks that should not @@ -53,94 +53,70 @@ #' abbreviated, this can be set to NULL. #'@param full_by_year Vector of integers, the value of breaks that should not be #' abbreviated. Defaults to NULL. +#'@param dateaxis Bool. \code{FALSE}, the default, directs the function to treat +#' the breaks as integers. If set to \code{TRUE} the function will instead +#' treat the breaks as date objects. \code{TRUE} should be used when called +#' within a \code{scale_*_date} ggplot element. #' -#'@describeIn abbr_years_cont For continuous scales #'@export -abbr_years_cont <- function(full_by_pos = c(1), - full_by_year = NULL) { +abbr_years <- function(full_by_pos = c(1), + full_by_year = NULL, + dateaxis = FALSE) { fxn <- function(breaks) { - # Determine length of each break. Note that when breaks have been modified, - # ggplot sometimes adds an additional NA break in the first and last - # positions. We check whether this is the case and, if so, remove those for - # testing purposes. - lengths <- stringr::str_length(as.integer(breaks[which(!is.na(breaks))])) + # For integer breaks, determine length of each break. Note that when breaks + # have been modified, ggplot sometimes adds an additional NA break in the + # first and last positions. We check whether this is the case and, if so, + # remove those for testing purposes. + if (!dateaxis) { + actual_breaks <- breaks[which(!is.na(breaks))] - # # Stop if the breaks are not in a four-digit format. - # if (!(min(lengths == 4) & max(lengths == 4))) { - # stop("Breaks are not in a four-digit format. Cannot abbreviate.") - # } + lengths <- stringr::str_length(as.integer(actual_breaks)) - # # Stop if breaks cannot be coerced to a number - # tryCatch({as.integer(breaks)}, - # warning = function(w){stop("Breaks cannot be coerced to a year. Cannot abbreviate.")}) + # # Stop if the breaks are not in a four-digit format. + if (!(min(lengths == 4) & max(lengths == 4))) { + stop("Breaks are not in a four-digit format. Cannot abbreviate.") + } - # Abbreviate all values - abbr <- paste0("'",substr(breaks,3,4)) - - # Account for leading NAs and increment up positions accordingly - leading_na <- which.min(is.na(breaks)) - 1 - full_by_pos <- full_by_pos + leading_na - - # Now convert referenced dates into positions - if(!is.null(full_by_year)) { - full_by_pos <- sort(unique(c(full_by_pos,match(full_by_year,breaks)))) + # # Stop if breaks cannot be coerced to a number + tryCatch({as.integer(actual_breaks)}, + warning = function(w){stop("Breaks cannot be coerced to a year. Cannot abbreviate.")}) } - # Add back full years for specified positions - if(!is.null(full_by_pos)) { - abbr[full_by_pos] <- breaks[full_by_pos] - } - - return(abbr) - } - - return(fxn) -} - -#'@describeIn abbr_years_cont For date scales -#' -#'@export -abbr_years_date <- function(full_by_pos = c(1), - full_by_year = NULL) { - fxn <- function(breaks) { - - # Convert given year integers into the number of days since 1970 (note this is - # how the breaks are handled internally by ggplot - they live in the following - # location of a ggplot chart 'a' that has been passed to ggplot_build() - # ggplot_build(a)$layout$panel_params[[1]]$x$breaks - # Note that breaks for the y axis can be accessed similarly. - if (!is.null(full_by_year)) + # If a date axis, convert given year integers into the number of days since + # 1970 (note this is how the breaks are handled internally by ggplot - they + # live in the following location of a ggplot chart 'a' that has been passed + # to ggplot_build() ggplot_build(a)$layout$panel_params[[1]]$x$breaks Note + # that breaks for the y axis can be accessed similarly. + if (dateaxis) { + if (!is.null(full_by_year)) {full_by_year <- as.numeric(as.Date(paste0(full_by_year,"-01-01")))} + } - # Stop if breaks cannot be coerced to a date - tryCatch({as.Date(breaks)}, - warning = function(w){stop("Breaks cannot be coerced to a date. Cannot abbreviate.")}) - - # Abbreviate all values - ggplot appears to correctly use the names of the - # breaks (which are the year values) when performing this operation on the - # breaks. + # Abbreviate all values abbr <- paste0("'",substr(breaks,3,4)) - # Account for leading NAs (see 'cont' variant for explanation) and increment - # up positions accordingly + # Account for leading NAs and increment up positions accordingly leading_na <- which.min(is.na(breaks)) - 1 if(!is.null(full_by_pos)) {full_by_pos <- full_by_pos + leading_na} - # Now convert referenced dates into positions, adding them and removing duplicates + # Now convert referenced dates into positions if(!is.null(full_by_year)) { - full_by_pos <- sort( - unique( - c(full_by_pos, - match(full_by_year,breaks)))) + full_by_pos <- sort(unique(c(full_by_pos,match(full_by_year,breaks)))) } # Add back full years for specified positions if(!is.null(full_by_pos)) { - # Extract the name of the break in ggplot's named list of numbers, which is - # the 4-digit year + # If the date axis, extract the name of the break in ggplot's named list + # of numbers, which is the 4-digit year + if (dateaxis) { abbr[full_by_pos] <- names(breaks)[full_by_pos] + } + # Otherwise, use the normal breaks + else { + abbr[full_by_pos] <- breaks[full_by_pos] + } } return(abbr) @@ -148,4 +124,3 @@ abbr_years_date <- function(full_by_pos = c(1), return(fxn) } - diff --git a/man/abbr_years_cont.Rd b/man/abbr_years.Rd similarity index 57% rename from man/abbr_years_cont.Rd rename to man/abbr_years.Rd index f509be46..3b334518 100644 --- a/man/abbr_years_cont.Rd +++ b/man/abbr_years.Rd @@ -1,13 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/axis_handling.R -\name{abbr_years_cont} -\alias{abbr_years_cont} -\alias{abbr_years_date} +\name{abbr_years} +\alias{abbr_years} \title{Axis handling helper functions} \usage{ -abbr_years_cont(full_by_pos = c(1), full_by_year = NULL) - -abbr_years_date(full_by_pos = c(1), full_by_year = NULL) +abbr_years(full_by_pos = c(1), full_by_year = NULL, dateaxis = FALSE) } \arguments{ \item{full_by_pos}{Vector of integers, the position of breaks that should not @@ -17,29 +14,27 @@ abbreviated, this can be set to NULL.} \item{full_by_year}{Vector of integers, the value of breaks that should not be abbreviated. Defaults to NULL.} + +\item{dateaxis}{Bool. \code{FALSE}, the default, directs the function to treat +the breaks as integers. If set to \code{TRUE} the function will instead +treat the breaks as date objects. \code{TRUE} should be used when called +within a \code{scale_*_date} ggplot element.} } \description{ -`abbr_years_cont()` and `abbr_years_date()` are helper functions that allow -users to abbreviate year labels to their two-digit representation (e.g., 2008 -to '08), but not abbreviating any specified breaks. They do so by creating a -new function that takes the breaks supplied by \code{ggplot} as their only -argument. These functions were modeled after the syntax and approach of the -labeling functions in the \code{scales::label_*} family. +`abbr_years()` is a helper functions that allows users to abbreviate year +labels to their two-digit representation (e.g., 2008 to '08), but not +abbreviating any specified breaks. It does so by creating a new function that +takes the breaks supplied by \code{ggplot} as its only argument. The +function was modeled after the syntax and approach of the labeling functions +in the \code{scales::label_*} family. } -\section{Functions}{ -\itemize{ -\item \code{abbr_years_cont}: For continuous scales - -\item \code{abbr_years_date}: For date scales -}} - \examples{ \dontrun{ # Default implementation - this will abbreviate all labels except the first # for both continuous and date scales, using their respective abbreviation # function. Note the syntax - this function actually produces another # function, and so you must include the opening and closing parentheses -# following the function's name (i.e., \code{abbr_years_cont()}). +# following the function's name (i.e., \code{abbr_year()}). df2 <- dplyr::mutate(transit_ridership,year2 = as.Date(paste0(year,"-01-01"))) df1 <- filter(df2,year >= 2000) @@ -47,12 +42,12 @@ df1 <- filter(df2,year >= 2000) ggplot(df1, aes(x = year, y = ridership, color = system)) + geom_line() + - scale_x_continuous(labels = abbr_years_cont()) + scale_x_continuous(labels = abbr_years()) ggplot(df1, aes(x = year2, y = ridership, color = system)) + geom_line() + - scale_x_date(labels = abbr_years_date()) + scale_x_date(labels = abbr_years(dateaxis = TRUE)) # If customizations are desired, users can use \code{full_by_pos} and/or # \code{full_by_year} to maintain the full version of the specified labels. @@ -60,15 +55,15 @@ ggplot(df1, ggplot(df2, aes(x = year2, y = ridership, color = system)) + geom_line() + - scale_x_date(labels = abbr_years_date(full_by_year = c(2000))) + scale_x_date(labels = abbr_years(full_by_year = c(2000), dateaxis = TRUE)) # You can also remove the default maintenance of the first label and only # specify specific years. ggplot(df2, aes(x = year, y = ridership, color = system)) + geom_line() + - scale_x_continuous(labels = abbr_years_cont(full_by_pos = NULL, - full_by_year = c(1990,2020))) + scale_x_continuous(labels = abbr_years(full_by_pos = NULL, + full_by_year = c(1990,2020))) } } From 1c1a488476c31e10b9e3681f8ded3c7d73e9d19b Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Fri, 2 Apr 2021 16:22:30 -0500 Subject: [PATCH 027/173] some improved functionality --- NAMESPACE | 3 ++ R/axis_handling.R | 72 ++++++++++++++++++++++------------------------- man/abbr_years.Rd | 2 +- 3 files changed, 37 insertions(+), 40 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index d6cfd7fa..fd4ab267 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -45,7 +45,10 @@ importFrom(ggpubr,get_legend) importFrom(glue,glue) importFrom(glue,glue_collapse) importFrom(gridExtra,arrangeGrob) +importFrom(lubridate,day) importFrom(lubridate,decimal_date) +importFrom(lubridate,month) +importFrom(lubridate,year) importFrom(purrr,compact) importFrom(purrr,map) importFrom(purrr,walk2) diff --git a/R/axis_handling.R b/R/axis_handling.R index 0c71e64c..b3284e1f 100644 --- a/R/axis_handling.R +++ b/R/axis_handling.R @@ -3,11 +3,12 @@ #'`abbr_years()` is a helper functions that allows users to abbreviate year #'labels to their two-digit representation (e.g., 2008 to '08), but not #'abbreviating any specified breaks. It does so by creating a new function that -#'takes the breaks supplied by \code{ggplot} as its only argument. The +#'takes the breaks supplied by \code{ggplot2} as its only argument. The #'function was modeled after the syntax and approach of the labeling functions #'in the \code{scales::label_*} family. #' #'@importFrom stringr str_length +#'@importFrom lubridate year month day #' #'@examples #'\dontrun{ @@ -65,59 +66,52 @@ abbr_years <- function(full_by_pos = c(1), fxn <- function(breaks) { - # For integer breaks, determine length of each break. Note that when breaks - # have been modified, ggplot sometimes adds an additional NA break in the - # first and last positions. We check whether this is the case and, if so, - # remove those for testing purposes. - if (!dateaxis) { - actual_breaks <- breaks[which(!is.na(breaks))] - - lengths <- stringr::str_length(as.integer(actual_breaks)) + # If a date axis, breaks are stored as number of days since 1/1/1970. These + # must be converted to integer years, but this should error if all breaks + # don't fall on the same calendar day of a distinct year. + if (dateaxis) { + dates <- as.Date(breaks, origin = "1970-01-01") - # # Stop if the breaks are not in a four-digit format. - if (!(min(lengths == 4) & max(lengths == 4))) { - stop("Breaks are not in a four-digit format. Cannot abbreviate.") - } + if (length(unique(month(stats::na.omit(dates)))) != 1 | + length(unique(day(stats::na.omit(dates)))) != 1) { + message(paste( + paste("Currently, breaks are:", paste(dates[!is.na(dates)], collapse = ", ")), + "This function only works if all breaks are on identical calendar days.", + sep = "\n") + ) + stop("Breaks cannot be abbreviated.", call. = FALSE) + } - # # Stop if breaks cannot be coerced to a number - tryCatch({as.integer(actual_breaks)}, - warning = function(w){stop("Breaks cannot be coerced to a year. Cannot abbreviate.")}) + breaks <- lubridate::year(dates) } - # If a date axis, convert given year integers into the number of days since - # 1970 (note this is how the breaks are handled internally by ggplot - they - # live in the following location of a ggplot chart 'a' that has been passed - # to ggplot_build() ggplot_build(a)$layout$panel_params[[1]]$x$breaks Note - # that breaks for the y axis can be accessed similarly. - if (dateaxis) { - if (!is.null(full_by_year)) - {full_by_year <- as.numeric(as.Date(paste0(full_by_year,"-01-01")))} - } + # Stop if the breaks are not in a four-digit format. + if (!all(stringr::str_length(breaks) == 4, na.rm = TRUE)) { + message(paste( + paste("Currently, breaks are:", paste(breaks[!is.na(breaks)], collapse = ", ")), + "Remove any breaks that contain decimals. Consider `breaks = scales::pretty_breaks()`", + "If the axis is in date format, use `abbr_years(dateaxis = TRUE)`.", + sep = "\n") + ) + stop("Breaks cannot be abbreviated.", call. = FALSE) + } # Abbreviate all values abbr <- paste0("'",substr(breaks,3,4)) - # Account for leading NAs and increment up positions accordingly + # If there is a leading NA, increment up positions accordingly leading_na <- which.min(is.na(breaks)) - 1 - if(!is.null(full_by_pos)) {full_by_pos <- full_by_pos + leading_na} + if(!is.null(full_by_pos)) { + full_by_pos <- full_by_pos + leading_na + } - # Now convert referenced dates into positions + # Convert specified years into positions if(!is.null(full_by_year)) { full_by_pos <- sort(unique(c(full_by_pos,match(full_by_year,breaks)))) } # Add back full years for specified positions - if(!is.null(full_by_pos)) { - # If the date axis, extract the name of the break in ggplot's named list - # of numbers, which is the 4-digit year - if (dateaxis) { - abbr[full_by_pos] <- names(breaks)[full_by_pos] - } - # Otherwise, use the normal breaks - else { - abbr[full_by_pos] <- breaks[full_by_pos] - } - } + abbr[full_by_pos] <- breaks[full_by_pos] return(abbr) } diff --git a/man/abbr_years.Rd b/man/abbr_years.Rd index 3b334518..3cfb3498 100644 --- a/man/abbr_years.Rd +++ b/man/abbr_years.Rd @@ -24,7 +24,7 @@ within a \code{scale_*_date} ggplot element.} `abbr_years()` is a helper functions that allows users to abbreviate year labels to their two-digit representation (e.g., 2008 to '08), but not abbreviating any specified breaks. It does so by creating a new function that -takes the breaks supplied by \code{ggplot} as its only argument. The +takes the breaks supplied by \code{ggplot2} as its only argument. The function was modeled after the syntax and approach of the labeling functions in the \code{scales::label_*} family. } From 2637972eedd3f9b9c20b3c83c75104274a2cd01e Mon Sep 17 00:00:00 2001 From: Matthew Stern <54633946+tallishmatt@users.noreply.github.com> Date: Fri, 2 Apr 2021 16:49:09 -0500 Subject: [PATCH 028/173] clean up - remove `integer_breaks` function. This is old, hardly works, and is really unnecessary. - adjusted pkgdown.yml - made abbr_year examples testable, removed `\dontrun{}` tags --- NAMESPACE | 1 - R/axis_handling.R | 18 ++++++++++-------- R/integer_breaks.R | 29 ----------------------------- man/abbr_years.Rd | 18 ++++++++++-------- man/integer_breaks.Rd | 27 --------------------------- pkgdown/_pkgdown.yml | 2 +- 6 files changed, 21 insertions(+), 74 deletions(-) delete mode 100644 R/integer_breaks.R delete mode 100644 man/integer_breaks.Rd diff --git a/NAMESPACE b/NAMESPACE index fd4ab267..3dc55747 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -26,7 +26,6 @@ export(finalize_plot) export(geom_recessions) export(geom_text_lastonly) export(gg_lwd_convert) -export(integer_breaks) export(theme_cmap) export(unapply_cmap_default_aes) export(update_recessions) diff --git a/R/axis_handling.R b/R/axis_handling.R index b3284e1f..625271f5 100644 --- a/R/axis_handling.R +++ b/R/axis_handling.R @@ -11,15 +11,17 @@ #'@importFrom lubridate year month day #' #'@examples -#'\dontrun{ +#' +#'# basic functionality +#'abbr_years()(c(2010:2020)) +#'abbr_years(full_by_year = 2000)(c(1990:2010)) +#' +#' #' # Default implementation - this will abbreviate all labels except the first -#' # for both continuous and date scales, using their respective abbreviation -#' # function. Note the syntax - this function actually produces another -#' # function, and so you must include the opening and closing parentheses -#' # following the function's name (i.e., \code{abbr_year()}). +#' # for both continuous and date scales. #' -#' df2 <- dplyr::mutate(transit_ridership,year2 = as.Date(paste0(year,"-01-01"))) -#' df1 <- filter(df2,year >= 2000) +#' df2 <- dplyr::mutate(transit_ridership, year2 = as.Date(lubridate::date_decimal(year))) +#' df1 <- dplyr::filter(df2, year >= 2000) #' #' ggplot(df1, #' aes(x = year, y = ridership, color = system)) + @@ -46,7 +48,7 @@ #' geom_line() + #' scale_x_continuous(labels = abbr_years(full_by_pos = NULL, #' full_by_year = c(1990,2020))) -#'} +#' #' #'@param full_by_pos Vector of integers, the position of breaks that should not #' be abbreviated. This defaults to \code{c(1)}, which retains the original diff --git a/R/integer_breaks.R b/R/integer_breaks.R deleted file mode 100644 index 0dbe5c76..00000000 --- a/R/integer_breaks.R +++ /dev/null @@ -1,29 +0,0 @@ -#' clean up integer axis breaks -#' -#' Where n = desired number of ticks. Function uses \code{floor(pretty())} to -#' generate good breaks for the x or y axis of a ggplot. Borrowed with respect -#' from \url{https://joshuacook.netlify.com/post/integer-values-ggplot-axis/} -#' -#' @param n Numeric, desired number of breaks. -#' @param ... other arguments passed on to \code{\link[base]{pretty}} -#' -#' @examples -#' -#' ggplot(data = dplyr::filter(grp_over_time, category == "Goods-Producing"), -#' mapping = aes(x = year, y = realgrp, color = cluster)) + -#' geom_line() + -#' scale_x_continuous("Year", breaks = integer_breaks(n = 4)) + -#' theme_minimal() -#' -#' @export -integer_breaks <- function(n = 5, ...) { - fxn <- function(x) { - breaks <- floor(pretty(x, n, ...)) - names(breaks) <- attr(breaks, "labels") - breaks - } - return(fxn) -} - - - diff --git a/man/abbr_years.Rd b/man/abbr_years.Rd index 3cfb3498..129e989e 100644 --- a/man/abbr_years.Rd +++ b/man/abbr_years.Rd @@ -29,15 +29,17 @@ function was modeled after the syntax and approach of the labeling functions in the \code{scales::label_*} family. } \examples{ -\dontrun{ + +# basic functionality +abbr_years()(c(2010:2020)) +abbr_years(full_by_year = 2000)(c(1990:2010)) + + # Default implementation - this will abbreviate all labels except the first -# for both continuous and date scales, using their respective abbreviation -# function. Note the syntax - this function actually produces another -# function, and so you must include the opening and closing parentheses -# following the function's name (i.e., \code{abbr_year()}). +# for both continuous and date scales. -df2 <- dplyr::mutate(transit_ridership,year2 = as.Date(paste0(year,"-01-01"))) -df1 <- filter(df2,year >= 2000) +df2 <- dplyr::mutate(transit_ridership, year2 = as.Date(lubridate::date_decimal(year))) +df1 <- dplyr::filter(df2, year >= 2000) ggplot(df1, aes(x = year, y = ridership, color = system)) + @@ -64,6 +66,6 @@ ggplot(df2, geom_line() + scale_x_continuous(labels = abbr_years(full_by_pos = NULL, full_by_year = c(1990,2020))) -} + } diff --git a/man/integer_breaks.Rd b/man/integer_breaks.Rd deleted file mode 100644 index c0f8f6e0..00000000 --- a/man/integer_breaks.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/integer_breaks.R -\name{integer_breaks} -\alias{integer_breaks} -\title{clean up integer axis breaks} -\usage{ -integer_breaks(n = 5, ...) -} -\arguments{ -\item{n}{Numeric, desired number of breaks.} - -\item{...}{other arguments passed on to \code{\link[base]{pretty}}} -} -\description{ -Where n = desired number of ticks. Function uses \code{floor(pretty())} to -generate good breaks for the x or y axis of a ggplot. Borrowed with respect -from \url{https://joshuacook.netlify.com/post/integer-values-ggplot-axis/} -} -\examples{ - -ggplot(data = dplyr::filter(grp_over_time, category == "Goods-Producing"), -mapping = aes(x = year, y = realgrp, color = cluster)) + - geom_line() + - scale_x_continuous("Year", breaks = integer_breaks(n = 4)) + - theme_minimal() - -} diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index 19d5dae9..4ca43e07 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -23,7 +23,7 @@ reference: - contents: - starts_with("geom_") - cmap_default_aes - - integer_breaks + - abbr_years - title: Color Palettes and Gradients - contents: - starts_with("viz_") From 008c459b4b89239f15c25274ce038c630d50f3cc Mon Sep 17 00:00:00 2001 From: Matthew Stern <54633946+tallishmatt@users.noreply.github.com> Date: Fri, 2 Apr 2021 16:49:24 -0500 Subject: [PATCH 029/173] one more thing --- NAMESPACE | 1 + R/axis_handling.R | 1 + 2 files changed, 2 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 3dc55747..4cead533 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -51,6 +51,7 @@ importFrom(lubridate,year) importFrom(purrr,compact) importFrom(purrr,map) importFrom(purrr,walk2) +importFrom(stats,na.omit) importFrom(stringr,str_length) importFrom(stringr,str_replace) importFrom(stringr,str_trunc) diff --git a/R/axis_handling.R b/R/axis_handling.R index 625271f5..2db5185f 100644 --- a/R/axis_handling.R +++ b/R/axis_handling.R @@ -9,6 +9,7 @@ #' #'@importFrom stringr str_length #'@importFrom lubridate year month day +#'@importFrom stats na.omit #' #'@examples #' From 904f5416d96561ff6befbf0ef111369593ccc0ed Mon Sep 17 00:00:00 2001 From: sarahcmap Date: Fri, 2 Apr 2021 20:04:11 -0500 Subject: [PATCH 030/173] - add ragg to imports - remove bmp as save type option - change to ragg for raster export - change to svglite for svg export --- DESCRIPTION | 1 + NAMESPACE | 1 + R/cmapplot.R | 2 +- R/finalize_plot.R | 19 ++++++++----------- man/finalize_plot.Rd | 2 +- 5 files changed, 12 insertions(+), 13 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 076b3a84..0c784114 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -48,6 +48,7 @@ Imports: lubridate, magrittr, purrr, + ragg, rlang, scales, stringr, diff --git a/NAMESPACE b/NAMESPACE index cf49d899..90bb72b3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -37,6 +37,7 @@ import(grDevices) import(graphics) import(grid) import(gridtext) +import(ragg) import(rlang) import(scales) importFrom(generics,intersect) diff --git a/R/cmapplot.R b/R/cmapplot.R index 01090bc0..fbf68c3d 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -11,7 +11,7 @@ #' #' @name cmapplot #' @docType package -#' @import ggplot2 dplyr grid scales grDevices graphics rlang gridtext +#' @import ggplot2 dplyr grid scales grDevices graphics ragg rlang gridtext #' @importFrom glue glue glue_collapse #' @importFrom sysfonts font_files #' @keywords internal diff --git a/R/finalize_plot.R b/R/finalize_plot.R index 44beb857..b2ae0c68 100644 --- a/R/finalize_plot.R +++ b/R/finalize_plot.R @@ -30,7 +30,7 @@ #'@param mode Vector, the action(s) to be taken with the plot. View in R with #' \code{plot}, the default, or \code{window} (\code{window} only works on #' computers running Windows). Save using any of the following: \code{png}, -#' \code{tiff}, \code{jpeg}, \code{bmp}, \code{svg}, \code{pdf}, \code{ps}. Run +#' \code{tiff}, \code{jpeg}, \code{svg}, \code{pdf}, \code{ps}. Run #' multiple simultaneous outputs with a vector, e.g. \code{c("plot", "png", #' "pdf")}. #'@param filename Char, the file path and name you want the plot to be saved to. @@ -204,7 +204,7 @@ finalize_plot <- function(plot = NULL, } # Check mode argument - savetypes_raster <- c("png", "tiff", "jpeg", "bmp") + savetypes_raster <- c("png", "tiff", "jpeg") savetypes_vector <- c("svg", "ps", "pdf") savetypes_print <- c("plot", "window") @@ -473,7 +473,6 @@ finalize_plot <- function(plot = NULL, # Construct arglist for drawing device arglist <- list(filename = filename, - type = "cairo", width = width, height = height, units = "in", @@ -695,20 +694,18 @@ save_plot <- function(finished_graphic, # Add required cairo prefix to function name for pdf and ps (see `?cairo`) mode <- ifelse (mode == "pdf" | mode == "ps", paste0("cairo_" , mode), mode) + # Add required agg prefix to function name for raster modes + mode <- ifelse (mode %in% savetypes_raster, paste0("agg_" , mode), mode) + + # change svg to svglite + mode <- ifelse (mode == "svg", "svglite", mode) + # If file exists and overwrite == FALSE, do not write if (file.exists(arglist$filename) & !overwrite) { message(paste0(fname, ": SKIPPED (try `overwrite = TRUE`?)")) return() } - # prepare the arglist for svg - if (mode == 'svglite') { - - arglist$file <- arglist$filename - arglist$filename <- NULL; - - } - # Write to device ----------------------------------------------- tryCatch( { diff --git a/man/finalize_plot.Rd b/man/finalize_plot.Rd index 4eea1e89..dc18ebe3 100644 --- a/man/finalize_plot.Rd +++ b/man/finalize_plot.Rd @@ -56,7 +56,7 @@ plot, 0 aligns left and 1 aligns right. 0.5 aligns center.} \item{mode}{Vector, the action(s) to be taken with the plot. View in R with \code{plot}, the default, or \code{window} (\code{window} only works on computers running Windows). Save using any of the following: \code{png}, -\code{tiff}, \code{jpeg}, \code{bmp}, \code{svg}, \code{pdf}, \code{ps}. Run +\code{tiff}, \code{jpeg}, \code{svg}, \code{pdf}, \code{ps}. Run multiple simultaneous outputs with a vector, e.g. \code{c("plot", "png", "pdf")}.} From ee9066627b22d77765c780e9b821c50f52a1c8b4 Mon Sep 17 00:00:00 2001 From: Matthew Stern <54633946+tallishmatt@users.noreply.github.com> Date: Fri, 2 Apr 2021 22:35:07 -0500 Subject: [PATCH 031/173] set up env and font registry `cmapplot_global` env initializes with "sans" (e.g. Arial) as default font. .onLoad uses systemfonts pkg to register Whitney if available and overwrite fonts as Whitney instead. the `display_cmap_fonts()` test function is updated to call on the new `cmapplot_global` env rather than the `cmapplot_globals` list. --- R/cmapplot.R | 184 ++++++++++++++++++++++++++++++++------------------- 1 file changed, 115 insertions(+), 69 deletions(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index 01090bc0..a17d66e9 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -17,6 +17,26 @@ #' @keywords internal "_PACKAGE" + +# establish location for cmapplot global variables +cmapplot_global <- new.env(parent = emptyenv()) + +# set up default font handling +# (overridden if local machine has Whitney in .onLoad) +cmapplot_global$use_whitney <- FALSE +cmapplot_global$font <- list( + strong = list(family = "sans", face = "bold"), + regular = list(family = "sans", face = "plain"), + light = list(family = "sans", face = "plain")) + +# establish font sizes +cmapplot_global$fsize <- list( + S = 11, + M = 14, + L = 17 +) + + #'cmapplot global variables #' #'A list of predefined variables for use by the cmapplot package and its users. @@ -134,78 +154,104 @@ cmapplot_globals <- list( ## Update fonts based on system -- *must* be done with .onLoad() +#' @import systemfonts .onLoad <- function(...) { - # Check for Whitney - all_fonts <- sysfonts::font_files() - whitney_fonts <- all_fonts[all_fonts$family %in% c("Whitney Medium", "Whitney Book", "Whitney Semibold") & all_fonts$face=="Regular", ] - cmapplot_globals$use_whitney <<- length(whitney_fonts$family) >= 3 - - # Font handling for Windows users - if (.Platform$OS.type == "windows") { - - # Use Whitney if available - if (cmapplot_globals$use_whitney) { - # Add fonts to R - grDevices::windowsFonts( - `Whitney Medium` = grDevices::windowsFont("Whitney Medium"), - `Whitney Book` = grDevices::windowsFont("Whitney Book"), - `Whitney Semibold` = grDevices::windowsFont("Whitney Semibold") - ) - - # Update font variables - cmapplot_globals$font <<- list( - strong = list(family = "Whitney Semibold", face = "plain"), - regular = list(family = "Whitney Medium", face = "plain"), - light = list(family = "Whitney Book", face = "plain") - ) - - # Otherwise, use Calibri - } else { - packageStartupMessage( - "WARNING: Whitney is not installed on this PC, so CMAP theme will default to Calibri" - ) - # Add fonts to R - grDevices::windowsFonts( - `Calibri` = grDevices::windowsFont("Calibri"), - `Calibri Light` = grDevices::windowsFont("Calibri Light") - ) - - # Update font variables - cmapplot_globals$font <<- list( - strong = list(family = "Calibri", face = "bold"), - regular = list(family = "Calibri", face = "plain"), - light = list(family = "Calibri Light", face = "plain") - ) - } - - # Font handling for macOS/Linux/Unix + # check for Whitney + all_fonts <- systemfonts::system_fonts() + whitney_core <- all_fonts$name[all_fonts$name %in% c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold")] + assign("use_whitney", length(whitney_core) >= 3, envir = cmapplot_global) + + if(get("use_whitney", envir = cmapplot_global)){ + # Register all Whitney fonts + # note: this registers italic fonts as variants of core fonts and as standalone fonts, + # so there is some duplication. + whitney_fonts <- select(filter(all_fonts, family == "Whitney"), name, path) + purrr::walk2(whitney_fonts$name, whitney_fonts$path, register_font) + + # Update font variables + assign("font", + list( + strong = list(family = "Whitney-Semibold", face = "plain"), + regular = list(family = "Whitney-Medium", face = "plain"), + light = list(family = "Whitney-Book", face = "plain")), + envir = cmapplot_global) } else { - - # Use Whitney if available - if (cmapplot_globals$use_whitney) { - # Add fonts to R - grDevices::X11Fonts( - `Whitney Medium` = grDevices::X11Font("-*-whitney-medium-%s-*-*-%d-*-*-*-*-*-*-*"), - `Whitney Book` = grDevices::X11Font("-*-whitney-book-%s-*-*-%d-*-*-*-*-*-*-*"), - `Whitney Semibold` = grDevices::X11Font("-*-whitney-semibold-%s-*-*-%d-*-*-*-*-*-*-*") - ) - - # Update font variables - cmapplot_globals$font <<- list( - strong = list(family = "Whitney Semibold", face = "plain"), - regular = list(family = "Whitney Medium", face = "plain"), - light = list(family = "Whitney Book", face = "plain") - ) - - # Otherwise, stick to Arial (set prior to .onLoad()) - } else { - packageStartupMessage( - "WARNING: Whitney is not installed on this system, so CMAP theme will default to Arial" - ) - } + packageStartupMessage( + "WARNING: Whitney is not installed on this machine, so CMAP theme will use your default sans-Serif font" + ) } + # # Check for Whitney + # all_fonts <- sysfonts::font_files() + # whitney_fonts <- all_fonts[all_fonts$family %in% c("Whitney Medium", "Whitney Book", "Whitney Semibold") & all_fonts$face=="Regular", ] + # cmapplot_globals$use_whitney <<- length(whitney_fonts$family) >= 3 + # + # # Font handling for Windows users + # if (.Platform$OS.type == "windows") { + # + # # Use Whitney if available + # if (cmapplot_globals$use_whitney) { + # # Add fonts to R + # grDevices::windowsFonts( + # `Whitney Medium` = grDevices::windowsFont("Whitney Medium"), + # `Whitney Book` = grDevices::windowsFont("Whitney Book"), + # `Whitney Semibold` = grDevices::windowsFont("Whitney Semibold") + # ) + # + # # Update font variables + # cmapplot_globals$font <<- list( + # strong = list(family = "Whitney Semibold", face = "plain"), + # regular = list(family = "Whitney Medium", face = "plain"), + # light = list(family = "Whitney Book", face = "plain") + # ) + # + # # Otherwise, use Calibri + # } else { + # packageStartupMessage( + # "WARNING: Whitney is not installed on this PC, so CMAP theme will default to Calibri" + # ) + # # Add fonts to R + # grDevices::windowsFonts( + # `Calibri` = grDevices::windowsFont("Calibri"), + # `Calibri Light` = grDevices::windowsFont("Calibri Light") + # ) + # + # # Update font variables + # cmapplot_globals$font <<- list( + # strong = list(family = "Calibri", face = "bold"), + # regular = list(family = "Calibri", face = "plain"), + # light = list(family = "Calibri Light", face = "plain") + # ) + # } + # + # # Font handling for macOS/Linux/Unix + # } else { + # + # # Use Whitney if available + # if (cmapplot_globals$use_whitney) { + # # Add fonts to R + # grDevices::X11Fonts( + # `Whitney Medium` = grDevices::X11Font("-*-whitney-medium-%s-*-*-%d-*-*-*-*-*-*-*"), + # `Whitney Book` = grDevices::X11Font("-*-whitney-book-%s-*-*-%d-*-*-*-*-*-*-*"), + # `Whitney Semibold` = grDevices::X11Font("-*-whitney-semibold-%s-*-*-%d-*-*-*-*-*-*-*") + # ) + # + # # Update font variables + # cmapplot_globals$font <<- list( + # strong = list(family = "Whitney Semibold", face = "plain"), + # regular = list(family = "Whitney Medium", face = "plain"), + # light = list(family = "Whitney Book", face = "plain") + # ) + # + # # Otherwise, stick to Arial (set prior to .onLoad()) + # } else { + # packageStartupMessage( + # "WARNING: Whitney is not installed on this system, so CMAP theme will default to Arial" + # ) + # } + # } + # Load CMAP preferred default.aes (can't be done until fonts are specified) cmapplot_globals$default_aes_cmap <<- init_cmap_default_aes() @@ -220,8 +266,8 @@ display_cmap_fonts <- function() { graphics::plot(c(0,2), c(0,6), type="n", xlab="", ylab="") draw.me <- function(name, font, size, placement){ - thisfont <- cmapplot_globals$font[[font]] - thissize <- cmapplot_globals$fsize[[size]] + thisfont <- cmapplot_global$font[[font]] + thissize <- cmapplot_global$fsize[[size]] graphics::par(family=thisfont$family, font=ifelse(thisfont$face == "bold", 2, 1)) From 972f828e6a245acea83757766fd57eb8b8945503 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Fri, 2 Apr 2021 23:21:11 -0500 Subject: [PATCH 032/173] tweak --- R/cmapplot.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index a17d66e9..0bc3885a 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -163,11 +163,11 @@ cmapplot_globals <- list( assign("use_whitney", length(whitney_core) >= 3, envir = cmapplot_global) if(get("use_whitney", envir = cmapplot_global)){ - # Register all Whitney fonts - # note: this registers italic fonts as variants of core fonts and as standalone fonts, - # so there is some duplication. + # Register all Whitney fonts (note: this registers italic fonts both as + # variants of core fonts and as standalone fonts, so there is some + # duplication.) whitney_fonts <- select(filter(all_fonts, family == "Whitney"), name, path) - purrr::walk2(whitney_fonts$name, whitney_fonts$path, register_font) + purrr::walk2(whitney_fonts$name, whitney_fonts$path, systemfonts::register_font) # Update font variables assign("font", From 12e15cb1442a8b7e058485ef1531ff072dae13f7 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Fri, 2 Apr 2021 23:52:49 -0500 Subject: [PATCH 033/173] revert back to `globals` gave up on new cmap_global nomenclature--too many references throughout package to update. Converted remaining items from the list to the environment. --- R/cmapplot.R | 259 ++++++++++++++++-------------------------------- R/default_aes.R | 11 ++ R/theme_cmap.R | 17 ++-- 3 files changed, 104 insertions(+), 183 deletions(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index 0bc3885a..0d693809 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -18,101 +18,32 @@ "_PACKAGE" + # establish location for cmapplot global variables -cmapplot_global <- new.env(parent = emptyenv()) +cmapplot_globals <- new.env(parent = emptyenv()) # set up default font handling # (overridden if local machine has Whitney in .onLoad) -cmapplot_global$use_whitney <- FALSE -cmapplot_global$font <- list( +cmapplot_globals$use_whitney <- FALSE +cmapplot_globals$font <- list( strong = list(family = "sans", face = "bold"), regular = list(family = "sans", face = "plain"), light = list(family = "sans", face = "plain")) # establish font sizes -cmapplot_global$fsize <- list( +cmapplot_globals$fsize <- list( S = 11, M = 14, L = 17 ) - -#'cmapplot global variables -#' -#'A list of predefined variables for use by the cmapplot package and its users. -#'It includes commonly used colors, font and font size specifications, and a -#'list of constants which aid in drawing cmap-themed plots. -#' -#'@section Plot Constants: The only portion of these global variables of -#' interest to the user is \code{cmapplot_globals$consts}, a list of default -#' constants that set certain plot aesthetics. Units of all plot constants are -#' "bigpts": 1/72 of an inch. Most plot constants are invoked (and can be -#' overridden) in \code{\link{finalize_plot}}: these are marked below with an -#' \strong{F}. Some are used/can be overridden in \code{\link{theme_cmap}}: -#' these are marked with \strong{T}. -#' -#' \itemize{ \item \code{lwd_strongline}: This stronger-width line is drawn -#' vertically or horizontally with the \code{hline, vline} args of -#' \code{theme_cmap()}. \strong{(T)} \item \code{lwd_gridline}: This -#' thinner-width line is drawn vertically or horizontally with the -#' \code{gridlines, axislines} args of \code{theme_cmap()}. \strong{(T)} \item -#' \code{lwd_plotline}: The width of any lines drawn by geoms in the plot (e.g. -#' \code{geom_line}) but not explicitly sized by the geom's aesthetic. -#' Implemented by \code{finalize_plot} or by \code{apply_cmap_default_aes} but -#' not overridable in either context. (Modify by setting the size explicitly in -#' the geom, but see \code{gg_lwd_convert} first.) \item \code{lwd_topline}: -#' The width of the line above the plot. \strong{(F)} \item -#' \code{length_ticks}: The length of the axis ticks (if shown). \strong{(T)} -#' \item \code{margin_topline_t}: The margin between the top edge of the image -#' and the top line. \strong{(F)} \item \code{margin_title_t}: The margin -#' between the top line and the title. \strong{(F)} \item -#' \code{margin_title_b}: The margin between the title and the caption when -#' both are drawn in the sidebar. \strong{(F)} \item \code{margin_caption_b}: -#' The margin between the bottom of the caption and the bottom edge of the -#' image. \strong{(F)} \item \code{margin_legend_t}: The margin between the top -#' line and the plot box (i.e., the top of the legend). \strong{(F)} \item -#' \code{margin_legend_i}: The margin between legends (this only applies in -#' plots with two or more legends and does not affect legend spacing on plots -#' with single legends that have multiple rows). \strong{(T, F)} \item -#' \code{margin_legend_b}: The margin between the bottom of the legend and the -#' rest of the plot. \strong{(T, F)} \item \code{margin_plot_b}: The margin -#' between the bottom of the plot and the bottom edge of the image (or top of -#' caption). \strong{(F)} \item \code{margin_sidebar_l}: The margin between the -#' left edge of the image and the title and caption, when the sidebar exists. -#' Deducted from \code{title_width}. \strong{(F)} \item \code{margin_plot_l}: -#' The margin between the left edge of the plot and the sodebar. \strong{(F)} -#' \item \code{margin_plot_r}: The margin between the right edge of the plot -#' and the edge of the image. \strong{(F)} \item \code{margin_panel_r}: Padding -#' between the plot and its right-hand drawing extent. Override this based on -#' space needed for x axis labels. \strong{(T)} \item \code{leading_title}: -#' Text leading for Title text. \strong{(F)} \item \code{leading_caption}: Text -#' leading for Caption text. \strong{(F)} } -#' -#'@export -cmapplot_globals <- list( - - ## Colors - colors = list( +## Colors +cmapplot_globals$colors <- list( blackish = "#222222" - ), - - ## Font sizes - fsize = list( - S = 11, - M = 14, - L = 17 - ), - - ## Base typefaces -- modified later by .onLoad() - font = list( - strong = list(family = "Arial", face = "bold"), - regular = list(family = "Arial", face = "plain"), - light = list(family = "Arial", face = "plain") - ), - use_whitney = FALSE, + ) - ## Establish plotting constants in bigpts (1/72 of inch) - consts = list( +## Establish plotting constants in bigpts (1/72 of inch) +cmapplot_globals$consts = list( lwd_gridline = 0.3, lwd_strongline = 1, lwd_plotline = 3, @@ -132,25 +63,7 @@ cmapplot_globals <- list( margin_panel_r = 10, leading_title = 1, leading_caption = 1 - ), - - # list of geoms whose aesthetics will be customized - geoms_that_change = c( - "Label", - "Line", - "Text", - "TextLast", - "PointLast", - "RecessionsText" - ), - - # empty location for loading in preferred aesthetics during `.onLoad` - default_aes_cmap = NULL, - - # empty location for caching existing aesthetics during `.onLoad` - default_aes_cached = NULL - -) + ) ## Update fonts based on system -- *must* be done with .onLoad() @@ -160,9 +73,9 @@ cmapplot_globals <- list( # check for Whitney all_fonts <- systemfonts::system_fonts() whitney_core <- all_fonts$name[all_fonts$name %in% c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold")] - assign("use_whitney", length(whitney_core) >= 3, envir = cmapplot_global) + assign("use_whitney", length(whitney_core) >= 3, envir = cmapplot_globals) - if(get("use_whitney", envir = cmapplot_global)){ + if(get("use_whitney", envir = cmapplot_globals)){ # Register all Whitney fonts (note: this registers italic fonts both as # variants of core fonts and as standalone fonts, so there is some # duplication.) @@ -175,99 +88,40 @@ cmapplot_globals <- list( strong = list(family = "Whitney-Semibold", face = "plain"), regular = list(family = "Whitney-Medium", face = "plain"), light = list(family = "Whitney-Book", face = "plain")), - envir = cmapplot_global) + envir = cmapplot_globals) } else { packageStartupMessage( "WARNING: Whitney is not installed on this machine, so CMAP theme will use your default sans-Serif font" ) } - # # Check for Whitney - # all_fonts <- sysfonts::font_files() - # whitney_fonts <- all_fonts[all_fonts$family %in% c("Whitney Medium", "Whitney Book", "Whitney Semibold") & all_fonts$face=="Regular", ] - # cmapplot_globals$use_whitney <<- length(whitney_fonts$family) >= 3 - # - # # Font handling for Windows users - # if (.Platform$OS.type == "windows") { - # - # # Use Whitney if available - # if (cmapplot_globals$use_whitney) { - # # Add fonts to R - # grDevices::windowsFonts( - # `Whitney Medium` = grDevices::windowsFont("Whitney Medium"), - # `Whitney Book` = grDevices::windowsFont("Whitney Book"), - # `Whitney Semibold` = grDevices::windowsFont("Whitney Semibold") - # ) - # - # # Update font variables - # cmapplot_globals$font <<- list( - # strong = list(family = "Whitney Semibold", face = "plain"), - # regular = list(family = "Whitney Medium", face = "plain"), - # light = list(family = "Whitney Book", face = "plain") - # ) - # - # # Otherwise, use Calibri - # } else { - # packageStartupMessage( - # "WARNING: Whitney is not installed on this PC, so CMAP theme will default to Calibri" - # ) - # # Add fonts to R - # grDevices::windowsFonts( - # `Calibri` = grDevices::windowsFont("Calibri"), - # `Calibri Light` = grDevices::windowsFont("Calibri Light") - # ) - # - # # Update font variables - # cmapplot_globals$font <<- list( - # strong = list(family = "Calibri", face = "bold"), - # regular = list(family = "Calibri", face = "plain"), - # light = list(family = "Calibri Light", face = "plain") - # ) - # } - # - # # Font handling for macOS/Linux/Unix - # } else { - # - # # Use Whitney if available - # if (cmapplot_globals$use_whitney) { - # # Add fonts to R - # grDevices::X11Fonts( - # `Whitney Medium` = grDevices::X11Font("-*-whitney-medium-%s-*-*-%d-*-*-*-*-*-*-*"), - # `Whitney Book` = grDevices::X11Font("-*-whitney-book-%s-*-*-%d-*-*-*-*-*-*-*"), - # `Whitney Semibold` = grDevices::X11Font("-*-whitney-semibold-%s-*-*-%d-*-*-*-*-*-*-*") - # ) - # - # # Update font variables - # cmapplot_globals$font <<- list( - # strong = list(family = "Whitney Semibold", face = "plain"), - # regular = list(family = "Whitney Medium", face = "plain"), - # light = list(family = "Whitney Book", face = "plain") - # ) - # - # # Otherwise, stick to Arial (set prior to .onLoad()) - # } else { - # packageStartupMessage( - # "WARNING: Whitney is not installed on this system, so CMAP theme will default to Arial" - # ) - # } - # } - # Load CMAP preferred default.aes (can't be done until fonts are specified) - cmapplot_globals$default_aes_cmap <<- init_cmap_default_aes() + assign("default_aes_cmap", + init_cmap_default_aes(), + env = cmapplot_globals) # Cache existing default.aes - cmapplot_globals$default_aes_cached <<- fetch_current_default_aes() + assign("default_aes_cached", + fetch_current_default_aes(), + env = cmapplot_globals) } # Font spec visualization helper function --------------------------------- +#' Font visualization test +#' +#' This internal function uses base R graphics to display the five text variants +#' that should show up on a cmap themed graphic - and what fonts the package is +#' planning to use to display them. +#' +#' @noRd display_cmap_fonts <- function() { graphics::plot(c(0,2), c(0,6), type="n", xlab="", ylab="") draw.me <- function(name, font, size, placement){ - thisfont <- cmapplot_global$font[[font]] - thissize <- cmapplot_global$fsize[[size]] + thisfont <- cmapplot_globals$font[[font]] + thissize <- cmapplot_globals$fsize[[size]] graphics::par(family=thisfont$family, font=ifelse(thisfont$face == "bold", 2, 1)) @@ -354,3 +208,58 @@ gg_lwd_convert <- function(value, unit = "bigpts") { value_out / .lwd ) } + + +#'cmapplot global variables +#' +#'A list of predefined variables for use by the cmapplot package and its users. +#'It includes commonly used colors, font and font size specifications, and a +#'list of constants which aid in drawing cmap-themed plots. +#' +#'@section Plot Constants: The only portion of these global variables of +#' interest to the user is \code{cmapplot_globals$consts}, a list of default +#' constants that set certain plot aesthetics. Units of all plot constants are +#' "bigpts": 1/72 of an inch. Most plot constants are invoked (and can be +#' overridden) in \code{\link{finalize_plot}}: these are marked below with an +#' \strong{F}. Some are used/can be overridden in \code{\link{theme_cmap}}: +#' these are marked with \strong{T}. +#' +#' \itemize{ \item \code{lwd_strongline}: This stronger-width line is drawn +#' vertically or horizontally with the \code{hline, vline} args of +#' \code{theme_cmap()}. \strong{(T)} \item \code{lwd_gridline}: This +#' thinner-width line is drawn vertically or horizontally with the +#' \code{gridlines, axislines} args of \code{theme_cmap()}. \strong{(T)} \item +#' \code{lwd_plotline}: The width of any lines drawn by geoms in the plot (e.g. +#' \code{geom_line}) but not explicitly sized by the geom's aesthetic. +#' Implemented by \code{finalize_plot} or by \code{apply_cmap_default_aes} but +#' not overridable in either context. (Modify by setting the size explicitly in +#' the geom, but see \code{gg_lwd_convert} first.) \item \code{lwd_topline}: +#' The width of the line above the plot. \strong{(F)} \item +#' \code{length_ticks}: The length of the axis ticks (if shown). \strong{(T)} +#' \item \code{margin_topline_t}: The margin between the top edge of the image +#' and the top line. \strong{(F)} \item \code{margin_title_t}: The margin +#' between the top line and the title. \strong{(F)} \item +#' \code{margin_title_b}: The margin between the title and the caption when +#' both are drawn in the sidebar. \strong{(F)} \item \code{margin_caption_b}: +#' The margin between the bottom of the caption and the bottom edge of the +#' image. \strong{(F)} \item \code{margin_legend_t}: The margin between the top +#' line and the plot box (i.e., the top of the legend). \strong{(F)} \item +#' \code{margin_legend_i}: The margin between legends (this only applies in +#' plots with two or more legends and does not affect legend spacing on plots +#' with single legends that have multiple rows). \strong{(T, F)} \item +#' \code{margin_legend_b}: The margin between the bottom of the legend and the +#' rest of the plot. \strong{(T, F)} \item \code{margin_plot_b}: The margin +#' between the bottom of the plot and the bottom edge of the image (or top of +#' caption). \strong{(F)} \item \code{margin_sidebar_l}: The margin between the +#' left edge of the image and the title and caption, when the sidebar exists. +#' Deducted from \code{title_width}. \strong{(F)} \item \code{margin_plot_l}: +#' The margin between the left edge of the plot and the sodebar. \strong{(F)} +#' \item \code{margin_plot_r}: The margin between the right edge of the plot +#' and the edge of the image. \strong{(F)} \item \code{margin_panel_r}: Padding +#' between the plot and its right-hand drawing extent. Override this based on +#' space needed for x axis labels. \strong{(T)} \item \code{leading_title}: +#' Text leading for Title text. \strong{(F)} \item \code{leading_caption}: Text +#' leading for Caption text. \strong{(F)} } +#' +#'@export +cmapplot_globals_OLD <- list() diff --git a/R/default_aes.R b/R/default_aes.R index 4cf716d8..0329588e 100644 --- a/R/default_aes.R +++ b/R/default_aes.R @@ -1,3 +1,14 @@ +# list of all geoms whose aesthetics will be customized +cmapplot_globals$geoms_that_change <- c( + "Label", + "Line", + "Text", + "TextLast", + "PointLast", + "RecessionsText" +) + + #' Initialize CMAP `default_aes` values #' #' Internal function to load in default aesthetics for modified geoms. diff --git a/R/theme_cmap.R b/R/theme_cmap.R index 99f2fac3..a2e1c716 100644 --- a/R/theme_cmap.R +++ b/R/theme_cmap.R @@ -7,8 +7,8 @@ #'undesireable outcomes in a ggplot that also invokes \code{coord_flip()}. Under #'the hood, \code{theme_cmap(xlab = "foo")} both sets \code{ggplot2::xlab = #'"foo"} and 'turns on' the ggplot theme element \code{axis.title.x}. With -#'\code{coord_flip()}, the xlab travels with the data (becoming the ylab) but the -#'theme modifier stays on the x axis. To solve this, rewrite your ggplot +#'\code{coord_flip()}, the xlab travels with the data (becoming the ylab) but +#'the theme modifier stays on the x axis. To solve this, rewrite your ggplot #'construction to avoid \code{coord_flip()} or manually turn off and on the #'correct elements from ggplot2's \code{\link[ggplot2]{theme}} function in the #'\code{...} of this function. @@ -20,10 +20,11 @@ #' \code{coord_flip()}. #'@param hline,vline Numeric, the location of a strong horizontal or vertical #' line to be added to the plot. Use \code{hline = 0}, for example, to place a -#' line at y = 0 to differentiate between positive and negative values. The width -#' of this line is determined by \code{cmapplot_globals$lwd_strongline}. Note that -#' on most displays the difference between this line and gridlines is impossible -#' to discern in R. The difference will be visible upon export. +#' line at y = 0 to differentiate between positive and negative values. The +#' width of this line is determined by +#' \code{cmapplot_globals$consts$lwd_strongline}. Note that on most displays +#' the difference between this line and gridlines is impossible to discern in +#' R. The difference will be visible upon export. #'@param gridlines Char, the grid lines to be displayed on the chart. If left as #' default, horizontal grid lines will be displayed while vertical grid lines #' will be masked. Acceptable values are "h" (horizontal only), "v" (vertical @@ -50,8 +51,8 @@ #'@param debug Bool, Defaults to \code{FALSE}. Set to \code{TRUE} to show #' rectangles around all \code{geom_rect()} elements for debugging. #'@param overrides Named list, overrides the default drawing attributes defined -#' in \code{cmapplot_globals$consts} which are drawn by \code{\link{theme_cmap}}. -#' Units are in bigpts (1/72 of an inch). +#' in \code{cmapplot_globals$consts} which are drawn by +#' \code{\link{theme_cmap}}. Units are in bigpts (1/72 of an inch). #'@param ... pass additional arguments to ggplot2's \code{\link[ggplot2]{theme}} #' function to override any elements of the default CMAP theme. #' From 7060aa5aff3535f6d11714c0e82214d82ac87415 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sat, 3 Apr 2021 00:08:05 -0500 Subject: [PATCH 034/173] implement envir getter and setter basic, for testing. would need documentation if it works. --- R/cmapplot.R | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/R/cmapplot.R b/R/cmapplot.R index 0d693809..a740d980 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -107,6 +107,22 @@ cmapplot_globals$consts = list( } +get_cmapplot_global <- function(name){ + get(name, envir = cmapplot_globals) +} + +set_cmapplot_global <- function(name, value){ + + # do a get to make sure the variable exists. + p <- get_cmapplot_global(name) + + assign(name, value, envir = cmapplot_globals) + + invisible() +} + + + # Font spec visualization helper function --------------------------------- #' Font visualization test From 874bff3330bec59db9c2b65b935db93a1f299977 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sat, 3 Apr 2021 00:13:55 -0500 Subject: [PATCH 035/173] documentation --- NAMESPACE | 5 ++++- R/cmapplot.R | 2 ++ ...pplot_globals.Rd => cmapplot_globals_OLD.Rd} | 8 ++++---- man/theme_cmap.Rd | 17 +++++++++-------- 4 files changed, 19 insertions(+), 13 deletions(-) rename man/{cmapplot_globals.Rd => cmapplot_globals_OLD.Rd} (96%) diff --git a/NAMESPACE b/NAMESPACE index 9494d632..4e6bfde2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -20,12 +20,14 @@ export(cmap_fill_highlight) export(cmap_fill_race) export(cmap_gradients) export(cmap_palettes) -export(cmapplot_globals) +export(cmapplot_globals_OLD) export(finalize_plot) export(geom_recessions) export(geom_text_lastonly) +export(get_cmapplot_global) export(gg_lwd_convert) export(integer_breaks) +export(set_cmapplot_global) export(theme_cmap) export(unapply_cmap_default_aes) export(update_recessions) @@ -39,6 +41,7 @@ import(grid) import(gridtext) import(rlang) import(scales) +import(systemfonts) importFrom(generics,intersect) importFrom(ggpubr,get_legend) importFrom(glue,glue) diff --git a/R/cmapplot.R b/R/cmapplot.R index a740d980..030df660 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -107,10 +107,12 @@ cmapplot_globals$consts = list( } +#' @export get_cmapplot_global <- function(name){ get(name, envir = cmapplot_globals) } +#' @export set_cmapplot_global <- function(name, value){ # do a get to make sure the variable exists. diff --git a/man/cmapplot_globals.Rd b/man/cmapplot_globals_OLD.Rd similarity index 96% rename from man/cmapplot_globals.Rd rename to man/cmapplot_globals_OLD.Rd index df2e9ac7..97ccaf96 100644 --- a/man/cmapplot_globals.Rd +++ b/man/cmapplot_globals_OLD.Rd @@ -1,14 +1,14 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/cmapplot.R \docType{data} -\name{cmapplot_globals} -\alias{cmapplot_globals} +\name{cmapplot_globals_OLD} +\alias{cmapplot_globals_OLD} \title{cmapplot global variables} \format{ -An object of class \code{list} of length 8. +An object of class \code{list} of length 0. } \usage{ -cmapplot_globals +cmapplot_globals_OLD } \description{ A list of predefined variables for use by the cmapplot package and its users. diff --git a/man/theme_cmap.Rd b/man/theme_cmap.Rd index 0d6e1ad4..8985c070 100644 --- a/man/theme_cmap.Rd +++ b/man/theme_cmap.Rd @@ -27,10 +27,11 @@ details for unexpected outcomes when using these arguments along with \item{hline, vline}{Numeric, the location of a strong horizontal or vertical line to be added to the plot. Use \code{hline = 0}, for example, to place a -line at y = 0 to differentiate between positive and negative values. The width -of this line is determined by \code{cmapplot_globals$lwd_strongline}. Note that -on most displays the difference between this line and gridlines is impossible -to discern in R. The difference will be visible upon export.} +line at y = 0 to differentiate between positive and negative values. The +width of this line is determined by +\code{cmapplot_globals$consts$lwd_strongline}. Note that on most displays +the difference between this line and gridlines is impossible to discern in +R. The difference will be visible upon export.} \item{gridlines}{Char, the grid lines to be displayed on the chart. If left as default, horizontal grid lines will be displayed while vertical grid lines @@ -64,8 +65,8 @@ be one row of three and another row of two).} rectangles around all \code{geom_rect()} elements for debugging.} \item{overrides}{Named list, overrides the default drawing attributes defined -in \code{cmapplot_globals$consts} which are drawn by \code{\link{theme_cmap}}. -Units are in bigpts (1/72 of an inch).} +in \code{cmapplot_globals$consts} which are drawn by +\code{\link{theme_cmap}}. Units are in bigpts (1/72 of an inch).} \item{...}{pass additional arguments to ggplot2's \code{\link[ggplot2]{theme}} function to override any elements of the default CMAP theme.} @@ -79,8 +80,8 @@ Using either the \code{xlab} or \code{ylab} argument, but not both, will have undesireable outcomes in a ggplot that also invokes \code{coord_flip()}. Under the hood, \code{theme_cmap(xlab = "foo")} both sets \code{ggplot2::xlab = "foo"} and 'turns on' the ggplot theme element \code{axis.title.x}. With -\code{coord_flip()}, the xlab travels with the data (becoming the ylab) but the -theme modifier stays on the x axis. To solve this, rewrite your ggplot +\code{coord_flip()}, the xlab travels with the data (becoming the ylab) but +the theme modifier stays on the x axis. To solve this, rewrite your ggplot construction to avoid \code{coord_flip()} or manually turn off and on the correct elements from ggplot2's \code{\link[ggplot2]{theme}} function in the \code{...} of this function. From 0f7bb584580975169895fd486e35c5338da7357a Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sat, 3 Apr 2021 00:26:51 -0500 Subject: [PATCH 036/173] left some notes not sure why exporting doesn't seem to be working --- R/cmapplot.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/cmapplot.R b/R/cmapplot.R index 030df660..d8ee21ba 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -107,6 +107,9 @@ cmapplot_globals$consts = list( } +# why aren't these available functions? +# and, I'd like to figure out how to parse for $ + #' @export get_cmapplot_global <- function(name){ get(name, envir = cmapplot_globals) From 1de5255531e954bc0d97a092f133baad61d41856 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sat, 3 Apr 2021 00:43:07 -0500 Subject: [PATCH 037/173] more fiddling --- DESCRIPTION | 2 +- NAMESPACE | 1 - R/cmapplot.R | 6 +++++- man/get_cmapplot_global.Rd | 11 +++++++++++ man/set_cmapplot_global.Rd | 11 +++++++++++ 5 files changed, 28 insertions(+), 3 deletions(-) create mode 100644 man/get_cmapplot_global.Rd create mode 100644 man/set_cmapplot_global.Rd diff --git a/DESCRIPTION b/DESCRIPTION index d9b92bf0..1e6e1291 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -51,7 +51,7 @@ Imports: rlang, scales, stringr, - sysfonts + systemfonts Suggests: knitr, rmarkdown, diff --git a/NAMESPACE b/NAMESPACE index 4e6bfde2..604cd7f9 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -53,6 +53,5 @@ importFrom(purrr,map) importFrom(purrr,walk2) importFrom(stringr,str_replace) importFrom(stringr,str_trunc) -importFrom(sysfonts,font_files) importFrom(utils,modifyList) importFrom(utils,read.csv) diff --git a/R/cmapplot.R b/R/cmapplot.R index d8ee21ba..1be57f1c 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -13,7 +13,6 @@ #' @docType package #' @import ggplot2 dplyr grid scales grDevices graphics rlang gridtext #' @importFrom glue glue glue_collapse -#' @importFrom sysfonts font_files #' @keywords internal "_PACKAGE" @@ -110,11 +109,16 @@ cmapplot_globals$consts = list( # why aren't these available functions? # and, I'd like to figure out how to parse for $ +#' Get a value from the cmapplot_globals environment +#' #' @export get_cmapplot_global <- function(name){ get(name, envir = cmapplot_globals) } + +#' Set a value in the cmapplot_globals environment +#' #' @export set_cmapplot_global <- function(name, value){ diff --git a/man/get_cmapplot_global.Rd b/man/get_cmapplot_global.Rd new file mode 100644 index 00000000..1774974c --- /dev/null +++ b/man/get_cmapplot_global.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cmapplot.R +\name{get_cmapplot_global} +\alias{get_cmapplot_global} +\title{Get a value from the cmapplot_globals environment} +\usage{ +get_cmapplot_global(name) +} +\description{ +Get a value from the cmapplot_globals environment +} diff --git a/man/set_cmapplot_global.Rd b/man/set_cmapplot_global.Rd new file mode 100644 index 00000000..986698b2 --- /dev/null +++ b/man/set_cmapplot_global.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cmapplot.R +\name{set_cmapplot_global} +\alias{set_cmapplot_global} +\title{Set a value in the cmapplot_globals environment} +\usage{ +set_cmapplot_global(name, value) +} +\description{ +Set a value in the cmapplot_globals environment +} From 02c10211487a226764ae82338bff9df18fe2ce21 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sat, 3 Apr 2021 00:57:55 -0500 Subject: [PATCH 038/173] working now, check passes --- R/cmapplot.R | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index 1be57f1c..78a96a82 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -69,6 +69,8 @@ cmapplot_globals$consts = list( #' @import systemfonts .onLoad <- function(...) { + family <- name <- path <- NULL + # check for Whitney all_fonts <- systemfonts::system_fonts() whitney_core <- all_fonts$name[all_fonts$name %in% c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold")] @@ -97,23 +99,28 @@ cmapplot_globals$consts = list( # Load CMAP preferred default.aes (can't be done until fonts are specified) assign("default_aes_cmap", init_cmap_default_aes(), - env = cmapplot_globals) + envir = cmapplot_globals) # Cache existing default.aes assign("default_aes_cached", fetch_current_default_aes(), - env = cmapplot_globals) + envir = cmapplot_globals) } -# why aren't these available functions? -# and, I'd like to figure out how to parse for $ +# Figure out how to parse for $ #' Get a value from the cmapplot_globals environment #' #' @export get_cmapplot_global <- function(name){ + + # WORKING HERE + #names <- stringr::str_split(name, "\\$")[[1]] + #top <- get(names[[1]], envir = cmapplot_globals) + get(name, envir = cmapplot_globals) + } From 21d0bec96a63b71d70966239827b8b8e5b02894d Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sat, 3 Apr 2021 12:03:05 -0500 Subject: [PATCH 039/173] working get and set --- R/cmapplot.R | 55 +++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 46 insertions(+), 9 deletions(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index 78a96a82..fd2bb93d 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -113,13 +113,24 @@ cmapplot_globals$consts = list( #' Get a value from the cmapplot_globals environment #' #' @export -get_cmapplot_global <- function(name){ +get_cmapplot_global <- function(...){ - # WORKING HERE - #names <- stringr::str_split(name, "\\$")[[1]] - #top <- get(names[[1]], envir = cmapplot_globals) + # establish vector of sublocations + names <- unlist(stringr::str_split(c(...), "\\$")) - get(name, envir = cmapplot_globals) + # fetch the top-level element from the list + var <- get(names[1], envir = cmapplot_globals) + + # recurse over additional names to extract the right value + for(i in seq_along(names[-1])+1){ + var <- var[[names[i]]] + } + + if(is.null(var)){ + stop(paste0("object '", paste(names, collapse = "$"), "' not found")) + } + + return(var) } @@ -127,12 +138,38 @@ get_cmapplot_global <- function(name){ #' Set a value in the cmapplot_globals environment #' #' @export -set_cmapplot_global <- function(name, value){ +set_cmapplot_global <- function(value, ..., quietly = FALSE){ + + # do a full get to make sure the variable exists. + # this is a throw-away, just used to as a check + p <- get_cmapplot_global(...) - # do a get to make sure the variable exists. - p <- get_cmapplot_global(name) + # establish vector of sublocations + names <- unlist(stringr::str_split(c(...), "\\$")) - assign(name, value, envir = cmapplot_globals) + # get the top-level item + item <- get_cmapplot_global(names[1]) + + # build a string to evaluate that modifies some element of the item. + str <- paste0( + "item", + ifelse(length(names)>1, paste0("$", paste(names[-1], collapse = "$")),""), + "<- '", value, "'") + + # replace the specific item by evaluating the string + eval(parse(text = str)) + + # and replace the top level item in the globals env + assign(names[1], item, envir = cmapplot_globals) + + # report + if(!quietly){ + cat(paste0( + "Item: ", paste(names, collapse = "$"), "\n", + "Old value: '", p, "'\n", + "New value: '", value, "'" + )) + } invisible() } From af920efe0ee85d6433e2125f67002dc54abbbbe3 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sat, 3 Apr 2021 12:16:52 -0500 Subject: [PATCH 040/173] mas --- R/cmapplot.R | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index fd2bb93d..cac3b547 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -107,11 +107,17 @@ cmapplot_globals$consts = list( envir = cmapplot_globals) } - -# Figure out how to parse for $ +#' Get all values from the cmapplot_globals environment +#' +#' @export +get_cmapplot_globals <- function(){ + as.list(cmapplot_globals) +} #' Get a value from the cmapplot_globals environment #' +#' @describeIn get_cmapplot_globals +#' #' @export get_cmapplot_global <- function(...){ @@ -137,6 +143,7 @@ get_cmapplot_global <- function(...){ #' Set a value in the cmapplot_globals environment #' +#' @describeIn get_cmapplot_globals #' @export set_cmapplot_global <- function(value, ..., quietly = FALSE){ From b906067260957d412d3e69872f26c67b2119496a Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sat, 3 Apr 2021 12:28:40 -0500 Subject: [PATCH 041/173] documentation --- NAMESPACE | 2 +- R/cmapplot.R | 115 +++++++++--------- man/get_cmapplot_global.Rd | 11 -- ...globals_OLD.Rd => get_cmapplot_globals.Rd} | 30 +++-- man/set_cmapplot_global.Rd | 11 -- 5 files changed, 79 insertions(+), 90 deletions(-) delete mode 100644 man/get_cmapplot_global.Rd rename man/{cmapplot_globals_OLD.Rd => get_cmapplot_globals.Rd} (87%) delete mode 100644 man/set_cmapplot_global.Rd diff --git a/NAMESPACE b/NAMESPACE index 604cd7f9..127c7c61 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -20,11 +20,11 @@ export(cmap_fill_highlight) export(cmap_fill_race) export(cmap_gradients) export(cmap_palettes) -export(cmapplot_globals_OLD) export(finalize_plot) export(geom_recessions) export(geom_text_lastonly) export(get_cmapplot_global) +export(get_cmapplot_globals) export(gg_lwd_convert) export(integer_breaks) export(set_cmapplot_global) diff --git a/R/cmapplot.R b/R/cmapplot.R index cac3b547..d55071c2 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -107,16 +107,69 @@ cmapplot_globals$consts = list( envir = cmapplot_globals) } -#' Get all values from the cmapplot_globals environment +#'The cmapplot_globals environment #' -#' @export +#'The \code{cmapplot_globals} environment contains a list of predefined +#'variables for use by the cmapplot package and its users. It includes commonly +#'used colors, font and font size specifications, and a list of constants which +#'aid in drawing cmap-themed plots. +#' +#'@section Plot Constants: The primary portion of these global variables of +#' interest to the user is \code{cmapplot_globals$consts}, a list of default +#' constants that set certain plot aesthetics. Units of all plot constants are +#' "bigpts": 1/72 of an inch. Most plot constants are invoked (and can be +#' overridden) in \code{\link{finalize_plot}}: these are marked below with an +#' \strong{F}. Some are used/can be overridden in \code{\link{theme_cmap}}: +#' these are marked with \strong{T}. +#' +#' \itemize{ \item \code{lwd_strongline}: This stronger-width line is drawn +#' vertically or horizontally with the \code{hline, vline} args of +#' \code{theme_cmap()}. \strong{(T)} \item \code{lwd_gridline}: This +#' thinner-width line is drawn vertically or horizontally with the +#' \code{gridlines, axislines} args of \code{theme_cmap()}. \strong{(T)} \item +#' \code{lwd_plotline}: The width of any lines drawn by geoms in the plot (e.g. +#' \code{geom_line}) but not explicitly sized by the geom's aesthetic. +#' Implemented by \code{finalize_plot} or by \code{apply_cmap_default_aes} but +#' not overridable in either context. (Modify by setting the size explicitly in +#' the geom, but see \code{gg_lwd_convert} first.) \item \code{lwd_topline}: +#' The width of the line above the plot. \strong{(F)} \item +#' \code{length_ticks}: The length of the axis ticks (if shown). \strong{(T)} +#' \item \code{margin_topline_t}: The margin between the top edge of the image +#' and the top line. \strong{(F)} \item \code{margin_title_t}: The margin +#' between the top line and the title. \strong{(F)} \item +#' \code{margin_title_b}: The margin between the title and the caption when +#' both are drawn in the sidebar. \strong{(F)} \item \code{margin_caption_b}: +#' The margin between the bottom of the caption and the bottom edge of the +#' image. \strong{(F)} \item \code{margin_legend_t}: The margin between the top +#' line and the plot box (i.e., the top of the legend). \strong{(F)} \item +#' \code{margin_legend_i}: The margin between legends (this only applies in +#' plots with two or more legends and does not affect legend spacing on plots +#' with single legends that have multiple rows). \strong{(T, F)} \item +#' \code{margin_legend_b}: The margin between the bottom of the legend and the +#' rest of the plot. \strong{(T, F)} \item \code{margin_plot_b}: The margin +#' between the bottom of the plot and the bottom edge of the image (or top of +#' caption). \strong{(F)} \item \code{margin_sidebar_l}: The margin between the +#' left edge of the image and the title and caption, when the sidebar exists. +#' Deducted from \code{title_width}. \strong{(F)} \item \code{margin_plot_l}: +#' The margin between the left edge of the plot and the sodebar. \strong{(F)} +#' \item \code{margin_plot_r}: The margin between the right edge of the plot +#' and the edge of the image. \strong{(F)} \item \code{margin_panel_r}: Padding +#' between the plot and its right-hand drawing extent. Override this based on +#' space needed for x axis labels. \strong{(T)} \item \code{leading_title}: +#' Text leading for Title text. \strong{(F)} \item \code{leading_caption}: Text +#' leading for Caption text. \strong{(F)} } +#' +#'@describeIn get_cmapplot_globals Get the entire environment as a list. +#' +#'@export get_cmapplot_globals <- function(){ as.list(cmapplot_globals) } #' Get a value from the cmapplot_globals environment #' -#' @describeIn get_cmapplot_globals +#' +#' @describeIn get_cmapplot_globals Get a specific global value #' #' @export get_cmapplot_global <- function(...){ @@ -143,7 +196,7 @@ get_cmapplot_global <- function(...){ #' Set a value in the cmapplot_globals environment #' -#' @describeIn get_cmapplot_globals +#' @describeIn get_cmapplot_globals Set a specific global value #' @export set_cmapplot_global <- function(value, ..., quietly = FALSE){ @@ -285,57 +338,3 @@ gg_lwd_convert <- function(value, unit = "bigpts") { ) } - -#'cmapplot global variables -#' -#'A list of predefined variables for use by the cmapplot package and its users. -#'It includes commonly used colors, font and font size specifications, and a -#'list of constants which aid in drawing cmap-themed plots. -#' -#'@section Plot Constants: The only portion of these global variables of -#' interest to the user is \code{cmapplot_globals$consts}, a list of default -#' constants that set certain plot aesthetics. Units of all plot constants are -#' "bigpts": 1/72 of an inch. Most plot constants are invoked (and can be -#' overridden) in \code{\link{finalize_plot}}: these are marked below with an -#' \strong{F}. Some are used/can be overridden in \code{\link{theme_cmap}}: -#' these are marked with \strong{T}. -#' -#' \itemize{ \item \code{lwd_strongline}: This stronger-width line is drawn -#' vertically or horizontally with the \code{hline, vline} args of -#' \code{theme_cmap()}. \strong{(T)} \item \code{lwd_gridline}: This -#' thinner-width line is drawn vertically or horizontally with the -#' \code{gridlines, axislines} args of \code{theme_cmap()}. \strong{(T)} \item -#' \code{lwd_plotline}: The width of any lines drawn by geoms in the plot (e.g. -#' \code{geom_line}) but not explicitly sized by the geom's aesthetic. -#' Implemented by \code{finalize_plot} or by \code{apply_cmap_default_aes} but -#' not overridable in either context. (Modify by setting the size explicitly in -#' the geom, but see \code{gg_lwd_convert} first.) \item \code{lwd_topline}: -#' The width of the line above the plot. \strong{(F)} \item -#' \code{length_ticks}: The length of the axis ticks (if shown). \strong{(T)} -#' \item \code{margin_topline_t}: The margin between the top edge of the image -#' and the top line. \strong{(F)} \item \code{margin_title_t}: The margin -#' between the top line and the title. \strong{(F)} \item -#' \code{margin_title_b}: The margin between the title and the caption when -#' both are drawn in the sidebar. \strong{(F)} \item \code{margin_caption_b}: -#' The margin between the bottom of the caption and the bottom edge of the -#' image. \strong{(F)} \item \code{margin_legend_t}: The margin between the top -#' line and the plot box (i.e., the top of the legend). \strong{(F)} \item -#' \code{margin_legend_i}: The margin between legends (this only applies in -#' plots with two or more legends and does not affect legend spacing on plots -#' with single legends that have multiple rows). \strong{(T, F)} \item -#' \code{margin_legend_b}: The margin between the bottom of the legend and the -#' rest of the plot. \strong{(T, F)} \item \code{margin_plot_b}: The margin -#' between the bottom of the plot and the bottom edge of the image (or top of -#' caption). \strong{(F)} \item \code{margin_sidebar_l}: The margin between the -#' left edge of the image and the title and caption, when the sidebar exists. -#' Deducted from \code{title_width}. \strong{(F)} \item \code{margin_plot_l}: -#' The margin between the left edge of the plot and the sodebar. \strong{(F)} -#' \item \code{margin_plot_r}: The margin between the right edge of the plot -#' and the edge of the image. \strong{(F)} \item \code{margin_panel_r}: Padding -#' between the plot and its right-hand drawing extent. Override this based on -#' space needed for x axis labels. \strong{(T)} \item \code{leading_title}: -#' Text leading for Title text. \strong{(F)} \item \code{leading_caption}: Text -#' leading for Caption text. \strong{(F)} } -#' -#'@export -cmapplot_globals_OLD <- list() diff --git a/man/get_cmapplot_global.Rd b/man/get_cmapplot_global.Rd deleted file mode 100644 index 1774974c..00000000 --- a/man/get_cmapplot_global.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/cmapplot.R -\name{get_cmapplot_global} -\alias{get_cmapplot_global} -\title{Get a value from the cmapplot_globals environment} -\usage{ -get_cmapplot_global(name) -} -\description{ -Get a value from the cmapplot_globals environment -} diff --git a/man/cmapplot_globals_OLD.Rd b/man/get_cmapplot_globals.Rd similarity index 87% rename from man/cmapplot_globals_OLD.Rd rename to man/get_cmapplot_globals.Rd index 97ccaf96..2a42a954 100644 --- a/man/cmapplot_globals_OLD.Rd +++ b/man/get_cmapplot_globals.Rd @@ -1,20 +1,33 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/cmapplot.R -\docType{data} -\name{cmapplot_globals_OLD} -\alias{cmapplot_globals_OLD} -\title{cmapplot global variables} -\format{ -An object of class \code{list} of length 0. -} +\name{get_cmapplot_globals} +\alias{get_cmapplot_globals} +\alias{get_cmapplot_global} +\alias{set_cmapplot_global} +\title{The cmapplot_globals environment} \usage{ -cmapplot_globals_OLD +get_cmapplot_globals() + +get_cmapplot_global(...) + +set_cmapplot_global(value, ..., quietly = FALSE) } \description{ A list of predefined variables for use by the cmapplot package and its users. It includes commonly used colors, font and font size specifications, and a list of constants which aid in drawing cmap-themed plots. + +This sets. } +\section{Functions}{ +\itemize{ +\item \code{get_cmapplot_globals}: Get the entire environment as a list. + +\item \code{get_cmapplot_global}: Get a specific global value + +\item \code{set_cmapplot_global}: Set a specific global value +}} + \section{Plot Constants}{ The only portion of these global variables of interest to the user is \code{cmapplot_globals$consts}, a list of default @@ -62,4 +75,3 @@ list of constants which aid in drawing cmap-themed plots. leading for Caption text. \strong{(F)} } } -\keyword{datasets} diff --git a/man/set_cmapplot_global.Rd b/man/set_cmapplot_global.Rd deleted file mode 100644 index 986698b2..00000000 --- a/man/set_cmapplot_global.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/cmapplot.R -\name{set_cmapplot_global} -\alias{set_cmapplot_global} -\title{Set a value in the cmapplot_globals environment} -\usage{ -set_cmapplot_global(name, value) -} -\description{ -Set a value in the cmapplot_globals environment -} From 680c7cada8b516bb6cc496f67bcf0d6b5fa1095f Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sun, 4 Apr 2021 22:43:50 -0500 Subject: [PATCH 042/173] final changes? I hope --- R/cmapplot.R | 176 +------------------------------- R/cmapplot_globals.R | 196 ++++++++++++++++++++++++++++++++++++ man/get_cmapplot_globals.Rd | 37 +++++-- pkgdown/_pkgdown.yml | 2 +- vignettes/colors.Rmd | 3 +- vignettes/cookbook.Rmd | 3 +- vignettes/finalize.Rmd | 3 +- vignettes/installation.Rmd | 4 +- vignettes/plots.Rmd | 3 +- 9 files changed, 242 insertions(+), 185 deletions(-) create mode 100644 R/cmapplot_globals.R diff --git a/R/cmapplot.R b/R/cmapplot.R index d55071c2..490a25c7 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -18,51 +18,6 @@ -# establish location for cmapplot global variables -cmapplot_globals <- new.env(parent = emptyenv()) - -# set up default font handling -# (overridden if local machine has Whitney in .onLoad) -cmapplot_globals$use_whitney <- FALSE -cmapplot_globals$font <- list( - strong = list(family = "sans", face = "bold"), - regular = list(family = "sans", face = "plain"), - light = list(family = "sans", face = "plain")) - -# establish font sizes -cmapplot_globals$fsize <- list( - S = 11, - M = 14, - L = 17 -) - -## Colors -cmapplot_globals$colors <- list( - blackish = "#222222" - ) - -## Establish plotting constants in bigpts (1/72 of inch) -cmapplot_globals$consts = list( - lwd_gridline = 0.3, - lwd_strongline = 1, - lwd_plotline = 3, - lwd_topline = 2, - length_ticks = 7, - margin_topline_t = 5, - margin_title_t = 5, - margin_title_b = 5, - margin_caption_b = 5, - margin_legend_t = 5, - margin_legend_i = 8, - margin_legend_b = 10, - margin_plot_b = 5, - margin_sidebar_l = 2, - margin_plot_l = 10, - margin_plot_r = 10, - margin_panel_r = 10, - leading_title = 1, - leading_caption = 1 - ) ## Update fonts based on system -- *must* be done with .onLoad() @@ -90,10 +45,6 @@ cmapplot_globals$consts = list( regular = list(family = "Whitney-Medium", face = "plain"), light = list(family = "Whitney-Book", face = "plain")), envir = cmapplot_globals) - } else { - packageStartupMessage( - "WARNING: Whitney is not installed on this machine, so CMAP theme will use your default sans-Serif font" - ) } # Load CMAP preferred default.aes (can't be done until fonts are specified) @@ -107,133 +58,16 @@ cmapplot_globals$consts = list( envir = cmapplot_globals) } -#'The cmapplot_globals environment -#' -#'The \code{cmapplot_globals} environment contains a list of predefined -#'variables for use by the cmapplot package and its users. It includes commonly -#'used colors, font and font size specifications, and a list of constants which -#'aid in drawing cmap-themed plots. -#' -#'@section Plot Constants: The primary portion of these global variables of -#' interest to the user is \code{cmapplot_globals$consts}, a list of default -#' constants that set certain plot aesthetics. Units of all plot constants are -#' "bigpts": 1/72 of an inch. Most plot constants are invoked (and can be -#' overridden) in \code{\link{finalize_plot}}: these are marked below with an -#' \strong{F}. Some are used/can be overridden in \code{\link{theme_cmap}}: -#' these are marked with \strong{T}. -#' -#' \itemize{ \item \code{lwd_strongline}: This stronger-width line is drawn -#' vertically or horizontally with the \code{hline, vline} args of -#' \code{theme_cmap()}. \strong{(T)} \item \code{lwd_gridline}: This -#' thinner-width line is drawn vertically or horizontally with the -#' \code{gridlines, axislines} args of \code{theme_cmap()}. \strong{(T)} \item -#' \code{lwd_plotline}: The width of any lines drawn by geoms in the plot (e.g. -#' \code{geom_line}) but not explicitly sized by the geom's aesthetic. -#' Implemented by \code{finalize_plot} or by \code{apply_cmap_default_aes} but -#' not overridable in either context. (Modify by setting the size explicitly in -#' the geom, but see \code{gg_lwd_convert} first.) \item \code{lwd_topline}: -#' The width of the line above the plot. \strong{(F)} \item -#' \code{length_ticks}: The length of the axis ticks (if shown). \strong{(T)} -#' \item \code{margin_topline_t}: The margin between the top edge of the image -#' and the top line. \strong{(F)} \item \code{margin_title_t}: The margin -#' between the top line and the title. \strong{(F)} \item -#' \code{margin_title_b}: The margin between the title and the caption when -#' both are drawn in the sidebar. \strong{(F)} \item \code{margin_caption_b}: -#' The margin between the bottom of the caption and the bottom edge of the -#' image. \strong{(F)} \item \code{margin_legend_t}: The margin between the top -#' line and the plot box (i.e., the top of the legend). \strong{(F)} \item -#' \code{margin_legend_i}: The margin between legends (this only applies in -#' plots with two or more legends and does not affect legend spacing on plots -#' with single legends that have multiple rows). \strong{(T, F)} \item -#' \code{margin_legend_b}: The margin between the bottom of the legend and the -#' rest of the plot. \strong{(T, F)} \item \code{margin_plot_b}: The margin -#' between the bottom of the plot and the bottom edge of the image (or top of -#' caption). \strong{(F)} \item \code{margin_sidebar_l}: The margin between the -#' left edge of the image and the title and caption, when the sidebar exists. -#' Deducted from \code{title_width}. \strong{(F)} \item \code{margin_plot_l}: -#' The margin between the left edge of the plot and the sodebar. \strong{(F)} -#' \item \code{margin_plot_r}: The margin between the right edge of the plot -#' and the edge of the image. \strong{(F)} \item \code{margin_panel_r}: Padding -#' between the plot and its right-hand drawing extent. Override this based on -#' space needed for x axis labels. \strong{(T)} \item \code{leading_title}: -#' Text leading for Title text. \strong{(F)} \item \code{leading_caption}: Text -#' leading for Caption text. \strong{(F)} } -#' -#'@describeIn get_cmapplot_globals Get the entire environment as a list. -#' -#'@export -get_cmapplot_globals <- function(){ - as.list(cmapplot_globals) -} - -#' Get a value from the cmapplot_globals environment -#' -#' -#' @describeIn get_cmapplot_globals Get a specific global value -#' -#' @export -get_cmapplot_global <- function(...){ - - # establish vector of sublocations - names <- unlist(stringr::str_split(c(...), "\\$")) - # fetch the top-level element from the list - var <- get(names[1], envir = cmapplot_globals) - - # recurse over additional names to extract the right value - for(i in seq_along(names[-1])+1){ - var <- var[[names[i]]] - } - - if(is.null(var)){ - stop(paste0("object '", paste(names, collapse = "$"), "' not found")) +.onAttach <- function(...){ + if(!get("use_whitney", envir = cmapplot_globals)){ + packageStartupMessage( + "WARNING: Whitney is not installed on this machine, so CMAP theme will use your default sans-Serif font" + ) } - - return(var) - } -#' Set a value in the cmapplot_globals environment -#' -#' @describeIn get_cmapplot_globals Set a specific global value -#' @export -set_cmapplot_global <- function(value, ..., quietly = FALSE){ - - # do a full get to make sure the variable exists. - # this is a throw-away, just used to as a check - p <- get_cmapplot_global(...) - - # establish vector of sublocations - names <- unlist(stringr::str_split(c(...), "\\$")) - - # get the top-level item - item <- get_cmapplot_global(names[1]) - - # build a string to evaluate that modifies some element of the item. - str <- paste0( - "item", - ifelse(length(names)>1, paste0("$", paste(names[-1], collapse = "$")),""), - "<- '", value, "'") - - # replace the specific item by evaluating the string - eval(parse(text = str)) - - # and replace the top level item in the globals env - assign(names[1], item, envir = cmapplot_globals) - - # report - if(!quietly){ - cat(paste0( - "Item: ", paste(names, collapse = "$"), "\n", - "Old value: '", p, "'\n", - "New value: '", value, "'" - )) - } - - invisible() -} - # Font spec visualization helper function --------------------------------- diff --git a/R/cmapplot_globals.R b/R/cmapplot_globals.R new file mode 100644 index 00000000..8eb7e2b9 --- /dev/null +++ b/R/cmapplot_globals.R @@ -0,0 +1,196 @@ +# establish location for cmapplot global variables +cmapplot_globals <- new.env(parent = emptyenv()) + +# set up default font handling +# (overridden if local machine has Whitney in .onLoad) +cmapplot_globals$use_whitney <- FALSE +cmapplot_globals$font <- list( + strong = list(family = "sans", face = "bold"), + regular = list(family = "sans", face = "plain"), + light = list(family = "sans", face = "plain")) + +# establish font sizes +cmapplot_globals$fsize <- list( + S = 11, + M = 14, + L = 17 +) + +## Colors +cmapplot_globals$colors <- list( + blackish = "#222222" +) + +## Establish plotting constants in bigpts (1/72 of inch) +cmapplot_globals$consts <- list( + lwd_gridline = 0.3, + lwd_strongline = 1, + lwd_plotline = 3, + lwd_topline = 2, + length_ticks = 7, + margin_topline_t = 5, + margin_title_t = 5, + margin_title_b = 5, + margin_caption_b = 5, + margin_legend_t = 5, + margin_legend_i = 8, + margin_legend_b = 10, + margin_plot_b = 5, + margin_sidebar_l = 2, + margin_plot_l = 10, + margin_plot_r = 10, + margin_panel_r = 10, + leading_title = 1, + leading_caption = 1 +) + +#'The cmapplot_globals environment +#' +#'The \code{cmapplot_globals} environment contains a list of predefined +#'variables for use by the cmapplot package and its users. It includes commonly +#'used colors, font and font size specifications, and a list of constants which +#'aid in drawing cmap-themed plots. It cannot be accessed directly, but the +#'helper functions described here provide the user access if needed. +#' +#'@section Plot Constants: The primary portion of these global variables of +#' interest to the user is \code{cmapplot_globals$consts}, a list of default +#' constants that set certain plot aesthetics. Units of all plot constants are +#' "bigpts": 1/72 of an inch. Most plot constants are invoked (and can be +#' overridden) in \code{\link{finalize_plot}}: these are marked below with an +#' \strong{F}. Some are used/can be overridden in \code{\link{theme_cmap}}: +#' these are marked with \strong{T}. +#' +#' \itemize{ \item \code{lwd_strongline}: This stronger-width line is drawn +#' vertically or horizontally with the \code{hline, vline} args of +#' \code{theme_cmap()}. \strong{(T)} \item \code{lwd_gridline}: This +#' thinner-width line is drawn vertically or horizontally with the +#' \code{gridlines, axislines} args of \code{theme_cmap()}. \strong{(T)} \item +#' \code{lwd_plotline}: The width of any lines drawn by geoms in the plot (e.g. +#' \code{geom_line}) but not explicitly sized by the geom's aesthetic. +#' Implemented by \code{finalize_plot} or by \code{apply_cmap_default_aes} but +#' not overridable in either context. (Modify by setting the size explicitly in +#' the geom, but see \code{gg_lwd_convert} first.) \item \code{lwd_topline}: +#' The width of the line above the plot. \strong{(F)} \item +#' \code{length_ticks}: The length of the axis ticks (if shown). \strong{(T)} +#' \item \code{margin_topline_t}: The margin between the top edge of the image +#' and the top line. \strong{(F)} \item \code{margin_title_t}: The margin +#' between the top line and the title. \strong{(F)} \item +#' \code{margin_title_b}: The margin between the title and the caption when +#' both are drawn in the sidebar. \strong{(F)} \item \code{margin_caption_b}: +#' The margin between the bottom of the caption and the bottom edge of the +#' image. \strong{(F)} \item \code{margin_legend_t}: The margin between the top +#' line and the plot box (i.e., the top of the legend). \strong{(F)} \item +#' \code{margin_legend_i}: The margin between legends (this only applies in +#' plots with two or more legends and does not affect legend spacing on plots +#' with single legends that have multiple rows). \strong{(T, F)} \item +#' \code{margin_legend_b}: The margin between the bottom of the legend and the +#' rest of the plot. \strong{(T, F)} \item \code{margin_plot_b}: The margin +#' between the bottom of the plot and the bottom edge of the image (or top of +#' caption). \strong{(F)} \item \code{margin_sidebar_l}: The margin between the +#' left edge of the image and the title and caption, when the sidebar exists. +#' Deducted from \code{title_width}. \strong{(F)} \item \code{margin_plot_l}: +#' The margin between the left edge of the plot and the sodebar. \strong{(F)} +#' \item \code{margin_plot_r}: The margin between the right edge of the plot +#' and the edge of the image. \strong{(F)} \item \code{margin_panel_r}: Padding +#' between the plot and its right-hand drawing extent. Override this based on +#' space needed for x axis labels. \strong{(T)} \item \code{leading_title}: +#' Text leading for Title text. \strong{(F)} \item \code{leading_caption}: Text +#' leading for Caption text. \strong{(F)} } +#' +#' @aliases cmapplot_globals +#' +#' @describeIn get_cmapplot_globals Get the entire environment as a list. +#' +#' @export +get_cmapplot_globals <- function(){ + as.list(cmapplot_globals) +} + +#' Get a value from the cmapplot_globals environment +#' +#' @examples +#' +#' # These are the same: +#' get_cmapplot_global("consts$lwd_gridline") +#' get_cmapplot_global("consts", "lwd_gridline") +#' +#' @describeIn get_cmapplot_globals Get a specific global value +#' +#' @export +get_cmapplot_global <- function(...){ + + # establish vector of sublocations + names <- unlist(stringr::str_split(c(...), "\\$")) + + # fetch the top-level element from the list + var <- get(names[1], envir = cmapplot_globals) + + # recurse over additional names to extract the right value + for(i in seq_along(names[-1])+1){ + var <- var[[names[i]]] + } + + if(is.null(var)){ + stop(paste0("object '", paste(names, collapse = "$"), "' not found")) + } + + return(var) + +} + + +#' Set a value in the cmapplot_globals environment +#' +#' @param value the value to be set +#' +#' @param ... The path to the variable within \code{cmapplot_globals} to be +#' get/set. The function willparse \code{$}, or recursive list elements can be +#' split over multiple arguments (e.g. \code{"font$strong$family"} is +#' equivalent to \code{"font", "strong", "family"}). +#' +#' @param quietly suppress confirmatory messages +#' +#' @examples +#' +#' # Globals can be modified if needed +#' set_cmapplot_global(5, "consts$lwd_gridline") +#' get_cmapplot_global("consts$lwd_gridline") +#' +#' @describeIn get_cmapplot_globals Set a specific global value +#' +#' @export +set_cmapplot_global <- function(value, ..., quietly = FALSE){ + + # do a full get to make sure the variable exists. + # this is a throw-away, just used to as a check + p <- get_cmapplot_global(...) + + # establish vector of sublocations + names <- unlist(stringr::str_split(c(...), "\\$")) + + # get the top-level item + item <- get_cmapplot_global(names[1]) + + # build a string to evaluate that modifies some element of the item. + str <- paste0( + "item", + ifelse(length(names)>1, paste0("$", paste(names[-1], collapse = "$")),""), + "<- '", value, "'") + + # replace the specific item by evaluating the string + eval(parse(text = str)) + + # and replace the top level item in the globals env + assign(names[1], item, envir = cmapplot_globals) + + # report + if(!quietly){ + cat(paste0( + "Item: ", paste(names, collapse = "$"), "\n", + "Old value: '", p, "'\n", + "New value: '", value, "'" + )) + } + + invisible() +} diff --git a/man/get_cmapplot_globals.Rd b/man/get_cmapplot_globals.Rd index 2a42a954..e39f8f93 100644 --- a/man/get_cmapplot_globals.Rd +++ b/man/get_cmapplot_globals.Rd @@ -1,7 +1,8 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/cmapplot.R +% Please edit documentation in R/cmapplot_globals.R \name{get_cmapplot_globals} \alias{get_cmapplot_globals} +\alias{cmapplot_globals} \alias{get_cmapplot_global} \alias{set_cmapplot_global} \title{The cmapplot_globals environment} @@ -12,12 +13,22 @@ get_cmapplot_global(...) set_cmapplot_global(value, ..., quietly = FALSE) } -\description{ -A list of predefined variables for use by the cmapplot package and its users. -It includes commonly used colors, font and font size specifications, and a -list of constants which aid in drawing cmap-themed plots. +\arguments{ +\item{...}{The path to the variable within \code{cmapplot_globals} to be +get/set. The function willparse \code{$}, or recursive list elements can be +split over multiple arguments (e.g. \code{"font$strong$family"} is +equivalent to \code{"font", "strong", "family"}).} + +\item{value}{the value to be set} -This sets. +\item{quietly}{suppress confirmatory messages} +} +\description{ +The \code{cmapplot_globals} environment contains a list of predefined +variables for use by the cmapplot package and its users. It includes commonly +used colors, font and font size specifications, and a list of constants which +aid in drawing cmap-themed plots. It cannot be accessed directly, but the +helper functions described here provide the user access if needed. } \section{Functions}{ \itemize{ @@ -29,7 +40,7 @@ This sets. }} \section{Plot Constants}{ - The only portion of these global variables of + The primary portion of these global variables of interest to the user is \code{cmapplot_globals$consts}, a list of default constants that set certain plot aesthetics. Units of all plot constants are "bigpts": 1/72 of an inch. Most plot constants are invoked (and can be @@ -75,3 +86,15 @@ This sets. leading for Caption text. \strong{(F)} } } +\examples{ + +# These are the same: +get_cmapplot_global("consts$lwd_gridline") +get_cmapplot_global("consts", "lwd_gridline") + + +# Globals can be modified if needed +set_cmapplot_global(5, "consts$lwd_gridline") +get_cmapplot_global("consts$lwd_gridline") + +} diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index 19d5dae9..0829b77a 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -41,7 +41,7 @@ reference: - vehicle_ownership - title: Lesser used objects - contents: - - cmapplot_globals + - ends_with("cmapplot_globals") - gg_lwd_convert - update_recessions - customproto diff --git a/vignettes/colors.Rmd b/vignettes/colors.Rmd index f5ed7cad..945b924e 100644 --- a/vignettes/colors.Rmd +++ b/vignettes/colors.Rmd @@ -14,7 +14,8 @@ knitr::opts_chunk$set( fig.width = 7, fig.asp = 400/670, fig.retina = 4, - fig.align = "center" + fig.align = "center", + dev = "ragg_png" ) library(tidyverse) diff --git a/vignettes/cookbook.Rmd b/vignettes/cookbook.Rmd index d3f16052..b3d3b319 100644 --- a/vignettes/cookbook.Rmd +++ b/vignettes/cookbook.Rmd @@ -15,7 +15,8 @@ knitr::opts_chunk$set( fig.asp = 400/670, fig.retina = 4, fig.align = "center", - out.width = "100%" + out.width = "100%", + dev = "ragg_png" ) library(tidyverse) diff --git a/vignettes/finalize.Rmd b/vignettes/finalize.Rmd index 44cb9910..84520827 100644 --- a/vignettes/finalize.Rmd +++ b/vignettes/finalize.Rmd @@ -15,7 +15,8 @@ knitr::opts_chunk$set( fig.asp = 400/670, fig.retina = 4, fig.align = "center", - out.width = "100%" + out.width = "100%", + dev = "ragg_png" ) library(tidyverse) diff --git a/vignettes/installation.Rmd b/vignettes/installation.Rmd index ed3a5224..43f23f09 100644 --- a/vignettes/installation.Rmd +++ b/vignettes/installation.Rmd @@ -41,6 +41,6 @@ After completing these steps, your computer should be ready to use and export gr ## CMAP fonts -CMAP's design standards require the usage of the Whitney typeface. Whitney is not freely available, but rather requires a license. On CMAP computers, which should already have the Whitney font family installed, cmapplot will use Whitney without any issues. If you receive a warning that Whitney is not installed when you load the package, please verify that the Whitney fonts (specifically, the Book, Medium and Semibold variants) are installed in **C:\\Windows\\Fonts**. If it is not, please submit an IT helpdesk request to get it installed. If Whitney *is* already installed and you are receiving the warning message, please reach out to a member of the cmapplot development team. +CMAP's design standards require the usage of the Whitney typeface. Whitney is not freely available, but rather requires a license. On CMAP computers, which should already have the Whitney font family installed, cmapplot will use Whitney without any issues. If you receive a warning that Whitney is not installed when you load the package, please verify that the Whitney fonts (specifically, the Book, Medium and Semibold variants) are installed. If it is not, please submit an IT helpdesk request to get them installed. If Whitney *is* already installed and you are receiving the warning message, please reach out to a member of the cmapplot development team. -Non-CMAP users will have to license Whitney on their own, or else use cmapplot with its fall-back fonts: Calibri (on Windows) or Arial (on macOS/Linux). +Non-CMAP users will have to license Whitney on their own, or else use cmapplot without. The package will default to your system's default sans-serif font, which is likely Arial. diff --git a/vignettes/plots.Rmd b/vignettes/plots.Rmd index 39224d85..6fce73bd 100644 --- a/vignettes/plots.Rmd +++ b/vignettes/plots.Rmd @@ -14,7 +14,8 @@ knitr::opts_chunk$set( fig.width = 7, fig.asp = 400/670, fig.retina = 4, - fig.align = "center" + fig.align = "center", + dev = "ragg_png" ) library(tidyverse) From 9ca3cd96f98c84166aec046bdc14decef378c297 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sun, 4 Apr 2021 23:22:28 -0500 Subject: [PATCH 043/173] set global tweak --- R/cmapplot_globals.R | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/R/cmapplot_globals.R b/R/cmapplot_globals.R index 8eb7e2b9..bf480428 100644 --- a/R/cmapplot_globals.R +++ b/R/cmapplot_globals.R @@ -161,8 +161,8 @@ get_cmapplot_global <- function(...){ #' @export set_cmapplot_global <- function(value, ..., quietly = FALSE){ - # do a full get to make sure the variable exists. - # this is a throw-away, just used to as a check + # do a get of the specific attribute to make sure it exists. + # this will error if the path is null p <- get_cmapplot_global(...) # establish vector of sublocations @@ -174,8 +174,12 @@ set_cmapplot_global <- function(value, ..., quietly = FALSE){ # build a string to evaluate that modifies some element of the item. str <- paste0( "item", - ifelse(length(names)>1, paste0("$", paste(names[-1], collapse = "$")),""), - "<- '", value, "'") + if(length(names)>1){ paste0("$", paste(names[-1], collapse = "$"))} else {""}, + "<- ", + if(!is.numeric(value)) {"'"} else {""}, + value, + if(!is.numeric(value)) {"'"} else {""} + ) # replace the specific item by evaluating the string eval(parse(text = str)) From 44fa37b6ac8aa531de50e79479679d6d8f6ef526 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Mon, 5 Apr 2021 00:39:13 -0500 Subject: [PATCH 044/173] Update DESCRIPTION --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index 1e6e1291..8159c1f0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -48,6 +48,7 @@ Imports: lubridate, magrittr, purrr, + ragg, rlang, scales, stringr, From d8d99d783b75d11b89d5cf36dafafb441cb47feb Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Mon, 5 Apr 2021 12:05:11 -0500 Subject: [PATCH 045/173] Move helper functions into utilities.R --- R/cmapplot.R | 123 +++----------------------------------------------- R/utilities.R | 99 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 105 insertions(+), 117 deletions(-) create mode 100644 R/utilities.R diff --git a/R/cmapplot.R b/R/cmapplot.R index 490a25c7..02e020c8 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -11,17 +11,13 @@ #' #' @name cmapplot #' @docType package -#' @import ggplot2 dplyr grid scales grDevices graphics rlang gridtext +#' @import dplyr ggplot2 graphics grDevices grid gridtext rlang scales systemfonts #' @importFrom glue glue glue_collapse #' @keywords internal "_PACKAGE" - - - -## Update fonts based on system -- *must* be done with .onLoad() -#' @import systemfonts +# Update fonts based on system -- *must* be done with .onLoad() .onLoad <- function(...) { family <- name <- path <- NULL @@ -40,10 +36,9 @@ # Update font variables assign("font", - list( - strong = list(family = "Whitney-Semibold", face = "plain"), - regular = list(family = "Whitney-Medium", face = "plain"), - light = list(family = "Whitney-Book", face = "plain")), + list(strong = list(family = "Whitney-Semibold", face = "plain"), + regular = list(family = "Whitney-Medium", face = "plain"), + light = list(family = "Whitney-Book", face = "plain")), envir = cmapplot_globals) } @@ -62,113 +57,7 @@ .onAttach <- function(...){ if(!get("use_whitney", envir = cmapplot_globals)){ packageStartupMessage( - "WARNING: Whitney is not installed on this machine, so CMAP theme will use your default sans-Serif font" + "WARNING: Whitney was not found on this machine, so CMAP theme will use your default sans-serif font" ) } } - - - - -# Font spec visualization helper function --------------------------------- - -#' Font visualization test -#' -#' This internal function uses base R graphics to display the five text variants -#' that should show up on a cmap themed graphic - and what fonts the package is -#' planning to use to display them. -#' -#' @noRd -display_cmap_fonts <- function() { - graphics::plot(c(0,2), c(0,6), type="n", xlab="", ylab="") - - draw.me <- function(name, font, size, placement){ - thisfont <- cmapplot_globals$font[[font]] - thissize <- cmapplot_globals$fsize[[size]] - - graphics::par(family=thisfont$family, - font=ifelse(thisfont$face == "bold", 2, 1)) - graphics::text(1, placement, - paste(name, - paste(paste("font:", font), paste("size:", size), sep = ", "), - paste(thisfont$family, thisfont$face, thissize, sep = ", "), - sep = " | "), - cex=thissize/12, ps=12) - } - - draw.me(name = "Title", font = "strong", size = "L", 5) - draw.me(name = "Main", font = "regular", size = "M", 4) - draw.me(name = "Axis", font = "light", size = "M", 3) - draw.me(name = "Label", font = "strong", size = "M", 2) - draw.me(name = "Note", font = "light", size = "S", 1) -} - - -# Plot sizes and colors --------------------------------------------------- - - -#' Line width conversion -#' -#' The factor \code{.lwd} is used to calculate correct output sizes for line -#' widths. For line widths in \code{ggplot2}, the size in mm must be divided -#' by this factor for correct output. Because the user is likely to prefer -#' other units besides for mm, \code{gg_lwd_convert()} is provided as a -#' convenience function, converting from any unit all the way to ggplot units. -#' -#' \code{.lwd} is equal to \code{ggplot2::.stroke / ggplot2::.pt}. In -#' \code{ggplot2}, the size in mm is divided by \code{.lwd} to achieve the -#' correct output. In the \code{grid} package, however, the size in points -#' (\code{pts} (or maybe \code{bigpts}? Unclear.) must be divided by -#' \code{.lwd}. The user is unlikely to interact directly with \code{grid}, -#' but this is how \code{finalize_plot()} does its work. -#' -#' This is closely related to \code{ggplot::.pt}, which is the factor that -#' font sizes (in \code{pts}) must be divided by for text geoms within -#' \code{ggplot2}. Confusingly, \code{.pt} is not required for \code{ggplot2} -#' font sizes outside the plot area: e.g. axis titles, etc. -#' -#' @seealso grid's \code{\link[grid]{unit}}, ggplot2's -#' \code{\link[ggplot2]{.pt}}, and -#' \url{https://stackoverflow.com/questions/17311917/ggplot2-the-unit-of-size} -#' -#' @examples -#' ggplot() + coord_cartesian(xlim = c(-3, 3), ylim = c(-3, 3)) + -#' -#' # a green line 3 points wide -#' geom_hline(yintercept = 1, color = "green", size = gg_lwd_convert(3)) + -#' -#' # black text of size 24 points -#' annotate("text", -2, 0, label = "text", size = 24/ggplot2::.pt) -#' -#' -#' # a blue line 6 points wide, drawn over the plot with the `grid` package -#' grid::grid.lines(y = 0.4, -#' gp = grid::gpar(col = "blue", lwd = 6 / .lwd)) -#' -#' -#' @export -.lwd <- ggplot2::.pt / ggplot2::.stroke - - -#' Helper function to calculate correct size for ggplot line widths. -#' -#' @param value Numeric, the value to be converted. -#' @param unit Char, the unit of the value to be converted. Can be any of the -#' units accepted by \code{grid::unit()}, including "bigpts", "pt", "mm", and -#' "in". Default is \code{bigpts}. -#' -#' @describeIn dot-lwd Function to convert from any unit directly to ggplot2's -#' preferred millimeters. -#' -#' @export -gg_lwd_convert <- function(value, unit = "bigpts") { - - # convert input type to mm - value_out <- grid::convertUnit(grid::unit(value, unit), "mm", valueOnly = TRUE) - - # return with conversion factor - return( - value_out / .lwd - ) -} - diff --git a/R/utilities.R b/R/utilities.R new file mode 100644 index 00000000..5dc3b24d --- /dev/null +++ b/R/utilities.R @@ -0,0 +1,99 @@ +# Font spec visualization helper function --------------------------------- + +#' Font visualization test +#' +#' This internal function uses base R graphics to display the five text variants +#' that should show up on a cmap themed graphic - and what fonts the package is +#' planning to use to display them. +#' +#' @noRd +display_cmap_fonts <- function() { + graphics::plot(c(0,2), c(0,6), type="n", xlab="", ylab="") + + draw.me <- function(name, font, size, placement){ + thisfont <- cmapplot_globals$font[[font]] + thissize <- cmapplot_globals$fsize[[size]] + + graphics::par(family=thisfont$family, + font=ifelse(thisfont$face == "bold", 2, 1)) + graphics::text(1, placement, + paste(name, + paste(paste("font:", font), paste("size:", size), sep = ", "), + paste(thisfont$family, thisfont$face, thissize, sep = ", "), + sep = " | "), + cex=thissize/12, ps=12) + } + + draw.me(name = "Title", font = "strong", size = "L", 5) + draw.me(name = "Main", font = "regular", size = "M", 4) + draw.me(name = "Axis", font = "light", size = "M", 3) + draw.me(name = "Label", font = "strong", size = "M", 2) + draw.me(name = "Note", font = "light", size = "S", 1) +} + + + +# Plot sizes and colors --------------------------------------------------- + +#' Line width conversion +#' +#' The factor \code{.lwd} is used to calculate correct output sizes for line +#' widths. For line widths in \code{ggplot2}, the size in mm must be divided +#' by this factor for correct output. Because the user is likely to prefer +#' other units besides for mm, \code{gg_lwd_convert()} is provided as a +#' convenience function, converting from any unit all the way to ggplot units. +#' +#' \code{.lwd} is equal to \code{ggplot2::.stroke / ggplot2::.pt}. In +#' \code{ggplot2}, the size in mm is divided by \code{.lwd} to achieve the +#' correct output. In the \code{grid} package, however, the size in points +#' (\code{pts} (or maybe \code{bigpts}? Unclear.) must be divided by +#' \code{.lwd}. The user is unlikely to interact directly with \code{grid}, +#' but this is how \code{finalize_plot()} does its work. +#' +#' This is closely related to \code{ggplot::.pt}, which is the factor that +#' font sizes (in \code{pts}) must be divided by for text geoms within +#' \code{ggplot2}. Confusingly, \code{.pt} is not required for \code{ggplot2} +#' font sizes outside the plot area: e.g. axis titles, etc. +#' +#' @seealso grid's \code{\link[grid]{unit}}, ggplot2's +#' \code{\link[ggplot2]{.pt}}, and +#' \url{https://stackoverflow.com/questions/17311917/ggplot2-the-unit-of-size} +#' +#' @examples +#' ggplot() + coord_cartesian(xlim = c(-3, 3), ylim = c(-3, 3)) + +#' +#' # a green line 3 points wide +#' geom_hline(yintercept = 1, color = "green", size = gg_lwd_convert(3)) + +#' +#' # black text of size 24 points +#' annotate("text", -2, 0, label = "text", size = 24/ggplot2::.pt) +#' +#' +#' # a blue line 6 points wide, drawn over the plot with the `grid` package +#' grid::grid.lines(y = 0.4, gp = grid::gpar(col = "blue", lwd = 6 / .lwd)) +#' +#' @export +.lwd <- ggplot2::.pt / ggplot2::.stroke + + +#' Helper function to calculate correct size for ggplot line widths. +#' +#' @param value Numeric, the value to be converted. +#' @param unit Char, the unit of the value to be converted. Can be any of the +#' units accepted by \code{grid::unit()}, including "bigpts", "pt", "mm", and +#' "in". Default is \code{bigpts}. +#' +#' @describeIn dot-lwd Function to convert from any unit directly to ggplot2's +#' preferred millimeters. +#' +#' @export +gg_lwd_convert <- function(value, unit = "bigpts") { + + # convert input type to mm + value_out <- grid::convertUnit(grid::unit(value, unit), "mm", valueOnly = TRUE) + + # return with conversion factor + return( + value_out / .lwd + ) +} From 91697944974dd34822e87898476a03b1f0dd0ff9 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Mon, 5 Apr 2021 12:05:28 -0500 Subject: [PATCH 046/173] Minor edits --- R/cmapplot_globals.R | 21 +++++++++------------ 1 file changed, 9 insertions(+), 12 deletions(-) diff --git a/R/cmapplot_globals.R b/R/cmapplot_globals.R index bf480428..ef33943c 100644 --- a/R/cmapplot_globals.R +++ b/R/cmapplot_globals.R @@ -1,27 +1,27 @@ -# establish location for cmapplot global variables +# Initialize environment for cmapplot global variables cmapplot_globals <- new.env(parent = emptyenv()) -# set up default font handling -# (overridden if local machine has Whitney in .onLoad) +# Set up default font handling +# (Note: overridden by .onLoad() if Whitney is available) cmapplot_globals$use_whitney <- FALSE cmapplot_globals$font <- list( strong = list(family = "sans", face = "bold"), regular = list(family = "sans", face = "plain"), light = list(family = "sans", face = "plain")) -# establish font sizes +# Set common font sizes cmapplot_globals$fsize <- list( S = 11, M = 14, L = 17 ) -## Colors +# Define CMAP colors cmapplot_globals$colors <- list( blackish = "#222222" ) -## Establish plotting constants in bigpts (1/72 of inch) +# Establish plotting constants in bigpts (1/72 of inch) cmapplot_globals$consts <- list( lwd_gridline = 0.3, lwd_strongline = 1, @@ -174,11 +174,9 @@ set_cmapplot_global <- function(value, ..., quietly = FALSE){ # build a string to evaluate that modifies some element of the item. str <- paste0( "item", - if(length(names)>1){ paste0("$", paste(names[-1], collapse = "$"))} else {""}, - "<- ", - if(!is.numeric(value)) {"'"} else {""}, - value, - if(!is.numeric(value)) {"'"} else {""} + ifelse(length(names) > 1, paste0("$", paste(names[-1], collapse = "$")), ""), + " <- ", + ifelse(!is.numeric(value), paste0("'", value, "'"), value) ) # replace the specific item by evaluating the string @@ -195,6 +193,5 @@ set_cmapplot_global <- function(value, ..., quietly = FALSE){ "New value: '", value, "'" )) } - invisible() } From f87e295ac95f37036f91412281dade17648bfc72 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Mon, 5 Apr 2021 12:15:00 -0500 Subject: [PATCH 047/173] Moved geoms_that_change definition into cmapplot_globals.R --- R/cmapplot_globals.R | 11 +++++++++++ R/default_aes.R | 11 ----------- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/R/cmapplot_globals.R b/R/cmapplot_globals.R index ef33943c..178209cc 100644 --- a/R/cmapplot_globals.R +++ b/R/cmapplot_globals.R @@ -44,6 +44,17 @@ cmapplot_globals$consts <- list( leading_caption = 1 ) +# List of all geoms whose aesthetics will be modified by cmapplot +cmapplot_globals$geoms_that_change <- c( + "Label", + "Line", + "Text", + "TextLast", + "PointLast", + "RecessionsText" +) + + #'The cmapplot_globals environment #' #'The \code{cmapplot_globals} environment contains a list of predefined diff --git a/R/default_aes.R b/R/default_aes.R index 0329588e..4cf716d8 100644 --- a/R/default_aes.R +++ b/R/default_aes.R @@ -1,14 +1,3 @@ -# list of all geoms whose aesthetics will be customized -cmapplot_globals$geoms_that_change <- c( - "Label", - "Line", - "Text", - "TextLast", - "PointLast", - "RecessionsText" -) - - #' Initialize CMAP `default_aes` values #' #' Internal function to load in default aesthetics for modified geoms. From 62896164214f7c0bd19842470289572936465f64 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Mon, 5 Apr 2021 12:26:14 -0500 Subject: [PATCH 048/173] Fixed typo --- R/default_aes.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/default_aes.R b/R/default_aes.R index 4cf716d8..7cdc7a26 100644 --- a/R/default_aes.R +++ b/R/default_aes.R @@ -58,7 +58,7 @@ init_cmap_default_aes <- function () { #' style standards, because (at least at the moment) setting geom aesthetic #' defaults on a plot-by-plot basis (such as with \code{ggplot2::theme}) is not #' possible. The geoms impacted are stored in -#' \code{cmapplot_globals$geoms_to_change}. +#' \code{cmapplot_globals$geoms_that_change}. #' #' These functions are employed implicitly within \code{\link{finalize_plot}} to #' apply preferred aesthetic defaults to final outputs. They are only necessary From eed080699f1ac9a11b6382331ebfdffa0b571c40 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Mon, 5 Apr 2021 12:26:36 -0500 Subject: [PATCH 049/173] Added note about font size units --- R/cmapplot_globals.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/cmapplot_globals.R b/R/cmapplot_globals.R index 178209cc..d0df1c74 100644 --- a/R/cmapplot_globals.R +++ b/R/cmapplot_globals.R @@ -9,7 +9,7 @@ cmapplot_globals$font <- list( regular = list(family = "sans", face = "plain"), light = list(family = "sans", face = "plain")) -# Set common font sizes +# Set common font sizes (bigpts) cmapplot_globals$fsize <- list( S = 11, M = 14, From 3f345bfa2ee493b7af5b9be7b77682377df597a8 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Mon, 5 Apr 2021 12:30:21 -0500 Subject: [PATCH 050/173] Rebuilt documentation --- man/cmap_default_aes.Rd | 2 +- man/dot-lwd.Rd | 6 ++---- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/man/cmap_default_aes.Rd b/man/cmap_default_aes.Rd index 44b99680..4c43639d 100644 --- a/man/cmap_default_aes.Rd +++ b/man/cmap_default_aes.Rd @@ -19,7 +19,7 @@ certain ggplot2 geoms. This is necessary for geoms to be "themed" to CMAP style standards, because (at least at the moment) setting geom aesthetic defaults on a plot-by-plot basis (such as with \code{ggplot2::theme}) is not possible. The geoms impacted are stored in -\code{cmapplot_globals$geoms_to_change}. +\code{cmapplot_globals$geoms_that_change}. } \details{ These functions are employed implicitly within \code{\link{finalize_plot}} to diff --git a/man/dot-lwd.Rd b/man/dot-lwd.Rd index 00356df8..62765db2 100644 --- a/man/dot-lwd.Rd +++ b/man/dot-lwd.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/cmapplot.R +% Please edit documentation in R/utilities.R \docType{data} \name{.lwd} \alias{.lwd} @@ -57,9 +57,7 @@ ggplot() + coord_cartesian(xlim = c(-3, 3), ylim = c(-3, 3)) + # a blue line 6 points wide, drawn over the plot with the `grid` package -grid::grid.lines(y = 0.4, - gp = grid::gpar(col = "blue", lwd = 6 / .lwd)) - +grid::grid.lines(y = 0.4, gp = grid::gpar(col = "blue", lwd = 6 / .lwd)) } \seealso{ From 93b21afa49149f24cdd7dc762a7c2f9fec4ffaeb Mon Sep 17 00:00:00 2001 From: sarahcmap Date: Mon, 5 Apr 2021 14:28:15 -0500 Subject: [PATCH 051/173] - add comma to description - spell out raster types again --- DESCRIPTION | 2 +- R/finalize_plot.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0f78cd68..d581658f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -52,7 +52,7 @@ Imports: rlang, scales, stringr, - systemfonts + systemfonts, svglite Suggests: knitr, diff --git a/R/finalize_plot.R b/R/finalize_plot.R index b2ae0c68..82536c00 100644 --- a/R/finalize_plot.R +++ b/R/finalize_plot.R @@ -695,7 +695,7 @@ save_plot <- function(finished_graphic, mode <- ifelse (mode == "pdf" | mode == "ps", paste0("cairo_" , mode), mode) # Add required agg prefix to function name for raster modes - mode <- ifelse (mode %in% savetypes_raster, paste0("agg_" , mode), mode) + mode <- ifelse (mode %in% c("png", "tiff", "jpeg"), paste0("agg_" , mode), mode) # change svg to svglite mode <- ifelse (mode == "svg", "svglite", mode) From b2db618149dedefca3b2402bce69152fc4938001 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux Date: Mon, 5 Apr 2021 14:37:53 -0500 Subject: [PATCH 052/173] Minor tweak to comment Just wanted to clarify the storage aspect. --- R/axis_handling.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/axis_handling.R b/R/axis_handling.R index 2db5185f..c8b5b498 100644 --- a/R/axis_handling.R +++ b/R/axis_handling.R @@ -69,9 +69,10 @@ abbr_years <- function(full_by_pos = c(1), fxn <- function(breaks) { - # If a date axis, breaks are stored as number of days since 1/1/1970. These - # must be converted to integer years, but this should error if all breaks - # don't fall on the same calendar day of a distinct year. + # If a date axis, breaks are stored by ggplot as the number of days since + # the origin date of January 1, 1970. These must be converted to integer + # years, but this should error if all breaks don't fall on the same calendar + # day of a distinct year. if (dateaxis) { dates <- as.Date(breaks, origin = "1970-01-01") From c4dcaa1650331e5987757f07ba3ac0cbb3bd2e97 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Mon, 5 Apr 2021 15:32:35 -0500 Subject: [PATCH 053/173] Corrected font size note Proving the point of why this needed to be added :) --- R/cmapplot_globals.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/cmapplot_globals.R b/R/cmapplot_globals.R index d0df1c74..3231b7e1 100644 --- a/R/cmapplot_globals.R +++ b/R/cmapplot_globals.R @@ -9,7 +9,7 @@ cmapplot_globals$font <- list( regular = list(family = "sans", face = "plain"), light = list(family = "sans", face = "plain")) -# Set common font sizes (bigpts) +# Set common font sizes (pts) cmapplot_globals$fsize <- list( S = 11, M = 14, From 44fbb8373295612bc8da5b6459354cf1e8d9ebcd Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Mon, 5 Apr 2021 15:46:47 -0500 Subject: [PATCH 054/173] Create test pkgdown action View results locally in gh-pages-test branch --- .github/workflows/pkgdown_test.yaml | 72 +++++++++++++++++++++++++++++ 1 file changed, 72 insertions(+) create mode 100644 .github/workflows/pkgdown_test.yaml diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml new file mode 100644 index 00000000..14f862d5 --- /dev/null +++ b/.github/workflows/pkgdown_test.yaml @@ -0,0 +1,72 @@ +# Automatically rebuilds pkgdown website any time master branch is updated. +# Based on . +on: + push: + branches: systemfonts + +name: pkgdown_systemfonts_test + +jobs: + pkgdown: + runs-on: macOS-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + steps: + - uses: actions/checkout@v2 + + - uses: r-lib/actions/setup-r@master + + - uses: r-lib/actions/setup-pandoc@master + + - name: Checkout CMAP fonts repo + uses: actions/checkout@v2 + with: + repository: CMAP-REPOS/cmap-fonts + token: ${{ secrets.CMAP_REPO_FULL_ACCESS }} + path: cmap-fonts + + - name: Install CMAP fonts for R access + # Inspiration: https://gist.github.com/Kevin-Lee/328e9993d6b3ad250636023fb2c7827f + run: | + repo_dir="$GITHUB_WORKSPACE/cmap-fonts" + font_dir="$HOME/Library/Fonts" + mkdir -p $font_dir + find_command="find \"$repo_dir\" -name '*.[o,t]tf' -type f -print0" + eval $find_command | xargs -0 -I % + eval $find_command | xargs -0 -I % cp "%" "$font_dir/" + find "$font_dir" -name '*.[o,t]tf' -print0 | xargs -0 -I % + + - name: Query dependencies + run: | + install.packages('remotes') + saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) + writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") + shell: Rscript {0} + + - name: Cache R packages + uses: actions/cache@v1 + with: + path: ${{ env.R_LIBS_USER }} + key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} + restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- + + - name: Install dependencies + run: | + remotes::install_deps(dependencies = TRUE) + install.packages("pkgdown") + shell: Rscript {0} + + - name: Check Whitney availability + run: | + all_fonts <- systemfonts::system_fonts() + message(paste(all_fonts$path[all_fonts$name %in% c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold")], collapse = "\n")) + shell: Rscript {0} + + - name: Install package + run: R CMD INSTALL . + + - name: Deploy package + run: | + git config --local user.email "actions@github.com" + git config --local user.name "GitHub Actions" + Rscript -e 'pkgdown::deploy_to_branch(branch="gh-pages-test", new_process = FALSE, clean = TRUE)' From 1b200fc30c4397d6a386db68703d5bf80ff47dd2 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Mon, 5 Apr 2021 16:08:53 -0500 Subject: [PATCH 055/173] Rebuilt NAMESPACE --- NAMESPACE | 1 - 1 file changed, 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index e8b6c2a8..dd94c2c8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -27,7 +27,6 @@ export(geom_text_lastonly) export(get_cmapplot_global) export(get_cmapplot_globals) export(gg_lwd_convert) -export(integer_breaks) export(set_cmapplot_global) export(theme_cmap) export(unapply_cmap_default_aes) From 9db07e944c50dd936da62056983f6f9ee465bc85 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Mon, 5 Apr 2021 16:09:03 -0500 Subject: [PATCH 056/173] Reference list tweaks --- pkgdown/_pkgdown.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index cff4c646..396cc842 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -22,13 +22,13 @@ reference: - title: Additional geoms & auxiliary functions - contents: - starts_with("geom_") - - cmap_default_aes + - ends_with("cmap_default_aes") - abbr_years -- title: Color Palettes and Gradients +- title: Color palettes & gradients - contents: - starts_with("viz_") - starts_with("cmap_fill_") -- title: Sample Datasets +- title: Sample datasets - contents: - cluster_jobchange - economy_basic @@ -41,7 +41,7 @@ reference: - vehicle_ownership - title: Lesser used objects - contents: - - ends_with("cmapplot_globals") + - contains("cmapplot_global") - gg_lwd_convert - update_recessions - customproto From 11db673d8b4b3e92f20b2a5bf0412df993a6ab42 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Mon, 5 Apr 2021 16:27:13 -0500 Subject: [PATCH 057/173] Print all located font files in log --- .github/workflows/pkgdown_test.yaml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index 14f862d5..89bd4919 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -59,7 +59,8 @@ jobs: - name: Check Whitney availability run: | all_fonts <- systemfonts::system_fonts() - message(paste(all_fonts$path[all_fonts$name %in% c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold")], collapse = "\n")) + message(paste(all_fonts$path, collapse = "\n")) + message(paste(all_fonts$name[all_fonts$name %in% c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold")], collapse = "\n")) shell: Rscript {0} - name: Install package From 4da37df4f131b269376e56fd13a1227ebd45d3e4 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Mon, 5 Apr 2021 17:07:46 -0500 Subject: [PATCH 058/173] Don't force all non-numeric types to character E.g. could not set TRUE or FALSE before --- R/cmapplot_globals.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/cmapplot_globals.R b/R/cmapplot_globals.R index 3231b7e1..85df09e4 100644 --- a/R/cmapplot_globals.R +++ b/R/cmapplot_globals.R @@ -187,7 +187,7 @@ set_cmapplot_global <- function(value, ..., quietly = FALSE){ "item", ifelse(length(names) > 1, paste0("$", paste(names[-1], collapse = "$")), ""), " <- ", - ifelse(!is.numeric(value), paste0("'", value, "'"), value) + ifelse(is.character(value), paste0("'", value, "'"), value) ) # replace the specific item by evaluating the string @@ -200,8 +200,8 @@ set_cmapplot_global <- function(value, ..., quietly = FALSE){ if(!quietly){ cat(paste0( "Item: ", paste(names, collapse = "$"), "\n", - "Old value: '", p, "'\n", - "New value: '", value, "'" + "Old value: ", ifelse(is.character(p), paste0("'", p, "'"), p), "\n", + "New value: ", ifelse(is.character(value), paste0("'", value, "'"), value) )) } invisible() From cc408161f37f83706f62f351689e39c4683ac266 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Mon, 5 Apr 2021 17:20:34 -0500 Subject: [PATCH 059/173] Attempt to register fonts --- .github/workflows/pkgdown_test.yaml | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index 89bd4919..f32721f7 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -56,18 +56,28 @@ jobs: install.packages("pkgdown") shell: Rscript {0} - - name: Check Whitney availability - run: | - all_fonts <- systemfonts::system_fonts() - message(paste(all_fonts$path, collapse = "\n")) - message(paste(all_fonts$name[all_fonts$name %in% c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold")], collapse = "\n")) - shell: Rscript {0} + # - name: Check Whitney availability + # run: | + # all_fonts <- systemfonts::system_fonts() + # message(paste(all_fonts$path, collapse = "\n")) + # message(paste(all_fonts$name[all_fonts$name %in% c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold")], collapse = "\n")) + # shell: Rscript {0} - name: Install package run: R CMD INSTALL . - - name: Deploy package + - name: Set git config run: | git config --local user.email "actions@github.com" git config --local user.name "GitHub Actions" - Rscript -e 'pkgdown::deploy_to_branch(branch="gh-pages-test", new_process = FALSE, clean = TRUE)' + + -name: Deploy package + run: | + font_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") + font_files <- list.files(font_dir, pattern = "Whitney") + font_names <- stringr::str_extract(font_files, "^[^.]+") + font_paths <- paste(font_dir, font_files, sep = "/") + purrr::walk2(font_names, font_paths, systemfonts::register_font) + message(cmapplot::get_cmapplot_global("use_whitney")) + pkgdown::deploy_to_branch(branch="gh-pages-test", new_process = FALSE, clean = TRUE) + shell Rscript {0} From c3d3aa6c8cda872b6a67d6f64124472f4e097dfd Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Mon, 5 Apr 2021 17:22:13 -0500 Subject: [PATCH 060/173] Corrected syntax issue --- .github/workflows/pkgdown_test.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index f32721f7..2fd9a143 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -80,4 +80,4 @@ jobs: purrr::walk2(font_names, font_paths, systemfonts::register_font) message(cmapplot::get_cmapplot_global("use_whitney")) pkgdown::deploy_to_branch(branch="gh-pages-test", new_process = FALSE, clean = TRUE) - shell Rscript {0} + shell: Rscript {0} From 715fd28189942bd688691ca4f85c449c0a82b5e4 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Mon, 5 Apr 2021 17:23:26 -0500 Subject: [PATCH 061/173] Corrected another syntax issue --- .github/workflows/pkgdown_test.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index 2fd9a143..89031229 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -71,7 +71,7 @@ jobs: git config --local user.email "actions@github.com" git config --local user.name "GitHub Actions" - -name: Deploy package + - name: Deploy package run: | font_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") font_files <- list.files(font_dir, pattern = "Whitney") From 5a4694583328fa83ec96089015f7bccd36d00381 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Mon, 5 Apr 2021 17:33:35 -0500 Subject: [PATCH 062/173] Unload/reload cmapplot before deploy --- .github/workflows/pkgdown_test.yaml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index 89031229..9279dbdf 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -73,11 +73,15 @@ jobs: - name: Deploy package run: | + detach("package:cmapplot", unload = TRUE) font_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") font_files <- list.files(font_dir, pattern = "Whitney") font_names <- stringr::str_extract(font_files, "^[^.]+") + message(font_names) font_paths <- paste(font_dir, font_files, sep = "/") + message(font_paths) purrr::walk2(font_names, font_paths, systemfonts::register_font) - message(cmapplot::get_cmapplot_global("use_whitney")) + library(cmapplot) + message(get_cmapplot_global("use_whitney")) pkgdown::deploy_to_branch(branch="gh-pages-test", new_process = FALSE, clean = TRUE) shell: Rscript {0} From 130c5b2736902268575c0adb778276099c142052 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Mon, 5 Apr 2021 17:39:34 -0500 Subject: [PATCH 063/173] Try devtools::reload() instead --- .github/workflows/pkgdown_test.yaml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index 9279dbdf..1d7f86c2 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -73,7 +73,6 @@ jobs: - name: Deploy package run: | - detach("package:cmapplot", unload = TRUE) font_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") font_files <- list.files(font_dir, pattern = "Whitney") font_names <- stringr::str_extract(font_files, "^[^.]+") @@ -81,7 +80,7 @@ jobs: font_paths <- paste(font_dir, font_files, sep = "/") message(font_paths) purrr::walk2(font_names, font_paths, systemfonts::register_font) - library(cmapplot) + devtools::reload() message(get_cmapplot_global("use_whitney")) pkgdown::deploy_to_branch(branch="gh-pages-test", new_process = FALSE, clean = TRUE) shell: Rscript {0} From fdcf783a65db5a3e8bc049c0d3832ffc6a92cf20 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Mon, 5 Apr 2021 17:46:52 -0500 Subject: [PATCH 064/173] One last attempt for the day... --- .github/workflows/pkgdown_test.yaml | 3 --- 1 file changed, 3 deletions(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index 1d7f86c2..164b82a0 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -76,11 +76,8 @@ jobs: font_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") font_files <- list.files(font_dir, pattern = "Whitney") font_names <- stringr::str_extract(font_files, "^[^.]+") - message(font_names) font_paths <- paste(font_dir, font_files, sep = "/") - message(font_paths) purrr::walk2(font_names, font_paths, systemfonts::register_font) - devtools::reload() message(get_cmapplot_global("use_whitney")) pkgdown::deploy_to_branch(branch="gh-pages-test", new_process = FALSE, clean = TRUE) shell: Rscript {0} From 32cb82251694da9f848093b8730d8449d9fbbe6b Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Mon, 5 Apr 2021 17:47:58 -0500 Subject: [PATCH 065/173] Just kidding, this is the real last attempt today --- .github/workflows/pkgdown_test.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index 164b82a0..e8aa3688 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -78,6 +78,7 @@ jobs: font_names <- stringr::str_extract(font_files, "^[^.]+") font_paths <- paste(font_dir, font_files, sep = "/") purrr::walk2(font_names, font_paths, systemfonts::register_font) + library(cmapplot) message(get_cmapplot_global("use_whitney")) pkgdown::deploy_to_branch(branch="gh-pages-test", new_process = FALSE, clean = TRUE) shell: Rscript {0} From 9ec7364cf832b60c022dd974dbe820e69900d3f1 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Tue, 6 Apr 2021 09:56:55 -0500 Subject: [PATCH 066/173] Check for Whitney in systemfonts::registry_fonts() too --- R/cmapplot.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index 02e020c8..f5db7d83 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -23,7 +23,11 @@ family <- name <- path <- NULL # check for Whitney - all_fonts <- systemfonts::system_fonts() + #all_fonts <- systemfonts::system_fonts() + all_fonts <- dplyr::bind_rows( + dplyr::select(systemfonts::system_fonts(), name, family, path), + dplyr::transmute(systemfonts::registry_fonts(), name = family, family = family, path = path) + ) whitney_core <- all_fonts$name[all_fonts$name %in% c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold")] assign("use_whitney", length(whitney_core) >= 3, envir = cmapplot_globals) From 2cfec6fcc42111fbd7369b6dbc2f77e616bdef0e Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Tue, 6 Apr 2021 09:57:22 -0500 Subject: [PATCH 067/173] Manually register fonts --- .github/workflows/pkgdown_test.yaml | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index e8aa3688..0764bca4 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -74,10 +74,9 @@ jobs: - name: Deploy package run: | font_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") - font_files <- list.files(font_dir, pattern = "Whitney") - font_names <- stringr::str_extract(font_files, "^[^.]+") - font_paths <- paste(font_dir, font_files, sep = "/") - purrr::walk2(font_names, font_paths, systemfonts::register_font) + systemfonts::register_font("Whitney-Book", plain=paste0(font_dir, "/Whitney-Book-Adv.otf"), italic=paste0(font_dir, "/Whitney-BookItal-Adv.otf")) + systemfonts::register_font("Whitney-Medium", plain=paste0(font_dir, "/Whitney-Medium-Adv.otf"), italic=paste0(font_dir, "/Whitney-MediumItal-Adv.otf")) + systemfonts::register_font("Whitney-Semibold", plain=paste0(font_dir, "/Whitney-Semibold-Adv.otf"), italic=paste0(font_dir, "/Whitney-SemiboldItal-Adv.otf")) library(cmapplot) message(get_cmapplot_global("use_whitney")) pkgdown::deploy_to_branch(branch="gh-pages-test", new_process = FALSE, clean = TRUE) From 608be33b04c0f3f90519adb27e68318742ef1cf9 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Tue, 6 Apr 2021 10:35:21 -0500 Subject: [PATCH 068/173] Print registry_fonts() family/path to log --- .github/workflows/pkgdown_test.yaml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index 0764bca4..b3547954 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -77,7 +77,8 @@ jobs: systemfonts::register_font("Whitney-Book", plain=paste0(font_dir, "/Whitney-Book-Adv.otf"), italic=paste0(font_dir, "/Whitney-BookItal-Adv.otf")) systemfonts::register_font("Whitney-Medium", plain=paste0(font_dir, "/Whitney-Medium-Adv.otf"), italic=paste0(font_dir, "/Whitney-MediumItal-Adv.otf")) systemfonts::register_font("Whitney-Semibold", plain=paste0(font_dir, "/Whitney-Semibold-Adv.otf"), italic=paste0(font_dir, "/Whitney-SemiboldItal-Adv.otf")) + message(paste(systemfonts::registry_fonts()$family, systemfonts::registry_fonts()$path, collapse="\n")) library(cmapplot) message(get_cmapplot_global("use_whitney")) - pkgdown::deploy_to_branch(branch="gh-pages-test", new_process = FALSE, clean = TRUE) + pkgdown::deploy_to_branch(branch="gh-pages-test", new_process=FALSE, clean=TRUE) shell: Rscript {0} From c022a2b844718fc8f9288a820fa3341da5f511e1 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Tue, 6 Apr 2021 17:14:09 -0500 Subject: [PATCH 069/173] a test --- .github/workflows/pkgdown_test.yaml | 2 ++ R/cmapplot.R | 10 +++++----- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index b3547954..9c6ef18d 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -80,5 +80,7 @@ jobs: message(paste(systemfonts::registry_fonts()$family, systemfonts::registry_fonts()$path, collapse="\n")) library(cmapplot) message(get_cmapplot_global("use_whitney")) + message(paste(systemfonts::registry_fonts()$family, systemfonts::registry_fonts()$path, collapse = "\n")) + message(get_cmapplot_global("font$strong")) pkgdown::deploy_to_branch(branch="gh-pages-test", new_process=FALSE, clean=TRUE) shell: Rscript {0} diff --git a/R/cmapplot.R b/R/cmapplot.R index f5db7d83..c6b4913c 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -32,11 +32,11 @@ assign("use_whitney", length(whitney_core) >= 3, envir = cmapplot_globals) if(get("use_whitney", envir = cmapplot_globals)){ - # Register all Whitney fonts (note: this registers italic fonts both as - # variants of core fonts and as standalone fonts, so there is some - # duplication.) - whitney_fonts <- select(filter(all_fonts, family == "Whitney"), name, path) - purrr::walk2(whitney_fonts$name, whitney_fonts$path, systemfonts::register_font) + # # Register all Whitney fonts (note: this registers italic fonts both as + # # variants of core fonts and as standalone fonts, so there is some + # # duplication.) + # whitney_fonts <- select(filter(all_fonts, family == "Whitney"), name, path) + # purrr::walk2(whitney_fonts$name, whitney_fonts$path, systemfonts::register_font) # Update font variables assign("font", From 11dc0ffcf9ff620f36bf1767849d6d752a9562ae Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Tue, 6 Apr 2021 18:46:16 -0500 Subject: [PATCH 070/173] test 2 --- .github/workflows/pkgdown_test.yaml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index 9c6ef18d..b72735bd 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -73,6 +73,7 @@ jobs: - name: Deploy package run: | + systemfonts::clear::registry() font_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") systemfonts::register_font("Whitney-Book", plain=paste0(font_dir, "/Whitney-Book-Adv.otf"), italic=paste0(font_dir, "/Whitney-BookItal-Adv.otf")) systemfonts::register_font("Whitney-Medium", plain=paste0(font_dir, "/Whitney-Medium-Adv.otf"), italic=paste0(font_dir, "/Whitney-MediumItal-Adv.otf")) @@ -80,7 +81,6 @@ jobs: message(paste(systemfonts::registry_fonts()$family, systemfonts::registry_fonts()$path, collapse="\n")) library(cmapplot) message(get_cmapplot_global("use_whitney")) - message(paste(systemfonts::registry_fonts()$family, systemfonts::registry_fonts()$path, collapse = "\n")) - message(get_cmapplot_global("font$strong")) + message(paste(get_cmapplot_global("font"), collapse = " ")) pkgdown::deploy_to_branch(branch="gh-pages-test", new_process=FALSE, clean=TRUE) shell: Rscript {0} From f69c275ca42d58586a4583d141a2a5c968761598 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Tue, 6 Apr 2021 19:27:05 -0500 Subject: [PATCH 071/173] typo --- .github/workflows/pkgdown_test.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index b72735bd..3743e2db 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -73,7 +73,7 @@ jobs: - name: Deploy package run: | - systemfonts::clear::registry() + systemfonts::clear_registry() font_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") systemfonts::register_font("Whitney-Book", plain=paste0(font_dir, "/Whitney-Book-Adv.otf"), italic=paste0(font_dir, "/Whitney-BookItal-Adv.otf")) systemfonts::register_font("Whitney-Medium", plain=paste0(font_dir, "/Whitney-Medium-Adv.otf"), italic=paste0(font_dir, "/Whitney-MediumItal-Adv.otf")) From 881a49675d2832fa7b66ecbd4a8d9de3cf772aad Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Tue, 6 Apr 2021 20:01:26 -0500 Subject: [PATCH 072/173] no italics? --- .github/workflows/pkgdown_test.yaml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index 3743e2db..cb3dc8cb 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -75,9 +75,9 @@ jobs: run: | systemfonts::clear_registry() font_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") - systemfonts::register_font("Whitney-Book", plain=paste0(font_dir, "/Whitney-Book-Adv.otf"), italic=paste0(font_dir, "/Whitney-BookItal-Adv.otf")) - systemfonts::register_font("Whitney-Medium", plain=paste0(font_dir, "/Whitney-Medium-Adv.otf"), italic=paste0(font_dir, "/Whitney-MediumItal-Adv.otf")) - systemfonts::register_font("Whitney-Semibold", plain=paste0(font_dir, "/Whitney-Semibold-Adv.otf"), italic=paste0(font_dir, "/Whitney-SemiboldItal-Adv.otf")) + systemfonts::register_font("Whitney-Book", paste0(font_dir, "/Whitney-Book-Adv.otf")) + systemfonts::register_font("Whitney-Medium", paste0(font_dir, "/Whitney-Medium-Adv.otf")) + systemfonts::register_font("Whitney-Semibold", paste0(font_dir, "/Whitney-Semibold-Adv.otf")) message(paste(systemfonts::registry_fonts()$family, systemfonts::registry_fonts()$path, collapse="\n")) library(cmapplot) message(get_cmapplot_global("use_whitney")) From ac2932dd07aaa5b02fcf88a776609579fbeb9fb2 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Wed, 7 Apr 2021 10:45:21 -0500 Subject: [PATCH 073/173] Register fonts from cloned repo instead of ~/Library/Fonts --- .github/workflows/pkgdown_test.yaml | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index cb3dc8cb..db5d9f81 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -25,16 +25,16 @@ jobs: token: ${{ secrets.CMAP_REPO_FULL_ACCESS }} path: cmap-fonts - - name: Install CMAP fonts for R access - # Inspiration: https://gist.github.com/Kevin-Lee/328e9993d6b3ad250636023fb2c7827f - run: | - repo_dir="$GITHUB_WORKSPACE/cmap-fonts" - font_dir="$HOME/Library/Fonts" - mkdir -p $font_dir - find_command="find \"$repo_dir\" -name '*.[o,t]tf' -type f -print0" - eval $find_command | xargs -0 -I % - eval $find_command | xargs -0 -I % cp "%" "$font_dir/" - find "$font_dir" -name '*.[o,t]tf' -print0 | xargs -0 -I % + # - name: Install CMAP fonts for R access + # # Inspiration: https://gist.github.com/Kevin-Lee/328e9993d6b3ad250636023fb2c7827f + # run: | + # repo_dir="$GITHUB_WORKSPACE/cmap-fonts" + # font_dir="$HOME/Library/Fonts" + # mkdir -p $font_dir + # find_command="find \"$repo_dir\" -name '*.[o,t]tf' -type f -print0" + # eval $find_command | xargs -0 -I % + # eval $find_command | xargs -0 -I % cp "%" "$font_dir/" + # find "$font_dir" -name '*.[o,t]tf' -print0 | xargs -0 -I % - name: Query dependencies run: | @@ -73,11 +73,10 @@ jobs: - name: Deploy package run: | - systemfonts::clear_registry() - font_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") - systemfonts::register_font("Whitney-Book", paste0(font_dir, "/Whitney-Book-Adv.otf")) - systemfonts::register_font("Whitney-Medium", paste0(font_dir, "/Whitney-Medium-Adv.otf")) - systemfonts::register_font("Whitney-Semibold", paste0(font_dir, "/Whitney-Semibold-Adv.otf")) + font_dir <- paste0(Sys.getenv("GITHUB_WORKSPACE"), "/cmap-fonts") + systemfonts::register_font("Whitney-Book", paste0(font_dir, "/Whitney-Book-Adv.otf"), italic=paste0(font_dir, "/Whitney-BookItal-Adv.otf")) + systemfonts::register_font("Whitney-Medium", paste0(font_dir, "/Whitney-Medium-Adv.otf"), italic=paste0(font_dir, "/Whitney-MediumItal-Adv.otf")) + systemfonts::register_font("Whitney-Semibold", paste0(font_dir, "/Whitney-Semibold-Adv.otf"), italic=paste0(font_dir, "/Whitney-SemiboldItal-Adv.otf")) message(paste(systemfonts::registry_fonts()$family, systemfonts::registry_fonts()$path, collapse="\n")) library(cmapplot) message(get_cmapplot_global("use_whitney")) From a0786435d40e4f42ab15f039d1eac98a62a68df0 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Thu, 8 Apr 2021 15:30:57 -0500 Subject: [PATCH 074/173] typo fix --- R/cmapplot.R | 2 +- man/cmapplot_globals.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index 01090bc0..ed9086f9 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -60,7 +60,7 @@ #' caption). \strong{(F)} \item \code{margin_sidebar_l}: The margin between the #' left edge of the image and the title and caption, when the sidebar exists. #' Deducted from \code{title_width}. \strong{(F)} \item \code{margin_plot_l}: -#' The margin between the left edge of the plot and the sodebar. \strong{(F)} +#' The margin between the left edge of the plot and the sidebar. \strong{(F)} #' \item \code{margin_plot_r}: The margin between the right edge of the plot #' and the edge of the image. \strong{(F)} \item \code{margin_panel_r}: Padding #' between the plot and its right-hand drawing extent. Override this based on diff --git a/man/cmapplot_globals.Rd b/man/cmapplot_globals.Rd index df2e9ac7..6467c019 100644 --- a/man/cmapplot_globals.Rd +++ b/man/cmapplot_globals.Rd @@ -53,7 +53,7 @@ list of constants which aid in drawing cmap-themed plots. caption). \strong{(F)} \item \code{margin_sidebar_l}: The margin between the left edge of the image and the title and caption, when the sidebar exists. Deducted from \code{title_width}. \strong{(F)} \item \code{margin_plot_l}: - The margin between the left edge of the plot and the sodebar. \strong{(F)} + The margin between the left edge of the plot and the sidebar. \strong{(F)} \item \code{margin_plot_r}: The margin between the right edge of the plot and the edge of the image. \strong{(F)} \item \code{margin_panel_r}: Padding between the plot and its right-hand drawing extent. Override this based on From f4e8d1bd35703beae01cd0d48569bb89ff57ad73 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sat, 10 Apr 2021 07:14:53 -0500 Subject: [PATCH 075/173] print font registry in vignette --- vignettes/finalize.Rmd | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/vignettes/finalize.Rmd b/vignettes/finalize.Rmd index 84520827..8c27df4a 100644 --- a/vignettes/finalize.Rmd +++ b/vignettes/finalize.Rmd @@ -7,7 +7,7 @@ vignette: > %\VignetteEncoding{UTF-8} --- -```{r setup, include = FALSE} +```{r setup} knitr::opts_chunk$set( collapse = TRUE, comment = "#>", @@ -43,6 +43,8 @@ p <- ggplot(data = df, nudge_x = 0.5) + coord_cartesian(clip = "off") + theme_cmap() + +systemfonts::registry_fonts() ``` `finalize_plot()` will place a ggplot into a frame defined by CMAP design standards. It will align your title and caption to the left, add a horizontal line on top, and make other adjustments. It can show you the final plot and/or export it as a raster or vector file. This function will not apply CMAP design standards to the plot itself; use `theme_cmap()` for that. From 418944fa792bfe0c9981bec06adb8f4911adeded Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sun, 11 Apr 2021 17:29:28 -0500 Subject: [PATCH 076/173] print contents of VM font folder --- .github/workflows/pkgdown_test.yaml | 35 ++++++++++++++++------------- R/cmapplot.R | 9 ++++---- 2 files changed, 24 insertions(+), 20 deletions(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index db5d9f81..c4d10307 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -25,16 +25,16 @@ jobs: token: ${{ secrets.CMAP_REPO_FULL_ACCESS }} path: cmap-fonts - # - name: Install CMAP fonts for R access - # # Inspiration: https://gist.github.com/Kevin-Lee/328e9993d6b3ad250636023fb2c7827f - # run: | - # repo_dir="$GITHUB_WORKSPACE/cmap-fonts" - # font_dir="$HOME/Library/Fonts" - # mkdir -p $font_dir - # find_command="find \"$repo_dir\" -name '*.[o,t]tf' -type f -print0" - # eval $find_command | xargs -0 -I % - # eval $find_command | xargs -0 -I % cp "%" "$font_dir/" - # find "$font_dir" -name '*.[o,t]tf' -print0 | xargs -0 -I % + - name: Install CMAP fonts for R access + # Inspiration: https://gist.github.com/Kevin-Lee/328e9993d6b3ad250636023fb2c7827f + run: | + repo_dir="$GITHUB_WORKSPACE/cmap-fonts" + font_dir="$HOME/Library/Fonts" + mkdir -p $font_dir + find_command="find \"$repo_dir\" -name '*.[o,t]tf' -type f -print0" + eval $find_command | xargs -0 -I % + eval $find_command | xargs -0 -I % cp "%" "$font_dir/" + find "$font_dir" -name '*.[o,t]tf' -print0 | xargs -0 -I % - name: Query dependencies run: | @@ -56,12 +56,15 @@ jobs: install.packages("pkgdown") shell: Rscript {0} - # - name: Check Whitney availability - # run: | - # all_fonts <- systemfonts::system_fonts() - # message(paste(all_fonts$path, collapse = "\n")) - # message(paste(all_fonts$name[all_fonts$name %in% c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold")], collapse = "\n")) - # shell: Rscript {0} + - name: Check Whitney availability + run: | + all_fonts <- systemfonts::system_fonts() + message("CONTENTS OF SYSTEMFONTS:") + message(paste(all_fonts$path, collapse = "\n")) + message(paste(all_fonts$name[all_fonts$name %in% c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold")], collapse = "\n")) + message("CONTENTS OF USER FONT FILE:") + message(paste(list.files(paste0(Sys.getenv("HOME"), "/Library/Fonts")), collapse = "\n")) + shell: Rscript {0} - name: Install package run: R CMD INSTALL . diff --git a/R/cmapplot.R b/R/cmapplot.R index c6b4913c..c5e4991d 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -24,13 +24,14 @@ # check for Whitney #all_fonts <- systemfonts::system_fonts() - all_fonts <- dplyr::bind_rows( - dplyr::select(systemfonts::system_fonts(), name, family, path), - dplyr::transmute(systemfonts::registry_fonts(), name = family, family = family, path = path) - ) + all_fonts <- systemfonts::system_fonts() whitney_core <- all_fonts$name[all_fonts$name %in% c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold")] assign("use_whitney", length(whitney_core) >= 3, envir = cmapplot_globals) + if(!get("use_whitney", envir = cmapplot_globals)){ + + } + if(get("use_whitney", envir = cmapplot_globals)){ # # Register all Whitney fonts (note: this registers italic fonts both as # # variants of core fonts and as standalone fonts, so there is some From 4b9e6479a6666ab2da41a56eec3bb35bdcd8b4a2 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sun, 11 Apr 2021 17:44:05 -0500 Subject: [PATCH 077/173] clean up pkgdown GHA --- .github/workflows/pkgdown_test.yaml | 25 +++++++------------------ 1 file changed, 7 insertions(+), 18 deletions(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index c4d10307..8ee2bebb 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -59,30 +59,19 @@ jobs: - name: Check Whitney availability run: | all_fonts <- systemfonts::system_fonts() - message("CONTENTS OF SYSTEMFONTS:") - message(paste(all_fonts$path, collapse = "\n")) + message("FONTS AUTOMATICALLY AVAILABLE TO SYSTEMFONTS:") message(paste(all_fonts$name[all_fonts$name %in% c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold")], collapse = "\n")) - message("CONTENTS OF USER FONT FILE:") - message(paste(list.files(paste0(Sys.getenv("HOME"), "/Library/Fonts")), collapse = "\n")) + user_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") + message(paste0("CONTENTS OF ", user_dir, ":") + message(paste(list.files(), collapse = "\n")) shell: Rscript {0} - name: Install package run: R CMD INSTALL . - - name: Set git config - run: | - git config --local user.email "actions@github.com" - git config --local user.name "GitHub Actions" - name: Deploy package run: | - font_dir <- paste0(Sys.getenv("GITHUB_WORKSPACE"), "/cmap-fonts") - systemfonts::register_font("Whitney-Book", paste0(font_dir, "/Whitney-Book-Adv.otf"), italic=paste0(font_dir, "/Whitney-BookItal-Adv.otf")) - systemfonts::register_font("Whitney-Medium", paste0(font_dir, "/Whitney-Medium-Adv.otf"), italic=paste0(font_dir, "/Whitney-MediumItal-Adv.otf")) - systemfonts::register_font("Whitney-Semibold", paste0(font_dir, "/Whitney-Semibold-Adv.otf"), italic=paste0(font_dir, "/Whitney-SemiboldItal-Adv.otf")) - message(paste(systemfonts::registry_fonts()$family, systemfonts::registry_fonts()$path, collapse="\n")) - library(cmapplot) - message(get_cmapplot_global("use_whitney")) - message(paste(get_cmapplot_global("font"), collapse = " ")) - pkgdown::deploy_to_branch(branch="gh-pages-test", new_process=FALSE, clean=TRUE) - shell: Rscript {0} + git config --local user.email "actions@github.com" + git config --local user.name "GitHub Actions" + Rscript -e 'pkgdown::deploy_to_branch(branch="gh-pages-test", new_process = FALSE, clean = TRUE)' From da5ab92a235548e4440d24babcf60ec1a6b43ebd Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sun, 11 Apr 2021 17:46:10 -0500 Subject: [PATCH 078/173] typo --- .github/workflows/pkgdown_test.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index 8ee2bebb..52188813 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -62,7 +62,7 @@ jobs: message("FONTS AUTOMATICALLY AVAILABLE TO SYSTEMFONTS:") message(paste(all_fonts$name[all_fonts$name %in% c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold")], collapse = "\n")) user_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") - message(paste0("CONTENTS OF ", user_dir, ":") + message(paste0("CONTENTS OF ", user_dir, ":")) message(paste(list.files(), collapse = "\n")) shell: Rscript {0} From 3b08605be8669b7f5d35be705bdbea16c71c8683 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sun, 11 Apr 2021 17:51:14 -0500 Subject: [PATCH 079/173] tweak font dir --- .github/workflows/pkgdown_test.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index 52188813..7fb22ba5 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -61,7 +61,7 @@ jobs: all_fonts <- systemfonts::system_fonts() message("FONTS AUTOMATICALLY AVAILABLE TO SYSTEMFONTS:") message(paste(all_fonts$name[all_fonts$name %in% c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold")], collapse = "\n")) - user_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") + user_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts/cmap-fonts") message(paste0("CONTENTS OF ", user_dir, ":")) message(paste(list.files(), collapse = "\n")) shell: Rscript {0} From 524f73a58dc9a5f5b11330d186fe4da2605b3456 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sun, 11 Apr 2021 17:57:36 -0500 Subject: [PATCH 080/173] another typo --- .github/workflows/pkgdown_test.yaml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index 7fb22ba5..0b0c6d66 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -61,9 +61,9 @@ jobs: all_fonts <- systemfonts::system_fonts() message("FONTS AUTOMATICALLY AVAILABLE TO SYSTEMFONTS:") message(paste(all_fonts$name[all_fonts$name %in% c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold")], collapse = "\n")) - user_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts/cmap-fonts") + user_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") message(paste0("CONTENTS OF ", user_dir, ":")) - message(paste(list.files(), collapse = "\n")) + message(paste(list.files(user_dir), collapse = "\n")) shell: Rscript {0} - name: Install package From a8ba10057bd7fa1f58d3f8b14aef9864754fba5b Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sun, 11 Apr 2021 18:52:25 -0500 Subject: [PATCH 081/173] mac font registration attempt 1 --- .github/workflows/pkgdown_test.yaml | 4 ++-- R/cmapplot.R | 29 ++++++++++++++++++----------- vignettes/finalize.Rmd | 4 +--- 3 files changed, 21 insertions(+), 16 deletions(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index 0b0c6d66..0a73aafe 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -59,8 +59,8 @@ jobs: - name: Check Whitney availability run: | all_fonts <- systemfonts::system_fonts() - message("FONTS AUTOMATICALLY AVAILABLE TO SYSTEMFONTS:") - message(paste(all_fonts$name[all_fonts$name %in% c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold")], collapse = "\n")) + message("WHITNEY FONTS AUTOMATICALLY AVAILABLE TO SYSTEMFONTS:") + message(paste(all_fonts$name[grepl("^Whitney", all_fonts$name)], collapse = "\n")) user_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") message(paste0("CONTENTS OF ", user_dir, ":")) message(paste(list.files(user_dir), collapse = "\n")) diff --git a/R/cmapplot.R b/R/cmapplot.R index c5e4991d..be8d634f 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -23,23 +23,30 @@ family <- name <- path <- NULL # check for Whitney - #all_fonts <- systemfonts::system_fonts() all_fonts <- systemfonts::system_fonts() - whitney_core <- all_fonts$name[all_fonts$name %in% c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold")] - assign("use_whitney", length(whitney_core) >= 3, envir = cmapplot_globals) + whitney_core <- c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold") + assign("use_whitney", + length(all_fonts$name[all_fonts$name %in% whitney_core]) >= 3, + envir = cmapplot_globals) - if(!get("use_whitney", envir = cmapplot_globals)){ + # If on a Mac, and !use_whitney, attempt to register from user's fonts folder + ## SHOULD THIS BE CHANGED TO ONLY IMPACT THE VM? SUCH AS USER == "runner"??? + if(.Platform$OS.type != "windows" & !get("use_whitney", envir = cmapplot_globals)){ + # attempt to register fonts in user's fonts folder + ## SHOULD THIS BE CHANGED TO ONLY WHITNEY FONTS? + user_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") + user_font_names <- sub("-Adv.otf$", "", list.files(user_dir)) + user_font_paths <- list.files(user_dir, full.names = TRUE) + purr::walk2(user_font_names, user_font_paths, systemfonts::register_font) + registry_fonts <- systemfonts::registry_fonts() + assign("use_whitney", + length(registry_fonts$name[registry_fonts$name %in% whitney_core]) >= 3, + envir = cmapplot_globals) } + # Update font names if(get("use_whitney", envir = cmapplot_globals)){ - # # Register all Whitney fonts (note: this registers italic fonts both as - # # variants of core fonts and as standalone fonts, so there is some - # # duplication.) - # whitney_fonts <- select(filter(all_fonts, family == "Whitney"), name, path) - # purrr::walk2(whitney_fonts$name, whitney_fonts$path, systemfonts::register_font) - - # Update font variables assign("font", list(strong = list(family = "Whitney-Semibold", face = "plain"), regular = list(family = "Whitney-Medium", face = "plain"), diff --git a/vignettes/finalize.Rmd b/vignettes/finalize.Rmd index 8c27df4a..84520827 100644 --- a/vignettes/finalize.Rmd +++ b/vignettes/finalize.Rmd @@ -7,7 +7,7 @@ vignette: > %\VignetteEncoding{UTF-8} --- -```{r setup} +```{r setup, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>", @@ -43,8 +43,6 @@ p <- ggplot(data = df, nudge_x = 0.5) + coord_cartesian(clip = "off") + theme_cmap() - -systemfonts::registry_fonts() ``` `finalize_plot()` will place a ggplot into a frame defined by CMAP design standards. It will align your title and caption to the left, add a horizontal line on top, and make other adjustments. It can show you the final plot and/or export it as a raster or vector file. This function will not apply CMAP design standards to the plot itself; use `theme_cmap()` for that. From ad921baddc64067fc3b29c5b6759e26ffd7a81f6 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sun, 11 Apr 2021 18:54:07 -0500 Subject: [PATCH 082/173] typo --- R/cmapplot.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index be8d634f..a8a9da9b 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -37,7 +37,7 @@ user_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") user_font_names <- sub("-Adv.otf$", "", list.files(user_dir)) user_font_paths <- list.files(user_dir, full.names = TRUE) - purr::walk2(user_font_names, user_font_paths, systemfonts::register_font) + purrr::walk2(user_font_names, user_font_paths, systemfonts::register_font) registry_fonts <- systemfonts::registry_fonts() assign("use_whitney", From a20eb26ab09483d7fb877861d0736fccc7bcf4f0 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sun, 11 Apr 2021 21:01:27 -0500 Subject: [PATCH 083/173] new branch --- .github/workflows/pkgdown_test.yaml | 2 +- vignettes/finalize.Rmd | 4 +++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index 0a73aafe..7bf11fac 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -74,4 +74,4 @@ jobs: run: | git config --local user.email "actions@github.com" git config --local user.name "GitHub Actions" - Rscript -e 'pkgdown::deploy_to_branch(branch="gh-pages-test", new_process = FALSE, clean = TRUE)' + Rscript -e 'pkgdown::deploy_to_branch(branch="gh-pages-test2", clean = TRUE)' diff --git a/vignettes/finalize.Rmd b/vignettes/finalize.Rmd index 84520827..8c27df4a 100644 --- a/vignettes/finalize.Rmd +++ b/vignettes/finalize.Rmd @@ -7,7 +7,7 @@ vignette: > %\VignetteEncoding{UTF-8} --- -```{r setup, include = FALSE} +```{r setup} knitr::opts_chunk$set( collapse = TRUE, comment = "#>", @@ -43,6 +43,8 @@ p <- ggplot(data = df, nudge_x = 0.5) + coord_cartesian(clip = "off") + theme_cmap() + +systemfonts::registry_fonts() ``` `finalize_plot()` will place a ggplot into a frame defined by CMAP design standards. It will align your title and caption to the left, add a horizontal line on top, and make other adjustments. It can show you the final plot and/or export it as a raster or vector file. This function will not apply CMAP design standards to the plot itself; use `theme_cmap()` for that. From 1b519aca6e4a73b6e4b8e413140e7edf8d8d863c Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Fri, 16 Apr 2021 16:38:41 -0500 Subject: [PATCH 084/173] test --- R/cmapplot.R | 1 + vignettes/finalize.Rmd | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index a8a9da9b..9d986c55 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -40,6 +40,7 @@ purrr::walk2(user_font_names, user_font_paths, systemfonts::register_font) registry_fonts <- systemfonts::registry_fonts() + message(paste(registry_fonts, collapse = "\n")) ## temp assign("use_whitney", length(registry_fonts$name[registry_fonts$name %in% whitney_core]) >= 3, envir = cmapplot_globals) diff --git a/vignettes/finalize.Rmd b/vignettes/finalize.Rmd index 8c27df4a..382b7c67 100644 --- a/vignettes/finalize.Rmd +++ b/vignettes/finalize.Rmd @@ -44,7 +44,7 @@ p <- ggplot(data = df, coord_cartesian(clip = "off") + theme_cmap() -systemfonts::registry_fonts() +systemfonts::registry_fonts() ``` `finalize_plot()` will place a ggplot into a frame defined by CMAP design standards. It will align your title and caption to the left, add a horizontal line on top, and make other adjustments. It can show you the final plot and/or export it as a raster or vector file. This function will not apply CMAP design standards to the plot itself; use `theme_cmap()` for that. From 013787bbeac492d47377b356c811c4f0bf4b0f5d Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Fri, 16 Apr 2021 16:46:24 -0500 Subject: [PATCH 085/173] typo --- R/cmapplot.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index 9d986c55..95cc169f 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -40,9 +40,9 @@ purrr::walk2(user_font_names, user_font_paths, systemfonts::register_font) registry_fonts <- systemfonts::registry_fonts() - message(paste(registry_fonts, collapse = "\n")) ## temp + message(length(registry_fonts$family[registry_fonts$family %in% whitney_core])) ## temp assign("use_whitney", - length(registry_fonts$name[registry_fonts$name %in% whitney_core]) >= 3, + length(registry_fonts$family[registry_fonts$family %in% whitney_core]) >= 3, envir = cmapplot_globals) } From 51b8f242e3fedf8a123e63e5bdc245cb5f7b8b68 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Mon, 19 Apr 2021 01:41:33 -0500 Subject: [PATCH 086/173] getting things working again --- .github/workflows/pkgdown_test.yaml | 4 +- R/cmapplot.R | 57 +++++++++++++++++++---------- R/utilities.R | 26 +++++++++++++ 3 files changed, 65 insertions(+), 22 deletions(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index 7bf11fac..a5a72b11 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -56,13 +56,13 @@ jobs: install.packages("pkgdown") shell: Rscript {0} - - name: Check Whitney availability + - name: Check Whitney availability in R run: | all_fonts <- systemfonts::system_fonts() message("WHITNEY FONTS AUTOMATICALLY AVAILABLE TO SYSTEMFONTS:") message(paste(all_fonts$name[grepl("^Whitney", all_fonts$name)], collapse = "\n")) user_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") - message(paste0("CONTENTS OF ", user_dir, ":")) + message(paste0("CONTENTS OF ", user_dir, " (MUST BE REGISTERED):")) message(paste(list.files(user_dir), collapse = "\n")) shell: Rscript {0} diff --git a/R/cmapplot.R b/R/cmapplot.R index 95cc169f..0cc8e781 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -22,28 +22,45 @@ family <- name <- path <- NULL - # check for Whitney - all_fonts <- systemfonts::system_fonts() - whitney_core <- c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold") - assign("use_whitney", - length(all_fonts$name[all_fonts$name %in% whitney_core]) >= 3, - envir = cmapplot_globals) + # if font registry already contains whitney core, set use_whitney == TRUE + check_for_whitney_core(set_global = TRUE) + + # else, register all whitney fonts in systemfonts. Then, if font registry + # contains whitney core, set use_whitney == TRUE + # + # (This is necessary because R looks up font by "family" with only basic + # variation (bold, italic, etc), so fonts like "Whitney-Book" are inaccessible + # by default. Font registration allows us to use the font's "name" as it's + # "family" so R can identify it.) + if(!get("use_whitney", envir = cmapplot_globals)){ + + whitney_fonts <- systemfonts::system_fonts() %>% + dplyr::filter(family == "Whitney") %>% + dplyr::select(name, path) + + purrr::walk2(whitney_fonts$name, whitney_fonts$path, systemfonts::register_font) + + check_for_whitney_core(set_global = TRUE) + } + + # else, if not on Windows, check for /Library/Fonts directory. + # register all Whitney fonts in this folder. + # If font registry contains whitney core, set use_whitney == TRUE + if(!get("use_whitney", envir = cmapplot_globals) & .Platform$OS.type != "windows"){ - # If on a Mac, and !use_whitney, attempt to register from user's fonts folder - ## SHOULD THIS BE CHANGED TO ONLY IMPACT THE VM? SUCH AS USER == "runner"??? - if(.Platform$OS.type != "windows" & !get("use_whitney", envir = cmapplot_globals)){ - # attempt to register fonts in user's fonts folder - ## SHOULD THIS BE CHANGED TO ONLY WHITNEY FONTS? user_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") - user_font_names <- sub("-Adv.otf$", "", list.files(user_dir)) - user_font_paths <- list.files(user_dir, full.names = TRUE) - purrr::walk2(user_font_names, user_font_paths, systemfonts::register_font) - - registry_fonts <- systemfonts::registry_fonts() - message(length(registry_fonts$family[registry_fonts$family %in% whitney_core])) ## temp - assign("use_whitney", - length(registry_fonts$family[registry_fonts$family %in% whitney_core]) >= 3, - envir = cmapplot_globals) + + if(dir.exists(user_dir)){ + whitney_fonts <- list.files(user_dir, full.names = TRUE) %>% + as.data.frame() %>% + rlang::set_names("path") %>% + dplyr::filter(stringr::str_detect(path, "Whitney")) %>% # Will error for username of "Whitney" + dplyr::mutate(name = stringr::str_extract(path, "Whitney-[:alpha:]*(?=-Adv.otf$)")) + + purrr::walk2(whitney_fonts$name, whitney_fonts$path, systemfonts::register_font) + + check_for_whitney_core(set_global = TRUE) + } } # Update font names diff --git a/R/utilities.R b/R/utilities.R index 5dc3b24d..b123172a 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -97,3 +97,29 @@ gg_lwd_convert <- function(value, unit = "bigpts") { value_out / .lwd ) } + + +#' Check for necessary Whitney fonts in systemfonts registry +#' +#' Invisibly returns TRUE or FALSE based on whether the three used Whitney fonts +#' are available in the systemfonts registry. +#' +#' @param set_global sets cmapplot_globals$use_whitney based on results +#' +#' @noRd +check_for_whitney_core <- function(set_global = FALSE){ + + whitney_core <- c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold") + + registry_fonts <- systemfonts::registry_fonts() + + whitney_core_present <- nrow(registry_fonts[registry_fonts$family %in% whitney_core,]) >= 3 + + if(set_global){ + assign("use_whitney", + whitney_core_present, + envir = cmapplot_globals) + } + + invisible(whitney_core_present) +} From b62472b50c8f794365078c33658bda607f8d5405 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Mon, 19 Apr 2021 01:46:44 -0500 Subject: [PATCH 087/173] clean up vignette testing --- vignettes/finalize.Rmd | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/vignettes/finalize.Rmd b/vignettes/finalize.Rmd index 382b7c67..84520827 100644 --- a/vignettes/finalize.Rmd +++ b/vignettes/finalize.Rmd @@ -7,7 +7,7 @@ vignette: > %\VignetteEncoding{UTF-8} --- -```{r setup} +```{r setup, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>", @@ -43,8 +43,6 @@ p <- ggplot(data = df, nudge_x = 0.5) + coord_cartesian(clip = "off") + theme_cmap() - -systemfonts::registry_fonts() ``` `finalize_plot()` will place a ggplot into a frame defined by CMAP design standards. It will align your title and caption to the left, add a horizontal line on top, and make other adjustments. It can show you the final plot and/or export it as a raster or vector file. This function will not apply CMAP design standards to the plot itself; use `theme_cmap()` for that. From 6c3e4ac85a4d699f6f0d9da33534d5fbbed573c9 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Mon, 19 Apr 2021 13:07:18 -0500 Subject: [PATCH 088/173] update pkgdown GHAs --- .github/workflows/pkgdown.yaml | 14 +++++++++----- .github/workflows/pkgdown_test.yaml | 5 +++-- 2 files changed, 12 insertions(+), 7 deletions(-) diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index fa4decf0..c73f5d03 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -56,11 +56,15 @@ jobs: install.packages("pkgdown") shell: Rscript {0} - - name: Check Whitney availability + - name: Check Whitney availability in R run: | - message(paste(sysfonts::font_paths(), collapse = "\n")) - all_fonts <- sysfonts::font_files() - message(paste(all_fonts[all_fonts$family %in% c("Whitney Medium", "Whitney Book", "Whitney Semibold") & all_fonts$face=="Regular", "file"], collapse = "\n")) + all_fonts <- systemfonts::system_fonts() + message("WHITNEY FONTS AUTOMATICALLY AVAILABLE TO SYSTEMFONTS:") + message(paste(all_fonts$name[grepl("^Whitney", all_fonts$name)], collapse = "\n")) + user_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") + library_fonts <- list.files(user_dir) + message(paste0("WHITNEY FONTS IN ", user_dir, " (MUST BE REGISTERED):")) + message(paste(library_fonts[grepl("^Whitney", library_fonts)], collapse = "\n")) shell: Rscript {0} - name: Install package @@ -70,4 +74,4 @@ jobs: run: | git config --local user.email "actions@github.com" git config --local user.name "GitHub Actions" - Rscript -e 'pkgdown::deploy_to_branch(new_process = FALSE, clean = TRUE)' + Rscript -e 'pkgdown::deploy_to_branch(clean = TRUE)' diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index a5a72b11..8bc28cb3 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -62,8 +62,9 @@ jobs: message("WHITNEY FONTS AUTOMATICALLY AVAILABLE TO SYSTEMFONTS:") message(paste(all_fonts$name[grepl("^Whitney", all_fonts$name)], collapse = "\n")) user_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") - message(paste0("CONTENTS OF ", user_dir, " (MUST BE REGISTERED):")) - message(paste(list.files(user_dir), collapse = "\n")) + library_fonts <- list.files(user_dir) + message(paste0("WHITNEY FONTS IN ", user_dir, " (MUST BE REGISTERED):")) + message(paste(library_fonts[grepl("^Whitney", library_fonts)], collapse = "\n")) shell: Rscript {0} - name: Install package From 90803ab7a73ba1744eff635c233e1fc73fc1fcc5 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Mon, 19 Apr 2021 13:25:21 -0500 Subject: [PATCH 089/173] adjust location of preferred font names --- R/cmapplot.R | 6 +++--- R/cmapplot_globals.R | 7 +++++++ R/utilities.R | 6 +++--- 3 files changed, 13 insertions(+), 6 deletions(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index 0cc8e781..930ce71d 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -66,9 +66,9 @@ # Update font names if(get("use_whitney", envir = cmapplot_globals)){ assign("font", - list(strong = list(family = "Whitney-Semibold", face = "plain"), - regular = list(family = "Whitney-Medium", face = "plain"), - light = list(family = "Whitney-Book", face = "plain")), + list(strong = list(family = cmapplot_globals$preferred_font$strong, face = "plain"), + regular = list(family = cmapplot_globals$preferred_font$regular, face = "plain"), + light = list(family = cmapplot_globals$preferred_font$light, face = "plain")), envir = cmapplot_globals) } diff --git a/R/cmapplot_globals.R b/R/cmapplot_globals.R index 85df09e4..0a65ef16 100644 --- a/R/cmapplot_globals.R +++ b/R/cmapplot_globals.R @@ -1,6 +1,13 @@ # Initialize environment for cmapplot global variables cmapplot_globals <- new.env(parent = emptyenv()) +# Establish names of preferred fonts +cmapplot_globals$preferred_font <- list( + strong = "Whitney-Semibold", + regular = "Whitney-Medium", + light = "Whitney-Book" +) + # Set up default font handling # (Note: overridden by .onLoad() if Whitney is available) cmapplot_globals$use_whitney <- FALSE diff --git a/R/utilities.R b/R/utilities.R index b123172a..c3f50254 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -109,11 +109,11 @@ gg_lwd_convert <- function(value, unit = "bigpts") { #' @noRd check_for_whitney_core <- function(set_global = FALSE){ - whitney_core <- c("Whitney-Medium", "Whitney-Book", "Whitney-Semibold") - registry_fonts <- systemfonts::registry_fonts() - whitney_core_present <- nrow(registry_fonts[registry_fonts$family %in% whitney_core,]) >= 3 + whitney_core_present <- nrow( + registry_fonts[registry_fonts$family %in% cmapplot_globals$preferred_font,] + ) >= 3 if(set_global){ assign("use_whitney", From 5ff89ba5fbe2b002dd8bbf2da6765a58d3fbc4be Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Wed, 21 Apr 2021 10:04:47 -0500 Subject: [PATCH 090/173] Minor tweaks --- .github/workflows/pkgdown_test.yaml | 1 - R/cmapplot.R | 14 +++++++------- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index 8bc28cb3..9d8547cd 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -70,7 +70,6 @@ jobs: - name: Install package run: R CMD INSTALL . - - name: Deploy package run: | git config --local user.email "actions@github.com" diff --git a/R/cmapplot.R b/R/cmapplot.R index 930ce71d..efbc34ae 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -22,15 +22,15 @@ family <- name <- path <- NULL - # if font registry already contains whitney core, set use_whitney == TRUE + # If font registry already contains whitney core, set use_whitney == TRUE check_for_whitney_core(set_global = TRUE) - # else, register all whitney fonts in systemfonts. Then, if font registry - # contains whitney core, set use_whitney == TRUE + # Else, register all whitney fonts in systemfonts. Then, if font registry + # contains whitney core, set use_whitney == TRUE. # # (This is necessary because R looks up font by "family" with only basic # variation (bold, italic, etc), so fonts like "Whitney-Book" are inaccessible - # by default. Font registration allows us to use the font's "name" as it's + # by default. Font registration allows us to use the font's "name" as its # "family" so R can identify it.) if(!get("use_whitney", envir = cmapplot_globals)){ @@ -43,8 +43,8 @@ check_for_whitney_core(set_global = TRUE) } - # else, if not on Windows, check for /Library/Fonts directory. - # register all Whitney fonts in this folder. + # Else, if not on Windows, check for ~/Library/Fonts directory. + # Register all Whitney fonts in this folder. # If font registry contains whitney core, set use_whitney == TRUE if(!get("use_whitney", envir = cmapplot_globals) & .Platform$OS.type != "windows"){ @@ -54,7 +54,7 @@ whitney_fonts <- list.files(user_dir, full.names = TRUE) %>% as.data.frame() %>% rlang::set_names("path") %>% - dplyr::filter(stringr::str_detect(path, "Whitney")) %>% # Will error for username of "Whitney" + dplyr::filter(stringr::str_detect(path, "Whitney-")) %>% # Hope "Whitney-" is not in username! dplyr::mutate(name = stringr::str_extract(path, "Whitney-[:alpha:]*(?=-Adv.otf$)")) purrr::walk2(whitney_fonts$name, whitney_fonts$path, systemfonts::register_font) From bc4adb23bf3abfd1bbb6cd197826c8170ed2774b Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Fri, 23 Apr 2021 01:31:28 -0500 Subject: [PATCH 091/173] custom registration --- R/cmapplot.R | 57 ++++++++++++++++++++++++++++---------------- R/cmapplot_globals.R | 6 ++--- R/utilities.R | 24 +++++++++++++++---- 3 files changed, 60 insertions(+), 27 deletions(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index efbc34ae..ecdc518e 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -23,44 +23,61 @@ family <- name <- path <- NULL # If font registry already contains whitney core, set use_whitney == TRUE - check_for_whitney_core(set_global = TRUE) + check_for_fonts(set_global = TRUE) - # Else, register all whitney fonts in systemfonts. Then, if font registry - # contains whitney core, set use_whitney == TRUE. + # Else, Find and register necessary whitney varients using systemfonts (or, + # alternatively, find them manually in ~/Library/Fonts). Then, if font + # registry contains whitney core, set use_whitney == TRUE. # # (This is necessary because R looks up font by "family" with only basic # variation (bold, italic, etc), so fonts like "Whitney-Book" are inaccessible - # by default. Font registration allows us to use the font's "name" as its - # "family" so R can identify it.) + # by default.) if(!get("use_whitney", envir = cmapplot_globals)){ whitney_fonts <- systemfonts::system_fonts() %>% dplyr::filter(family == "Whitney") %>% dplyr::select(name, path) - purrr::walk2(whitney_fonts$name, whitney_fonts$path, systemfonts::register_font) - - check_for_whitney_core(set_global = TRUE) - } - - # Else, if not on Windows, check for ~/Library/Fonts directory. - # Register all Whitney fonts in this folder. - # If font registry contains whitney core, set use_whitney == TRUE - if(!get("use_whitney", envir = cmapplot_globals) & .Platform$OS.type != "windows"){ - + # On some OSX systems (e.g. pkgdown GHA VM) system_fonts() cannot find fonts + # installed in the user fonts directory. In any case where system_fonts() + # sees no Whitney fonts, if `user_dir` exists it too is checked for fonts. user_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") - - if(dir.exists(user_dir)){ + if(nrow(whitney_fonts == 0) & dir.exists(user_dir)){ whitney_fonts <- list.files(user_dir, full.names = TRUE) %>% as.data.frame() %>% rlang::set_names("path") %>% dplyr::filter(stringr::str_detect(path, "Whitney-")) %>% # Hope "Whitney-" is not in username! dplyr::mutate(name = stringr::str_extract(path, "Whitney-[:alpha:]*(?=-Adv.otf$)")) + } - purrr::walk2(whitney_fonts$name, whitney_fonts$path, systemfonts::register_font) + # register preferred strong font (Whitney Semibold), with variants + systemfonts::register_font( + name = cmapplot_globals$preferred_font$strong, + plain = find_path("Whitney-Semibold", whitney_fonts), + bold = find_path("Whitney-Black", whitney_fonts), + italic = find_path("Whitney-SemiboldItalic", whitney_fonts), + bolditalic = find_path("Whitney-BlackItalic", whitney_fonts) + ) - check_for_whitney_core(set_global = TRUE) - } + # register preferred regular font (Whitney Medium), with variants + systemfonts::register_font( + name = cmapplot_globals$preferred_font$regular, + plain = find_path("Whitney-Medium", whitney_fonts), + bold = find_path("Whitney-Bold", whitney_fonts), + italic = find_path("Whitney-MediumItalic", whitney_fonts), + bolditalic = find_path("Whitney-BoldItalic", whitney_fonts) + ) + + # register preferred light font (Whitney Book), with variants + systemfonts::register_font( + name = cmapplot_globals$preferred_font$light, + plain = find_path("Whitney-Book", whitney_fonts), + bold = find_path("Whitney-Semibold", whitney_fonts), + italic = find_path("Whitney-BookItalic", whitney_fonts), + bolditalic = find_path("Whitney-SemiboldItalic", whitney_fonts) + ) + + check_for_fonts(set_global = TRUE) } # Update font names diff --git a/R/cmapplot_globals.R b/R/cmapplot_globals.R index 0a65ef16..a86f2c3e 100644 --- a/R/cmapplot_globals.R +++ b/R/cmapplot_globals.R @@ -3,9 +3,9 @@ cmapplot_globals <- new.env(parent = emptyenv()) # Establish names of preferred fonts cmapplot_globals$preferred_font <- list( - strong = "Whitney-Semibold", - regular = "Whitney-Medium", - light = "Whitney-Book" + strong = "Whitney Semibold", + regular = "Whitney Medium", + light = "Whitney Book" ) # Set up default font handling diff --git a/R/utilities.R b/R/utilities.R index c3f50254..e88c070c 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -107,19 +107,35 @@ gg_lwd_convert <- function(value, unit = "bigpts") { #' @param set_global sets cmapplot_globals$use_whitney based on results #' #' @noRd -check_for_whitney_core <- function(set_global = FALSE){ +check_for_fonts <- function(set_global = FALSE){ registry_fonts <- systemfonts::registry_fonts() - whitney_core_present <- nrow( + fonts_present <- nrow( registry_fonts[registry_fonts$family %in% cmapplot_globals$preferred_font,] ) >= 3 if(set_global){ assign("use_whitney", - whitney_core_present, + fonts_present, envir = cmapplot_globals) } - invisible(whitney_core_present) + invisible(fonts_present) +} + +#' Find a "path" using a "name" +#' +#' Taking a dataframe that has columns "name" and "path", search for one +#' specific name and, if a perfect match is found, return it's "path". +#' +#' @noRd +find_path <- function(query, df){ + df <- dplyr::filter(df, stringr::str_detect(name, paste0("^", query, "$"))) + + if(nrow(df) == 1){ + return(df[[1,"path"]]) + } else { + stop("Font not found", call. = FALSE) + } } From 233773a601548e8fd0cb31c7a3ac07875b53d8b8 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Fri, 23 Apr 2021 01:37:56 -0500 Subject: [PATCH 092/173] test message --- R/cmapplot.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/cmapplot.R b/R/cmapplot.R index ecdc518e..a5a94d52 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -48,6 +48,8 @@ rlang::set_names("path") %>% dplyr::filter(stringr::str_detect(path, "Whitney-")) %>% # Hope "Whitney-" is not in username! dplyr::mutate(name = stringr::str_extract(path, "Whitney-[:alpha:]*(?=-Adv.otf$)")) + + message(paste(whitney_fonts, collapse = "\n")) } # register preferred strong font (Whitney Semibold), with variants From 5ba8cded31d52382330af7870965ca4fd58813a3 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Fri, 23 Apr 2021 01:41:37 -0500 Subject: [PATCH 093/173] new check --- R/cmapplot.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/cmapplot.R b/R/cmapplot.R index a5a94d52..4ef19139 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -33,6 +33,8 @@ # variation (bold, italic, etc), so fonts like "Whitney-Book" are inaccessible # by default.) if(!get("use_whitney", envir = cmapplot_globals)){ + packageStartupMessage("Attempting to register Whitney fonts...") + message("Attempting to register Whitney fonts...") whitney_fonts <- systemfonts::system_fonts() %>% dplyr::filter(family == "Whitney") %>% From cface8d6b043ffb47db03ef25eb79b1f0c2c720a Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Fri, 23 Apr 2021 01:46:31 -0500 Subject: [PATCH 094/173] new check --- R/cmapplot.R | 3 --- R/utilities.R | 2 +- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index 4ef19139..1206007e 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -33,9 +33,6 @@ # variation (bold, italic, etc), so fonts like "Whitney-Book" are inaccessible # by default.) if(!get("use_whitney", envir = cmapplot_globals)){ - packageStartupMessage("Attempting to register Whitney fonts...") - message("Attempting to register Whitney fonts...") - whitney_fonts <- systemfonts::system_fonts() %>% dplyr::filter(family == "Whitney") %>% dplyr::select(name, path) diff --git a/R/utilities.R b/R/utilities.R index e88c070c..8c22ee20 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -136,6 +136,6 @@ find_path <- function(query, df){ if(nrow(df) == 1){ return(df[[1,"path"]]) } else { - stop("Font not found", call. = FALSE) + stop(paste0("Font '", query, "' not found"), call. = FALSE) } } From c76adff69c2dcc2b501b71984d2a1b0541c0e63e Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Fri, 23 Apr 2021 01:59:21 -0500 Subject: [PATCH 095/173] new check --- R/cmapplot.R | 2 -- R/utilities.R | 5 +++-- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index 1206007e..87661cbc 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -47,8 +47,6 @@ rlang::set_names("path") %>% dplyr::filter(stringr::str_detect(path, "Whitney-")) %>% # Hope "Whitney-" is not in username! dplyr::mutate(name = stringr::str_extract(path, "Whitney-[:alpha:]*(?=-Adv.otf$)")) - - message(paste(whitney_fonts, collapse = "\n")) } # register preferred strong font (Whitney Semibold), with variants diff --git a/R/utilities.R b/R/utilities.R index 8c22ee20..cf79c7bc 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -131,11 +131,12 @@ check_for_fonts <- function(set_global = FALSE){ #' #' @noRd find_path <- function(query, df){ - df <- dplyr::filter(df, stringr::str_detect(name, paste0("^", query, "$"))) + query <- paste0("^", query, "$") + df <- dplyr::filter(df, stringr::str_detect(name, query)) if(nrow(df) == 1){ return(df[[1,"path"]]) } else { - stop(paste0("Font '", query, "' not found"), call. = FALSE) + stop(paste0("Font '", query, "' not found. Query: ", query, ". nrow: ", nrow(df)), call. = FALSE) } } From ba44649d0c0405ba1cfecd80d7b085374d832b4c Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Fri, 23 Apr 2021 02:03:11 -0500 Subject: [PATCH 096/173] more checkssss --- R/utilities.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/utilities.R b/R/utilities.R index cf79c7bc..f732474a 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -131,12 +131,12 @@ check_for_fonts <- function(set_global = FALSE){ #' #' @noRd find_path <- function(query, df){ - query <- paste0("^", query, "$") - df <- dplyr::filter(df, stringr::str_detect(name, query)) + warning("test warning") + df2 <- dplyr::filter(df, stringr::str_detect(name, paste0("^", query, "$"))) - if(nrow(df) == 1){ - return(df[[1,"path"]]) + if(nrow(df2) == 1){ + return(df2[[1,"path"]]) } else { - stop(paste0("Font '", query, "' not found. Query: ", query, ". nrow: ", nrow(df)), call. = FALSE) + stop(paste0("Font '", query, "' not found. nrow before: ", nrow(df), ". nrow after: ", nrow(df2)), call. = FALSE) } } From 5546ff2d98c336f73df20a95e86a65c900d882f2 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Fri, 23 Apr 2021 02:09:47 -0500 Subject: [PATCH 097/173] new checks --- R/cmapplot.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/cmapplot.R b/R/cmapplot.R index 87661cbc..13adc923 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -42,6 +42,7 @@ # sees no Whitney fonts, if `user_dir` exists it too is checked for fonts. user_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") if(nrow(whitney_fonts == 0) & dir.exists(user_dir)){ + warning(paste("alternative search in", user_dir)) whitney_fonts <- list.files(user_dir, full.names = TRUE) %>% as.data.frame() %>% rlang::set_names("path") %>% @@ -49,6 +50,8 @@ dplyr::mutate(name = stringr::str_extract(path, "Whitney-[:alpha:]*(?=-Adv.otf$)")) } + warning(paste(whitney_fonts, collapse = "\n")) + # register preferred strong font (Whitney Semibold), with variants systemfonts::register_font( name = cmapplot_globals$preferred_font$strong, From ba1590add20755a7f52e2b7e456e99e64ac0fdb3 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Fri, 23 Apr 2021 02:12:41 -0500 Subject: [PATCH 098/173] I think I found it! --- R/cmapplot.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index 13adc923..24365161 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -41,7 +41,7 @@ # installed in the user fonts directory. In any case where system_fonts() # sees no Whitney fonts, if `user_dir` exists it too is checked for fonts. user_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") - if(nrow(whitney_fonts == 0) & dir.exists(user_dir)){ + if(nrow(whitney_fonts) == 0 & dir.exists(user_dir)){ warning(paste("alternative search in", user_dir)) whitney_fonts <- list.files(user_dir, full.names = TRUE) %>% as.data.frame() %>% From 64e2ce86011dd123fc80011663aea06285267a0f Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Fri, 23 Apr 2021 02:40:39 -0500 Subject: [PATCH 099/173] lets try this --- R/cmapplot.R | 50 +++++++++++++++++++++++++++----------------------- R/utilities.R | 38 ++++++++------------------------------ 2 files changed, 35 insertions(+), 53 deletions(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index 24365161..7062b0f2 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -23,7 +23,14 @@ family <- name <- path <- NULL # If font registry already contains whitney core, set use_whitney == TRUE - check_for_fonts(set_global = TRUE) + fonts_present <- systemfonts::registry_fonts() %>% + dplyr::filter(family %in% cmapplot_globals$preferred_font) %>% + nrow() >= 12 + + assign("use_whitney", + fonts_present, + envir = cmapplot_globals) + # Else, Find and register necessary whitney varients using systemfonts (or, # alternatively, find them manually in ~/Library/Fonts). Then, if font @@ -33,50 +40,47 @@ # variation (bold, italic, etc), so fonts like "Whitney-Book" are inaccessible # by default.) if(!get("use_whitney", envir = cmapplot_globals)){ - whitney_fonts <- systemfonts::system_fonts() %>% + whitney_paths <- systemfonts::system_fonts() %>% dplyr::filter(family == "Whitney") %>% - dplyr::select(name, path) + .[["path"]] # On some OSX systems (e.g. pkgdown GHA VM) system_fonts() cannot find fonts # installed in the user fonts directory. In any case where system_fonts() - # sees no Whitney fonts, if `user_dir` exists it too is checked for fonts. + # sees no Whitney fonts, if `user_dir` exists, it too is checked for fonts. user_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") - if(nrow(whitney_fonts) == 0 & dir.exists(user_dir)){ + if(length(whitney_paths) == 0 & dir.exists(user_dir)){ warning(paste("alternative search in", user_dir)) - whitney_fonts <- list.files(user_dir, full.names = TRUE) %>% - as.data.frame() %>% - rlang::set_names("path") %>% - dplyr::filter(stringr::str_detect(path, "Whitney-")) %>% # Hope "Whitney-" is not in username! - dplyr::mutate(name = stringr::str_extract(path, "Whitney-[:alpha:]*(?=-Adv.otf$)")) + whitney_paths <- list.files(user_dir, full.names = TRUE) %>% + .[grepl("Whitney-", .)] } - warning(paste(whitney_fonts, collapse = "\n")) + warning(paste(whitney_paths, collapse = "\n")) # register preferred strong font (Whitney Semibold), with variants systemfonts::register_font( name = cmapplot_globals$preferred_font$strong, - plain = find_path("Whitney-Semibold", whitney_fonts), - bold = find_path("Whitney-Black", whitney_fonts), - italic = find_path("Whitney-SemiboldItalic", whitney_fonts), - bolditalic = find_path("Whitney-BlackItalic", whitney_fonts) + plain = find_path("Whitney-Semibold-Adv", whitney_paths), + bold = find_path("Whitney-Black-Adv", whitney_paths), + italic = find_path("Whitney-SemiboldItal-Adv", whitney_paths), + bolditalic = find_path("Whitney-BlackItal-Adv", whitney_paths) ) # register preferred regular font (Whitney Medium), with variants systemfonts::register_font( name = cmapplot_globals$preferred_font$regular, - plain = find_path("Whitney-Medium", whitney_fonts), - bold = find_path("Whitney-Bold", whitney_fonts), - italic = find_path("Whitney-MediumItalic", whitney_fonts), - bolditalic = find_path("Whitney-BoldItalic", whitney_fonts) + plain = find_path("Whitney-Medium-Adv", whitney_paths), + bold = find_path("Whitney-Bold-Adv", whitney_paths), + italic = find_path("Whitney-MediumItal-Adv", whitney_paths), + bolditalic = find_path("Whitney-BoldItal-Adv", whitney_paths) ) # register preferred light font (Whitney Book), with variants systemfonts::register_font( name = cmapplot_globals$preferred_font$light, - plain = find_path("Whitney-Book", whitney_fonts), - bold = find_path("Whitney-Semibold", whitney_fonts), - italic = find_path("Whitney-BookItalic", whitney_fonts), - bolditalic = find_path("Whitney-SemiboldItalic", whitney_fonts) + plain = find_path("Whitney-Book-Adv", whitney_paths), + bold = find_path("Whitney-Semibold-Adv", whitney_paths), + italic = find_path("Whitney-BookItal-Adv", whitney_paths), + bolditalic = find_path("Whitney-SemiboldItal-Adv", whitney_paths) ) check_for_fonts(set_global = TRUE) diff --git a/R/utilities.R b/R/utilities.R index f732474a..259df1b1 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -99,30 +99,6 @@ gg_lwd_convert <- function(value, unit = "bigpts") { } -#' Check for necessary Whitney fonts in systemfonts registry -#' -#' Invisibly returns TRUE or FALSE based on whether the three used Whitney fonts -#' are available in the systemfonts registry. -#' -#' @param set_global sets cmapplot_globals$use_whitney based on results -#' -#' @noRd -check_for_fonts <- function(set_global = FALSE){ - - registry_fonts <- systemfonts::registry_fonts() - - fonts_present <- nrow( - registry_fonts[registry_fonts$family %in% cmapplot_globals$preferred_font,] - ) >= 3 - - if(set_global){ - assign("use_whitney", - fonts_present, - envir = cmapplot_globals) - } - - invisible(fonts_present) -} #' Find a "path" using a "name" #' @@ -130,13 +106,15 @@ check_for_fonts <- function(set_global = FALSE){ #' specific name and, if a perfect match is found, return it's "path". #' #' @noRd -find_path <- function(query, df){ - warning("test warning") - df2 <- dplyr::filter(df, stringr::str_detect(name, paste0("^", query, "$"))) +find_path <- function(query, vector){ + result <- vector[grepl(paste0("(\\\\|/)", query, ".[ot]tf$"), vector)] - if(nrow(df2) == 1){ - return(df2[[1,"path"]]) + if(length(result) == 1){ + return(result) } else { - stop(paste0("Font '", query, "' not found. nrow before: ", nrow(df), ". nrow after: ", nrow(df2)), call. = FALSE) + stop( + paste0("Font '", query, "' not found. search vector:\n", + paste(vector, collapse = "\n")), + call. = FALSE) } } From 0fe7e7fdf7f0d017f514a87f33e98a2aacc81f00 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Fri, 23 Apr 2021 02:44:38 -0500 Subject: [PATCH 100/173] famous last words --- R/cmapplot.R | 62 +++++++++++++++++++++++++++------------------------- 1 file changed, 32 insertions(+), 30 deletions(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index 7062b0f2..f11c8b74 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -49,41 +49,43 @@ # sees no Whitney fonts, if `user_dir` exists, it too is checked for fonts. user_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") if(length(whitney_paths) == 0 & dir.exists(user_dir)){ - warning(paste("alternative search in", user_dir)) whitney_paths <- list.files(user_dir, full.names = TRUE) %>% .[grepl("Whitney-", .)] } - warning(paste(whitney_paths, collapse = "\n")) - # register preferred strong font (Whitney Semibold), with variants - systemfonts::register_font( - name = cmapplot_globals$preferred_font$strong, - plain = find_path("Whitney-Semibold-Adv", whitney_paths), - bold = find_path("Whitney-Black-Adv", whitney_paths), - italic = find_path("Whitney-SemiboldItal-Adv", whitney_paths), - bolditalic = find_path("Whitney-BlackItal-Adv", whitney_paths) - ) - - # register preferred regular font (Whitney Medium), with variants - systemfonts::register_font( - name = cmapplot_globals$preferred_font$regular, - plain = find_path("Whitney-Medium-Adv", whitney_paths), - bold = find_path("Whitney-Bold-Adv", whitney_paths), - italic = find_path("Whitney-MediumItal-Adv", whitney_paths), - bolditalic = find_path("Whitney-BoldItal-Adv", whitney_paths) - ) - - # register preferred light font (Whitney Book), with variants - systemfonts::register_font( - name = cmapplot_globals$preferred_font$light, - plain = find_path("Whitney-Book-Adv", whitney_paths), - bold = find_path("Whitney-Semibold-Adv", whitney_paths), - italic = find_path("Whitney-BookItal-Adv", whitney_paths), - bolditalic = find_path("Whitney-SemiboldItal-Adv", whitney_paths) - ) - - check_for_fonts(set_global = TRUE) + if(length(whitney_paths >= 12)){ + # register preferred strong font (Whitney Semibold), with variants + systemfonts::register_font( + name = cmapplot_globals$preferred_font$strong, + plain = find_path("Whitney-Semibold-Adv", whitney_paths), + bold = find_path("Whitney-Black-Adv", whitney_paths), + italic = find_path("Whitney-SemiboldItal-Adv", whitney_paths), + bolditalic = find_path("Whitney-BlackItal-Adv", whitney_paths) + ) + + # register preferred regular font (Whitney Medium), with variants + systemfonts::register_font( + name = cmapplot_globals$preferred_font$regular, + plain = find_path("Whitney-Medium-Adv", whitney_paths), + bold = find_path("Whitney-Bold-Adv", whitney_paths), + italic = find_path("Whitney-MediumItal-Adv", whitney_paths), + bolditalic = find_path("Whitney-BoldItal-Adv", whitney_paths) + ) + + # register preferred light font (Whitney Book), with variants + systemfonts::register_font( + name = cmapplot_globals$preferred_font$light, + plain = find_path("Whitney-Book-Adv", whitney_paths), + bold = find_path("Whitney-Semibold-Adv", whitney_paths), + italic = find_path("Whitney-BookItal-Adv", whitney_paths), + bolditalic = find_path("Whitney-SemiboldItal-Adv", whitney_paths) + ) + + assign("use_whitney", + fonts_present, + envir = cmapplot_globals) + } } # Update font names From c698e0f1bbfd46a6ce9052c6939d28365a9ce657 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Fri, 23 Apr 2021 02:49:42 -0500 Subject: [PATCH 101/173] whoops --- R/cmapplot.R | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index f11c8b74..16efe632 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -22,7 +22,7 @@ family <- name <- path <- NULL - # If font registry already contains whitney core, set use_whitney == TRUE + # If font registry already contains Whitney core, set use_whitney == TRUE fonts_present <- systemfonts::registry_fonts() %>% dplyr::filter(family %in% cmapplot_globals$preferred_font) %>% nrow() >= 12 @@ -32,13 +32,9 @@ envir = cmapplot_globals) - # Else, Find and register necessary whitney varients using systemfonts (or, + # Else, Find and register necessary Whitney variants using systemfonts (or, # alternatively, find them manually in ~/Library/Fonts). Then, if font - # registry contains whitney core, set use_whitney == TRUE. - # - # (This is necessary because R looks up font by "family" with only basic - # variation (bold, italic, etc), so fonts like "Whitney-Book" are inaccessible - # by default.) + # registry contains Whitney core, set use_whitney == TRUE. if(!get("use_whitney", envir = cmapplot_globals)){ whitney_paths <- systemfonts::system_fonts() %>% dplyr::filter(family == "Whitney") %>% @@ -53,7 +49,7 @@ .[grepl("Whitney-", .)] } - + # If all Whitney fonts have been found... if(length(whitney_paths >= 12)){ # register preferred strong font (Whitney Semibold), with variants systemfonts::register_font( @@ -83,7 +79,7 @@ ) assign("use_whitney", - fonts_present, + TRUE, envir = cmapplot_globals) } } From c56726be01f06a1fb5c3a370d3312e84558d028e Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sun, 25 Apr 2021 14:13:40 -0500 Subject: [PATCH 102/173] check() works --- R/cmapplot.R | 100 ++++++++++++++++++++---------------- R/utilities.R | 9 ++-- man/get_cmapplot_globals.Rd | 2 +- vignettes/finalize.Rmd | 4 +- 4 files changed, 63 insertions(+), 52 deletions(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index 16efe632..da49a970 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -36,51 +36,60 @@ # alternatively, find them manually in ~/Library/Fonts). Then, if font # registry contains Whitney core, set use_whitney == TRUE. if(!get("use_whitney", envir = cmapplot_globals)){ - whitney_paths <- systemfonts::system_fonts() %>% - dplyr::filter(family == "Whitney") %>% - .[["path"]] + whitney_paths <- dplyr::filter(systemfonts::system_fonts(), family == "Whitney") + whitney_paths <- whitney_paths[["path"]] # On some OSX systems (e.g. pkgdown GHA VM) system_fonts() cannot find fonts # installed in the user fonts directory. In any case where system_fonts() # sees no Whitney fonts, if `user_dir` exists, it too is checked for fonts. user_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") if(length(whitney_paths) == 0 & dir.exists(user_dir)){ - whitney_paths <- list.files(user_dir, full.names = TRUE) %>% - .[grepl("Whitney-", .)] + whitney_paths <- list.files(user_dir, full.names = TRUE) + whitney_paths <- grep("Whitney-", whitney_paths) } - # If all Whitney fonts have been found... + # If all Whitney fonts have been found, attempt to register preferred + # fonts. If any registration fails, the try object should fail before + # `use_whitney` is set to TRUE. if(length(whitney_paths >= 12)){ - # register preferred strong font (Whitney Semibold), with variants - systemfonts::register_font( - name = cmapplot_globals$preferred_font$strong, - plain = find_path("Whitney-Semibold-Adv", whitney_paths), - bold = find_path("Whitney-Black-Adv", whitney_paths), - italic = find_path("Whitney-SemiboldItal-Adv", whitney_paths), - bolditalic = find_path("Whitney-BlackItal-Adv", whitney_paths) - ) - - # register preferred regular font (Whitney Medium), with variants - systemfonts::register_font( - name = cmapplot_globals$preferred_font$regular, - plain = find_path("Whitney-Medium-Adv", whitney_paths), - bold = find_path("Whitney-Bold-Adv", whitney_paths), - italic = find_path("Whitney-MediumItal-Adv", whitney_paths), - bolditalic = find_path("Whitney-BoldItal-Adv", whitney_paths) - ) - - # register preferred light font (Whitney Book), with variants - systemfonts::register_font( - name = cmapplot_globals$preferred_font$light, - plain = find_path("Whitney-Book-Adv", whitney_paths), - bold = find_path("Whitney-Semibold-Adv", whitney_paths), - italic = find_path("Whitney-BookItal-Adv", whitney_paths), - bolditalic = find_path("Whitney-SemiboldItal-Adv", whitney_paths) - ) - - assign("use_whitney", - TRUE, - envir = cmapplot_globals) + try({ + + # register preferred strong font (Whitney Semibold), with variants + systemfonts::register_font( + name = cmapplot_globals$preferred_font$strong, + plain = find_path("Whitney-Semibold-Adv", whitney_paths), + bold = find_path("Whitney-Black-Adv", whitney_paths), + italic = find_path("Whitney-SemiboldItal-Adv", whitney_paths), + bolditalic = find_path("Whitney-BlackItal-Adv", whitney_paths) + ) + + # register preferred regular font (Whitney Medium), with variants + systemfonts::register_font( + name = cmapplot_globals$preferred_font$regular, + plain = find_path("Whitney-Medium-Adv", whitney_paths), + bold = find_path("Whitney-Bold-Adv", whitney_paths), + italic = find_path("Whitney-MediumItal-Adv", whitney_paths), + bolditalic = find_path("Whitney-BoldItal-Adv", whitney_paths) + ) + + # register preferred light font (Whitney Book), with variants + systemfonts::register_font( + name = cmapplot_globals$preferred_font$light, + plain = find_path("Whitney-Book-Adv", whitney_paths), + bold = find_path("Whitney-Semibold-Adv", whitney_paths), + italic = find_path("Whitney-BookItal-Adv", whitney_paths), + bolditalic = find_path("Whitney-SemiboldItal-Adv", whitney_paths) + ) + + packageStartupMessage(paste0( + "cmapplot has registered the following fonts for use in this R session:\n ", + paste(cmapplot_globals$preferred_font, collapse = ", ") + )) + + assign("use_whitney", + TRUE, + envir = cmapplot_globals) + }) } } @@ -91,8 +100,18 @@ regular = list(family = cmapplot_globals$preferred_font$regular, face = "plain"), light = list(family = cmapplot_globals$preferred_font$light, face = "plain")), envir = cmapplot_globals) + } else { + packageStartupMessage( + "cmapplot cannot locate Whitney fonts, so CMAP themes will use your default sans-serif font" + ) } + # if (VERSION >= 1.4){ + # check ragg, set ragg, notify + # } else { + # message about need to update rstudio + # } + # Load CMAP preferred default.aes (can't be done until fonts are specified) assign("default_aes_cmap", init_cmap_default_aes(), @@ -103,12 +122,3 @@ fetch_current_default_aes(), envir = cmapplot_globals) } - - -.onAttach <- function(...){ - if(!get("use_whitney", envir = cmapplot_globals)){ - packageStartupMessage( - "WARNING: Whitney was not found on this machine, so CMAP theme will use your default sans-serif font" - ) - } -} diff --git a/R/utilities.R b/R/utilities.R index 259df1b1..36e41771 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -105,16 +105,17 @@ gg_lwd_convert <- function(value, unit = "bigpts") { #' Taking a dataframe that has columns "name" and "path", search for one #' specific name and, if a perfect match is found, return it's "path". #' +#' @param filename the complete file name, less a .otf or .ttf extension. +#' #' @noRd -find_path <- function(query, vector){ - result <- vector[grepl(paste0("(\\\\|/)", query, ".[ot]tf$"), vector)] +find_path <- function(filename, paths){ + result <- paths[grepl(paste0("(\\\\|/)", filename, ".[ot]tf$"), paths)] if(length(result) == 1){ return(result) } else { stop( - paste0("Font '", query, "' not found. search vector:\n", - paste(vector, collapse = "\n")), + paste0("Font '", filename, "' not found."), call. = FALSE) } } diff --git a/man/get_cmapplot_globals.Rd b/man/get_cmapplot_globals.Rd index e9783544..e39f8f93 100644 --- a/man/get_cmapplot_globals.Rd +++ b/man/get_cmapplot_globals.Rd @@ -77,7 +77,7 @@ helper functions described here provide the user access if needed. caption). \strong{(F)} \item \code{margin_sidebar_l}: The margin between the left edge of the image and the title and caption, when the sidebar exists. Deducted from \code{title_width}. \strong{(F)} \item \code{margin_plot_l}: - The margin between the left edge of the plot and the sidebar. \strong{(F)} + The margin between the left edge of the plot and the sodebar. \strong{(F)} \item \code{margin_plot_r}: The margin between the right edge of the plot and the edge of the image. \strong{(F)} \item \code{margin_panel_r}: Padding between the plot and its right-hand drawing extent. Override this based on diff --git a/vignettes/finalize.Rmd b/vignettes/finalize.Rmd index 84520827..a2cbe0a6 100644 --- a/vignettes/finalize.Rmd +++ b/vignettes/finalize.Rmd @@ -139,8 +139,8 @@ The title and caption blocks take HTML formatting tags, which you can use to man # A finalized line graph, with text tweaks finalize_plot(plot = p, title = "Annual
unlinked passenger trips
(in millions)", - caption = "Source: Chicago Metropolitan Agency for Planning - analysis of Regional Transportation Authority data") + caption = "Source: Chicago Metropolitan Agency for Planning + analysis of Regional Transportation Authority data") ``` ## Advanced customization From 50a921d701e1f000063330f4abe5d8d21c51d032 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sun, 25 Apr 2021 14:40:21 -0500 Subject: [PATCH 103/173] require agg for rstudio graphics --- DESCRIPTION | 1 + NAMESPACE | 1 + R/cmapplot.R | 29 +++++++++++++++++++++-------- 3 files changed, 23 insertions(+), 8 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8159c1f0..8facfcb2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -50,6 +50,7 @@ Imports: purrr, ragg, rlang, + rstudioapi, scales, stringr, systemfonts diff --git a/NAMESPACE b/NAMESPACE index dd94c2c8..7c85bff0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -40,6 +40,7 @@ import(graphics) import(grid) import(gridtext) import(rlang) +import(rstudioapi) import(scales) import(systemfonts) importFrom(generics,intersect) diff --git a/R/cmapplot.R b/R/cmapplot.R index da49a970..3c8750e0 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -17,7 +17,10 @@ "_PACKAGE" -# Update fonts based on system -- *must* be done with .onLoad() +#' Update fonts based on system -- *must* be done with .onLoad() +#' +#' @noRd +#' @import rstudioapi .onLoad <- function(...) { family <- name <- path <- NULL @@ -93,25 +96,35 @@ } } - # Update font names + # If Whitney is available... if(get("use_whitney", envir = cmapplot_globals)){ + # ... Update font names assign("font", list(strong = list(family = cmapplot_globals$preferred_font$strong, face = "plain"), regular = list(family = cmapplot_globals$preferred_font$regular, face = "plain"), light = list(family = cmapplot_globals$preferred_font$light, face = "plain")), envir = cmapplot_globals) + + # ... and check on rstudio graphics + if (rstudioapi::isAvailable()){ + if(rstudioapi::getVersion() > 1.4){ + if(getOption("RStudioGD.backend") != "ragg"){ + options(RStudioGD.backend = "ragg") + packageStartupMessage("cmapplot has set RStudio graphics to `ragg`.") + } + } else { + packageStartupMessage(paste( + "cmapplot requires RStudio v1.4 or greater to use Whitney fonts", + "in the R plots window. ")) + } + } + # Otherwise, notify user } else { packageStartupMessage( "cmapplot cannot locate Whitney fonts, so CMAP themes will use your default sans-serif font" ) } - # if (VERSION >= 1.4){ - # check ragg, set ragg, notify - # } else { - # message about need to update rstudio - # } - # Load CMAP preferred default.aes (can't be done until fonts are specified) assign("default_aes_cmap", init_cmap_default_aes(), From 9daa57cd868502e668e7d8266bce8b5abadbc989 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sun, 25 Apr 2021 14:45:42 -0500 Subject: [PATCH 104/173] typo in grep --- R/cmapplot.R | 4 ++-- R/utilities.R | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index 3c8750e0..3b726321 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -48,7 +48,7 @@ user_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") if(length(whitney_paths) == 0 & dir.exists(user_dir)){ whitney_paths <- list.files(user_dir, full.names = TRUE) - whitney_paths <- grep("Whitney-", whitney_paths) + whitney_paths <- grep("Whitney-", whitney_paths, value = TRUE) } # If all Whitney fonts have been found, attempt to register preferred @@ -115,7 +115,7 @@ } else { packageStartupMessage(paste( "cmapplot requires RStudio v1.4 or greater to use Whitney fonts", - "in the R plots window. ")) + "in the R plots window. Please upgrade RStudio.")) } } # Otherwise, notify user diff --git a/R/utilities.R b/R/utilities.R index 36e41771..03681155 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -109,7 +109,7 @@ gg_lwd_convert <- function(value, unit = "bigpts") { #' #' @noRd find_path <- function(filename, paths){ - result <- paths[grepl(paste0("(\\\\|/)", filename, ".[ot]tf$"), paths)] + result <- grep(paste0("(\\\\|/)", filename, ".[ot]tf$"), paths, value = TRUE) if(length(result) == 1){ return(result) From 53c8627ca585869f78f844140ab2dcef9e2af0cf Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sun, 25 Apr 2021 14:57:07 -0500 Subject: [PATCH 105/173] documentation updates --- R/utilities.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/utilities.R b/R/utilities.R index 03681155..62c58c35 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -100,12 +100,13 @@ gg_lwd_convert <- function(value, unit = "bigpts") { -#' Find a "path" using a "name" +#' Identify correct font path based on filename #' -#' Taking a dataframe that has columns "name" and "path", search for one -#' specific name and, if a perfect match is found, return it's "path". +#' Taking a list of font paths, search for a specific filename. If a perfect +#' match is found, return that path. #' #' @param filename the complete file name, less a .otf or .ttf extension. +#' @param path a vector of filepaths #' #' @noRd find_path <- function(filename, paths){ From 8ce6f93a9219a050ffdcf0eb0fbc6498910488d4 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sun, 25 Apr 2021 15:35:06 -0500 Subject: [PATCH 106/173] clearer messages looks like options() isn't sticky across R sessions, which seems strange to me. --- R/cmapplot.R | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index 3b726321..9eef3405 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -85,7 +85,7 @@ ) packageStartupMessage(paste0( - "cmapplot has registered the following fonts for use in this R session:\n ", + "cmapplot has registered the following fonts for use in this R session:\n ", paste(cmapplot_globals$preferred_font, collapse = ", ") )) @@ -110,7 +110,11 @@ if(rstudioapi::getVersion() > 1.4){ if(getOption("RStudioGD.backend") != "ragg"){ options(RStudioGD.backend = "ragg") - packageStartupMessage("cmapplot has set RStudio graphics to `ragg`.") + packageStartupMessage(paste( + "cmapplot has set RStudio graphics to `ragg` for the current session.", + "You can make this change permanent:\n ", + "Tools > Global Options > General > Graphics > Graphics Device > Backend == 'AGG'." + )) } } else { packageStartupMessage(paste( @@ -121,7 +125,7 @@ # Otherwise, notify user } else { packageStartupMessage( - "cmapplot cannot locate Whitney fonts, so CMAP themes will use your default sans-serif font" + "cmapplot cannot locate Whitney fonts, so CMAP themes will use your default sans-serif font." ) } From 6e6ea4e4fc66efc16d3b0b0bce66300fd514f1c8 Mon Sep 17 00:00:00 2001 From: Matthew Stern <54633946+matthewstern@users.noreply.github.com> Date: Sat, 1 May 2021 15:41:47 -0500 Subject: [PATCH 107/173] simplify `try()` and clarify comments --- R/cmapplot.R | 84 ++++++++++++++++++++++++++-------------------------- 1 file changed, 42 insertions(+), 42 deletions(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index 9eef3405..0ec6c60e 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -51,48 +51,48 @@ whitney_paths <- grep("Whitney-", whitney_paths, value = TRUE) } - # If all Whitney fonts have been found, attempt to register preferred - # fonts. If any registration fails, the try object should fail before - # `use_whitney` is set to TRUE. - if(length(whitney_paths >= 12)){ - try({ - - # register preferred strong font (Whitney Semibold), with variants - systemfonts::register_font( - name = cmapplot_globals$preferred_font$strong, - plain = find_path("Whitney-Semibold-Adv", whitney_paths), - bold = find_path("Whitney-Black-Adv", whitney_paths), - italic = find_path("Whitney-SemiboldItal-Adv", whitney_paths), - bolditalic = find_path("Whitney-BlackItal-Adv", whitney_paths) - ) - - # register preferred regular font (Whitney Medium), with variants - systemfonts::register_font( - name = cmapplot_globals$preferred_font$regular, - plain = find_path("Whitney-Medium-Adv", whitney_paths), - bold = find_path("Whitney-Bold-Adv", whitney_paths), - italic = find_path("Whitney-MediumItal-Adv", whitney_paths), - bolditalic = find_path("Whitney-BoldItal-Adv", whitney_paths) - ) - - # register preferred light font (Whitney Book), with variants - systemfonts::register_font( - name = cmapplot_globals$preferred_font$light, - plain = find_path("Whitney-Book-Adv", whitney_paths), - bold = find_path("Whitney-Semibold-Adv", whitney_paths), - italic = find_path("Whitney-BookItal-Adv", whitney_paths), - bolditalic = find_path("Whitney-SemiboldItal-Adv", whitney_paths) - ) - - packageStartupMessage(paste0( - "cmapplot has registered the following fonts for use in this R session:\n ", - paste(cmapplot_globals$preferred_font, collapse = ", ") - )) - - assign("use_whitney", - TRUE, - envir = cmapplot_globals) - }) + # Attempt to register preferred fonts using paths found above. The correct + # Whitney fonts may not be available (e.g. `whitney_paths` will have a length + # of 0 if no Whitney faces are located) - in this case, `find_path` will error + # and the try object will fail before `use_whitney` is set to TRUE. + try({ + + # register preferred strong font (Whitney Semibold), with variants + systemfonts::register_font( + name = cmapplot_globals$preferred_font$strong, + plain = find_path("Whitney-Semibold-Adv", whitney_paths), + bold = find_path("Whitney-Black-Adv", whitney_paths), + italic = find_path("Whitney-SemiboldItal-Adv", whitney_paths), + bolditalic = find_path("Whitney-BlackItal-Adv", whitney_paths) + ) + + # register preferred regular font (Whitney Medium), with variants + systemfonts::register_font( + name = cmapplot_globals$preferred_font$regular, + plain = find_path("Whitney-Medium-Adv", whitney_paths), + bold = find_path("Whitney-Bold-Adv", whitney_paths), + italic = find_path("Whitney-MediumItal-Adv", whitney_paths), + bolditalic = find_path("Whitney-BoldItal-Adv", whitney_paths) + ) + + # register preferred light font (Whitney Book), with variants + systemfonts::register_font( + name = cmapplot_globals$preferred_font$light, + plain = find_path("Whitney-Book-Adv", whitney_paths), + bold = find_path("Whitney-Semibold-Adv", whitney_paths), + italic = find_path("Whitney-BookItal-Adv", whitney_paths), + bolditalic = find_path("Whitney-SemiboldItal-Adv", whitney_paths) + ) + + packageStartupMessage(paste0( + "cmapplot has registered the following fonts for use in this R session:\n ", + paste(cmapplot_globals$preferred_font, collapse = ", ") + )) + + assign("use_whitney", + TRUE, + envir = cmapplot_globals) + }) } } From 661667a04da0800c3d4d54f9cd8f6bae71b5c792 Mon Sep 17 00:00:00 2001 From: Matthew Stern <54633946+matthewstern@users.noreply.github.com> Date: Sat, 1 May 2021 15:53:26 -0500 Subject: [PATCH 108/173] typo --- R/cmapplot.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index 0ec6c60e..2875a536 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -93,7 +93,6 @@ TRUE, envir = cmapplot_globals) }) - } } # If Whitney is available... From 840b1d52bd7212395e8f0d318b1e0c0306cffa98 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sun, 2 May 2021 10:20:27 -0500 Subject: [PATCH 109/173] small tweaks --- R/finalize_plot.R | 20 -------------------- R/utilities.R | 21 +++++++++++++++++++++ vignettes/finalize.Rmd | 4 ++-- 3 files changed, 23 insertions(+), 22 deletions(-) diff --git a/R/finalize_plot.R b/R/finalize_plot.R index b24906bd..debb832d 100644 --- a/R/finalize_plot.R +++ b/R/finalize_plot.R @@ -721,23 +721,3 @@ save_plot <- function(finished_graphic, ) } - - -#' Sub-fn to safely intepret grobHeight -#' -#' This returns the height of Grob in any real unit. -#' If the value passed in is null, it returns 0. -#' -#' @noRd -safe_grobHeight <- function(grob, unitTo = "bigpts", valueOnly = TRUE){ - - if(is.null(grob)){ - if(valueOnly){ - return(0) - } else { - return(unit(0, unitTo)) - } - } - - return(grid::convertHeight(grid::grobHeight(grob), unitTo, valueOnly)) -} diff --git a/R/utilities.R b/R/utilities.R index 62c58c35..fe75eee6 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -120,3 +120,24 @@ find_path <- function(filename, paths){ call. = FALSE) } } + + +#' Sub-fn to safely intepret grobHeight +#' +#' This returns the height of Grob in any real unit. +#' If the value passed in is null, it returns 0. +#' It is used in various places in `finalize_plot` +#' +#' @noRd +safe_grobHeight <- function(grob, unitTo = "bigpts", valueOnly = TRUE){ + + if(is.null(grob)){ + if(valueOnly){ + return(0) + } else { + return(unit(0, unitTo)) + } + } + + return(grid::convertHeight(grid::grobHeight(grob), unitTo, valueOnly)) +} diff --git a/vignettes/finalize.Rmd b/vignettes/finalize.Rmd index a2cbe0a6..8141939c 100644 --- a/vignettes/finalize.Rmd +++ b/vignettes/finalize.Rmd @@ -138,9 +138,9 @@ The title and caption blocks take HTML formatting tags, which you can use to man ```{r finalize5, message=FALSE} # A finalized line graph, with text tweaks finalize_plot(plot = p, - title = "Annual
unlinked passenger trips
(in millions)", + title = "Annual
unlinked passenger trips
(in millions)", caption = "Source: Chicago Metropolitan Agency for Planning - analysis of Regional Transportation Authority data") + analysis of Regional Transportation Authority data") ``` ## Advanced customization From c2c7b49225556bfa5df9b8a2ebfa80b97aef2ea2 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sun, 2 May 2021 16:23:30 -0500 Subject: [PATCH 110/173] attempt at dynamic GHA workflow --- .github/workflows/pkgdown_test.yaml | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index 9d8547cd..fdc4c147 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -2,7 +2,8 @@ # Based on . on: push: - branches: systemfonts + branches: master + pull_request: name: pkgdown_systemfonts_test @@ -52,6 +53,7 @@ jobs: - name: Install dependencies run: | + message() remotes::install_deps(dependencies = TRUE) install.packages("pkgdown") shell: Rscript {0} @@ -70,8 +72,18 @@ jobs: - name: Install package run: R CMD INSTALL . - - name: Deploy package + - name: Deploy packageto live branch + if: ${{ github.ref == 'refs/heads/main' }} run: | + echo "This is $GITHUB_REF. Deploying to 'gh-pages' branch." git config --local user.email "actions@github.com" git config --local user.name "GitHub Actions" - Rscript -e 'pkgdown::deploy_to_branch(branch="gh-pages-test2", clean = TRUE)' + Rscript -e 'pkgdown::deploy_to_branch(clean = TRUE)' + + - name: Deploy package to test branch + if: ${{ github.ref != 'refs/heads/main' }} + run: | + echo "This is $GITHUB_REF. Deploying to 'gh-pages-test' branch." + git config --local user.email "actions@github.com" + git config --local user.name "GitHub Actions" + Rscript -e 'pkgdown::deploy_to_branch(branch="gh-pages-test", clean = TRUE)' From e74c216d5e34c46c88685ab9dbca98d5f5777a96 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sun, 2 May 2021 16:31:27 -0500 Subject: [PATCH 111/173] tweaks to GHA --- .github/workflows/pkgdown_test.yaml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml index fdc4c147..2edb82cf 100644 --- a/.github/workflows/pkgdown_test.yaml +++ b/.github/workflows/pkgdown_test.yaml @@ -1,4 +1,5 @@ # Automatically rebuilds pkgdown website any time master branch is updated. +# Also builds pkgdown on "gh-pages-test" on commits to pull requests. # Based on . on: push: @@ -72,10 +73,10 @@ jobs: - name: Install package run: R CMD INSTALL . - - name: Deploy packageto live branch + - name: Deploy package to live branch if: ${{ github.ref == 'refs/heads/main' }} run: | - echo "This is $GITHUB_REF. Deploying to 'gh-pages' branch." + echo "This is $GITHUB_REF. Deploying to gh-pages branch." git config --local user.email "actions@github.com" git config --local user.name "GitHub Actions" Rscript -e 'pkgdown::deploy_to_branch(clean = TRUE)' @@ -83,7 +84,7 @@ jobs: - name: Deploy package to test branch if: ${{ github.ref != 'refs/heads/main' }} run: | - echo "This is $GITHUB_REF. Deploying to 'gh-pages-test' branch." + echo "This is $GITHUB_REF. Deploying to gh-pages-test branch." git config --local user.email "actions@github.com" git config --local user.name "GitHub Actions" Rscript -e 'pkgdown::deploy_to_branch(branch="gh-pages-test", clean = TRUE)' From 8204056d9b75c0aec038a36eba9139b5e87d24c9 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sun, 2 May 2021 16:41:15 -0500 Subject: [PATCH 112/173] Remove pkgtown test workflow, update main workflow primary pkgdown workflow now deploys to gh-pages-test on any open PR update, and *should* deploy to gh-pages on push to master. --- .github/workflows/pkgdown.yaml | 15 ++++- .github/workflows/pkgdown_test.yaml | 90 ----------------------------- 2 files changed, 14 insertions(+), 91 deletions(-) delete mode 100644 .github/workflows/pkgdown_test.yaml diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index c73f5d03..ceed61f1 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -1,8 +1,11 @@ # Automatically rebuilds pkgdown website any time master branch is updated. +# Also builds pkgdown on "gh-pages-test" on commits to pull requests. # Based on . +# Conditional based on . on: push: branches: master + pull_request: name: pkgdown @@ -70,8 +73,18 @@ jobs: - name: Install package run: R CMD INSTALL . - - name: Deploy package + - name: Deploy package to live branch + if: ${{ github.ref == 'refs/heads/main' }} run: | + echo "This is $GITHUB_REF. Deploying to gh-pages branch." git config --local user.email "actions@github.com" git config --local user.name "GitHub Actions" Rscript -e 'pkgdown::deploy_to_branch(clean = TRUE)' + + - name: Deploy package to test branch + if: ${{ github.ref != 'refs/heads/main' }} + run: | + echo "This is $GITHUB_REF. Deploying to gh-pages-test branch." + git config --local user.email "actions@github.com" + git config --local user.name "GitHub Actions" + Rscript -e 'pkgdown::deploy_to_branch(branch="gh-pages-test", clean = TRUE)' diff --git a/.github/workflows/pkgdown_test.yaml b/.github/workflows/pkgdown_test.yaml deleted file mode 100644 index 2edb82cf..00000000 --- a/.github/workflows/pkgdown_test.yaml +++ /dev/null @@ -1,90 +0,0 @@ -# Automatically rebuilds pkgdown website any time master branch is updated. -# Also builds pkgdown on "gh-pages-test" on commits to pull requests. -# Based on . -on: - push: - branches: master - pull_request: - -name: pkgdown_systemfonts_test - -jobs: - pkgdown: - runs-on: macOS-latest - env: - GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} - steps: - - uses: actions/checkout@v2 - - - uses: r-lib/actions/setup-r@master - - - uses: r-lib/actions/setup-pandoc@master - - - name: Checkout CMAP fonts repo - uses: actions/checkout@v2 - with: - repository: CMAP-REPOS/cmap-fonts - token: ${{ secrets.CMAP_REPO_FULL_ACCESS }} - path: cmap-fonts - - - name: Install CMAP fonts for R access - # Inspiration: https://gist.github.com/Kevin-Lee/328e9993d6b3ad250636023fb2c7827f - run: | - repo_dir="$GITHUB_WORKSPACE/cmap-fonts" - font_dir="$HOME/Library/Fonts" - mkdir -p $font_dir - find_command="find \"$repo_dir\" -name '*.[o,t]tf' -type f -print0" - eval $find_command | xargs -0 -I % - eval $find_command | xargs -0 -I % cp "%" "$font_dir/" - find "$font_dir" -name '*.[o,t]tf' -print0 | xargs -0 -I % - - - name: Query dependencies - run: | - install.packages('remotes') - saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) - writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") - shell: Rscript {0} - - - name: Cache R packages - uses: actions/cache@v1 - with: - path: ${{ env.R_LIBS_USER }} - key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} - restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- - - - name: Install dependencies - run: | - message() - remotes::install_deps(dependencies = TRUE) - install.packages("pkgdown") - shell: Rscript {0} - - - name: Check Whitney availability in R - run: | - all_fonts <- systemfonts::system_fonts() - message("WHITNEY FONTS AUTOMATICALLY AVAILABLE TO SYSTEMFONTS:") - message(paste(all_fonts$name[grepl("^Whitney", all_fonts$name)], collapse = "\n")) - user_dir <- paste0(Sys.getenv("HOME"), "/Library/Fonts") - library_fonts <- list.files(user_dir) - message(paste0("WHITNEY FONTS IN ", user_dir, " (MUST BE REGISTERED):")) - message(paste(library_fonts[grepl("^Whitney", library_fonts)], collapse = "\n")) - shell: Rscript {0} - - - name: Install package - run: R CMD INSTALL . - - - name: Deploy package to live branch - if: ${{ github.ref == 'refs/heads/main' }} - run: | - echo "This is $GITHUB_REF. Deploying to gh-pages branch." - git config --local user.email "actions@github.com" - git config --local user.name "GitHub Actions" - Rscript -e 'pkgdown::deploy_to_branch(clean = TRUE)' - - - name: Deploy package to test branch - if: ${{ github.ref != 'refs/heads/main' }} - run: | - echo "This is $GITHUB_REF. Deploying to gh-pages-test branch." - git config --local user.email "actions@github.com" - git config --local user.name "GitHub Actions" - Rscript -e 'pkgdown::deploy_to_branch(branch="gh-pages-test", clean = TRUE)' From 699f2da2118c39a4ad3d94f524471a1c27b91b73 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Mon, 3 May 2021 12:29:17 -0500 Subject: [PATCH 113/173] Modified text formatting example --- vignettes/finalize.Rmd | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/vignettes/finalize.Rmd b/vignettes/finalize.Rmd index 8141939c..d777a3db 100644 --- a/vignettes/finalize.Rmd +++ b/vignettes/finalize.Rmd @@ -138,9 +138,11 @@ The title and caption blocks take HTML formatting tags, which you can use to man ```{r finalize5, message=FALSE} # A finalized line graph, with text tweaks finalize_plot(plot = p, - title = "Annual
unlinked passenger trips
(in millions)", - caption = "Source: Chicago Metropolitan Agency for Planning - analysis of Regional Transportation Authority data") + title = "Annual unlinked passenger trips
(in millions)", + caption = "Source:
    +
  • Chicago Metropolitan Agency for Planning analysis
    • +
  • Regional Transportation Authority data
    • +
") ``` ## Advanced customization @@ -153,8 +155,11 @@ finalize_plot(plot = p, # A debugged finalized plot finalize_plot(plot = p, title = "Annual unlinked passenger trips (in millions)", - caption = "Source: Chicago Metropolitan Agency for Planning - analysis of Regional Transportation Authority data", + caption = 'Source: Chicago + Metropolitan Agency for Planning analysis of + RTA1 data. +

+ 1 Regional Transportation Authority', debug = TRUE) ``` @@ -196,9 +201,8 @@ There is a fairly long list of possible margins that can be customized using the Here, the margins are visualized as they impact a finalized plot that has a sidebar: - + Here, the same margins are visualized as they impact a finalized plot with no sidebar: - - + From a1caf114ab1cfab48d970c0b6c37d4b22d46b210 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Mon, 3 May 2021 12:30:21 -0500 Subject: [PATCH 114/173] Modified text formatting example --- vignettes/finalize.Rmd | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/vignettes/finalize.Rmd b/vignettes/finalize.Rmd index d777a3db..ff3063b5 100644 --- a/vignettes/finalize.Rmd +++ b/vignettes/finalize.Rmd @@ -139,10 +139,11 @@ The title and caption blocks take HTML formatting tags, which you can use to man # A finalized line graph, with text tweaks finalize_plot(plot = p, title = "Annual unlinked passenger trips
(in millions)", - caption = "Source:
    -
  • Chicago Metropolitan Agency for Planning analysis
    • -
  • Regional Transportation Authority data
    • -
") + caption = 'Source: Chicago + Metropolitan Agency for Planning analysis of + RTA1 data. +

+ 1 Regional Transportation Authority') ``` ## Advanced customization @@ -155,11 +156,8 @@ finalize_plot(plot = p, # A debugged finalized plot finalize_plot(plot = p, title = "Annual unlinked passenger trips (in millions)", - caption = 'Source: Chicago - Metropolitan Agency for Planning analysis of - RTA1 data. -

- 1 Regional Transportation Authority', + caption = "Source: Chicago Metropolitan Agency for Planning + analysis of Regional Transportation Authority data", debug = TRUE) ``` From 612c01e2ebeca08eab75e3f555a8b0362d526f85 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Mon, 3 May 2021 21:13:45 -0500 Subject: [PATCH 115/173] Handle edge case If there are multiple copies of a font installed (like is the case on my machine for whatever reason...not sure if I did that by mistake). --- R/utilities.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/utilities.R b/R/utilities.R index fe75eee6..8c9421c6 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -112,8 +112,8 @@ gg_lwd_convert <- function(value, unit = "bigpts") { find_path <- function(filename, paths){ result <- grep(paste0("(\\\\|/)", filename, ".[ot]tf$"), paths, value = TRUE) - if(length(result) == 1){ - return(result) + if(length(result) >= 1){ + return(result[1]) } else { stop( paste0("Font '", filename, "' not found."), From 51d467e3accbe82271710e5c3e008600b7e0d664 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Tue, 4 May 2021 09:13:50 -0500 Subject: [PATCH 116/173] add path length requirement --- R/cmapplot.R | 87 +++++++++++++++++++++++++++------------------------- 1 file changed, 45 insertions(+), 42 deletions(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index 2875a536..febdc0ea 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -51,48 +51,51 @@ whitney_paths <- grep("Whitney-", whitney_paths, value = TRUE) } - # Attempt to register preferred fonts using paths found above. The correct - # Whitney fonts may not be available (e.g. `whitney_paths` will have a length - # of 0 if no Whitney faces are located) - in this case, `find_path` will error - # and the try object will fail before `use_whitney` is set to TRUE. - try({ - - # register preferred strong font (Whitney Semibold), with variants - systemfonts::register_font( - name = cmapplot_globals$preferred_font$strong, - plain = find_path("Whitney-Semibold-Adv", whitney_paths), - bold = find_path("Whitney-Black-Adv", whitney_paths), - italic = find_path("Whitney-SemiboldItal-Adv", whitney_paths), - bolditalic = find_path("Whitney-BlackItal-Adv", whitney_paths) - ) - - # register preferred regular font (Whitney Medium), with variants - systemfonts::register_font( - name = cmapplot_globals$preferred_font$regular, - plain = find_path("Whitney-Medium-Adv", whitney_paths), - bold = find_path("Whitney-Bold-Adv", whitney_paths), - italic = find_path("Whitney-MediumItal-Adv", whitney_paths), - bolditalic = find_path("Whitney-BoldItal-Adv", whitney_paths) - ) - - # register preferred light font (Whitney Book), with variants - systemfonts::register_font( - name = cmapplot_globals$preferred_font$light, - plain = find_path("Whitney-Book-Adv", whitney_paths), - bold = find_path("Whitney-Semibold-Adv", whitney_paths), - italic = find_path("Whitney-BookItal-Adv", whitney_paths), - bolditalic = find_path("Whitney-SemiboldItal-Adv", whitney_paths) - ) - - packageStartupMessage(paste0( - "cmapplot has registered the following fonts for use in this R session:\n ", - paste(cmapplot_globals$preferred_font, collapse = ", ") - )) - - assign("use_whitney", - TRUE, - envir = cmapplot_globals) - }) + # Register preferred fonts using the paths found above. This will only be + # attempted if at least 10 paths are found, as 10 distinct faces are needed + # to register all possible variants of the three needed fonts. If the + # correct face cannot be found, `find_path` will error and the try object + # will fail before `use_whitney` is set to TRUE. + if (length(whitney_paths) >= 10){ + try({ + + # register preferred strong font (Whitney Semibold), with variants + systemfonts::register_font( + name = cmapplot_globals$preferred_font$strong, + plain = find_path("Whitney-Semibold-Adv", whitney_paths), + bold = find_path("Whitney-Black-Adv", whitney_paths), + italic = find_path("Whitney-SemiboldItal-Adv", whitney_paths), + bolditalic = find_path("Whitney-BlackItal-Adv", whitney_paths) + ) + + # register preferred regular font (Whitney Medium), with variants + systemfonts::register_font( + name = cmapplot_globals$preferred_font$regular, + plain = find_path("Whitney-Medium-Adv", whitney_paths), + bold = find_path("Whitney-Bold-Adv", whitney_paths), + italic = find_path("Whitney-MediumItal-Adv", whitney_paths), + bolditalic = find_path("Whitney-BoldItal-Adv", whitney_paths) + ) + + # register preferred light font (Whitney Book), with variants + systemfonts::register_font( + name = cmapplot_globals$preferred_font$light, + plain = find_path("Whitney-Book-Adv", whitney_paths), + bold = find_path("Whitney-Semibold-Adv", whitney_paths), + italic = find_path("Whitney-BookItal-Adv", whitney_paths), + bolditalic = find_path("Whitney-SemiboldItal-Adv", whitney_paths) + ) + + packageStartupMessage(paste0( + "cmapplot has registered the following fonts for use in this R session:\n ", + paste(cmapplot_globals$preferred_font, collapse = ", ") + )) + + assign("use_whitney", + TRUE, + envir = cmapplot_globals) + }) + } } # If Whitney is available... From ebdbb66aeddef4d315e1ea3818c6759ab142d85d Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Thu, 6 May 2021 17:09:16 -0500 Subject: [PATCH 117/173] Update to reflect new font behavior Removes reference to Calibri --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index e31d83ce..0549d045 100644 --- a/README.md +++ b/README.md @@ -83,7 +83,7 @@ manager with the command `brew install --cask xquartz`.) on a computer with the Whitney family of fonts installed (specifically the Book, Medium, and Semibold variants). If installed on a computer *without* Whitney, the package will still work, but the fonts will -default to Calibri (on Windows) or Arial (on macOS/Linux). +default to the system's default sans-serif font (typically Arial). ## CMAP theme and colors From b07fc89202ae40c70cfc34ed20758ec6d59e65aa Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Thu, 6 May 2021 17:28:30 -0500 Subject: [PATCH 118/173] Doesn't work, playing with it --- R/colors_continuous.R | 35 ++++++++++++++++++++++++++--------- 1 file changed, 26 insertions(+), 9 deletions(-) diff --git a/R/colors_continuous.R b/R/colors_continuous.R index 712f49ae..e9629af9 100644 --- a/R/colors_continuous.R +++ b/R/colors_continuous.R @@ -141,19 +141,36 @@ mid_rescaler2 <- function(mid) { #' @export cmap_fill_continuous <- function(palette = "seq_reds", reverse = FALSE, + discrete = FALSE, middle = 0, ...) { if (substr(palette,1,3) == "div") { - ggplot2::scale_fill_gradientn( - colours = cmap_pal_continuous(palette, reverse = reverse)(256), - rescaler = mid_rescaler2(middle), - ... - ) + if (discrete) { + ggplot2::discrete_scale( + "fill", "cmap_palettes", + palette = cmap_pal_discrete(palette, reverse = reverse), + ... + ) + } else { + ggplot2::scale_fill_gradientn( + colours = cmap_pal_continuous(palette, reverse = reverse)(256), + rescaler = mid_rescaler2(middle), + ... + ) + } } else { - ggplot2::scale_fill_gradientn( - colours = cmap_pal_continuous(palette, reverse = reverse)(256), - ... - ) + if (discrete) { + ggplot2::discrete_scale( + "fill", "cmap_palettes", + palette = cmap_pal_discrete(palette, reverse = reverse), + ... + ) + } else { + ggplot2::scale_fill_gradientn( + colours = cmap_pal_continuous(palette, reverse = reverse)(256), + ... + ) + } } } From 2cac68bb83e12b8ad9b1583aec32fd2b7a6ff25c Mon Sep 17 00:00:00 2001 From: Matthew Stern <54633946+tallishmatt@users.noreply.github.com> Date: Fri, 7 May 2021 17:19:14 -0500 Subject: [PATCH 119/173] remove "window" mode --- R/finalize_plot.R | 47 +++++++++++++++++++++++++---------------------- 1 file changed, 25 insertions(+), 22 deletions(-) diff --git a/R/finalize_plot.R b/R/finalize_plot.R index ff0903d8..90468833 100644 --- a/R/finalize_plot.R +++ b/R/finalize_plot.R @@ -4,9 +4,8 @@ #'your title and caption to the left, add a horizontal line on top, and make #'other adjustments. It can show you the final plot and/or export it as a raster #'or vector file. This function will not apply CMAP design standards to the plot -#'itself: use with \code{theme_cmap()} for that. Exports from this function use -#'Cairo graphics drivers, while drawing within R is done with default (Windows) -#'drivers. +#'itself: use with \code{theme_cmap()} for that. This function uses ragg drivers +#'in R and for raster exports, svglite for svg, and cairo_pdf for PDFs. #' #'@param plot ggplot object, the variable name of the plot you have created that #' you want to finalize. If null (the default), the most recent plot will be @@ -28,8 +27,7 @@ #' aligns text to bottom; 1 aligns top. When the caption is located below the #' plot, 0 aligns left and 1 aligns right. 0.5 aligns center. #'@param mode Vector, the action(s) to be taken with the plot. View in R with -#' \code{plot}, the default, or \code{window} (\code{window} only works on -#' computers running Windows). Save using any of the following: \code{png}, +#' \code{plot}, the default. Save using any of the following: \code{png}, #' \code{tiff}, \code{jpeg}, \code{svg}, \code{pdf}, \code{ps}. Run #' multiple simultaneous outputs with a vector, e.g. \code{c("plot", "png", #' "pdf")}. @@ -94,7 +92,7 @@ #' finalize_plot(econ_plot, #' "Cluster-level employment changes in the Chicago MSA, 2001-17", #' "Source: Chicago Metropolitan Agency for Planning analysis", -#' mode = "window", +#' mode = "plot", #' height = 6, #' width = 8, #' sidebar_width = 2.5, @@ -197,16 +195,17 @@ finalize_plot <- function(plot = NULL, caption_align <- 1 } - # Remove any `window` mode specified if OS is not Windows - if ("window" %in% mode & .Platform$OS.type != "windows"){ - mode <- stringr::str_replace(mode, "^window$", "plot") - message("`mode='window'` is not supported on non-Windows systems. Switching to `mode='plot'` instead.") - } + # mode "window" disabled for now + # # Remove any `window` mode specified if OS is not Windows + # if ("window" %in% mode & .Platform$OS.type != "windows"){ + # mode <- stringr::str_replace(mode, "^window$", "plot") + # message("`mode='window'` is not supported on non-Windows systems. Switching to `mode='plot'` instead.") + # } # Check mode argument savetypes_raster <- c("png", "tiff", "jpeg") savetypes_vector <- c("svg", "ps", "pdf") - savetypes_print <- c("plot", "window") + savetypes_print <- c("plot") # mode "window" disabled for now mode <- match.arg(arg = unique(mode), choices = c(savetypes_print, @@ -630,6 +629,10 @@ prepare_plot <- function(plot, #' Sub-fn to draw plot within R +#' +#' At the moment, it is not known how to open a new ragg device, so "window" +#' mode is disabled. +#' #' @noRd draw_plot <- function(finished_graphic, width, @@ -637,12 +640,12 @@ draw_plot <- function(finished_graphic, fill_canvas, mode){ - # In window mode, open new drawing device - if (mode == "window") { - grDevices::dev.new(width = width * 1.02, - height = height * 1.02, - noRStudioGD = TRUE) - } + # # In window mode, open new drawing device + # if (mode == "window") { + # grDevices::dev.new(width = width * 1.02, + # height = height * 1.02, + # noRStudioGD = TRUE) + # } # Draw blank canvas grid::grid.rect(gp = grid::gpar(fill = fill_canvas, @@ -665,10 +668,10 @@ draw_plot <- function(finished_graphic, grid::grid.draw(finished_graphic) grid::popViewport() - # In window mode, reset device to default without closing window - if (mode == "window") { - grDevices::dev.next() - } + # # In window mode, reset device to default without closing window + # if (mode == "window") { + # grDevices::dev.next() + # } } From c43da29786517b72096952c0ace0be24df7db3bd Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sun, 9 May 2021 18:58:00 -0500 Subject: [PATCH 120/173] optimize device selection --- R/finalize_plot.R | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/R/finalize_plot.R b/R/finalize_plot.R index 90468833..db9fccaf 100644 --- a/R/finalize_plot.R +++ b/R/finalize_plot.R @@ -693,27 +693,27 @@ save_plot <- function(finished_graphic, # Construct pretty filename for messages fname <- stringr::str_trunc(arglist$filename, 50, "left") - - # Add required cairo prefix to function name for pdf and ps (see `?cairo`) - mode <- ifelse (mode == "pdf" | mode == "ps", paste0("cairo_" , mode), mode) - - # Add required agg prefix to function name for raster modes - mode <- ifelse (mode %in% c("png", "tiff", "jpeg"), paste0("agg_" , mode), mode) - - # change svg to svglite - mode <- ifelse (mode == "svg", "svglite", mode) - # If file exists and overwrite == FALSE, do not write if (file.exists(arglist$filename) & !overwrite) { message(paste0(fname, ": SKIPPED (try `overwrite = TRUE`?)")) return() } + # identify device function based on mode + devfn <- switch( + mode, + svg = "svglite", + pdf = "cairo_pdf", + ps = "cairo_ps", + png = "agg_png", + tiff = "agg_tiff", + jpeg = "agg_jpeg") + # Write to device ----------------------------------------------- tryCatch( { # Open the device, draw the plot, close the device - suppressWarnings(do.call(mode, arglist)) + suppressWarnings(do.call(devfn, arglist)) grid::grid.draw(finished_graphic) dev.off() From dc1869fa5c3ecdfe3b4ac3f5fdaf09d02638498d Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sun, 9 May 2021 19:01:55 -0500 Subject: [PATCH 121/173] remove ref to window mode from vignette --- vignettes/finalize.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/finalize.Rmd b/vignettes/finalize.Rmd index ff3063b5..cb0b09bb 100644 --- a/vignettes/finalize.Rmd +++ b/vignettes/finalize.Rmd @@ -56,7 +56,7 @@ In this vignette we will use the final version of the line chart developed in `v After creating a plot and applying `theme_cmap()`, use `finalize_plot()` to complete the implementation of CMAP design standards. You will probably want to set at least the `title` and `caption`, although the function will extract them from the ggplot if they were specified. -As you are preparing the plot, you will likely want to view it within R. Do this by leaving leaving the default `mode = "plot"` to send the finished plot to the "Plots" tab within RStudio. Windows users may prefer `mode = "window"`, which draws the plot in a popup window. In both modes, the plot will show up "actual size" (depending on your screen's resolution) surrounded by a grey canvas. +As you are preparing the plot, you will likely want to view it within R. Do this by leaving leaving the default `mode = "plot"` to send the finished plot to the "Plots" tab within RStudio. The plot will show up "actual size" (depending on your screen's resolution) surrounded by a gray canvas. ```{r finalize1, fig.width=11, out.width="100%"} finalize_plot(plot = p, From 64f4dedfe335bf73352b9406a9c0b3590c295bdd Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Tue, 11 May 2021 14:16:15 -0500 Subject: [PATCH 122/173] Revert "Doesn't work, playing with it" This reverts commit b07fc89202ae40c70cfc34ed20758ec6d59e65aa. --- R/colors_continuous.R | 35 +++++++++-------------------------- 1 file changed, 9 insertions(+), 26 deletions(-) diff --git a/R/colors_continuous.R b/R/colors_continuous.R index e9629af9..712f49ae 100644 --- a/R/colors_continuous.R +++ b/R/colors_continuous.R @@ -141,36 +141,19 @@ mid_rescaler2 <- function(mid) { #' @export cmap_fill_continuous <- function(palette = "seq_reds", reverse = FALSE, - discrete = FALSE, middle = 0, ...) { if (substr(palette,1,3) == "div") { - if (discrete) { - ggplot2::discrete_scale( - "fill", "cmap_palettes", - palette = cmap_pal_discrete(palette, reverse = reverse), - ... - ) - } else { - ggplot2::scale_fill_gradientn( - colours = cmap_pal_continuous(palette, reverse = reverse)(256), - rescaler = mid_rescaler2(middle), - ... - ) - } + ggplot2::scale_fill_gradientn( + colours = cmap_pal_continuous(palette, reverse = reverse)(256), + rescaler = mid_rescaler2(middle), + ... + ) } else { - if (discrete) { - ggplot2::discrete_scale( - "fill", "cmap_palettes", - palette = cmap_pal_discrete(palette, reverse = reverse), - ... - ) - } else { - ggplot2::scale_fill_gradientn( - colours = cmap_pal_continuous(palette, reverse = reverse)(256), - ... - ) - } + ggplot2::scale_fill_gradientn( + colours = cmap_pal_continuous(palette, reverse = reverse)(256), + ... + ) } } From 48a3bac01a26ffb5305c4525b7d1b5d041d5780b Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Tue, 11 May 2021 14:17:04 -0500 Subject: [PATCH 123/173] Add gradients to list of palettes --- R/colors_discrete.R | 33 +++++++++++++++++++-------------- 1 file changed, 19 insertions(+), 14 deletions(-) diff --git a/R/colors_discrete.R b/R/colors_discrete.R index bed8276e..cd8e3ebe 100644 --- a/R/colors_discrete.R +++ b/R/colors_discrete.R @@ -11,30 +11,35 @@ #' purrr::walk2(cmap_palettes, names(cmap_palettes), viz_palette) #' #' @export -cmap_palettes <- list( +cmap_palettes <- c( - prosperity = c("#662f00", "#e5d072", "#44008c", "#c8e572", "#c9a7ef"), + # Add CMAP gradients to the palettes list (note that we don't add the + # palettes to the gradients list since those are not sequential). + cmap_gradients, - community = c("#cc5f00", "#006b8c", "#e5a872", "#d2efa7", "#662f00"), + # Mixed color palettes + list(prosperity = c("#662f00", "#e5d072", "#44008c", "#c8e572", "#c9a7ef"), - environment = c("#00665c", "#b7e572", "#3f0030", "#36d8ca", "#006b8c"), + community = c("#cc5f00", "#006b8c", "#e5a872", "#d2efa7", "#662f00"), - governance = c("#006b8c", "#efa7a7", "#8c4100", "#00303f", "#cca600", "#a7efe8"), + environment = c("#00665c", "#b7e572", "#3f0030", "#36d8ca", "#006b8c"), - mobility = c("#8c0000", "#e5bd72", "#a7efe8", "#6d8692", "#0084ac", "#efa7a7"), + governance = c("#006b8c", "#efa7a7", "#8c4100", "#00303f", "#cca600", "#a7efe8"), - legislation = c("#00becc", "#cc5f00", "#3f0e00", "#cca600", "#003f8c", "#67ac00"), + mobility = c("#8c0000", "#e5bd72", "#a7efe8", "#6d8692", "#0084ac", "#efa7a7"), - friday = c("#00093f", "#ac8c00", "#475c66", "#e5d072", "#b5c1c8", "#006b8c"), + legislation = c("#00becc", "#cc5f00", "#3f0e00", "#cca600", "#003f8c", "#67ac00"), - race = c(white = "#75a5d8", - black = "#84c87e", - hispanic = "#d8ba39", - asian = "#e77272", - other = "#607b88") + friday = c("#00093f", "#ac8c00", "#475c66", "#e5d072", "#b5c1c8", "#006b8c"), -) + race = c(white = "#75a5d8", + black = "#84c87e", + hispanic = "#d8ba39", + asian = "#e77272", + other = "#607b88") + ) +) #' Print palette for reference #' From fe9c20c09817fc13ed5d2aec44df6cdea63d266d Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Tue, 11 May 2021 15:21:53 -0500 Subject: [PATCH 124/173] Update documentation --- R/colors_discrete.R | 17 +++++++++++------ man/cmap_fill_discrete.Rd | 4 +++- man/cmap_palettes.Rd | 11 ++++++----- 3 files changed, 20 insertions(+), 12 deletions(-) diff --git a/R/colors_discrete.R b/R/colors_discrete.R index cd8e3ebe..e5a8f8b6 100644 --- a/R/colors_discrete.R +++ b/R/colors_discrete.R @@ -1,6 +1,8 @@ #' CMAP discrete color palettes #' -#' A selection of discrete color palettes from the CMAP color palette. +#' A selection of discrete color palettes from the CMAP color palette. These +#' include mixed color palettes and discrete versions of the gradients defined +#' in \code{link{cmap_fill_continuous}}. #' #' @examples #' # Get names of available discrete palettes. @@ -47,9 +49,8 @@ cmap_palettes <- c( #' @param ttl character, title to be displayed (the name of the palette) #' @param num numeric, the number of colours to display #' -#' @describeIn cmap_palettes Display CMAP diverging palettes. Borrowed with -#' respect from the \href{https://github.com/ropenscilabs/ochRe}{ochRe -#' package} +#' @describeIn cmap_palettes Display CMAP palettes. Borrowed with respect from +#' the \href{https://github.com/ropenscilabs/ochRe}{ochRe package} #' #' @export viz_palette <- function(pal, ttl = deparse(substitute(pal)), num = length(pal)) { @@ -66,7 +67,9 @@ viz_palette <- function(pal, ttl = deparse(substitute(pal)), num = length(pal)) #' Discrete palette prep function #' -#' @param palette Choose from 'cmap_palettes' list +#' @param palette Choose from 'cmap_palettes' list, or use one of the gradients +#' defined in the 'cmap_gradients' list (gradients will be automatically +#' converted into discrete bins) #' @param reverse Logical; reverse color order? #' @param ... Additional parameters passed on to the scale type #' @@ -85,7 +88,9 @@ cmap_pal_discrete <- function(palette = "prosperity", reverse = FALSE) { #' Pick the function depending on the aesthetic of your ggplot object (fill or #' color). See \code{link{cmap_palettes}} for a listing of available gradients. #' -#' @param palette Choose from 'cmap_palettes' list +#' @param palette Choose from 'cmap_palettes' list, or use one of the gradients +#' defined in the 'cmap_gradients' list (gradients will be automatically +#' converted into discrete bins) #' @param reverse Logical; reverse color order? #' @param ... Additional parameters passed on to the scale type #' diff --git a/man/cmap_fill_discrete.Rd b/man/cmap_fill_discrete.Rd index d238a32b..faa8333e 100644 --- a/man/cmap_fill_discrete.Rd +++ b/man/cmap_fill_discrete.Rd @@ -13,7 +13,9 @@ cmap_color_discrete(palette = "prosperity", reverse = FALSE, ...) cmap_colour_discrete(palette = "prosperity", reverse = FALSE, ...) } \arguments{ -\item{palette}{Choose from 'cmap_palettes' list} +\item{palette}{Choose from 'cmap_palettes' list, or use one of the gradients +defined in the 'cmap_gradients' list (gradients will be automatically +converted into discrete bins)} \item{reverse}{Logical; reverse color order?} diff --git a/man/cmap_palettes.Rd b/man/cmap_palettes.Rd index 29014960..cfaa78d1 100644 --- a/man/cmap_palettes.Rd +++ b/man/cmap_palettes.Rd @@ -6,7 +6,7 @@ \alias{viz_palette} \title{CMAP discrete color palettes} \format{ -An object of class \code{list} of length 8. +An object of class \code{list} of length 31. } \usage{ cmap_palettes @@ -21,13 +21,14 @@ viz_palette(pal, ttl = deparse(substitute(pal)), num = length(pal)) \item{num}{numeric, the number of colours to display} } \description{ -A selection of discrete color palettes from the CMAP color palette. +A selection of discrete color palettes from the CMAP color palette. These +include mixed color palettes and discrete versions of the gradients defined +in \code{link{cmap_fill_continuous}}. } \section{Functions}{ \itemize{ -\item \code{viz_palette}: Display CMAP diverging palettes. Borrowed with -respect from the \href{https://github.com/ropenscilabs/ochRe}{ochRe -package} +\item \code{viz_palette}: Display CMAP palettes. Borrowed with respect from +the \href{https://github.com/ropenscilabs/ochRe}{ochRe package} }} \examples{ From 8f3fee65b00859537da7932aa875e97875641d6f Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Tue, 11 May 2021 15:22:15 -0500 Subject: [PATCH 125/173] Update vignettes Reorder and add note about discrete versions of gradients. --- vignettes/colors.Rmd | 35 +++++++++++++++++------------------ 1 file changed, 17 insertions(+), 18 deletions(-) diff --git a/vignettes/colors.Rmd b/vignettes/colors.Rmd index 945b924e..be5e7fbe 100644 --- a/vignettes/colors.Rmd +++ b/vignettes/colors.Rmd @@ -24,24 +24,6 @@ library(cmapplot) Palettes based on the CMAP color palette can be applied directly to ggplot2 graphics. The package contains both discrete and continuous color palettes. Each type of palette can be applied to either the color or fill attributes of a ggplot. - -## Discrete palettes - -Add discrete palettes by adding either the `cmap_fill_discrete()` or `cmap_color_discrete()` function to your plot construction. Note that discrete palettes will automatically interpolate additional colors if the dataset has more colors than the palette. This can be helpful but is not ideal for finished graphics. See `?cmap_palettes` for displays of all discrete palettes. - -```{r color_discrete, message = FALSE} -df <- dplyr::filter(grp_over_time, category == "Goods-Producing") - -ggplot(data = df) + - geom_line(mapping = aes(x = year, y = realgrp, color = cluster), - size = 1.25) + - scale_x_continuous(breaks = seq(from = 2007, to = 2017, by = 2)) + - cmap_color_discrete(palette = "community", reverse = TRUE) + - theme_cmap() + - ggtitle("Real GRP of goods-producing clusters over time") -``` - - ## Continuous palettes Add continuous palettes by adding either the `cmap_fill_continuous()` or `cmap_color_continuous()` function to your plot construction. For example: @@ -66,6 +48,23 @@ ggplot(data = df) + If you're using a divergent palette, you can specify the midpoint where the divergence begins (default is zero). See `?cmap_gradients` for displays of all continuous palettes. +## Discrete palettes + +Add discrete palettes by adding either the `cmap_fill_discrete()` or `cmap_color_discrete()` function to your plot construction. Note that discrete palettes will automatically interpolate additional colors if the dataset has more colors than the palette. This can be helpful but is not ideal for finished graphics. See `?cmap_palettes` for displays of all discrete palettes. These include a set of complementary colors (e.g., the `"prosperity"` palette), but also discrete versions of the gradients defined above (e.g., a binned blue palette implemented by calling `"seq_blues"`). + +```{r color_discrete, message = FALSE} +df <- dplyr::filter(grp_over_time, category == "Goods-Producing") + +ggplot(data = df) + + geom_line(mapping = aes(x = year, y = realgrp, color = cluster), + size = 1.25) + + scale_x_continuous(breaks = seq(from = 2007, to = 2017, by = 2)) + + cmap_color_discrete(palette = "community", reverse = TRUE) + + theme_cmap() + + ggtitle("Real GRP of goods-producing clusters over time") +``` + + ## Race/ethnicity palette If you have a graph with categories based on race and ethnicity, there are functions to apply pre-determined colors for each demographic group: `cmap_fill_race()` and `cmap_color_race()`. In the arguments, specify the case-sensitive name of each group as it appears in your data. The function can be used even if your dataset does not contain every race/ethnicity category — simply omit the parameters for the missing categories. From 97f9efa6824455a17bd0f0fd7dec2e68cddd51e8 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Wed, 12 May 2021 09:54:44 -0500 Subject: [PATCH 126/173] Colour/color tweak Mainly doing this to start a new check --- R/colors_discrete.R | 10 ++++------ man/cmap_palettes.Rd | 4 ++-- 2 files changed, 6 insertions(+), 8 deletions(-) diff --git a/R/colors_discrete.R b/R/colors_discrete.R index e5a8f8b6..7351a391 100644 --- a/R/colors_discrete.R +++ b/R/colors_discrete.R @@ -45,9 +45,9 @@ cmap_palettes <- c( #' Print palette for reference #' -#' @param pal character, vector of (hexadecimal) colours representing a palette +#' @param pal character, vector of (hexadecimal) colors representing a palette #' @param ttl character, title to be displayed (the name of the palette) -#' @param num numeric, the number of colours to display +#' @param num numeric, the number of colors to display #' #' @describeIn cmap_palettes Display CMAP palettes. Borrowed with respect from #' the \href{https://github.com/ropenscilabs/ochRe}{ochRe package} @@ -59,12 +59,11 @@ viz_palette <- function(pal, ttl = deparse(substitute(pal)), num = length(pal)) } pal_func <- grDevices::colorRampPalette(pal) graphics::image(seq_len(num), 1, as.matrix(seq_len(num)), col = pal_func(num), - main = paste0(ttl, " (", length(pal), " colours in palette, ", + main = paste0(ttl, " (", length(pal), " colors in palette, ", num, " displayed)"), xlab = "", ylab = "", xaxt = "n", yaxt = "n", bty = "n") } - #' Discrete palette prep function #' #' @param palette Choose from 'cmap_palettes' list, or use one of the gradients @@ -82,7 +81,6 @@ cmap_pal_discrete <- function(palette = "prosperity", reverse = FALSE) { return(grDevices::colorRampPalette(pal)) } - #' Apply discrete CMAP palettes to ggplot2 aesthetics #' #' Pick the function depending on the aesthetic of your ggplot object (fill or @@ -118,7 +116,7 @@ cmap_fill_discrete <- function(palette = "prosperity", reverse = FALSE, ...) { #' @export cmap_color_discrete <- function(palette = "prosperity", reverse = FALSE, ...) { ggplot2::discrete_scale( - "colour", "cmap_palettes", + "color", "cmap_palettes", palette = cmap_pal_discrete(palette, reverse = reverse), ... ) diff --git a/man/cmap_palettes.Rd b/man/cmap_palettes.Rd index cfaa78d1..080a14a6 100644 --- a/man/cmap_palettes.Rd +++ b/man/cmap_palettes.Rd @@ -14,11 +14,11 @@ cmap_palettes viz_palette(pal, ttl = deparse(substitute(pal)), num = length(pal)) } \arguments{ -\item{pal}{character, vector of (hexadecimal) colours representing a palette} +\item{pal}{character, vector of (hexadecimal) colors representing a palette} \item{ttl}{character, title to be displayed (the name of the palette)} -\item{num}{numeric, the number of colours to display} +\item{num}{numeric, the number of colors to display} } \description{ A selection of discrete color palettes from the CMAP color palette. These From 5d7e2d7445f89a8f1b3beb05dd5987571386615d Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Wed, 12 May 2021 20:11:44 -0500 Subject: [PATCH 127/173] Change back to colour Just for internal references --- R/colors_discrete.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/colors_discrete.R b/R/colors_discrete.R index 7351a391..42010384 100644 --- a/R/colors_discrete.R +++ b/R/colors_discrete.R @@ -116,7 +116,7 @@ cmap_fill_discrete <- function(palette = "prosperity", reverse = FALSE, ...) { #' @export cmap_color_discrete <- function(palette = "prosperity", reverse = FALSE, ...) { ggplot2::discrete_scale( - "color", "cmap_palettes", + "colour", "cmap_palettes", palette = cmap_pal_discrete(palette, reverse = reverse), ... ) From 9852752fe462d26968bc9358ef6bf8c7ad433dfb Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Thu, 13 May 2021 11:52:11 -0500 Subject: [PATCH 128/173] Update margin image references --- pkgdown/_pkgdown.yml | 4 ++++ vignettes/finalize.Rmd | 4 ++-- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index 396cc842..7c18718d 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -55,3 +55,7 @@ articles: - finalize - colors - cookbook + +resource_files: +- man/figures/margins1.png +- man/figures/margins2.png diff --git a/vignettes/finalize.Rmd b/vignettes/finalize.Rmd index ff3063b5..a54d887b 100644 --- a/vignettes/finalize.Rmd +++ b/vignettes/finalize.Rmd @@ -199,8 +199,8 @@ There is a fairly long list of possible margins that can be customized using the Here, the margins are visualized as they impact a finalized plot that has a sidebar: - + Here, the same margins are visualized as they impact a finalized plot with no sidebar: - + From b5d485d88bad763cdab712277161a96513596269 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Thu, 13 May 2021 11:54:25 -0500 Subject: [PATCH 129/173] that didn't work --- vignettes/finalize.Rmd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/vignettes/finalize.Rmd b/vignettes/finalize.Rmd index a54d887b..ff3063b5 100644 --- a/vignettes/finalize.Rmd +++ b/vignettes/finalize.Rmd @@ -199,8 +199,8 @@ There is a fairly long list of possible margins that can be customized using the Here, the margins are visualized as they impact a finalized plot that has a sidebar: - + Here, the same margins are visualized as they impact a finalized plot with no sidebar: - + From ee2983cb74e11546a9c96efdf3c7d5df237e21b9 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Fri, 28 May 2021 10:01:31 -0500 Subject: [PATCH 130/173] Change case of file extensions --- man/figures/{margins1.PNG => margins1.png} | Bin man/figures/{margins2.PNG => margins2.png} | Bin 2 files changed, 0 insertions(+), 0 deletions(-) rename man/figures/{margins1.PNG => margins1.png} (100%) rename man/figures/{margins2.PNG => margins2.png} (100%) diff --git a/man/figures/margins1.PNG b/man/figures/margins1.png similarity index 100% rename from man/figures/margins1.PNG rename to man/figures/margins1.png diff --git a/man/figures/margins2.PNG b/man/figures/margins2.png similarity index 100% rename from man/figures/margins2.PNG rename to man/figures/margins2.png From d2cfb08c6799f6dfa5d9203c19deec2650cd54b8 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Wed, 2 Jun 2021 13:24:46 -0500 Subject: [PATCH 131/173] Update vignette Incorporates Noel's suggestion. --- vignettes/finalize.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/finalize.Rmd b/vignettes/finalize.Rmd index cb0b09bb..869c8f4f 100644 --- a/vignettes/finalize.Rmd +++ b/vignettes/finalize.Rmd @@ -56,7 +56,7 @@ In this vignette we will use the final version of the line chart developed in `v After creating a plot and applying `theme_cmap()`, use `finalize_plot()` to complete the implementation of CMAP design standards. You will probably want to set at least the `title` and `caption`, although the function will extract them from the ggplot if they were specified. -As you are preparing the plot, you will likely want to view it within R. Do this by leaving leaving the default `mode = "plot"` to send the finished plot to the "Plots" tab within RStudio. The plot will show up "actual size" (depending on your screen's resolution) surrounded by a gray canvas. +As you are preparing the plot, you will likely want to view it within R. Do this by leaving leaving the default `mode = "plot"` to send the finished plot to the "Plots" tab within RStudio. The plot will show up "actual size" (depending on your screen's resolution) surrounded by a gray canvas. If you want to view the plot in a separate window, you can select the "Zoom" button at the top left of the plot. This may be especially useful for large plots that cannot easily be displayed within RStudio's default plotting window. ```{r finalize1, fig.width=11, out.width="100%"} finalize_plot(plot = p, From 3d0a693bc31f87f6bddd855c32026610f987dfa8 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Wed, 2 Jun 2021 14:52:14 -0500 Subject: [PATCH 132/173] Test exports of SVGs with fonts --- test_export.svg | 61 ++++++++++++++++++++++++++++++++++++++++ test_export_modified.svg | 61 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 122 insertions(+) create mode 100644 test_export.svg create mode 100644 test_export_modified.svg diff --git a/test_export.svg b/test_export.svg new file mode 100644 index 00000000..ec5b0a79 --- /dev/null +++ b/test_export.svg @@ -0,0 +1,61 @@ + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 + + + + + + + + +0 +1 +2 +3 +4 +5 +6 + + + + + + + + +Title | font: strong, size: L | Whitney Semibold, plain, 17 +Main | font: regular, size: M | Whitney Medium, plain, 14 +Axis | font: light, size: M | Whitney Book, plain, 14 +Label | font: strong, size: M | Whitney Semibold, plain, 14 +Note | font: light, size: S | Whitney Book, plain, 11 + + diff --git a/test_export_modified.svg b/test_export_modified.svg new file mode 100644 index 00000000..db38a2e4 --- /dev/null +++ b/test_export_modified.svg @@ -0,0 +1,61 @@ + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 + + + + + + + + +0 +1 +2 +3 +4 +5 +6 + + + + + + + + +Title | font: strong, size: L | Whitney Semibold, plain, 17 +Main | font: regular, size: M | Whitney Medium, plain, 14 +Axis | font: light, size: M | Whitney Book, plain, 14 +Label | font: strong, size: M | Whitney Semibold, plain, 14 +Note | font: light, size: S | Whitney Book, plain, 11 + + From 89ffcffeedada7dd6fc3ae6f97d10604d8bfb3a7 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Thu, 3 Jun 2021 11:24:36 -0500 Subject: [PATCH 133/173] Revert to svg For now, use `svg` instead of `svglite`. --- NAMESPACE | 1 - R/finalize_plot.R | 3 +-- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 60b31a19..2684b228 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -60,6 +60,5 @@ importFrom(stats,na.omit) importFrom(stringr,str_length) importFrom(stringr,str_replace) importFrom(stringr,str_trunc) -importFrom(svglite,svglite) importFrom(utils,modifyList) importFrom(utils,read.csv) diff --git a/R/finalize_plot.R b/R/finalize_plot.R index db9fccaf..5f90972b 100644 --- a/R/finalize_plot.R +++ b/R/finalize_plot.R @@ -76,7 +76,6 @@ #'@importFrom ggpubr get_legend #'@importFrom purrr compact #'@importFrom stringr str_replace -#'@importFrom svglite svglite #' #'@examples #' \dontrun{ @@ -702,7 +701,7 @@ save_plot <- function(finished_graphic, # identify device function based on mode devfn <- switch( mode, - svg = "svglite", + svg = "svg", pdf = "cairo_pdf", ps = "cairo_ps", png = "agg_png", From 9907002d27c8a79e1ac2365894c1e0d79502b341 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Thu, 3 Jun 2021 11:24:42 -0500 Subject: [PATCH 134/173] Update documentation --- man/finalize_plot.Rd | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/man/finalize_plot.Rd b/man/finalize_plot.Rd index dc18ebe3..786da4ff 100644 --- a/man/finalize_plot.Rd +++ b/man/finalize_plot.Rd @@ -54,8 +54,7 @@ aligns text to bottom; 1 aligns top. When the caption is located below the plot, 0 aligns left and 1 aligns right. 0.5 aligns center.} \item{mode}{Vector, the action(s) to be taken with the plot. View in R with -\code{plot}, the default, or \code{window} (\code{window} only works on -computers running Windows). Save using any of the following: \code{png}, +\code{plot}, the default. Save using any of the following: \code{png}, \code{tiff}, \code{jpeg}, \code{svg}, \code{pdf}, \code{ps}. Run multiple simultaneous outputs with a vector, e.g. \code{c("plot", "png", "pdf")}.} @@ -116,9 +115,8 @@ Place a ggplot into a frame defined by CMAP design standards. It will align your title and caption to the left, add a horizontal line on top, and make other adjustments. It can show you the final plot and/or export it as a raster or vector file. This function will not apply CMAP design standards to the plot -itself: use with \code{theme_cmap()} for that. Exports from this function use -Cairo graphics drivers, while drawing within R is done with default (Windows) -drivers. +itself: use with \code{theme_cmap()} for that. This function uses ragg drivers +in R and for raster exports, svglite for svg, and cairo_pdf for PDFs. } \examples{ \dontrun{ @@ -134,7 +132,7 @@ econ_plot <- ggplot(data = cluster_jobchange, finalize_plot(econ_plot, "Cluster-level employment changes in the Chicago MSA, 2001-17", "Source: Chicago Metropolitan Agency for Planning analysis", - mode = "window", + mode = "plot", height = 6, width = 8, sidebar_width = 2.5, From 78308f6b78d2eda9fc29994224a0f10e08298d47 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Thu, 3 Jun 2021 11:24:49 -0500 Subject: [PATCH 135/173] Remove test exports --- test_export.svg | 61 ---------------------------------------- test_export_modified.svg | 61 ---------------------------------------- 2 files changed, 122 deletions(-) delete mode 100644 test_export.svg delete mode 100644 test_export_modified.svg diff --git a/test_export.svg b/test_export.svg deleted file mode 100644 index ec5b0a79..00000000 --- a/test_export.svg +++ /dev/null @@ -1,61 +0,0 @@ - - - - - - - - - - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 - - - - - - - - -Title | font: strong, size: L | Whitney Semibold, plain, 17 -Main | font: regular, size: M | Whitney Medium, plain, 14 -Axis | font: light, size: M | Whitney Book, plain, 14 -Label | font: strong, size: M | Whitney Semibold, plain, 14 -Note | font: light, size: S | Whitney Book, plain, 11 - - diff --git a/test_export_modified.svg b/test_export_modified.svg deleted file mode 100644 index db38a2e4..00000000 --- a/test_export_modified.svg +++ /dev/null @@ -1,61 +0,0 @@ - - - - - - - - - - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 - - - - - - - - -0 -1 -2 -3 -4 -5 -6 - - - - - - - - -Title | font: strong, size: L | Whitney Semibold, plain, 17 -Main | font: regular, size: M | Whitney Medium, plain, 14 -Axis | font: light, size: M | Whitney Book, plain, 14 -Label | font: strong, size: M | Whitney Semibold, plain, 14 -Note | font: light, size: S | Whitney Book, plain, 11 - - From a74775b0d9f63423613fb8c93d9c76e552f42270 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Thu, 3 Jun 2021 11:27:01 -0500 Subject: [PATCH 136/173] Remove svglite --- DESCRIPTION | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 277b5d51..8facfcb2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -53,8 +53,7 @@ Imports: rstudioapi, scales, stringr, - systemfonts, - svglite + systemfonts Suggests: knitr, rmarkdown, From 51b72d97d41c0bc471d1bdb6e098f085de23843b Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Thu, 3 Jun 2021 16:45:48 -0500 Subject: [PATCH 137/173] Update documentation --- R/finalize_plot.R | 2 +- man/finalize_plot.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/finalize_plot.R b/R/finalize_plot.R index 5f90972b..03697102 100644 --- a/R/finalize_plot.R +++ b/R/finalize_plot.R @@ -5,7 +5,7 @@ #'other adjustments. It can show you the final plot and/or export it as a raster #'or vector file. This function will not apply CMAP design standards to the plot #'itself: use with \code{theme_cmap()} for that. This function uses ragg drivers -#'in R and for raster exports, svglite for svg, and cairo_pdf for PDFs. +#'in R and for raster exports, svg for svg, and cairo_pdf for PDFs. #' #'@param plot ggplot object, the variable name of the plot you have created that #' you want to finalize. If null (the default), the most recent plot will be diff --git a/man/finalize_plot.Rd b/man/finalize_plot.Rd index 786da4ff..07cedc34 100644 --- a/man/finalize_plot.Rd +++ b/man/finalize_plot.Rd @@ -116,7 +116,7 @@ your title and caption to the left, add a horizontal line on top, and make other adjustments. It can show you the final plot and/or export it as a raster or vector file. This function will not apply CMAP design standards to the plot itself: use with \code{theme_cmap()} for that. This function uses ragg drivers -in R and for raster exports, svglite for svg, and cairo_pdf for PDFs. +in R and for raster exports, svg for svg, and cairo_pdf for PDFs. } \examples{ \dontrun{ From f01fd960404ef011fca0f34a06105cb5e76bc392 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Fri, 4 Jun 2021 12:31:09 -0500 Subject: [PATCH 138/173] Add `abbr_years` to vignette --- vignettes/plots.Rmd | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/vignettes/plots.Rmd b/vignettes/plots.Rmd index 6fce73bd..62d02410 100644 --- a/vignettes/plots.Rmd +++ b/vignettes/plots.Rmd @@ -155,6 +155,19 @@ q <- q + geom_text_lastonly( q ``` +### Abbreviating years in date axes + +By default, date axes with units in years display the full year for each axis label (e.g., 2000, 2001, 2002, 2003). In some cases, users may want to abbreviate some, but not all, of these axis labels, such as by maintaining the full year for the first label and abbreviating subsequent labels (e.g., 2000, '01, '02, '03). The function `abbr_years` enables users to do so, defaulting to abbreviating all years but the first. + +This function uses syntax similar to those in the `scales::label_*` family, and can be applied to scales of the `scale_*_continuous` or `scale_*_date` families. Users can specify which years should be abbreviated by either their value (using `full_by_year`) or their position on the axis (using `full_by_pos`). More details are available in `?abbr_years`. + +```{r abbr_years, message = FALSE} +p + + geom_line() + + theme_cmap() + + scale_x_continuous(labels = abbr_years(full_by_year = c(2000))) +``` + ### Applying CMAP default aesthetics Every ggplot2 "geom" has default aesthetics that cannot be modified by a ggplot2 theme (and therefore, cannot be modified by `theme_cmap()`). Notice, for example, that the text drawn in the plot via `geom_text_lastonly()` and `geom_recessions()` still appears in Arial (R's default font), although the legend and axis fonts appear in Whitney. This is automatically corrected in `finalize_plot()`. However, if you'd like to see these impacts at this stage, you can override ggplot2's default aesthetics for line and text geoms with CMAP defaults via `apply_cmap_default_aes()`. From 7de2666eb8abb15e531bb400ec33c146e3aa9165 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Wed, 9 Jun 2021 14:53:25 -0500 Subject: [PATCH 139/173] Update version number --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8facfcb2..0b145da5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: cmapplot Title: CMAP Themes and Color Palettes -Version: 1.1.0 +Version: 1.2.0 Authors@R: c( person("Matthew", "Stern", role = c("aut", "cre"), From 657b8497c8d47df97bf9a454d7aa27db935b4607 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Wed, 9 Jun 2021 15:36:14 -0500 Subject: [PATCH 140/173] Add RStudio prompt for vanilla R users --- R/cmapplot.R | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index c338e015..cf52c541 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -121,8 +121,13 @@ } else { packageStartupMessage(paste( "cmapplot requires RStudio v1.4 or greater to use Whitney fonts", - "in the R plots window. Please upgrade RStudio.")) + "in the R plots window.\nPlease update RStudio.")) } + # If using vanilla R, encourage RStudio installation + } else { + packageStartupMessage(paste( + "cmapplot requires RStudio to use Whitney fonts in the R plots window.\n", + "Please install RStudio. ")) } # Otherwise, notify user } else { From a0ae4bce91605afce8f2925d70173788560bb203 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux Date: Wed, 9 Jun 2021 16:07:30 -0500 Subject: [PATCH 141/173] Minor grammar correction --- R/axis_handling.R | 2 +- man/abbr_years.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/axis_handling.R b/R/axis_handling.R index c8b5b498..95eecf01 100644 --- a/R/axis_handling.R +++ b/R/axis_handling.R @@ -2,7 +2,7 @@ #' #'`abbr_years()` is a helper functions that allows users to abbreviate year #'labels to their two-digit representation (e.g., 2008 to '08), but not -#'abbreviating any specified breaks. It does so by creating a new function that +#'abbreviate any specified breaks. It does so by creating a new function that #'takes the breaks supplied by \code{ggplot2} as its only argument. The #'function was modeled after the syntax and approach of the labeling functions #'in the \code{scales::label_*} family. diff --git a/man/abbr_years.Rd b/man/abbr_years.Rd index 129e989e..e5d97ecc 100644 --- a/man/abbr_years.Rd +++ b/man/abbr_years.Rd @@ -23,7 +23,7 @@ within a \code{scale_*_date} ggplot element.} \description{ `abbr_years()` is a helper functions that allows users to abbreviate year labels to their two-digit representation (e.g., 2008 to '08), but not -abbreviating any specified breaks. It does so by creating a new function that +abbreviate any specified breaks. It does so by creating a new function that takes the breaks supplied by \code{ggplot2} as its only argument. The function was modeled after the syntax and approach of the labeling functions in the \code{scales::label_*} family. From efc60c5cfc71568792e996f5c76b69bacafa625b Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Wed, 9 Jun 2021 16:20:08 -0500 Subject: [PATCH 142/173] Doc tweaks, smoother images from viz_gradient() --- R/colors_continuous.R | 4 ++-- R/colors_discrete.R | 2 +- man/cmap_gradients.Rd | 2 +- man/cmap_palettes.Rd | 2 +- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/colors_continuous.R b/R/colors_continuous.R index 712f49ae..43c2ac8a 100644 --- a/R/colors_continuous.R +++ b/R/colors_continuous.R @@ -4,7 +4,7 @@ #' #' @examples #' # Get names of available continuous palettes. -#' # (Call viz_palette("name_of_palette") to preview one.) +#' # (Call viz_gradient(cmap_gradients$name_of_palette) to preview one.) #' names(cmap_gradients) #' #' # Run the following function to visualize *all* continuous palettes @@ -86,7 +86,7 @@ cmap_gradients <- list( #' @export viz_gradient <- function(pal, ttl = deparse(substitute(pal))) { pal_func <- grDevices::colorRampPalette(pal, space = "Lab") - graphics::image(seq_len(30), 1, as.matrix(seq_len(30)), col = pal_func(30), + graphics::image(seq_len(300), 1, as.matrix(seq_len(300)), col = pal_func(300), main = ttl, xlab = "", ylab = "", xaxt = "n", yaxt = "n", bty = "n") } diff --git a/R/colors_discrete.R b/R/colors_discrete.R index 42010384..e7e22a27 100644 --- a/R/colors_discrete.R +++ b/R/colors_discrete.R @@ -6,7 +6,7 @@ #' #' @examples #' # Get names of available discrete palettes. -#' # (Call viz_palette("name_of_palette") to preview one.) +#' # (Call viz_palette(cmap_palettes$name_of_palette) to preview one.) #' names(cmap_palettes) #' #' # Run the following function to visualize *all* discrete palettes diff --git a/man/cmap_gradients.Rd b/man/cmap_gradients.Rd index 4065dc0c..e77fafdf 100644 --- a/man/cmap_gradients.Rd +++ b/man/cmap_gradients.Rd @@ -30,7 +30,7 @@ additional colors as needed. Modeled after viz_palette from the \examples{ # Get names of available continuous palettes. -# (Call viz_palette("name_of_palette") to preview one.) +# (Call viz_gradient(cmap_gradients$name_of_palette) to preview one.) names(cmap_gradients) # Run the following function to visualize *all* continuous palettes diff --git a/man/cmap_palettes.Rd b/man/cmap_palettes.Rd index 080a14a6..5f26d4f6 100644 --- a/man/cmap_palettes.Rd +++ b/man/cmap_palettes.Rd @@ -33,7 +33,7 @@ the \href{https://github.com/ropenscilabs/ochRe}{ochRe package} \examples{ # Get names of available discrete palettes. -# (Call viz_palette("name_of_palette") to preview one.) +# (Call viz_palette(cmap_palettes$name_of_palette) to preview one.) names(cmap_palettes) # Run the following function to visualize *all* discrete palettes From d21e201e098ead8134c588ceaeb41ff1dbf85690 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Wed, 9 Jun 2021 16:40:20 -0500 Subject: [PATCH 143/173] Reknit README with ragg --- README.Rmd | 3 ++- README.md | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/README.Rmd b/README.Rmd index 186389ff..7436bf5b 100644 --- a/README.Rmd +++ b/README.Rmd @@ -38,7 +38,8 @@ knitr::opts_chunk$set( fig.width = 7, fig.asp = 400/670, fig.retina = 4, - fig.align = "center" + fig.align = "center", + dev = "ragg_png" ) devtools::load_all() diff --git a/README.md b/README.md index 0549d045..e31d83ce 100644 --- a/README.md +++ b/README.md @@ -83,7 +83,7 @@ manager with the command `brew install --cask xquartz`.) on a computer with the Whitney family of fonts installed (specifically the Book, Medium, and Semibold variants). If installed on a computer *without* Whitney, the package will still work, but the fonts will -default to the system's default sans-serif font (typically Arial). +default to Calibri (on Windows) or Arial (on macOS/Linux). ## CMAP theme and colors From 59866996ac72aa9df418f9afdc085ed3265e512c Mon Sep 17 00:00:00 2001 From: Daniel Comeaux Date: Wed, 9 Jun 2021 16:52:38 -0500 Subject: [PATCH 144/173] capitalization, line breaks, date --- R/cmapplot.R | 2 +- R/utilities.R | 7 +++---- vignettes/plots.Rmd | 2 +- 3 files changed, 5 insertions(+), 6 deletions(-) diff --git a/R/cmapplot.R b/R/cmapplot.R index cf52c541..5456177f 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -35,7 +35,7 @@ envir = cmapplot_globals) - # Else, Find and register necessary Whitney variants using systemfonts (or, + # Else, find and register necessary Whitney variants using systemfonts (or, # alternatively, find them manually in ~/Library/Fonts). Then, if font # registry contains Whitney core, set use_whitney == TRUE. if(!get("use_whitney", envir = cmapplot_globals)){ diff --git a/R/utilities.R b/R/utilities.R index 8c9421c6..2519395b 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -3,7 +3,7 @@ #' Font visualization test #' #' This internal function uses base R graphics to display the five text variants -#' that should show up on a cmap themed graphic - and what fonts the package is +#' that should show up on a CMAP themed graphic - and what fonts the package is #' planning to use to display them. #' #' @noRd @@ -124,9 +124,8 @@ find_path <- function(filename, paths){ #' Sub-fn to safely intepret grobHeight #' -#' This returns the height of Grob in any real unit. -#' If the value passed in is null, it returns 0. -#' It is used in various places in `finalize_plot` +#' This returns the height of a grob in any real unit. If the value passed in is +#' null, it returns 0. It is used in various places in `finalize_plot`. #' #' @noRd safe_grobHeight <- function(grob, unitTo = "bigpts", valueOnly = TRUE){ diff --git a/vignettes/plots.Rmd b/vignettes/plots.Rmd index 62d02410..3f31c351 100644 --- a/vignettes/plots.Rmd +++ b/vignettes/plots.Rmd @@ -127,7 +127,7 @@ The function `geom_recessions()`, allows for the addition of rectangles (and tex `ggplot()` always draws geoms *on top* of base plot elements like gridlines. The default fill and alpha values for `geom_recessions()` are the most transparent way possible to achieve CMAP palette color `#002d49` when drawn on a white background — thus impacting the color of the gridlines as little as possible. -This function relies on the National Bureau of Economic Research's definitions of recessions. Details on how to update these dates, as well as how to provide your own, can be found in `geom_recessions()` and `update_recessions()`. If the most recent recession has not yet been declared over (as is the case in March 2021), the function will default to displaying this ongoing recession from its beginning through the end of the visualized data. If this is not desired (for example, if the visualization is of a projection far into the future), users can remove this ongoing recession by setting `show_ongoing = FALSE`. +This function relies on the National Bureau of Economic Research's definitions of recessions. Details on how to update these dates, as well as how to provide your own, can be found in `geom_recessions()` and `update_recessions()`. If the most recent recession has not yet been declared over (as is the case in June 2021), the function will default to displaying this ongoing recession from its beginning through the end of the visualized data. If this is not desired (for example, if the visualization is of a projection far into the future), users can remove this ongoing recession by setting `show_ongoing = FALSE`. ```{r recessions, message = FALSE} q <- ggplot(data = df, From 334848eab360b5998aca5f75e372d92b80efcc9e Mon Sep 17 00:00:00 2001 From: Daniel Comeaux Date: Wed, 9 Jun 2021 16:52:55 -0500 Subject: [PATCH 145/173] Change references to cmapplot_globals --- vignettes/finalize.Rmd | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/vignettes/finalize.Rmd b/vignettes/finalize.Rmd index 869c8f4f..1019b550 100644 --- a/vignettes/finalize.Rmd +++ b/vignettes/finalize.Rmd @@ -163,9 +163,9 @@ finalize_plot(plot = p, ### Overriding plotting constants -Default values in `finalize_plot()` attempt to reflect CMAP design standards using constants defined in `cmapplot_globals$consts`. Users can manually adjust these constants by passing a named list to the `overrides` argument. For example, the chart below uses `overrides` to modify the margin below the title (`margin_title_b`), the margin to the left of the sidebar (`margin_sidebar_l`), and the margin above the legend (`margin_legend_t`). +Default values in `finalize_plot()` attempt to reflect CMAP design standards using constants. The list of preset values can be accessed by calling `get_cmapplot_globals()`, while individual presets can be accessed using `get_cmapplot_global()`. Users can manually adjust these constants by passing a named list to the `overrides` argument. For example, the chart below uses `overrides` to modify the margin below the title (`margin_title_b`), the margin to the left of the sidebar (`margin_sidebar_l`), and the margin above the legend (`margin_legend_t`). -The [Many, many margins] section of this article describes most of these `consts` visually. To learn more about all possible overrides, see `?cmapplot_globals`. +The [Many, many margins] section of this article describes most of these `consts` visually. To learn more about all possible overrides, see `?set_cmapplot_global`. ```{r finalize7, message=FALSE} # A finalized plot with some formatting overrides @@ -195,7 +195,7 @@ finalize_plot(plot = p, ### Many, many margins -There is a fairly long list of possible margins that can be customized using the `overrides` argument of `finalize_plot()`. You can read more about the available options for customization in `?cmapplot_globals`. +There is a fairly long list of possible margins that can be customized using the `overrides` argument of `finalize_plot()`. You can read more about the available options for customization in `?set_cmapplot_global`. Here, the margins are visualized as they impact a finalized plot that has a sidebar: From 1f53e9800b9826a2381a158a450270e74f65d866 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Wed, 9 Jun 2021 16:53:03 -0500 Subject: [PATCH 146/173] Grammar & clarity --- vignettes/installation.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/installation.Rmd b/vignettes/installation.Rmd index 43f23f09..fe530288 100644 --- a/vignettes/installation.Rmd +++ b/vignettes/installation.Rmd @@ -41,6 +41,6 @@ After completing these steps, your computer should be ready to use and export gr ## CMAP fonts -CMAP's design standards require the usage of the Whitney typeface. Whitney is not freely available, but rather requires a license. On CMAP computers, which should already have the Whitney font family installed, cmapplot will use Whitney without any issues. If you receive a warning that Whitney is not installed when you load the package, please verify that the Whitney fonts (specifically, the Book, Medium and Semibold variants) are installed. If it is not, please submit an IT helpdesk request to get them installed. If Whitney *is* already installed and you are receiving the warning message, please reach out to a member of the cmapplot development team. +CMAP's design standards require the usage of the Whitney typeface. Whitney is not freely available, but rather requires a license. On CMAP computers, which should already have the Whitney font family installed, cmapplot will use Whitney without any issues. If you receive a warning that Whitney is not installed when you load the package, please verify that the Whitney fonts (specifically, the Book, Medium and Semibold variants) are installed. If they are not, please submit an IT helpdesk request to get them installed. If the Whitney font family *is* already installed and you are receiving the warning message, please reach out to a member of the cmapplot development team. Non-CMAP users will have to license Whitney on their own, or else use cmapplot without. The package will default to your system's default sans-serif font, which is likely Arial. From 0bba6ba3273a8918e764630d16cade602bed09d0 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Wed, 9 Jun 2021 17:38:04 -0500 Subject: [PATCH 147/173] Code formatting, minor clarification --- vignettes/plots.Rmd | 26 +++++++++++--------------- 1 file changed, 11 insertions(+), 15 deletions(-) diff --git a/vignettes/plots.Rmd b/vignettes/plots.Rmd index 3f31c351..f4f8ec8b 100644 --- a/vignettes/plots.Rmd +++ b/vignettes/plots.Rmd @@ -83,12 +83,12 @@ p + theme_cmap(ylab = "Annual Ridership (Millions)", `theme_cmap()` also allows users to easily add tick marks on the x- and/or the y-axes, using the argument `axisticks`. Note that here, some additional manipulation of the y-axis scale is necessary for the axis ticks to touch the lowest horizontal gridline (this is to override `ggplot2`'s default behavior, which expands the scale slightly beyond the extent of the data for aesthetic reasons). ```{r mods2, message = FALSE} -p + scale_y_continuous(breaks = c(0, 200, 400), - limits = c(-1, 575), - expand = c(0, 0)) + +p + geom_line() + + scale_y_continuous(breaks = c(0, 200, 400), + limits = c(-1, 575), + expand = c(0, 0)) + theme_cmap(ylab = "Annual Ridership (Millions)", - axisticks = "x") + - geom_line() + axisticks = "x") ``` ### Overriding plotting defaults @@ -146,10 +146,9 @@ The function `geom_text_lastonly()` allows the user to label only the final poin Due to ggplot2's underlying structure, `geom_text()` labels are clipped by the plot's default extent. Often, the right side of the plot will need to be expanded — or plot clipping turned off — for correct display of these labels. `?geom_text_lastonly` describes a number of methods to account for this. ```{r textlast, message = FALSE} -q <- q + geom_text_lastonly( - mapping = aes(label = round(ridership, digits = 0)), - add_points = TRUE, - nudge_x = 0.5) + +q <- q + geom_text_lastonly(mapping = aes(label = round(ridership, digits = 0)), + add_points = TRUE, + nudge_x = 0.5) + coord_cartesian(clip = "off") q @@ -159,12 +158,10 @@ q By default, date axes with units in years display the full year for each axis label (e.g., 2000, 2001, 2002, 2003). In some cases, users may want to abbreviate some, but not all, of these axis labels, such as by maintaining the full year for the first label and abbreviating subsequent labels (e.g., 2000, '01, '02, '03). The function `abbr_years` enables users to do so, defaulting to abbreviating all years but the first. -This function uses syntax similar to those in the `scales::label_*` family, and can be applied to scales of the `scale_*_continuous` or `scale_*_date` families. Users can specify which years should be abbreviated by either their value (using `full_by_year`) or their position on the axis (using `full_by_pos`). More details are available in `?abbr_years`. +This function uses syntax similar to those in the `scales::label_*()` family, and can be applied to a plot via the labels parameters of the `ggplot2::scale_x_continuous` or `ggplot2::scale_x_date()` functions (or their y-axis counterparts). Users can specify which years should be abbreviated by either their value (using `full_by_year`) or their position on the axis (using `full_by_pos`). More details are available in `?abbr_years`. ```{r abbr_years, message = FALSE} -p + - geom_line() + - theme_cmap() + +p + geom_line() + theme_cmap() + scale_x_continuous(labels = abbr_years(full_by_year = c(2000))) ``` @@ -187,10 +184,9 @@ In addition, `theme_cmap()` provides a debug mode in which it draws outlines aro ```{r debug, message = FALSE} ggplot(data = df, - mapping = aes(x = year, y = ridership, color = system)) + + mapping = aes(x = year, y = ridership, color = system)) + geom_recessions(ymin = 0) + geom_line() + theme_cmap(ylab = "Annual Ridership (Millions)", debug = TRUE) ``` - From 18c667c3bb165742daddad9c772641fd2d12b0e7 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Wed, 9 Jun 2021 17:46:38 -0500 Subject: [PATCH 148/173] Minor tweaks --- vignettes/finalize.Rmd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/vignettes/finalize.Rmd b/vignettes/finalize.Rmd index 1019b550..6d001e61 100644 --- a/vignettes/finalize.Rmd +++ b/vignettes/finalize.Rmd @@ -67,9 +67,9 @@ finalize_plot(plot = p, ### Exporting a plot -Once you are happy with your plot, export it using `finalize_plot()` with one or more of the write modes `c("svg", "ps", "pdf", "png", "tiff", "jpeg", "bmp")` as well as the filename argument. If Communications staff will be modifying your graphic, they will require one of the vector formats (SVG or PDF). Although many raster formats are available, PNG is likely to look the best. +Once you are happy with your plot, export it using `finalize_plot()` with one or more of the write modes `c("svg", "ps", "pdf", "png", "tiff", "jpeg", "bmp")` as well as the filename argument. If Communications staff will be modifying your graphic, they will require one of the vector formats (preferably PDF). While many raster formats are available, PNG is *strongly* recommended over the others for the best balance of filesize and visual fidelity. -You may specify multiple modes simultaneously using the form `mode = c("png", "pdf", "plot")`. That would export the plot as both a `pdf` and `png`, as well as display it in the plotting window of your R console. +You may specify multiple modes simultaneously using the form `mode = c("png", "pdf", "plot")`. That would export the plot as both a PDF and PNG, as well as display it in the plotting window of your R console. Some additional notes: From 2f71be2e45d402492ef4468670da4bd78cc732ff Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Thu, 10 Jun 2021 09:43:25 -0500 Subject: [PATCH 149/173] Display CMAP logo on pkgdown site --- DESCRIPTION | 2 +- pkgdown/_pkgdown.yml | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0b145da5..2789d267 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -24,7 +24,7 @@ Authors@R: c( role = "aut", email = "gritzenthaler@cmap.illinois.gov"), person("Chicago Metropolitan Agency for Planning", - role = "cph")) + role = "cph", "fnd")) Description: Provides themes and color scales for 'ggplot2', based on Chicago Metropolitan Agency for Planning (CMAP) design guidelines. URL: https://cmap-repos.github.io/cmapplot, https://github.com/CMAP-REPOS/cmapplot diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index 7c18718d..a7b16511 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -9,6 +9,9 @@ home: authors: Chicago Metropolitan Agency for Planning: href: https://www.cmap.illinois.gov + html: > + Chicago Metropolitan Agency for Planning logo template: params: From 03fc0bf76e835161b1e0dd1d3205bd0c593b9ba5 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Thu, 10 Jun 2021 09:53:21 -0500 Subject: [PATCH 150/173] Update DESCRIPTION --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 2789d267..26c4401e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -24,7 +24,7 @@ Authors@R: c( role = "aut", email = "gritzenthaler@cmap.illinois.gov"), person("Chicago Metropolitan Agency for Planning", - role = "cph", "fnd")) + role = c("cph", "fnd"))) Description: Provides themes and color scales for 'ggplot2', based on Chicago Metropolitan Agency for Planning (CMAP) design guidelines. URL: https://cmap-repos.github.io/cmapplot, https://github.com/CMAP-REPOS/cmapplot From de46419d3f2f3add3247388e946f1a5a819f4e08 Mon Sep 17 00:00:00 2001 From: sarahcmap <44509150+sarahcmap@users.noreply.github.com> Date: Fri, 11 Jun 2021 10:27:17 -0500 Subject: [PATCH 151/173] remove bmp mention --- vignettes/finalize.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/finalize.Rmd b/vignettes/finalize.Rmd index 6d001e61..10b7b75a 100644 --- a/vignettes/finalize.Rmd +++ b/vignettes/finalize.Rmd @@ -67,7 +67,7 @@ finalize_plot(plot = p, ### Exporting a plot -Once you are happy with your plot, export it using `finalize_plot()` with one or more of the write modes `c("svg", "ps", "pdf", "png", "tiff", "jpeg", "bmp")` as well as the filename argument. If Communications staff will be modifying your graphic, they will require one of the vector formats (preferably PDF). While many raster formats are available, PNG is *strongly* recommended over the others for the best balance of filesize and visual fidelity. +Once you are happy with your plot, export it using `finalize_plot()` with one or more of the write modes `c("svg", "ps", "pdf", "png", "tiff", "jpeg")` as well as the filename argument. If Communications staff will be modifying your graphic, they will require one of the vector formats (preferably PDF). While many raster formats are available, PNG is *strongly* recommended over the others for the best balance of filesize and visual fidelity. You may specify multiple modes simultaneously using the form `mode = c("png", "pdf", "plot")`. That would export the plot as both a PDF and PNG, as well as display it in the plotting window of your R console. From 0561d7340466553f78f8e6b1ee4b1ccf361a9324 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Mon, 14 Jun 2021 09:12:31 -0500 Subject: [PATCH 152/173] updated news.Md --- NEWS.md | 27 +++++++++++++++++++++++++++ R/cmapplot.R | 6 +++--- 2 files changed, 30 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index 155fe096..9e24c7bb 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,30 @@ +# cmapplot 1.2.0 +PR # 123 + +This is a version-level update that includes many fixes and new features and introduces new dependencies, most significantly RStudio 1.4 or greater. + +### New features +* cmapplot now utilizes the new systemfonts package for custom font rendering, rather than sysfonts on Windows and X11fonts on Mac and other Unix-based machines. In addition, raster exports from `finalize_plot` now rely on the new raster drawing package ragg. These changes improve font accuracy and consistency across platforms. Note that this improvement does not yet extend to svg outputs, but may in the future (#134). +* When an axis breaks are 4-digit years, new function `abbr_years` allows the conversion of specific years to 2-digit abbreviations, as is common on some designed CMAP graphics. +* cmapplot_globals, which contains key package constants, is now an internal environment rather than an exported list. It can be accessed via new functions `get_cmapplot_globals` and `get_cmapplot_global`. Constants can now be overridden by the user for the current session by using `set_cmapplot_global`. Note that this does not yet apply to geom aesthetics set by the package, but may in the future (issue #117). + +### Bug fixes +* Continuous color gradients can now be used on discrete color scales. E.g. `cmap_color_discrete` and `cmap_fill_discrete` can now call gradients as well as discrete palettes (see #70 and #119) +* internal table `recessions` has been updated to include the business cycle contraction that began in Feb 202 (no end date for this cycle yet). +* `geom_recessions` and related `update_recessions` have been updated to allow for ongoing recessions, improve NBER source for recessions table, and decrease likelihood of data fetch errors. + +### Backend changes +* pkgdown site now correctly displays Whitney fonts and margin description images +* backend script reorganization +* improvements to pkgdown build github action, including ability to publish a test site + +### Backward compatibility notes +* **This package will now only render Whitney Fonts in RStudio when RStudio version >= 1.4** +* `finalize_plot`'s `window` mode has been disabled for now, due to inability to use ragg drivers in independent window devices. Use `mode = "plot"` and click the "Zoom" button in the plot window instead. +* `cmapplot_globals`, the exported list of package constants, has been removed (See new features `set_cmapplot_global` etc) +* `integer_breaks` removed from package + + # cmapplot 1.1.0 PR #111 | February 24, 2021 diff --git a/R/cmapplot.R b/R/cmapplot.R index 5456177f..6efb4dcd 100644 --- a/R/cmapplot.R +++ b/R/cmapplot.R @@ -87,7 +87,7 @@ ) packageStartupMessage(paste0( - "cmapplot has registered the following fonts for use in this R session:\n ", + "cmapplot has registered the following fonts for use in this R session:\n ", paste(cmapplot_globals$preferred_font, collapse = ", ") )) @@ -114,7 +114,7 @@ options(RStudioGD.backend = "ragg") packageStartupMessage(paste( "cmapplot has set RStudio graphics to `ragg` for the current session.", - "You can make this change permanent:\n ", + "You can make this change permanent:\n ", "Tools > Global Options > General > Graphics > Graphics Device > Backend == 'AGG'." )) } @@ -126,7 +126,7 @@ # If using vanilla R, encourage RStudio installation } else { packageStartupMessage(paste( - "cmapplot requires RStudio to use Whitney fonts in the R plots window.\n", + "cmapplot requires RStudio to use Whitney fonts in the R plots window.\n ", "Please install RStudio. ")) } # Otherwise, notify user From 404dabf95cb97d0a194ac66f78bcb6a4f8a4e380 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Thu, 17 Jun 2021 17:11:53 -0500 Subject: [PATCH 153/173] initial framework - moved all palettes to tibble in globals - removed `cmap_gradients` and `cmap_palettes` objects - adjusted `viz_gradient` and `cmap_pal_continuous` fns to use this new setup. Outstanding: - adjust discrete functions accordingly - update namespace and DESCRIPTION - adjust documentation, including and especially the `cmap_palettes` and `cmap_gradients` objects. Consider combining these into a single help page. --- R/cmapplot_globals.R | 57 ++++++++++++++++++++++++++++++ R/colors_continuous.R | 82 +++++++++---------------------------------- R/colors_discrete.R | 28 --------------- 3 files changed, 74 insertions(+), 93 deletions(-) diff --git a/R/cmapplot_globals.R b/R/cmapplot_globals.R index a86f2c3e..55ef5df4 100644 --- a/R/cmapplot_globals.R +++ b/R/cmapplot_globals.R @@ -28,6 +28,63 @@ cmapplot_globals$colors <- list( blackish = "#222222" ) +#' @importFrom tibble tribble +#' +# Define CMAP palettes +cmapplot_globals$palettes <- tibble::tribble( + ~name, ~type, ~colors, + # discrete + "prosperity", "discrete", c("#662f00", "#e5d072", "#44008c", "#c8e572", "#c9a7ef"), + "community", "discrete", c("#cc5f00", "#006b8c", "#e5a872", "#d2efa7", "#662f00"), + "environment", "discrete", c("#00665c", "#b7e572", "#3f0030", "#36d8ca", "#006b8c"), + "governance", "discrete", c("#006b8c", "#efa7a7", "#8c4100", "#00303f", "#cca600", "#a7efe8"), + "mobility", "discrete", c("#8c0000", "#e5bd72", "#a7efe8", "#6d8692", "#0084ac", "#efa7a7"), + "legislation", "discrete", c("#00becc", "#cc5f00", "#3f0e00", "#cca600", "#003f8c", "#67ac00"), + "friday", "discrete", c("#00093f", "#ac8c00", "#475c66", "#e5d072", "#b5c1c8", "#006b8c"), + "race", "discrete", c(white = "#75a5d8", + black = "#84c87e", + hispanic = "#d8ba39", + asian = "#e77272", + other = "#607b88"), + + # Single-hue sequential + "reds", "sequential", c("#efa7a7", "#e57272", "#d83636", "#cc0000", "#ac0000", "#8c0000", "#660000"), + "oranges", "sequential", c("#efc9a7", "#e5a872", "#d88236", "#cc5f00", "#ac5000", "#8c4100", "#662f00"), + "yellows", "sequential", c("#efe1a7", "#e5d072", "#d8ba36", "#cca600", "#ac8c00", "#8c7200", "#665300"), + "greens", "sequential", c("#d2efa7", "#b7e572", "#97d836", "#7acc00", "#67ac00", "#548c00", "#3d6600"), + "teals", "sequential", c("#a7efe8", "#72e5db", "#36d8ca", "#00ccb8", "#00ac9c", "#008c7e", "#00665c"), + "blues", "sequential", c("#a7deef", "#72cae5", "#36b2d8", "#009ccc", "#0084ac", "#006b8c", "#004e66"), + "purples", "sequential", c("#c9a7ef", "#aa72e5", "#8436d8", "#6300cc", "#5300ac", "#44008c", "#310066"), + "grays", "sequential", c("#e3e8eb", "#dbe1e4", "#d2d9de", "#c3cdd3", "#b5c1c8", "#a7b5be", "#9daab3", + "#8a9ea8", "#7b929d", "#6d8692", "#5e7a87", "#475c66", "#2f3d44"), + + # Multi-hue sequential + "yellow_orange_red", "sequential", c("#efe1a7", "#e5bd72", "#d88236", "#cc3000", "#8c0000"), + "green_teal_blue", "sequential", c("#d2efa7", "#72e584", "#00ccb8", "#00838c", "#004e66"), + "orange_red", "sequential", c("#efc9a7", "#e59a72", "#cc3000", "#8c1000", "#660000"), + "yellow_orange", "sequential", c("#efe1a7", "#e5c672", "#cc8200", "#8c4100", "#662f00"), + "yellow_green", "sequential", c("#f8f4df", "#e5e172", "#b4cc00", "#698c00", "#3d6600"), + "green_teal", "sequential", c("#d2efa7", "#8de572", "#00cc1f", "#008c4b", "#00665c"), + "teal_blue", "sequential", c("#a7efe8", "#72e5e3", "#00becc", "#00778c", "#004e66"), + "red_purple", "sequential", c("#efa7a7", "#e5729e", "#cc0099", "#77008c", "#310066"), + + # Multi-hue diverging + "yellow_purple", "divergent", c("#8c7200", "#ac8c00", "#cca600", "#d8ba36", "#e5d072", "#e3e8eb", + "#aa72e5", "#8436d8", "#6300cc", "#5300ac", "#44008c"), + "orange_blue", "divergent", c("#8c4100", "#ac5000", "#cc5f00", "#d88236", "#e5a872", "#e3e8eb", + "#72cae5", "#36b2d8", "#009ccc", "#0084ac", "#006b8c"), + "red_teal", "divergent", c("#660000", "#8c0000", "#cc0000", "#d83636", "#e57272", "#e3e8eb", + "#72e5db", "#36d8ca", "#00ccb8", "#00ac9c", "#008c7e"), + "purple_green", "divergent", c("#44008c", "#5300ac", "#6300cc", "#8436d8", "#aa72e5", "#e3e8eb", + "#b7e572", "#97d836", "#7acc00", "#67ac00", "#548c00"), + "blue_yellow", "divergent", c("#006b8c", "#0084ac", "#009ccc", "#36b2d8", "#72cae5", "#e3e8eb", + "#e5d072", "#d8ba36", "#cca600", "#ac8c00", "#8c7200"), + "teal_orange", "divergent", c("#008c7e", "#00ac9c", "#00ccb8", "#36d8ca", "#72e5db", "#e3e8eb", + "#e5a872", "#d88236", "#cc5f00", "#ac5000", "#8c4100"), + "green_red", "divergent", c("#548c00", "#67ac00", "#7acc00", "#97d836", "#b7e572", "#e3e8eb", + "#e57272", "#d83636", "#cc0000", "#8c0000", "#660000") +) + # Establish plotting constants in bigpts (1/72 of inch) cmapplot_globals$consts <- list( lwd_gridline = 0.3, diff --git a/R/colors_continuous.R b/R/colors_continuous.R index 43c2ac8a..d7b41208 100644 --- a/R/colors_continuous.R +++ b/R/colors_continuous.R @@ -11,67 +11,7 @@ #' purrr::walk2(cmap_gradients, names(cmap_gradients), viz_gradient) #' #' @export -cmap_gradients <- list( - # Single-hue sequential gradients - seq_reds = c("#efa7a7", "#e57272", "#d83636", "#cc0000", "#ac0000", "#8c0000", "#660000"), - - seq_oranges = c("#efc9a7", "#e5a872", "#d88236", "#cc5f00", "#ac5000", "#8c4100", "#662f00"), - - seq_yellows = c("#efe1a7", "#e5d072", "#d8ba36", "#cca600", "#ac8c00", "#8c7200", "#665300"), - - seq_greens = c("#d2efa7", "#b7e572", "#97d836", "#7acc00", "#67ac00", "#548c00", "#3d6600"), - - seq_teals = c("#a7efe8", "#72e5db", "#36d8ca", "#00ccb8", "#00ac9c", "#008c7e", "#00665c"), - - seq_blues = c("#a7deef", "#72cae5", "#36b2d8", "#009ccc", "#0084ac", "#006b8c", "#004e66"), - - seq_purples = c("#c9a7ef", "#aa72e5", "#8436d8", "#6300cc", "#5300ac", "#44008c", "#310066"), - - seq_grays = c("#e3e8eb", "#dbe1e4", "#d2d9de", "#c3cdd3", "#b5c1c8", "#a7b5be", "#9daab3", - "#8a9ea8", "#7b929d", "#6d8692", "#5e7a87", "#475c66", "#2f3d44"), - - # Multi-hue sequential gradients - seq_yellow_orange_red = c("#efe1a7", "#e5bd72", "#d88236", "#cc3000", "#8c0000"), - - seq_green_teal_blue = c("#d2efa7", "#72e584", "#00ccb8", "#00838c", "#004e66"), - - seq_orange_red = c("#efc9a7", "#e59a72", "#cc3000", "#8c1000", "#660000"), - - seq_yellow_orange = c("#efe1a7", "#e5c672", "#cc8200", "#8c4100", "#662f00"), - - seq_yellow_green = c("#f8f4df", "#e5e172", "#b4cc00", "#698c00", "#3d6600"), - - seq_green_teal = c("#d2efa7", "#8de572", "#00cc1f", "#008c4b", "#00665c"), - - seq_teal_blue = c("#a7efe8", "#72e5e3", "#00becc", "#00778c", "#004e66"), - - seq_red_purple = c("#efa7a7", "#e5729e", "#cc0099", "#77008c", "#310066"), - - - # Multi-hue diverging gradients - div_yellow_purple = c("#8c7200", "#ac8c00", "#cca600", "#d8ba36", "#e5d072", "#e3e8eb", - "#aa72e5", "#8436d8", "#6300cc", "#5300ac", "#44008c"), - - div_orange_blue = c("#8c4100", "#ac5000", "#cc5f00", "#d88236", "#e5a872", "#e3e8eb", - "#72cae5", "#36b2d8", "#009ccc", "#0084ac", "#006b8c"), - - div_red_teal = c("#660000", "#8c0000", "#cc0000", "#d83636", "#e57272", "#e3e8eb", - "#72e5db", "#36d8ca", "#00ccb8", "#00ac9c", "#008c7e"), - - div_purple_green = c("#44008c", "#5300ac", "#6300cc", "#8436d8", "#aa72e5", "#e3e8eb", - "#b7e572" , "#97d836", "#7acc00", "#67ac00", "#548c00"), - - div_blue_yellow = c("#006b8c", "#0084ac", "#009ccc", "#36b2d8", "#72cae5", "#e3e8eb", - "#e5d072", "#d8ba36", "#cca600", "#ac8c00", "#8c7200"), - - div_teal_orange = c("#008c7e", "#00ac9c", "#00ccb8", "#36d8ca", "#72e5db", "#e3e8eb", - "#e5a872", "#d88236", "#cc5f00", "#ac5000", "#8c4100"), - - div_green_red = c("#548c00", "#67ac00", "#7acc00", "#97d836", "#b7e572", "#e3e8eb", - "#e57272", "#d83636", "#cc0000", "#8c0000", "#660000") - -) #' Visualize CMAP color gradients @@ -84,7 +24,19 @@ cmap_gradients <- list( #' \href{https://github.com/ropenscilabs/ochRe}{ochRe package} #' #' @export -viz_gradient <- function(pal, ttl = deparse(substitute(pal))) { +viz_gradient <- function(pal, ttl = NULL) { + + # if `pal` appears to be a reference to a named cmap palette... + if (pal[1] %in% cmapplot_globals$palettes$name) { + # use the palette as the title (unless a custom title has been provided) + if (is.null(ttl) | missing(ttl)){ ttl <- pal } + # and extract the palette colors + pal <- cmapplot_globals$palettes[[which(cmapplot_globals$palettes$name == pal),"colors"]][[1]] + } else { + # otherwise, use the object name as the title (unless a custom title has been provided) + if (is.null(ttl) | missing(ttl)){ ttl <- deparse(substitute(pal)) } + } + pal_func <- grDevices::colorRampPalette(pal, space = "Lab") graphics::image(seq_len(300), 1, as.matrix(seq_len(300)), col = pal_func(300), main = ttl, xlab = "", ylab = "", @@ -98,8 +50,8 @@ viz_gradient <- function(pal, ttl = deparse(substitute(pal))) { #' @param reverse Logical; reverse color order? #' #' @noRd -cmap_pal_continuous <- function(palette = "seq_reds", reverse = FALSE) { - pal <- cmap_gradients[[palette]] +cmap_pal_continuous <- function(palette = "reds", reverse = FALSE) { + pal <- cmapplot_globals$palettes[[which(cmapplot_globals$palettes$name == palette),"colors"]][[1]] if (reverse) { pal <- rev(pal) } @@ -134,12 +86,12 @@ mid_rescaler2 <- function(mid) { #' ggplot(dplyr::filter(grp_over_time, cluster=="Biopharmaceuticals"), #' aes(x = year, y = realgrp, color = realgrp)) + #' geom_line() + -#' cmap_color_continuous(palette = "seq_red_purple") +#' cmap_color_continuous(palette = "red_purple") #' #' @describeIn cmap_fill_continuous for fill aesthetic #' #' @export -cmap_fill_continuous <- function(palette = "seq_reds", +cmap_fill_continuous <- function(palette = "reds", reverse = FALSE, middle = 0, ...) { diff --git a/R/colors_discrete.R b/R/colors_discrete.R index e7e22a27..88bf8534 100644 --- a/R/colors_discrete.R +++ b/R/colors_discrete.R @@ -13,35 +13,7 @@ #' purrr::walk2(cmap_palettes, names(cmap_palettes), viz_palette) #' #' @export -cmap_palettes <- c( - # Add CMAP gradients to the palettes list (note that we don't add the - # palettes to the gradients list since those are not sequential). - cmap_gradients, - - # Mixed color palettes - list(prosperity = c("#662f00", "#e5d072", "#44008c", "#c8e572", "#c9a7ef"), - - community = c("#cc5f00", "#006b8c", "#e5a872", "#d2efa7", "#662f00"), - - environment = c("#00665c", "#b7e572", "#3f0030", "#36d8ca", "#006b8c"), - - governance = c("#006b8c", "#efa7a7", "#8c4100", "#00303f", "#cca600", "#a7efe8"), - - mobility = c("#8c0000", "#e5bd72", "#a7efe8", "#6d8692", "#0084ac", "#efa7a7"), - - legislation = c("#00becc", "#cc5f00", "#3f0e00", "#cca600", "#003f8c", "#67ac00"), - - friday = c("#00093f", "#ac8c00", "#475c66", "#e5d072", "#b5c1c8", "#006b8c"), - - race = c(white = "#75a5d8", - black = "#84c87e", - hispanic = "#d8ba39", - asian = "#e77272", - other = "#607b88") - - ) -) #' Print palette for reference #' From 0f4c869273b2f775fa4662045c416bbe58d101e9 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Thu, 17 Jun 2021 17:18:07 -0500 Subject: [PATCH 154/173] helper function --- R/cmapplot_globals.R | 2 +- R/colors_continuous.R | 11 +++++++++-- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/R/cmapplot_globals.R b/R/cmapplot_globals.R index 55ef5df4..c441c1fd 100644 --- a/R/cmapplot_globals.R +++ b/R/cmapplot_globals.R @@ -29,7 +29,7 @@ cmapplot_globals$colors <- list( ) #' @importFrom tibble tribble -#' + # Define CMAP palettes cmapplot_globals$palettes <- tibble::tribble( ~name, ~type, ~colors, diff --git a/R/colors_continuous.R b/R/colors_continuous.R index d7b41208..b7ec63c2 100644 --- a/R/colors_continuous.R +++ b/R/colors_continuous.R @@ -31,7 +31,7 @@ viz_gradient <- function(pal, ttl = NULL) { # use the palette as the title (unless a custom title has been provided) if (is.null(ttl) | missing(ttl)){ ttl <- pal } # and extract the palette colors - pal <- cmapplot_globals$palettes[[which(cmapplot_globals$palettes$name == pal),"colors"]][[1]] + pal <- fetch_pal(pal) } else { # otherwise, use the object name as the title (unless a custom title has been provided) if (is.null(ttl) | missing(ttl)){ ttl <- deparse(substitute(pal)) } @@ -44,6 +44,12 @@ viz_gradient <- function(pal, ttl = NULL) { } +#' Palette Fetcher +#' @noRd +fetch_pal <- function(pal){ + cmapplot_globals$palettes[[which(cmapplot_globals$palettes$name == pal),"colors"]][[1]] +} + #' Continuous palette prep function #' #' @param palette Choose from 'cmap_gradients' list @@ -51,7 +57,8 @@ viz_gradient <- function(pal, ttl = NULL) { #' #' @noRd cmap_pal_continuous <- function(palette = "reds", reverse = FALSE) { - pal <- cmapplot_globals$palettes[[which(cmapplot_globals$palettes$name == palette),"colors"]][[1]] + # grab the palette. + pal <- fetch_pal(palette) if (reverse) { pal <- rev(pal) } From e9df8b719cd57496ced3d35d0350634eee58cbee Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Thu, 17 Jun 2021 17:21:18 -0500 Subject: [PATCH 155/173] documentation --- R/colors_continuous.R | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/R/colors_continuous.R b/R/colors_continuous.R index b7ec63c2..c0af7d99 100644 --- a/R/colors_continuous.R +++ b/R/colors_continuous.R @@ -45,23 +45,24 @@ viz_gradient <- function(pal, ttl = NULL) { #' Palette Fetcher +#' +#' @param pal a name to search for in cmapplot_globals$palettes +#' #' @noRd fetch_pal <- function(pal){ cmapplot_globals$palettes[[which(cmapplot_globals$palettes$name == pal),"colors"]][[1]] } + #' Continuous palette prep function #' -#' @param palette Choose from 'cmap_gradients' list +#' @param palette A CMAP palette name #' @param reverse Logical; reverse color order? #' #' @noRd cmap_pal_continuous <- function(palette = "reds", reverse = FALSE) { - # grab the palette. pal <- fetch_pal(palette) - if (reverse) { - pal <- rev(pal) - } + if (reverse) { pal <- rev(pal) } return(grDevices::colorRampPalette(pal)) } @@ -102,7 +103,7 @@ cmap_fill_continuous <- function(palette = "reds", reverse = FALSE, middle = 0, ...) { - if (substr(palette,1,3) == "div") { + if (substr(palette,1,3) == "div") { ## THIS LINE NEEDS TO CHANGE. ggplot2::scale_fill_gradientn( colours = cmap_pal_continuous(palette, reverse = reverse)(256), rescaler = mid_rescaler2(middle), From af17c1858b8837b3c421d6a475c3f883a12898aa Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Fri, 18 Jun 2021 08:46:25 -0500 Subject: [PATCH 156/173] wrapped up with continuous colors still need to do discrete and race and update documentation. --- R/colors_continuous.R | 30 ++++++++++++++---------------- R/utilities.R | 24 ++++++++++++++++++++++++ 2 files changed, 38 insertions(+), 16 deletions(-) diff --git a/R/colors_continuous.R b/R/colors_continuous.R index c0af7d99..15e41bda 100644 --- a/R/colors_continuous.R +++ b/R/colors_continuous.R @@ -26,8 +26,8 @@ #' @export viz_gradient <- function(pal, ttl = NULL) { - # if `pal` appears to be a reference to a named cmap palette... - if (pal[1] %in% cmapplot_globals$palettes$name) { + # if `pal` is a named sequential or divergent CMAP palette... + if (fetch_pal(pal[1], c("sequential", "divergent"), "exists")) { # use the palette as the title (unless a custom title has been provided) if (is.null(ttl) | missing(ttl)){ ttl <- pal } # and extract the palette colors @@ -44,16 +44,6 @@ viz_gradient <- function(pal, ttl = NULL) { } -#' Palette Fetcher -#' -#' @param pal a name to search for in cmapplot_globals$palettes -#' -#' @noRd -fetch_pal <- function(pal){ - cmapplot_globals$palettes[[which(cmapplot_globals$palettes$name == pal),"colors"]][[1]] -} - - #' Continuous palette prep function #' #' @param palette A CMAP palette name @@ -103,17 +93,21 @@ cmap_fill_continuous <- function(palette = "reds", reverse = FALSE, middle = 0, ...) { - if (substr(palette,1,3) == "div") { ## THIS LINE NEEDS TO CHANGE. + type <- fetch_pal(palette, return = "type") + + if (type == "divergent") { ggplot2::scale_fill_gradientn( colours = cmap_pal_continuous(palette, reverse = reverse)(256), rescaler = mid_rescaler2(middle), ... ) - } else { + } else if (type == "sequential"){ ggplot2::scale_fill_gradientn( colours = cmap_pal_continuous(palette, reverse = reverse)(256), ... ) + } else { + NULL } } @@ -125,17 +119,21 @@ cmap_color_continuous <- function(palette = "seq_reds", reverse = FALSE, middle = 0, ...) { - if (substr(palette,1,3) == "div") { + type <- fetch_pal(palette, return = "type") + + if (type == "divergent") { ggplot2::scale_colour_gradientn( colours = cmap_pal_continuous(palette, reverse = reverse)(256), rescaler = mid_rescaler2(middle), ... ) - } else { + } else if (type == "sequential"){ ggplot2::scale_colour_gradientn( colours = cmap_pal_continuous(palette, reverse = reverse)(256), ... ) + } else { + NULL } } diff --git a/R/utilities.R b/R/utilities.R index 2519395b..cb0816aa 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -140,3 +140,27 @@ safe_grobHeight <- function(grob, unitTo = "bigpts", valueOnly = TRUE){ return(grid::convertHeight(grid::grobHeight(grob), unitTo, valueOnly)) } + + +#' Palette Fetcher +#' +#' @param pal a name to search for in cmapplot_globals$palettes +#' @param which a vector of palette types to consider +#' +#' @noRd +fetch_pal <- function(pal, + which = unique(cmapplot_globals$palettes$type), + return = c("colors", "type", "exists")){ + return <- match.arg(return) + df <- dplyr::filter( + cmapplot_globals$palettes, + name == pal, + type %in% which + ) + if (return == "exists"){ + return(nrow(df)==1) + } + + if (nrow(df) != 1) return(NULL) + return(df[[return]][[1]]) +} From 4b1e12bbad12cbd91812c65b767be06778367812 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Fri, 18 Jun 2021 15:51:59 -0500 Subject: [PATCH 157/173] Update utilities.R --- R/utilities.R | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/R/utilities.R b/R/utilities.R index cb0816aa..7f91bc5a 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -157,10 +157,12 @@ fetch_pal <- function(pal, name == pal, type %in% which ) + if (return == "exists"){ return(nrow(df)==1) + } else if (nrow(df)==1){ + return(df[[return]][[1]]) + } else { + return(NULL) } - - if (nrow(df) != 1) return(NULL) - return(df[[return]][[1]]) } From f95c2952478ea106433b6174135fe30d6235853a Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sat, 19 Jun 2021 10:21:45 -0500 Subject: [PATCH 158/173] discrete palettes --- R/colors_discrete.R | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/R/colors_discrete.R b/R/colors_discrete.R index 88bf8534..a7ef68e4 100644 --- a/R/colors_discrete.R +++ b/R/colors_discrete.R @@ -25,10 +25,22 @@ #' the \href{https://github.com/ropenscilabs/ochRe}{ochRe package} #' #' @export -viz_palette <- function(pal, ttl = deparse(substitute(pal)), num = length(pal)) { - if (num <= 0) { - stop("'num' should be > 0") +viz_palette <- function(pal, ttl = NULL, num = NULL) { + + # if `pal` is a named CMAP palette of any type... + if (fetch_pal(pal[1], return = "exists")) { + # use the palette as the title (unless a custom title has been provided) + if (is.null(ttl) | missing(ttl)){ ttl <- pal } + # and extract the palette colors + pal <- fetch_pal(pal) + } else { + # otherwise, use the object name as the title (unless a custom title has been provided) + if (is.null(ttl) | missing(ttl)){ ttl <- deparse(substitute(pal)) } } + + # use the palette's intrinsic length (unless a custom length has been provided) + if (is.null(num) | missing(num)){ num <- length(pal) } + pal_func <- grDevices::colorRampPalette(pal) graphics::image(seq_len(num), 1, as.matrix(seq_len(num)), col = pal_func(num), main = paste0(ttl, " (", length(pal), " colors in palette, ", @@ -46,7 +58,7 @@ viz_palette <- function(pal, ttl = deparse(substitute(pal)), num = length(pal)) #' #' @noRd cmap_pal_discrete <- function(palette = "prosperity", reverse = FALSE) { - pal <- cmap_palettes[[palette]] + pal <- fetch_pal(palette) if (reverse) { pal <- rev(pal) } From 292cb14979ec93dd581de8a4971d7c1a3a07d61b Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Sat, 19 Jun 2021 10:28:03 -0500 Subject: [PATCH 159/173] race palette --- R/colors_race.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/colors_race.R b/R/colors_race.R index 062308bb..9805934a 100644 --- a/R/colors_race.R +++ b/R/colors_race.R @@ -8,7 +8,7 @@ #' #' @noRd make_race_palette <- function(white, black, hispanic, asian, other) { - race_palette <- cmap_palettes$race + race_palette <- fetch_pal("race") if (!missing(white)) { names(race_palette)[1] <- white } if (!missing(black)) { names(race_palette)[2] <- black } if (!missing(hispanic)) { names(race_palette)[3] <- hispanic } From e2b5817297ca17b4fb5168b2465e840cd37cdef2 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Mon, 21 Jun 2021 10:35:57 -0500 Subject: [PATCH 160/173] should mostly be working --- DESCRIPTION | 4 +- NAMESPACE | 3 +- R/colors_continuous.R | 26 ++------- R/colors_discrete.R | 38 +++++++------ man/cmap_fill_continuous.Rd | 4 +- man/cmap_gradients.Rd | 40 -------------- man/cmap_palettes.Rd | 43 --------------- man/cmapplot.Rd | 2 +- man/viz_palette.Rd | 55 ++++++++++++++++++ vignettes/colors.Rmd | 107 ++++++++++++++++++++++++++---------- 10 files changed, 166 insertions(+), 156 deletions(-) delete mode 100644 man/cmap_gradients.Rd delete mode 100644 man/cmap_palettes.Rd create mode 100644 man/viz_palette.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 26c4401e..c78e54d7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -53,12 +53,12 @@ Imports: rstudioapi, scales, stringr, - systemfonts + systemfonts, + tibble Suggests: knitr, rmarkdown, testthat, - tibble, tidyverse RoxygenNote: 7.1.1 VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index 2684b228..26ef2a60 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -19,8 +19,6 @@ export(cmap_fill_continuous) export(cmap_fill_discrete) export(cmap_fill_highlight) export(cmap_fill_race) -export(cmap_gradients) -export(cmap_palettes) export(finalize_plot) export(geom_recessions) export(geom_text_lastonly) @@ -60,5 +58,6 @@ importFrom(stats,na.omit) importFrom(stringr,str_length) importFrom(stringr,str_replace) importFrom(stringr,str_trunc) +importFrom(tibble,tribble) importFrom(utils,modifyList) importFrom(utils,read.csv) diff --git a/R/colors_continuous.R b/R/colors_continuous.R index 15e41bda..22b5324c 100644 --- a/R/colors_continuous.R +++ b/R/colors_continuous.R @@ -1,27 +1,11 @@ -#' CMAP continuous color palettes (gradients) -#' -#' Sequential and divergent gradients extracted from the CMAP color palette. -#' -#' @examples -#' # Get names of available continuous palettes. -#' # (Call viz_gradient(cmap_gradients$name_of_palette) to preview one.) -#' names(cmap_gradients) -#' -#' # Run the following function to visualize *all* continuous palettes -#' purrr::walk2(cmap_gradients, names(cmap_gradients), viz_gradient) -#' -#' @export - - - #' Visualize CMAP color gradients #' -#' @param pal = select from cmap_gradients list -#' @param ttl = display title (optional) +#' @describeIn viz_palette interpolates the range of colors a sequential or +#' divergent palette offers when used on a continuous scale. #' -#' @describeIn cmap_gradients Display CMAP continuous palettes, interpolating -#' additional colors as needed. Modeled after viz_palette from the -#' \href{https://github.com/ropenscilabs/ochRe}{ochRe package} +#' @examples +#' # Vizualize a sequential or divergent palette with interpolation +#' viz_gradient("reds") #' #' @export viz_gradient <- function(pal, ttl = NULL) { diff --git a/R/colors_discrete.R b/R/colors_discrete.R index a7ef68e4..97918bc4 100644 --- a/R/colors_discrete.R +++ b/R/colors_discrete.R @@ -1,28 +1,32 @@ -#' CMAP discrete color palettes +#' Vizualizing CMAP color palettes #' -#' A selection of discrete color palettes from the CMAP color palette. These -#' include mixed color palettes and discrete versions of the gradients defined -#' in \code{link{cmap_fill_continuous}}. +#' The cmapplot package contains a many color palettes extracted from the +#' larger, official CMAP color palette. Helper functions allow the user to +#' inspect the various palettes before applying them to plots. #' -#' @examples -#' # Get names of available discrete palettes. -#' # (Call viz_palette(cmap_palettes$name_of_palette) to preview one.) -#' names(cmap_palettes) +#' Palettes are stored in a tibble the \code{cmapplot_globals} environment. The +#' user can access this tibble with \code{\link{get_cmapplot_global}}. For more +#' information about available cmapplot color palettes and how to apply them, +#' see \code{vignette("colors")}. #' -#' # Run the following function to visualize *all* discrete palettes -#' purrr::walk2(cmap_palettes, names(cmap_palettes), viz_palette) +#' These functions are modified with respect from the +#' \href{https://github.com/ropenscilabs/ochRe}{ochRe package}) #' -#' @export - - -#' Print palette for reference +#' @describeIn viz_palette displays the colors of any cmapplot palette #' -#' @param pal character, vector of (hexadecimal) colors representing a palette +#' @param pal character, name of a a cmapplot palette, or a vector of colors +#' representing a palette #' @param ttl character, title to be displayed (the name of the palette) #' @param num numeric, the number of colors to display #' -#' @describeIn cmap_palettes Display CMAP palettes. Borrowed with respect from -#' the \href{https://github.com/ropenscilabs/ochRe}{ochRe package} +#' @examples +#' # Visualize a single palette as individual colors +#' viz_palette("prosperity") +#' +#' # Get names of all available palettes. +#' as.data.frame(get_cmapplot_global("palettes")[1:2]) +#' +#' @aliases cmap_palettes cmap_gradients cmap_colors #' #' @export viz_palette <- function(pal, ttl = NULL, num = NULL) { diff --git a/man/cmap_fill_continuous.Rd b/man/cmap_fill_continuous.Rd index 3246c795..445f1874 100644 --- a/man/cmap_fill_continuous.Rd +++ b/man/cmap_fill_continuous.Rd @@ -6,7 +6,7 @@ \alias{cmap_colour_continuous} \title{Apply continuous CMAP palettes (gradients) to ggplot2 aesthetics} \usage{ -cmap_fill_continuous(palette = "seq_reds", reverse = FALSE, middle = 0, ...) +cmap_fill_continuous(palette = "reds", reverse = FALSE, middle = 0, ...) cmap_color_continuous(palette = "seq_reds", reverse = FALSE, middle = 0, ...) @@ -40,6 +40,6 @@ to 0). See \code{\link{cmap_gradients}} for a listing of available gradients. ggplot(dplyr::filter(grp_over_time, cluster=="Biopharmaceuticals"), aes(x = year, y = realgrp, color = realgrp)) + geom_line() + - cmap_color_continuous(palette = "seq_red_purple") + cmap_color_continuous(palette = "red_purple") } diff --git a/man/cmap_gradients.Rd b/man/cmap_gradients.Rd deleted file mode 100644 index e77fafdf..00000000 --- a/man/cmap_gradients.Rd +++ /dev/null @@ -1,40 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/colors_continuous.R -\docType{data} -\name{cmap_gradients} -\alias{cmap_gradients} -\alias{viz_gradient} -\title{CMAP continuous color palettes (gradients)} -\format{ -An object of class \code{list} of length 23. -} -\usage{ -cmap_gradients - -viz_gradient(pal, ttl = deparse(substitute(pal))) -} -\arguments{ -\item{pal}{= select from cmap_gradients list} - -\item{ttl}{= display title (optional)} -} -\description{ -Sequential and divergent gradients extracted from the CMAP color palette. -} -\section{Functions}{ -\itemize{ -\item \code{viz_gradient}: Display CMAP continuous palettes, interpolating -additional colors as needed. Modeled after viz_palette from the -\href{https://github.com/ropenscilabs/ochRe}{ochRe package} -}} - -\examples{ -# Get names of available continuous palettes. -# (Call viz_gradient(cmap_gradients$name_of_palette) to preview one.) -names(cmap_gradients) - -# Run the following function to visualize *all* continuous palettes -purrr::walk2(cmap_gradients, names(cmap_gradients), viz_gradient) - -} -\keyword{datasets} diff --git a/man/cmap_palettes.Rd b/man/cmap_palettes.Rd deleted file mode 100644 index 5f26d4f6..00000000 --- a/man/cmap_palettes.Rd +++ /dev/null @@ -1,43 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/colors_discrete.R -\docType{data} -\name{cmap_palettes} -\alias{cmap_palettes} -\alias{viz_palette} -\title{CMAP discrete color palettes} -\format{ -An object of class \code{list} of length 31. -} -\usage{ -cmap_palettes - -viz_palette(pal, ttl = deparse(substitute(pal)), num = length(pal)) -} -\arguments{ -\item{pal}{character, vector of (hexadecimal) colors representing a palette} - -\item{ttl}{character, title to be displayed (the name of the palette)} - -\item{num}{numeric, the number of colors to display} -} -\description{ -A selection of discrete color palettes from the CMAP color palette. These -include mixed color palettes and discrete versions of the gradients defined -in \code{link{cmap_fill_continuous}}. -} -\section{Functions}{ -\itemize{ -\item \code{viz_palette}: Display CMAP palettes. Borrowed with respect from -the \href{https://github.com/ropenscilabs/ochRe}{ochRe package} -}} - -\examples{ -# Get names of available discrete palettes. -# (Call viz_palette(cmap_palettes$name_of_palette) to preview one.) -names(cmap_palettes) - -# Run the following function to visualize *all* discrete palettes -purrr::walk2(cmap_palettes, names(cmap_palettes), viz_palette) - -} -\keyword{datasets} diff --git a/man/cmapplot.Rd b/man/cmapplot.Rd index 8b98b119..e0421027 100644 --- a/man/cmapplot.Rd +++ b/man/cmapplot.Rd @@ -39,7 +39,7 @@ Authors: Other contributors: \itemize{ - \item Chicago Metropolitan Agency for Planning [copyright holder] + \item Chicago Metropolitan Agency for Planning [copyright holder, funder] } } diff --git a/man/viz_palette.Rd b/man/viz_palette.Rd new file mode 100644 index 00000000..8f8600be --- /dev/null +++ b/man/viz_palette.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/colors_continuous.R, R/colors_discrete.R +\name{viz_gradient} +\alias{viz_gradient} +\alias{viz_palette} +\alias{cmap_palettes} +\alias{cmap_gradients} +\alias{cmap_colors} +\title{Visualize CMAP color gradients} +\usage{ +viz_gradient(pal, ttl = NULL) + +viz_palette(pal, ttl = NULL, num = NULL) +} +\arguments{ +\item{pal}{character, name of a a cmapplot palette, or a vector of colors +representing a palette} + +\item{ttl}{character, title to be displayed (the name of the palette)} + +\item{num}{numeric, the number of colors to display} +} +\description{ +The cmapplot package contains a many color palettes extracted from the +larger, official CMAP color palette. Helper functions allow the user to +inspect the various palettes before applying them to plots. +} +\details{ +Palettes are stored in a tibble the \code{cmapplot_globals} environment. The +user can access this tibble with \code{\link{get_cmapplot_global}}. For more +information about available cmapplot color palettes and how to apply them, +see \code{vignette("colors")}. + +These functions are modified with respect from the +\href{https://github.com/ropenscilabs/ochRe}{ochRe package}) +} +\section{Functions}{ +\itemize{ +\item \code{viz_gradient}: interpolates the range of colors a sequential or +divergent palette offers when used on a continuous scale. + +\item \code{viz_palette}: displays the colors of any cmapplot palette +}} + +\examples{ +# Vizualize a sequential or divergent palette with interpolation +viz_gradient("reds") + +# Visualize a single palette as individual colors +viz_palette("prosperity") + +# Get names of all available palettes. +as.data.frame(get_cmapplot_global("palettes")[1:2]) + +} diff --git a/vignettes/colors.Rmd b/vignettes/colors.Rmd index be5e7fbe..2327793d 100644 --- a/vignettes/colors.Rmd +++ b/vignettes/colors.Rmd @@ -22,35 +22,15 @@ library(tidyverse) library(cmapplot) ``` -Palettes based on the CMAP color palette can be applied directly to ggplot2 graphics. The package contains both discrete and continuous color palettes. Each type of palette can be applied to either the color or fill attributes of a ggplot. +There are `r nrow(get_cmapplot_global("palettes"))` color palettes in the cmapplot package, across three categories: discrete, sequential, and divergent. Mirroring the underlying functionality of ggplot2, cmapplot can apply these color palettes as either a `discrete` or `continuous` scales to either the `color` (outline) or `fill` attributes of a ggplot. -## Continuous palettes +## Using CMAP colors in plots -Add continuous palettes by adding either the `cmap_fill_continuous()` or `cmap_color_continuous()` function to your plot construction. For example: - -```{r color_continuous, message = FALSE} -df <- dplyr::filter( - percentile_wages, - cluster %in% c("Biopharmaceuticals", "Hospitality and Tourism", "Paper and Packaging") -) - -ggplot(data = df) + - geom_point(mapping = aes(x = cluster, y = wage, color = percentile), - size = 5) + - scale_y_continuous(labels = scales::dollar) + - scale_x_discrete(labels = scales::label_wrap(18)) + - coord_flip() + - cmap_color_continuous(palette = "seq_red_purple") + - theme_cmap() + - ggtitle("Wage percentiles for key clusters") -``` - -If you're using a divergent palette, you can specify the midpoint where the divergence begins (default is zero). See `?cmap_gradients` for displays of all continuous palettes. +### Discrete scales +Discrete color scales are used to assign colors to discrete bins, such as the lines in a time series line chart. Discrete scale functions work with any palette -- discrete, sequential, or divergent. Add a discrete color scale by calling either the `cmap_fill_discrete()` or `cmap_color_discrete()` function in your plot construction. -## Discrete palettes - -Add discrete palettes by adding either the `cmap_fill_discrete()` or `cmap_color_discrete()` function to your plot construction. Note that discrete palettes will automatically interpolate additional colors if the dataset has more colors than the palette. This can be helpful but is not ideal for finished graphics. See `?cmap_palettes` for displays of all discrete palettes. These include a set of complementary colors (e.g., the `"prosperity"` palette), but also discrete versions of the gradients defined above (e.g., a binned blue palette implemented by calling `"seq_blues"`). +Note that discrete scales will automatically interpolate additional colors if the dataset has more colors than the underlying palette. This can be helpful but is not ideal for finished graphics. ```{r color_discrete, message = FALSE} df <- dplyr::filter(grp_over_time, category == "Goods-Producing") @@ -64,10 +44,11 @@ ggplot(data = df) + ggtitle("Real GRP of goods-producing clusters over time") ``` +### Race/ethnicity scale -## Race/ethnicity palette +In order to maintain a consistent data language, CMAP uses specific colors for displaying data based on race and ethnicity. To map these colors to each demographic group, use `cmap_fill_race()` or `cmap_color_race()`. -If you have a graph with categories based on race and ethnicity, there are functions to apply pre-determined colors for each demographic group: `cmap_fill_race()` and `cmap_color_race()`. In the arguments, specify the case-sensitive name of each group as it appears in your data. The function can be used even if your dataset does not contain every race/ethnicity category — simply omit the parameters for the missing categories. +In the arguments, specify the case-sensitive name of each group as it appears in your data. The functions can be used even if your dataset does not contain every race/ethnicity category — simply omit the parameters for the missing categories. ```{r color_race, message = FALSE} df <- dplyr::filter( @@ -87,8 +68,27 @@ ggplot(data = df) + ggtitle("Percent employed in specialized traded clusters, by race") ``` +### Continuous scales +Continuous color scales work with sequential and divergent palettes. Add a continuous scale by calling either the `cmap_fill_continuous()` or `cmap_color_continuous()` function in your plot construction. If you're using a divergent palette, you can specify the midpoint where the divergence begins (default is zero). -## Highlighting categories +```{r color_continuous, message = FALSE} +df <- dplyr::filter( + percentile_wages, + cluster %in% c("Biopharmaceuticals", "Hospitality and Tourism", "Paper and Packaging") +) + +ggplot(data = df) + + geom_point(mapping = aes(x = cluster, y = wage, color = percentile), + size = 5) + + scale_y_continuous(labels = scales::dollar) + + scale_x_discrete(labels = scales::label_wrap(18)) + + coord_flip() + + cmap_color_continuous(palette = "red_teal", middle = 50) + + theme_cmap() + + ggtitle("Wage percentiles for key clusters") +``` + +### Highlighting categories If you want to draw attention to a specific group in your graph, use `cmap_fill_highlight()` or `cmap_color_highlight()`. This will make your highlighted group one color and all other groups identical in another color. Specify the vector in your data that determines the groups, and then the value of the group to be singled out. Note that this *must* be the same vector specified in the `fill`/`color` aesthetic. The highlight and non-highlight colors have defaults, but can be changed with the `color_value` and `color_other` parameters, respectively. @@ -104,3 +104,54 @@ ggplot(data = df) + theme_cmap(show.legend = FALSE) + # Legend is redundant in this example ggtitle("Annual passenger trips by service, in millions") ``` + + +## Available color palettes +Palettes are stored in a tibble in the `cmapplot_globals` environment. This tibble can be accessed with `get_cmapplot_global("palettes")`, and specific palettes can be visualized in the plot window with `viz_palette()` and `viz_gradient()`. This table lists all palettes currently available in the package: + +```{r palettes, echo = FALSE, results = 'asis'} + +pals <- get_cmapplot_global("palettes") +discrete <- filter(pals, type == "discrete")[["name"]] +sequential1 <- filter(pals, type == "sequential", !stringr::str_detect(name, "_"))[["name"]] +sequential2 <- filter(pals, type == "sequential", stringr::str_detect(name, "_"))[["name"]] +divergent <- filter(pals, type == "divergent")[["name"]] + +maxlength <- max(length(discrete), length(sequential1), length(sequential2), length(divergent)) +length(discrete) <- length(sequential1) <- length(sequential2) <- length(divergent) <- maxlength + +out <- tibble(Discrete = discrete, + Sequential = sequential1, + `Sequential (multi-hue)` = sequential2, + Divergent = divergent) +out[is.na(out)] <- "" + +knitr::kable(out) +``` + +### Discrete palettes +Use these palettes with `cmap_fill_discrete()` or `cmap_color_discrete()`: +```{r show_discrete, echo = FALSE, fig.asp = 300/670} +nms <- dplyr::filter(get_cmapplot_global("palettes"), type == "discrete", name != "race")$name +purrr::walk(nms, viz_palette) +``` + +The race palette is a special discrete palette, which should be used with the specific functions `cmap_fill_race()` or `cmap_color_race()`: +```{r show_discrete_palettes, echo = FALSE, fig.asp = 300/670} +viz_palette("race") +``` + +### Sequential palettes +Use these palettes with `cmap_fill_continuous()`, `cmap_fill_discrete()`, or their `color` variants. +```{r show_sequential, echo = FALSE, fig.asp = 300/670} +nms <- dplyr::filter(get_cmapplot_global("palettes"), type == "sequential")$name +purrr::walk(nms, viz_gradient) +``` + +### Divergent palettes +Use these palettes with `cmap_fill_continuous()` `cmap_fill_discrete()`, or their `color` variants. +```{r show_diverent, echo = FALSE, fig.asp = 300/670} +nms <- dplyr::filter(get_cmapplot_global("palettes"), type == "divergent")$name +purrr::walk(nms, viz_gradient) +``` + From f9072c27e7a94db3c109d9f4f54e97f2668d6a4b Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Mon, 21 Jun 2021 11:00:36 -0500 Subject: [PATCH 161/173] tweaks --- NAMESPACE | 1 + R/colors_discrete.R | 13 ++++++++----- R/utilities.R | 20 ++++++++++++++++++-- man/viz_palette.Rd | 37 +++++++++++++++++++++++++++++++------ vignettes/cookbook.Rmd | 4 ++-- 5 files changed, 60 insertions(+), 15 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 26ef2a60..f63038a2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -19,6 +19,7 @@ export(cmap_fill_continuous) export(cmap_fill_discrete) export(cmap_fill_highlight) export(cmap_fill_race) +export(fetch_pal) export(finalize_plot) export(geom_recessions) export(geom_text_lastonly) diff --git a/R/colors_discrete.R b/R/colors_discrete.R index 97918bc4..e29a900b 100644 --- a/R/colors_discrete.R +++ b/R/colors_discrete.R @@ -5,12 +5,15 @@ #' inspect the various palettes before applying them to plots. #' #' Palettes are stored in a tibble the \code{cmapplot_globals} environment. The -#' user can access this tibble with \code{\link{get_cmapplot_global}}. For more -#' information about available cmapplot color palettes and how to apply them, -#' see \code{vignette("colors")}. +#' user can access this tibble with \code{\link{get_cmapplot_global}}, but it is +#' easier to access information about a single palette with \code{fetch_pal}. #' -#' These functions are modified with respect from the -#' \href{https://github.com/ropenscilabs/ochRe}{ochRe package}) +#' \code{viz_palette} and \code{viz_gradient} draw the palette to the plots +#' window. These functions are modified with respect from the +#' \href{https://github.com/ropenscilabs/ochRe}{ochRe package}. +#' +#' For more information about available cmapplot color palettes and how to apply +#' them, see \code{vignette("colors")}. #' #' @describeIn viz_palette displays the colors of any cmapplot palette #' diff --git a/R/utilities.R b/R/utilities.R index 7f91bc5a..a24ba255 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -144,20 +144,36 @@ safe_grobHeight <- function(grob, unitTo = "bigpts", valueOnly = TRUE){ #' Palette Fetcher #' -#' @param pal a name to search for in cmapplot_globals$palettes #' @param which a vector of palette types to consider +#' @param return Value to return. "colors", the default, returns the palette as +#' a vector of colors. "type" returns the palette's type. "Exists" returns +#' TRUE or FALSE based on whether the name is found in the palettes table. #' -#' @noRd +#' @describeIn viz_palette Return details about a palette +#' +#' @examples +#' # Identify the first two colors of the Prosperity Palette +#' fetch_pal("prosperity")[1:2] +#' +#' # Confirm that "reds" is a sequential palette +#' fetch_pal("reds", which = "sequential", return = "exists") +#' +#' @export fetch_pal <- function(pal, which = unique(cmapplot_globals$palettes$type), return = c("colors", "type", "exists")){ + # basics + name <- type <- NULL return <- match.arg(return) + + # filter palettes df <- dplyr::filter( cmapplot_globals$palettes, name == pal, type %in% which ) + # construct return if (return == "exists"){ return(nrow(df)==1) } else if (nrow(df)==1){ diff --git a/man/viz_palette.Rd b/man/viz_palette.Rd index 8f8600be..7ee59d21 100644 --- a/man/viz_palette.Rd +++ b/man/viz_palette.Rd @@ -1,16 +1,24 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/colors_continuous.R, R/colors_discrete.R +% Please edit documentation in R/colors_continuous.R, R/colors_discrete.R, +% R/utilities.R \name{viz_gradient} \alias{viz_gradient} \alias{viz_palette} \alias{cmap_palettes} \alias{cmap_gradients} \alias{cmap_colors} +\alias{fetch_pal} \title{Visualize CMAP color gradients} \usage{ viz_gradient(pal, ttl = NULL) viz_palette(pal, ttl = NULL, num = NULL) + +fetch_pal( + pal, + which = unique(cmapplot_globals$palettes$type), + return = c("colors", "type", "exists") +) } \arguments{ \item{pal}{character, name of a a cmapplot palette, or a vector of colors @@ -19,6 +27,12 @@ representing a palette} \item{ttl}{character, title to be displayed (the name of the palette)} \item{num}{numeric, the number of colors to display} + +\item{which}{a vector of palette types to consider} + +\item{return}{Value to return. "colors", the default, returns the palette as +a vector of colors. "type" returns the palette's type. "Exists" returns +TRUE or FALSE based on whether the name is found in the palettes table.} } \description{ The cmapplot package contains a many color palettes extracted from the @@ -27,12 +41,15 @@ inspect the various palettes before applying them to plots. } \details{ Palettes are stored in a tibble the \code{cmapplot_globals} environment. The -user can access this tibble with \code{\link{get_cmapplot_global}}. For more -information about available cmapplot color palettes and how to apply them, -see \code{vignette("colors")}. +user can access this tibble with \code{\link{get_cmapplot_global}}, but it is +easier to access information about a single palette with \code{fetch_pal}. + +\code{viz_palette} and \code{viz_gradient} draw the palette to the plots +window. These functions are modified with respect from the +\href{https://github.com/ropenscilabs/ochRe}{ochRe package}. -These functions are modified with respect from the -\href{https://github.com/ropenscilabs/ochRe}{ochRe package}) +For more information about available cmapplot color palettes and how to apply +them, see \code{vignette("colors")}. } \section{Functions}{ \itemize{ @@ -40,6 +57,8 @@ These functions are modified with respect from the divergent palette offers when used on a continuous scale. \item \code{viz_palette}: displays the colors of any cmapplot palette + +\item \code{fetch_pal}: Return details about a palette }} \examples{ @@ -52,4 +71,10 @@ viz_palette("prosperity") # Get names of all available palettes. as.data.frame(get_cmapplot_global("palettes")[1:2]) +# Identify the first two colors of the Prosperity Palette +fetch_pal("prosperity")[1:2] + +# Confirm that "reds" is a sequential palette +fetch_pal("reds", which = "sequential", return = "exists") + } diff --git a/vignettes/cookbook.Rmd b/vignettes/cookbook.Rmd index b3d3b319..d0ca4c3f 100644 --- a/vignettes/cookbook.Rmd +++ b/vignettes/cookbook.Rmd @@ -195,8 +195,8 @@ p <- ggplot(data = df, mapping = aes(x = TOT_POP_DIFF, y = LF_POP_DIFF)) + # Manually adjust point size/color aesthetics and legend items scale_size(range = c(5, 25)) + # Minimum/maximum size of points scale_color_manual( - values = c(`Increase` = cmap_palettes$legislation[1], # Modify point colors - `Decrease` = cmap_palettes$legislation[2]), + values = c(`Increase` = fetch_pal("legislation")[1], # Modify point colors + `Decrease` = fetch_pal("legislation")[2]), breaks = c("Increase", "Decrease"), # Specify order of legend items labels = c("Increase in labor force\nparticipation rate", # Modify legend labels for each color "Decrease in labor force\nparticipation rate") # ("\n" inserts a line break) From 25410d2170ef96882ba1858824774e2af8f083c0 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Mon, 21 Jun 2021 11:20:58 -0500 Subject: [PATCH 162/173] typos --- R/colors_continuous.R | 2 +- R/colors_discrete.R | 2 +- vignettes/colors.Rmd | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/colors_continuous.R b/R/colors_continuous.R index 22b5324c..c4967b17 100644 --- a/R/colors_continuous.R +++ b/R/colors_continuous.R @@ -1,4 +1,4 @@ -#' Visualize CMAP color gradients +#' Visualizing CMAP colors #' #' @describeIn viz_palette interpolates the range of colors a sequential or #' divergent palette offers when used on a continuous scale. diff --git a/R/colors_discrete.R b/R/colors_discrete.R index e29a900b..be93986a 100644 --- a/R/colors_discrete.R +++ b/R/colors_discrete.R @@ -1,4 +1,4 @@ -#' Vizualizing CMAP color palettes +#' Visualizing CMAP colors #' #' The cmapplot package contains a many color palettes extracted from the #' larger, official CMAP color palette. Helper functions allow the user to diff --git a/vignettes/colors.Rmd b/vignettes/colors.Rmd index 2327793d..afa95296 100644 --- a/vignettes/colors.Rmd +++ b/vignettes/colors.Rmd @@ -22,7 +22,7 @@ library(tidyverse) library(cmapplot) ``` -There are `r nrow(get_cmapplot_global("palettes"))` color palettes in the cmapplot package, across three categories: discrete, sequential, and divergent. Mirroring the underlying functionality of ggplot2, cmapplot can apply these color palettes as either a `discrete` or `continuous` scales to either the `color` (outline) or `fill` attributes of a ggplot. +There are `r nrow(get_cmapplot_global("palettes"))` color palettes in the cmapplot package, across three categories: discrete, sequential, and divergent. Mirroring the underlying functionality of ggplot2, cmapplot can apply these color palettes as either `discrete` or `continuous` scales to either the `color` (outline) or `fill` attributes of a ggplot. ## Using CMAP colors in plots @@ -107,7 +107,7 @@ ggplot(data = df) + ## Available color palettes -Palettes are stored in a tibble in the `cmapplot_globals` environment. This tibble can be accessed with `get_cmapplot_global("palettes")`, and specific palettes can be visualized in the plot window with `viz_palette()` and `viz_gradient()`. This table lists all palettes currently available in the package: +Palettes are stored in a tibble in the `cmapplot_globals` environment. This tibble can be accessed with `get_cmapplot_global("palettes")`, with specific details about any specific palette most easily accessed with `fetch_pal()`. Palettes can be visualized in the plot window with `viz_palette()` and `viz_gradient()`. This table lists all palettes currently available in the package: ```{r palettes, echo = FALSE, results = 'asis'} From 09b48126fb0f981c01d422d5d987a818a34fc857 Mon Sep 17 00:00:00 2001 From: Matthew Stern Date: Mon, 21 Jun 2021 16:42:05 -0500 Subject: [PATCH 163/173] final tweaks --- NEWS.md | 6 +++++- R/colors_discrete.R | 5 +++++ R/utilities.R | 2 -- 3 files changed, 10 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index 9e24c7bb..07264165 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,10 +6,12 @@ This is a version-level update that includes many fixes and new features and int ### New features * cmapplot now utilizes the new systemfonts package for custom font rendering, rather than sysfonts on Windows and X11fonts on Mac and other Unix-based machines. In addition, raster exports from `finalize_plot` now rely on the new raster drawing package ragg. These changes improve font accuracy and consistency across platforms. Note that this improvement does not yet extend to svg outputs, but may in the future (#134). * When an axis breaks are 4-digit years, new function `abbr_years` allows the conversion of specific years to 2-digit abbreviations, as is common on some designed CMAP graphics. -* cmapplot_globals, which contains key package constants, is now an internal environment rather than an exported list. It can be accessed via new functions `get_cmapplot_globals` and `get_cmapplot_global`. Constants can now be overridden by the user for the current session by using `set_cmapplot_global`. Note that this does not yet apply to geom aesthetics set by the package, but may in the future (issue #117). +* `cmapplot_globals`, which contains key package constants, is now an internal environment rather than an exported list. It can be accessed via new functions `get_cmapplot_globals` and `get_cmapplot_global`. Constants can now be overridden by the user for the current session by using `set_cmapplot_global`. Note that this does not yet apply to geom aesthetics set by the package, but may in the future (issue #117). +* All palettes programmed into the package have been moved into a tibble at `cmapplot_globals$palettes`. A new function `fetch_pal` can be used to get details about any specific palette. ### Bug fixes * Continuous color gradients can now be used on discrete color scales. E.g. `cmap_color_discrete` and `cmap_fill_discrete` can now call gradients as well as discrete palettes (see #70 and #119) +* Nomenclature in help files (e.g. "palette" vs "scale") has been adjusted for clarity. * internal table `recessions` has been updated to include the business cycle contraction that began in Feb 202 (no end date for this cycle yet). * `geom_recessions` and related `update_recessions` have been updated to allow for ongoing recessions, improve NBER source for recessions table, and decrease likelihood of data fetch errors. @@ -22,6 +24,8 @@ This is a version-level update that includes many fixes and new features and int * **This package will now only render Whitney Fonts in RStudio when RStudio version >= 1.4** * `finalize_plot`'s `window` mode has been disabled for now, due to inability to use ragg drivers in independent window devices. Use `mode = "plot"` and click the "Zoom" button in the plot window instead. * `cmapplot_globals`, the exported list of package constants, has been removed (See new features `set_cmapplot_global` etc) +* Color lists `cmap_palettes` and `cmap_gradients` have been removed (This information has been moved to `cmapplot_globals$palettes`. To access palette colors directly, use, say `fetch_pal("reds")` rather than `cmap_gradients$reds`. +* `viz_palette` and `viz_gradient` now take as a first argument either the name of a palette (e.g. `"reds"`) or the color palette itself (e.g. `fetch_pal("reds")`). `viz_palette(cmap_gradient$reds)` no longer works. * `integer_breaks` removed from package diff --git a/R/colors_discrete.R b/R/colors_discrete.R index be93986a..3152894d 100644 --- a/R/colors_discrete.R +++ b/R/colors_discrete.R @@ -66,6 +66,11 @@ viz_palette <- function(pal, ttl = NULL, num = NULL) { #' @noRd cmap_pal_discrete <- function(palette = "prosperity", reverse = FALSE) { pal <- fetch_pal(palette) + + if(palette == "race"){ + message("WARNING: The `race` palette should only be used with `cmap_fill_race` or `cmap_color_race`.") + } + if (reverse) { pal <- rev(pal) } diff --git a/R/utilities.R b/R/utilities.R index a24ba255..96fb04ab 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -1,5 +1,3 @@ -# Font spec visualization helper function --------------------------------- - #' Font visualization test #' #' This internal function uses base R graphics to display the five text variants From 99be59d2c4f6cc29755accb97c2bfb67fdaae1ca Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Tue, 22 Jun 2021 11:53:28 -0500 Subject: [PATCH 164/173] Change default palette from reds to blues Red is way too aggressive to be the default, and also not very CMAP-y. --- R/colors_continuous.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/colors_continuous.R b/R/colors_continuous.R index c4967b17..3dcc79d6 100644 --- a/R/colors_continuous.R +++ b/R/colors_continuous.R @@ -73,7 +73,7 @@ mid_rescaler2 <- function(mid) { #' @describeIn cmap_fill_continuous for fill aesthetic #' #' @export -cmap_fill_continuous <- function(palette = "reds", +cmap_fill_continuous <- function(palette = "blues", reverse = FALSE, middle = 0, ...) { @@ -99,7 +99,7 @@ cmap_fill_continuous <- function(palette = "reds", #' @describeIn cmap_fill_continuous for color aesthetic #' #' @export -cmap_color_continuous <- function(palette = "seq_reds", +cmap_color_continuous <- function(palette = "blues", reverse = FALSE, middle = 0, ...) { From 8daea95cc3f6d4c4af91d2ca3445021b17f95d34 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Tue, 22 Jun 2021 12:24:45 -0500 Subject: [PATCH 165/173] Explicitly name palette types for clearer documentation These categories are pretty unlikely to change in the future --- R/utilities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/utilities.R b/R/utilities.R index 96fb04ab..6aefe223 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -158,7 +158,7 @@ safe_grobHeight <- function(grob, unitTo = "bigpts", valueOnly = TRUE){ #' #' @export fetch_pal <- function(pal, - which = unique(cmapplot_globals$palettes$type), + which = c("discrete", "sequential", "divergent"), #unique(cmapplot_globals$palettes$type), return = c("colors", "type", "exists")){ # basics name <- type <- NULL From 98ae09944b70b9d05abe614ef2f1a0b4f85b1b05 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Tue, 22 Jun 2021 12:54:00 -0500 Subject: [PATCH 166/173] Documentation Updating man files --- man/cmap_fill_continuous.Rd | 6 +++--- man/viz_palette.Rd | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/man/cmap_fill_continuous.Rd b/man/cmap_fill_continuous.Rd index 445f1874..9dac2923 100644 --- a/man/cmap_fill_continuous.Rd +++ b/man/cmap_fill_continuous.Rd @@ -6,11 +6,11 @@ \alias{cmap_colour_continuous} \title{Apply continuous CMAP palettes (gradients) to ggplot2 aesthetics} \usage{ -cmap_fill_continuous(palette = "reds", reverse = FALSE, middle = 0, ...) +cmap_fill_continuous(palette = "blues", reverse = FALSE, middle = 0, ...) -cmap_color_continuous(palette = "seq_reds", reverse = FALSE, middle = 0, ...) +cmap_color_continuous(palette = "blues", reverse = FALSE, middle = 0, ...) -cmap_colour_continuous(palette = "seq_reds", reverse = FALSE, middle = 0, ...) +cmap_colour_continuous(palette = "blues", reverse = FALSE, middle = 0, ...) } \arguments{ \item{palette}{String; Choose from 'cmap_gradients' list} diff --git a/man/viz_palette.Rd b/man/viz_palette.Rd index 7ee59d21..38c41a35 100644 --- a/man/viz_palette.Rd +++ b/man/viz_palette.Rd @@ -8,7 +8,7 @@ \alias{cmap_gradients} \alias{cmap_colors} \alias{fetch_pal} -\title{Visualize CMAP color gradients} +\title{Visualizing CMAP colors} \usage{ viz_gradient(pal, ttl = NULL) @@ -16,7 +16,7 @@ viz_palette(pal, ttl = NULL, num = NULL) fetch_pal( pal, - which = unique(cmapplot_globals$palettes$type), + which = c("discrete", "sequential", "divergent"), return = c("colors", "type", "exists") ) } From a4333d99e83c4c7fcbd75968c4a4d67776084a37 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Tue, 22 Jun 2021 13:27:54 -0500 Subject: [PATCH 167/173] Capitalization/tenses Minor tweaks --- R/cmapplot_globals.R | 2 +- R/colors_continuous.R | 4 ++-- R/colors_discrete.R | 2 +- R/utilities.R | 2 +- man/viz_palette.Rd | 6 +++--- 5 files changed, 8 insertions(+), 8 deletions(-) diff --git a/R/cmapplot_globals.R b/R/cmapplot_globals.R index c441c1fd..e9318904 100644 --- a/R/cmapplot_globals.R +++ b/R/cmapplot_globals.R @@ -68,7 +68,7 @@ cmapplot_globals$palettes <- tibble::tribble( "teal_blue", "sequential", c("#a7efe8", "#72e5e3", "#00becc", "#00778c", "#004e66"), "red_purple", "sequential", c("#efa7a7", "#e5729e", "#cc0099", "#77008c", "#310066"), - # Multi-hue diverging + # Multi-hue divergent "yellow_purple", "divergent", c("#8c7200", "#ac8c00", "#cca600", "#d8ba36", "#e5d072", "#e3e8eb", "#aa72e5", "#8436d8", "#6300cc", "#5300ac", "#44008c"), "orange_blue", "divergent", c("#8c4100", "#ac5000", "#cc5f00", "#d88236", "#e5a872", "#e3e8eb", diff --git a/R/colors_continuous.R b/R/colors_continuous.R index 3dcc79d6..be2a0f13 100644 --- a/R/colors_continuous.R +++ b/R/colors_continuous.R @@ -1,6 +1,6 @@ #' Visualizing CMAP colors #' -#' @describeIn viz_palette interpolates the range of colors a sequential or +#' @describeIn viz_palette Interpolates the range of colors a sequential or #' divergent palette offers when used on a continuous scale. #' #' @examples @@ -41,7 +41,7 @@ cmap_pal_continuous <- function(palette = "reds", reverse = FALSE) { } -#' internal helper function to rescale. Credit for idea is due to ijlyttle: +#' Internal helper function to rescale. Credit for idea is due to ijlyttle: # \url{https://github.com/tidyverse/ggplot2/issues/3738#issuecomment-583750802} #' #' @noRd diff --git a/R/colors_discrete.R b/R/colors_discrete.R index 3152894d..2a47c8dc 100644 --- a/R/colors_discrete.R +++ b/R/colors_discrete.R @@ -15,7 +15,7 @@ #' For more information about available cmapplot color palettes and how to apply #' them, see \code{vignette("colors")}. #' -#' @describeIn viz_palette displays the colors of any cmapplot palette +#' @describeIn viz_palette Displays the colors of any cmapplot palette #' #' @param pal character, name of a a cmapplot palette, or a vector of colors #' representing a palette diff --git a/R/utilities.R b/R/utilities.R index 6aefe223..3510d3f1 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -147,7 +147,7 @@ safe_grobHeight <- function(grob, unitTo = "bigpts", valueOnly = TRUE){ #' a vector of colors. "type" returns the palette's type. "Exists" returns #' TRUE or FALSE based on whether the name is found in the palettes table. #' -#' @describeIn viz_palette Return details about a palette +#' @describeIn viz_palette Returns details about a palette #' #' @examples #' # Identify the first two colors of the Prosperity Palette diff --git a/man/viz_palette.Rd b/man/viz_palette.Rd index 38c41a35..d03b6e0d 100644 --- a/man/viz_palette.Rd +++ b/man/viz_palette.Rd @@ -53,12 +53,12 @@ them, see \code{vignette("colors")}. } \section{Functions}{ \itemize{ -\item \code{viz_gradient}: interpolates the range of colors a sequential or +\item \code{viz_gradient}: Interpolates the range of colors a sequential or divergent palette offers when used on a continuous scale. -\item \code{viz_palette}: displays the colors of any cmapplot palette +\item \code{viz_palette}: Displays the colors of any cmapplot palette -\item \code{fetch_pal}: Return details about a palette +\item \code{fetch_pal}: Returns details about a palette }} \examples{ From a774e3c99f14e9d6ab56c6a844c4600b0f941f51 Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Tue, 22 Jun 2021 13:30:20 -0500 Subject: [PATCH 168/173] Discrete use of sequential/divergent palettes Minor update to vignette, could cut if @matthewstern you think this is unnecessary. --- vignettes/colors.Rmd | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/vignettes/colors.Rmd b/vignettes/colors.Rmd index afa95296..9f5ed898 100644 --- a/vignettes/colors.Rmd +++ b/vignettes/colors.Rmd @@ -148,8 +148,15 @@ nms <- dplyr::filter(get_cmapplot_global("palettes"), type == "sequential")$nam purrr::walk(nms, viz_gradient) ``` +If you use a sequential palette for a discrete scale, the package will automatically choose colors from across the selected gradient and interpolate additional ones if needed. For example, the `blues` palette is shown below, interpolating nine colors from the initial palette list of seven. + +```{r show_sequential_discrete, echo = FALSE, fig.asp = 300/670} +nms <- fetch_pal("blues") +viz_palette("blues",num = 9) +``` + ### Divergent palettes -Use these palettes with `cmap_fill_continuous()` `cmap_fill_discrete()`, or their `color` variants. +Use these palettes with `cmap_fill_continuous()` `cmap_fill_discrete()`, or their `color` variants. Using these palettes for a discrete scale will behave similarly to the discrete use of `blues` shown above. ```{r show_diverent, echo = FALSE, fig.asp = 300/670} nms <- dplyr::filter(get_cmapplot_global("palettes"), type == "divergent")$name purrr::walk(nms, viz_gradient) From fbbfb3a08133de4fc9c19f0796e711524765a00e Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Tue, 22 Jun 2021 13:35:57 -0500 Subject: [PATCH 169/173] Use prettier palettes for the documentation examples --- R/colors_continuous.R | 2 +- R/colors_discrete.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/colors_continuous.R b/R/colors_continuous.R index be2a0f13..6b09bd66 100644 --- a/R/colors_continuous.R +++ b/R/colors_continuous.R @@ -5,7 +5,7 @@ #' #' @examples #' # Vizualize a sequential or divergent palette with interpolation -#' viz_gradient("reds") +#' viz_gradient("green_teal_blue") #' #' @export viz_gradient <- function(pal, ttl = NULL) { diff --git a/R/colors_discrete.R b/R/colors_discrete.R index 2a47c8dc..cbff2d38 100644 --- a/R/colors_discrete.R +++ b/R/colors_discrete.R @@ -24,7 +24,7 @@ #' #' @examples #' # Visualize a single palette as individual colors -#' viz_palette("prosperity") +#' viz_palette("legislation") #' #' # Get names of all available palettes. #' as.data.frame(get_cmapplot_global("palettes")[1:2]) From 68ebb566b6cf727215c465afd8b8fc5588c783b2 Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Tue, 22 Jun 2021 13:40:45 -0500 Subject: [PATCH 170/173] Rebuilt help file --- man/viz_palette.Rd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/man/viz_palette.Rd b/man/viz_palette.Rd index d03b6e0d..9e886b04 100644 --- a/man/viz_palette.Rd +++ b/man/viz_palette.Rd @@ -63,10 +63,10 @@ divergent palette offers when used on a continuous scale. \examples{ # Vizualize a sequential or divergent palette with interpolation -viz_gradient("reds") +viz_gradient("green_teal_blue") # Visualize a single palette as individual colors -viz_palette("prosperity") +viz_palette("legislation") # Get names of all available palettes. as.data.frame(get_cmapplot_global("palettes")[1:2]) From 5aac6c15653ec2fa39ab9adf844959e93870f4ab Mon Sep 17 00:00:00 2001 From: Daniel Comeaux <58892984+dlcomeaux@users.noreply.github.com> Date: Tue, 22 Jun 2021 13:49:21 -0500 Subject: [PATCH 171/173] Delete unneeded line --- vignettes/colors.Rmd | 1 - 1 file changed, 1 deletion(-) diff --git a/vignettes/colors.Rmd b/vignettes/colors.Rmd index 9f5ed898..8d4f8399 100644 --- a/vignettes/colors.Rmd +++ b/vignettes/colors.Rmd @@ -151,7 +151,6 @@ purrr::walk(nms, viz_gradient) If you use a sequential palette for a discrete scale, the package will automatically choose colors from across the selected gradient and interpolate additional ones if needed. For example, the `blues` palette is shown below, interpolating nine colors from the initial palette list of seven. ```{r show_sequential_discrete, echo = FALSE, fig.asp = 300/670} -nms <- fetch_pal("blues") viz_palette("blues",num = 9) ``` From d0898e3ef0aad2282ad1019386e56be6b0e040f7 Mon Sep 17 00:00:00 2001 From: Matthew Stern <54633946+tallishmatt@users.noreply.github.com> Date: Tue, 22 Jun 2021 13:58:29 -0500 Subject: [PATCH 172/173] final tweaks --- R/utilities.R | 3 ++- vignettes/colors.Rmd | 44 +++++++++++++++++++++++--------------------- 2 files changed, 25 insertions(+), 22 deletions(-) diff --git a/R/utilities.R b/R/utilities.R index 3510d3f1..cdef8e90 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -158,11 +158,12 @@ safe_grobHeight <- function(grob, unitTo = "bigpts", valueOnly = TRUE){ #' #' @export fetch_pal <- function(pal, - which = c("discrete", "sequential", "divergent"), #unique(cmapplot_globals$palettes$type), + which = c("discrete", "sequential", "divergent"), return = c("colors", "type", "exists")){ # basics name <- type <- NULL return <- match.arg(return) + which <- match.arg(which, unique(cmapplot_globals$palettes$type), several.ok = TRUE) # filter palettes df <- dplyr::filter( diff --git a/vignettes/colors.Rmd b/vignettes/colors.Rmd index 8d4f8399..e7e712ac 100644 --- a/vignettes/colors.Rmd +++ b/vignettes/colors.Rmd @@ -24,6 +24,28 @@ library(cmapplot) There are `r nrow(get_cmapplot_global("palettes"))` color palettes in the cmapplot package, across three categories: discrete, sequential, and divergent. Mirroring the underlying functionality of ggplot2, cmapplot can apply these color palettes as either `discrete` or `continuous` scales to either the `color` (outline) or `fill` attributes of a ggplot. +This table lists all palettes currently available in the package: + +```{r palettes, echo = FALSE, results = 'asis'} + +pals <- get_cmapplot_global("palettes") +discrete <- filter(pals, type == "discrete")[["name"]] +sequential1 <- filter(pals, type == "sequential", !stringr::str_detect(name, "_"))[["name"]] +sequential2 <- filter(pals, type == "sequential", stringr::str_detect(name, "_"))[["name"]] +divergent <- filter(pals, type == "divergent")[["name"]] + +maxlength <- max(length(discrete), length(sequential1), length(sequential2), length(divergent)) +length(discrete) <- length(sequential1) <- length(sequential2) <- length(divergent) <- maxlength + +out <- tibble(Discrete = discrete, + Sequential = sequential1, + `Sequential (multi-hue)` = sequential2, + Divergent = divergent) +out[is.na(out)] <- "" + +knitr::kable(out) +``` + ## Using CMAP colors in plots ### Discrete scales @@ -107,27 +129,7 @@ ggplot(data = df) + ## Available color palettes -Palettes are stored in a tibble in the `cmapplot_globals` environment. This tibble can be accessed with `get_cmapplot_global("palettes")`, with specific details about any specific palette most easily accessed with `fetch_pal()`. Palettes can be visualized in the plot window with `viz_palette()` and `viz_gradient()`. This table lists all palettes currently available in the package: - -```{r palettes, echo = FALSE, results = 'asis'} - -pals <- get_cmapplot_global("palettes") -discrete <- filter(pals, type == "discrete")[["name"]] -sequential1 <- filter(pals, type == "sequential", !stringr::str_detect(name, "_"))[["name"]] -sequential2 <- filter(pals, type == "sequential", stringr::str_detect(name, "_"))[["name"]] -divergent <- filter(pals, type == "divergent")[["name"]] - -maxlength <- max(length(discrete), length(sequential1), length(sequential2), length(divergent)) -length(discrete) <- length(sequential1) <- length(sequential2) <- length(divergent) <- maxlength - -out <- tibble(Discrete = discrete, - Sequential = sequential1, - `Sequential (multi-hue)` = sequential2, - Divergent = divergent) -out[is.na(out)] <- "" - -knitr::kable(out) -``` +Palettes are stored in a tibble in the `cmapplot_globals` environment. This tibble can be accessed with `get_cmapplot_global("palettes")`, with specific details about any specific palette most easily accessed with `fetch_pal()`. Palettes can be visualized in the plot window with `viz_palette()` and `viz_gradient()`. ### Discrete palettes Use these palettes with `cmap_fill_discrete()` or `cmap_color_discrete()`: From eee80b70112380b445179bd769b7f5abdf7ff4da Mon Sep 17 00:00:00 2001 From: Noel Peterson Date: Tue, 22 Jun 2021 15:04:55 -0500 Subject: [PATCH 173/173] A few more tweaks --- R/colors_continuous.R | 4 ++-- R/colors_discrete.R | 6 +++--- R/utilities.R | 6 +++--- man/viz_palette.Rd | 4 ++-- vignettes/colors.Rmd | 10 +++++----- 5 files changed, 15 insertions(+), 15 deletions(-) diff --git a/R/colors_continuous.R b/R/colors_continuous.R index 6b09bd66..f98e532f 100644 --- a/R/colors_continuous.R +++ b/R/colors_continuous.R @@ -1,4 +1,4 @@ -#' Visualizing CMAP colors +#' Visualizing CMAP color palettes #' #' @describeIn viz_palette Interpolates the range of colors a sequential or #' divergent palette offers when used on a continuous scale. @@ -34,7 +34,7 @@ viz_gradient <- function(pal, ttl = NULL) { #' @param reverse Logical; reverse color order? #' #' @noRd -cmap_pal_continuous <- function(palette = "reds", reverse = FALSE) { +cmap_pal_continuous <- function(palette = "blues", reverse = FALSE) { pal <- fetch_pal(palette) if (reverse) { pal <- rev(pal) } return(grDevices::colorRampPalette(pal)) diff --git a/R/colors_discrete.R b/R/colors_discrete.R index cbff2d38..fbc8ec00 100644 --- a/R/colors_discrete.R +++ b/R/colors_discrete.R @@ -1,4 +1,4 @@ -#' Visualizing CMAP colors +#' Visualizing CMAP color palettes #' #' The cmapplot package contains a many color palettes extracted from the #' larger, official CMAP color palette. Helper functions allow the user to @@ -26,7 +26,7 @@ #' # Visualize a single palette as individual colors #' viz_palette("legislation") #' -#' # Get names of all available palettes. +#' # Print names and types of all available palettes #' as.data.frame(get_cmapplot_global("palettes")[1:2]) #' #' @aliases cmap_palettes cmap_gradients cmap_colors @@ -68,7 +68,7 @@ cmap_pal_discrete <- function(palette = "prosperity", reverse = FALSE) { pal <- fetch_pal(palette) if(palette == "race"){ - message("WARNING: The `race` palette should only be used with `cmap_fill_race` or `cmap_color_race`.") + message("WARNING: The `race` palette should only be used with `cmap_fill_race()` or `cmap_color_race()`.") } if (reverse) { diff --git a/R/utilities.R b/R/utilities.R index cdef8e90..9912f6fd 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -173,9 +173,9 @@ fetch_pal <- function(pal, ) # construct return - if (return == "exists"){ - return(nrow(df)==1) - } else if (nrow(df)==1){ + if (return == "exists") { + return(nrow(df) == 1) + } else if (nrow(df) == 1) { return(df[[return]][[1]]) } else { return(NULL) diff --git a/man/viz_palette.Rd b/man/viz_palette.Rd index 9e886b04..1ad981a4 100644 --- a/man/viz_palette.Rd +++ b/man/viz_palette.Rd @@ -8,7 +8,7 @@ \alias{cmap_gradients} \alias{cmap_colors} \alias{fetch_pal} -\title{Visualizing CMAP colors} +\title{Visualizing CMAP color palettes} \usage{ viz_gradient(pal, ttl = NULL) @@ -68,7 +68,7 @@ viz_gradient("green_teal_blue") # Visualize a single palette as individual colors viz_palette("legislation") -# Get names of all available palettes. +# Print names and types of all available palettes as.data.frame(get_cmapplot_global("palettes")[1:2]) # Identify the first two colors of the Prosperity Palette diff --git a/vignettes/colors.Rmd b/vignettes/colors.Rmd index e7e712ac..111d5968 100644 --- a/vignettes/colors.Rmd +++ b/vignettes/colors.Rmd @@ -46,7 +46,7 @@ out[is.na(out)] <- "" knitr::kable(out) ``` -## Using CMAP colors in plots +## Using CMAP color palettes in plots ### Discrete scales @@ -144,7 +144,7 @@ viz_palette("race") ``` ### Sequential palettes -Use these palettes with `cmap_fill_continuous()`, `cmap_fill_discrete()`, or their `color` variants. +Use these palettes with `cmap_fill_continuous()`/`cmap_color_continuous()` or `cmap_fill_discrete()`/`cmap_color_discrete()`. ```{r show_sequential, echo = FALSE, fig.asp = 300/670} nms <- dplyr::filter(get_cmapplot_global("palettes"), type == "sequential")$name purrr::walk(nms, viz_gradient) @@ -153,13 +153,13 @@ purrr::walk(nms, viz_gradient) If you use a sequential palette for a discrete scale, the package will automatically choose colors from across the selected gradient and interpolate additional ones if needed. For example, the `blues` palette is shown below, interpolating nine colors from the initial palette list of seven. ```{r show_sequential_discrete, echo = FALSE, fig.asp = 300/670} -viz_palette("blues",num = 9) +viz_palette("blues", num = 9) ``` ### Divergent palettes -Use these palettes with `cmap_fill_continuous()` `cmap_fill_discrete()`, or their `color` variants. Using these palettes for a discrete scale will behave similarly to the discrete use of `blues` shown above. +Use these palettes with `cmap_fill_continuous()`/`cmap_color_continuous()` or `cmap_fill_discrete()`/`cmap_color_discrete()`. Using these palettes for a discrete scale will behave similarly to the discrete use of `blues` shown above. ```{r show_diverent, echo = FALSE, fig.asp = 300/670} -nms <- dplyr::filter(get_cmapplot_global("palettes"), type == "divergent")$name +nms <- dplyr::filter(get_cmapplot_global("palettes"), type == "divergent")$name purrr::walk(nms, viz_gradient) ```