#' Save a branded plot
#' @description Save a \code{ggplot2} plot as png with an optional Sorenson Impact branding bar.
#' @importFrom magrittr "%>%"
#' @param filename Filename to create on disk. If "auto", defaults to the title of the \code{last_plot} within the \code{plot_directory}.
#' @param dir Directory to save file to. Defaults to "auto", which places plots in a "plots" subdir of the script dir.
#' @param plot Plot to save, defaults to last plot displayed.
#' @param width Width in inches (default: 6).
#' @param height Height in inches (default: 4).
#' @param dpi Dots per inch. Defaults to 300. The resolution of the file will be width*DPI by height*DPI.
#' @param add_logo Logical. Add the sorenson impact branding bar? (defaults: TRUE)
#' @param logo_height_ratio Number between 0 and 1, with sensibile values between .01 and .1. The percent of the image height that the bar should be. Default is 0.05.
#' @param band_color The color of the SI Logo band. Defaults to \code{si_design$granite}.
#' @return A png of the last plot with optional SI logo band.
#' @examples
#' \dontrun{
#' SI_colorplot() + ggplot2::ggtitle("My Title")
#' SI_ggsave(add_logo = TRUE)
#' }
#' @export
si_ggsave <- function(filename = "auto", dir = "auto", plot = ggplot2::last_plot(), width = 6, height = 4, dpi = 300, add_logo = TRUE, logo_height_ratio = .05, band_color = si_design$granite) {
if(dir == "auto"){
dir <- file.path(dirname(rstudioapi::getSourceEditorContext()$path), "plots")
if(!dir.exists(dir)) dir.create(dir)
}
if(!dir.exists(dir)) stop(cat("Provided dir \"", dir, "\" does not exist."))
if(filename == "auto") { #if the default "auto" is left, generate a dynamic file name.
if(is.null(ggplot2::last_plot()$labels$title)) stop("Plot must have a title to use auto filename with SI_ggsave. Add a title or specify the filename.")
# We use the plot title to create the file name
# !Be careful not to use the same plot title more than once!
# The following default variable is how the file is saved
filename <- file.path(dir, paste0(ggplot2::last_plot()$labels$title, ".png"))
}
# First we save the last plot with sensible defaults
ggplot2::ggsave(filename, plot, width = width, height = height, dpi = dpi)
# Now bring it back if we are adding the band
if(add_logo) {
plot <- magick::image_read(filename)
pwidth <- as.data.frame(magick::image_info(plot))$width
pheight <- as.data.frame(magick::image_info(plot))$height
# Load the logo and crop it to the width of the default plot, fig_width: 6
logo <- magick::image_read(paste0(.libPaths(), '/sorensonimpact/rmarkdown/templates/si_ioslides/skeleton/template/SI_logo_background.png')) %>%
magick::image_scale(paste0("x", pheight * logo_height_ratio)) %>% #make the height of the logo equal to a ratio of the height of the plot. Defaults to 5%.
magick::image_background(band_color, flatten = TRUE) %>%
magick::image_crop(paste0(pwidth, "x0+0+0")) #make the width of the logo match the width of the plot
# The final version is stacked on top of the sorenson logo
final_plot <- magick::image_append(c(plot, logo), stack = TRUE)
# And then we overwrite the standard ggsave call
magick::image_write(final_plot, filename)
}
}
#' Show Sorenson Impact Theme Colors
#' @description Shows the Sorenson Impact theme colors for reference.
#' @importFrom magrittr "%>%"
#' @return A plot of SI colors
#' @examples
#' \dontrun{
#' SI_colorplot()
#' }
#' @export
si_colorplot <- function() {
data.frame("color" = names(unlist(si_design)),
"code" = unlist(si_design), stringsAsFactors = F) %>%
ggplot2::ggplot() +
ggplot2::geom_rect(ggplot2::aes(fill = I(code)), xmin = 0, xmax = 1, ymin = 0, ymax = 1) +
ggplot2::facet_wrap(~color)
}
#' Apply all Sorenson Impact ggplot themes
#' @description Applies all Sorenson Impact custom colors and settings for ggplot
#' @return Invisibly sets SI ggplot theme values.
#' @examples
#' \dontrun{
#' SI_ggplot_update()
#' }
#' @export
si_ggplot_theme_update <- function() {
#New colors to add from Gwen: c("#741D5A", "#DD9E27", "#33439B", "#ED1C24", "#24420E")
ggplot2::update_geom_defaults("bar", list(fill = si_design$pacific))
ggplot2::update_geom_defaults("smooth", list(colour = si_design$pacific, fill = si_design$arctic, alpha = I(2/10)))
ggplot2::update_geom_defaults("point", list(colour = si_design$pacific, fill = si_design$pacific))
ggplot2::update_geom_defaults("col", list(fill = si_design$pacific))
ggplot2::theme_set(ggplot2::theme_minimal())
if("extrafont" %in% installed.packages()) {
if("Roboto" %in% extrafont::fonts()) {
#In order to use the SI font, Roboto, it needs to be installed. See https://github.com/wch/extrafont
#Once on the system and imported, also use loadfonts() and loadfonts(device="postscript")
ggplot2::theme_update(text = ggplot2::element_text(family = "Roboto"),
axis.text = ggplot2::element_text(family = "Roboto"),
strip.text = ggplot2::element_text(family = "Roboto"))
}
} else warning("Package extrafont not installed or Roboto font family not installed.")
}
#' Scale format to International System of Units (k, M, )
#' @description Format a vector of numeric values according to the International System of Units.
#'
#' (ie: 1,000 becomes "1 k", 2,500 becomes "2.5 k") See: http://en.wikipedia.org/wiki/SI_prefix
#' @param sep Seperator to use between number and unit (defaults to " ")
#' @param ... Passed by \code{ggplot2::scale_*_continuous}
#'
#' @return Used with scale_*_continuous, returns formatted axis labels
#' @export
#'
#' @examples
#' \dontrun{
#' ggplot(diamonds, aes(x = price)) + geom_density() + scale_x_continuous(labels = scale_si_unit())
#' }
scale_si_unit <- function(sep = " ", ...) {
# Based on code by Ben Tupper
# https://stat.ethz.ch/pipermail/r-help/2012-January/299804.html
function(x) {
limits <- c(1e-24, 1e-21, 1e-18, 1e-15, 1e-12,
1e-9, 1e-6, 1e-3, 1e0, 1e3,
1e6, 1e9, 1e12, 1e15, 1e18,
1e21, 1e24)
prefix <- c("y", "z", "a", "f", "p",
"n", "ยต", "m", " ", "k",
"M", "G", "T", "P", "E",
"Z", "Y")
# Vector with array indices according to position in intervals
i <- findInterval(abs(x), limits)
# Set prefix to " " for very small values < 1e-24
i <- ifelse(i==0, which(limits == 1e0), i)
paste(format(round(x/limits[i], 1),
trim=TRUE, scientific=FALSE, ...),
prefix[i], sep = sep)
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.