R-CMD-check / R CMD check (push) Failing after 1m39s
- R/colors.R: civilytics_colors named vector (from --cv-* CSS vars on civilytics.com), three palettes (main/sequential/diverging), scale_color_civilytics() and scale_fill_civilytics() for ggplot2 - R/fonts.R: auto-loads Inter + Libre Franklin from Google Fonts via showtext in .onLoad(); exports civilytics_load_fonts() for manual retry - R/theme.R: wires ggplot2 4.0 ink/paper/accent params into theme_grey() base, adds title_family + strip_color params; new theme_civilytics_dark() using navy_dark background and warm off-white text - R/logo.R: make_logo_grob(variant) accepts "light"/"dark" to select the white logo for dark-background compositions - DESCRIPTION: adds showtext, sysfonts; pins ggplot2 >= 4.0.0 - tests/testthat/test_theme.R: full test suite for colors, palettes, scales, both theme variants, and logo grob variants
187 lines
6.5 KiB
R
187 lines
6.5 KiB
R
#' Plot a jpeg image as a raster
|
|
#'
|
|
#' @param path a character representing the relative or absolute path to the image
|
|
#' @param add a logical, TRUE to add the image to an existing plot, FALSE creates a new plot
|
|
#' @param upscale a logical, TRUE upscales the resolution of the graphic by a factor of 3, FALSE
|
|
#' preserves the resolution
|
|
#' @return a rasterImage
|
|
#' @export
|
|
#' @importFrom jpeg readJPEG
|
|
#' @importFrom graphics rasterImage
|
|
#' @examples
|
|
#' img <- system.file("img","civilytics_logo.jpg",package="civilytics")
|
|
#' plot_jpeg(img)
|
|
plot_jpeg <- function(path, add=FALSE, upscale = TRUE)
|
|
{
|
|
jpg = readJPEG(path, native = TRUE) # read the file
|
|
res = dim(jpg)[2:1] # get the resolution, [x, y]
|
|
if (upscale){
|
|
res <- res * 3
|
|
}
|
|
if (!add) # initialize an empty plot area if add==FALSE
|
|
plot(1,1,xlim=c(1,res[1]),ylim=c(1,res[2]),asp=1,type='n',xaxs='i',yaxs='i',
|
|
xaxt='n',yaxt='n',xlab='',ylab='',bty='n', oma=c(0,0,1,1), mar=c(0,0,1,1)
|
|
)
|
|
rasterImage(jpg,1,1,res[1],res[2],interpolate=TRUE)
|
|
}
|
|
|
|
|
|
#' Plot a PNG file as a rasterGrob for inclusion in ggplot2
|
|
#'
|
|
#' @param filename a character with file path to a png file
|
|
#'
|
|
#' @return a plotted rasteGrob of a png image
|
|
#' @export
|
|
#' @importFrom png readPNG
|
|
#' @importFrom grid rasterGrob
|
|
get_png <- function(filename) {
|
|
grid::rasterGrob(png::readPNG(filename), interpolate = TRUE)
|
|
}
|
|
|
|
|
|
#' Add a logo to a ggplot2 object
|
|
#'
|
|
#' @param plot a ggplot2 grob
|
|
#' @param logo a logo grob created by make_logo_grob()
|
|
#' @param margin_param a numeric specifying what margin to add or subtract to align the logo
|
|
#'
|
|
#' @return a grob with a logo attached to it ready to plot
|
|
#' @importFrom ggplot2 theme
|
|
#' @importFrom gridExtra arrangeGrob
|
|
#' @export
|
|
add_logo <- function(plot, logo, margin_param = NULL) {
|
|
if(has_caption(plot)) {
|
|
# convert the caption size to a negative number and on the "pt" scale
|
|
# p1$theme$plot.caption$size * 1.1
|
|
# Count the number of lines, which is this + 1
|
|
# For each line, we can add a certain negative space to align the logo
|
|
cap_lines <- measure_caption(plot)
|
|
if (!is.null(margin_param)) {
|
|
plot <- plot + theme(plot.margin = unit(c(7, 7, margin_param, 7), "pt"))
|
|
} else {
|
|
plot <- plot + theme(plot.margin = unit(c(7, 7, cap_lines * -52, 7), "pt"))
|
|
}
|
|
} else {
|
|
plot <- plot + theme(plot.margin = unit(c(7, 7, -14, 7), "pt"))
|
|
}
|
|
|
|
arrangeGrob(plot, logo, heights = c(0.93, 0.1),
|
|
padding = unit(0.1, "line"))
|
|
}
|
|
|
|
#' Measure a ggplot2 object caption
|
|
#'
|
|
#' @param gg a ggplot object
|
|
#'
|
|
#' @return a numeric value stating the number of lines to be added or subtracted to align a logo with
|
|
#' the caption
|
|
#' @importFrom stringr str_count
|
|
#' @export
|
|
#'
|
|
#' @examples
|
|
#' p1 <- ggplot2::ggplot(mtcars, ggplot2::aes(mpg, wt)) + ggplot2::geom_point()
|
|
#' measure_caption(p1) # Should equal 1 since no caption is present
|
|
measure_caption <- function(gg) {
|
|
if (has_caption(gg)) {
|
|
stringr::str_count(gg$labels$caption, pattern = "\n") + 1
|
|
} else {
|
|
1
|
|
}
|
|
}
|
|
|
|
|
|
#' Test whether a ggplot2 object has a caption
|
|
#'
|
|
#' @param gg a gg object from ggplot2
|
|
#'
|
|
#' @return a logical, TRUE if a caption exists and FALSE if it does not
|
|
#' @import ggplot2
|
|
#' @export
|
|
#'
|
|
#' @examples
|
|
#' p1 <- ggplot2::ggplot(mtcars, ggplot2::aes(mpg, wt)) + ggplot2::geom_point()
|
|
#' has_caption(p1) # FALSE
|
|
has_caption <- function(gg) {
|
|
any(names(gg$labels) == "caption")
|
|
}
|
|
|
|
#' Add a logo to a ggplot2 object
|
|
#'
|
|
#' @param plot_list a list containing ggplot2 objects
|
|
#' @param logo a grob containing the logo created with `make_logo_grob`
|
|
#' @param nrow an integer, default = 1, for the number of rows to align the plots in
|
|
#' @param widths an optional vector the same length as plot_list with the widths for each plot
|
|
#' @param margin_param a number giving the adjustment up or down to help manually align logo and captions
|
|
#'
|
|
#' @return a grid object
|
|
#' @note The resulting object needs to be drawn to the screen using grid.draw()
|
|
#' @importFrom gridExtra arrangeGrob
|
|
#' @importFrom ggplot2 theme
|
|
#' @importFrom grid grid.draw
|
|
#' @export
|
|
#'
|
|
#' @examples
|
|
#' \dontrun{
|
|
#' library(ggplot2); library(grid)
|
|
#' tmp_plot <- ggplot(mtcars) + aes(x = hp, y = disp) + geom_point() + theme_civilytics()
|
|
#' tmp_logo <- make_logo_grob()
|
|
#' plot_and_logo <- add_logo(tmp_plot, tmp_logo)
|
|
#' grid.draw(plot_and_logo)
|
|
#' dev.off()
|
|
#' }
|
|
add_logo_ga <- function(plot_list, logo, nrow = 1, widths = NULL, margin_param = NULL) {
|
|
# Change position of logo depending on if plot has a caption
|
|
if (!is.null(margin_param)) {
|
|
margin <- theme(plot.margin = unit(c(7, 7, margin_param, 7), "pt"))
|
|
} else if (any(unlist(lapply(plot_list, has_caption)))) {
|
|
cap_lines <- max(sapply(plot_list, measure_caption))
|
|
margin <- theme(plot.margin = unit(c(7, 7, -7 * sqrt(cap_lines), 7), "pt"))
|
|
} else {
|
|
margin <- theme(plot.margin = unit(c(7, 7, 7, 7), "pt"))
|
|
}
|
|
if (nrow > 1) {
|
|
len <- length(plot_list)
|
|
plot_list[[len]] <- plot_list[[len]] + margin
|
|
} else {
|
|
plot_list <- lapply(plot_list, "+", margin)
|
|
}
|
|
|
|
if (nrow != 1) {
|
|
if (!is.null(widths)) warning("`widths` is ignored when `nrow > 1`")
|
|
hold <- arrangeGrob(grobs = plot_list, nrow = nrow, ncol = 1)
|
|
} else {
|
|
hold <- arrangeGrob(grobs = plot_list, nrow = 1, ncol = length(plot_list), widths = widths)
|
|
}
|
|
|
|
arrangeGrob(hold, logo, heights = c(0.93, .07))
|
|
}
|
|
|
|
|
|
#' Get a Civilytics Logo grob
|
|
#'
|
|
#' Returns a ggplot object containing the Civilytics logo as a rasterGrob,
|
|
#' ready to compose with plots via [add_logo()] or [add_logo_ga()].
|
|
#'
|
|
#' @param variant Character. `"light"` (default) uses the standard dark logo
|
|
#' suitable for light backgrounds. `"dark"` uses the white logo suitable for
|
|
#' dark backgrounds (pairs with [theme_civilytics_dark()]).
|
|
#'
|
|
#' @return A ggplot object (class `"gg"`) containing the logo grob.
|
|
#' @export
|
|
#' @importFrom ggplot2 ggplot theme_void annotation_custom
|
|
#' @examples
|
|
#' logo <- make_logo_grob() # light background
|
|
#' logo_dark <- make_logo_grob("dark") # dark background
|
|
#' class(logo) # "gg" "ggplot"
|
|
make_logo_grob <- function(variant = c("light", "dark")) {
|
|
variant <- match.arg(variant)
|
|
img_file <- if (variant == "dark") "civilytics_logo_white.png" else "civilytics_logo.png"
|
|
ggplot2::ggplot() +
|
|
ggplot2::theme_void() +
|
|
ggplot2::annotation_custom(
|
|
get_png(system.file("img", img_file, package = "civilytics")),
|
|
xmin = 0.7, xmax = 1
|
|
)
|
|
}
|
|
|