jared
ac8e3eb60e
R-CMD-check / R CMD check (push) Successful in 3m41s
The logo grob uses theme_void() (transparent background), so when arrangeGrob() composites it with a dark-themed plot, the logo strip falls back to the device default (white). Extract the plot's plot.background fill and apply it to the logo grob before compositing. Fixes the issue where theme_civilytics_dark(font_size = 16) piped to civilytics_logo(variant = "dark") would show a light background in the logo/caption area.
357 lines
13 KiB
R
357 lines
13 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
|
|
#' \dontrun{
|
|
#' img <- system.file("img","Knowles_Headshot_2019_good.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
|
|
#' @param font_scale Numeric. Multiplicative scaling factor applied to text
|
|
#' sizes before composing the plot with the logo. Default `1.1` inflates
|
|
#' text by ~10 \% to compensate for the viewport shrinkage caused by
|
|
#' [gridExtra::arrangeGrob()]. Set to `1` to disable.
|
|
#' @param position Character. Corner placement for the logo: `"bottom-right"`
|
|
#' (default), `"bottom-left"`, `"top-right"`, or `"top-left"`. Controls
|
|
#' whether the logo is placed above or below the plot.
|
|
#'
|
|
#' @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, font_scale = 1.1,
|
|
position = c("bottom-right", "bottom-left",
|
|
"top-right", "top-left")) {
|
|
position <- match.arg(position)
|
|
at_top <- grepl("top", position)
|
|
|
|
# Inherit the plot's background color so the logo strip matches.
|
|
# make_logo_grob() uses theme_void() (transparent), so without this the
|
|
# logo area falls back to the device default (white).
|
|
bg_fill <- plot$theme$plot.background$fill
|
|
if (!is.null(bg_fill) && !is.na(bg_fill)) {
|
|
logo <- logo + ggplot2::theme(
|
|
plot.background = ggplot2::element_rect(fill = bg_fill, color = NA)
|
|
)
|
|
}
|
|
|
|
# Inflate text sizes to compensate for arrangeGrob viewport shrinkage.
|
|
# All theme text elements use rel() sizing, so scaling the root 'text'
|
|
# element cascades to titles, axis labels, legends, captions, and strips.
|
|
if (!is.null(font_scale) && font_scale != 1) {
|
|
base_size <- plot$theme$text$size %||% 14
|
|
plot <- plot + ggplot2::theme(
|
|
text = ggplot2::element_text(size = base_size * font_scale)
|
|
)
|
|
}
|
|
|
|
if (at_top) {
|
|
# For top placement, tighten the top margin of the plot
|
|
if (!is.null(margin_param)) {
|
|
plot <- plot + theme(plot.margin = unit(c(margin_param, 7, 7, 7), "pt"))
|
|
} else {
|
|
plot <- plot + theme(plot.margin = unit(c(-14, 7, 7, 7), "pt"))
|
|
}
|
|
arrangeGrob(logo, plot, heights = c(0.1, 0.93),
|
|
padding = unit(0.1, "line"))
|
|
} else {
|
|
# Bottom placement (original behaviour)
|
|
if(has_caption(plot)) {
|
|
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 multiple ggplot2 objects
|
|
#'
|
|
#' @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
|
|
#' @param font_scale Numeric. Multiplicative scaling factor applied to text
|
|
#' sizes before composing. Default `1.1`. See [add_logo()] for details.
|
|
#'
|
|
#' @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, font_scale = 1.1) {
|
|
# Inherit the background color from the first plot so the logo strip matches
|
|
bg_fill <- plot_list[[1]]$theme$plot.background$fill
|
|
if (!is.null(bg_fill) && !is.na(bg_fill)) {
|
|
logo <- logo + ggplot2::theme(
|
|
plot.background = ggplot2::element_rect(fill = bg_fill, color = NA)
|
|
)
|
|
}
|
|
|
|
# Inflate text sizes to compensate for viewport shrinkage
|
|
if (!is.null(font_scale) && font_scale != 1) {
|
|
plot_list <- lapply(plot_list, function(p) {
|
|
base_size <- p$theme$text$size %||% 14
|
|
p + ggplot2::theme(
|
|
text = ggplot2::element_text(size = base_size * font_scale)
|
|
)
|
|
})
|
|
}
|
|
|
|
# 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()], [add_logo_ga()], or the
|
|
#' pipe-friendly [civilytics_logo()].
|
|
#'
|
|
#' @param type Character. `"wordmark"` (default) uses the full wordmark.
|
|
#' `"mark"` uses the compact C-pulse icon only.
|
|
#' @param variant Character. `"light"` (default) uses the dark logo for light
|
|
#' backgrounds. `"dark"` uses the reverse (light) logo for dark backgrounds
|
|
#' (pairs with [theme_civilytics_dark()]).
|
|
#' @param position Character. Corner placement for the logo: `"bottom-right"`
|
|
#' (default), `"bottom-left"`, `"top-right"`, or `"top-left"`. Controls
|
|
#' horizontal alignment of the logo grob.
|
|
#'
|
|
#' @return A ggplot object (class `"gg"`) containing the logo grob.
|
|
#' @export
|
|
#' @importFrom ggplot2 ggplot theme_void annotation_custom
|
|
#' @examples
|
|
#' logo <- make_logo_grob() # wordmark, light
|
|
#' logo <- make_logo_grob("mark", "dark") # mark, dark
|
|
#' logo <- make_logo_grob(position = "bottom-left") # left-aligned
|
|
#' class(logo) # "gg" "ggplot"
|
|
make_logo_grob <- function(type = c("wordmark", "mark"),
|
|
variant = c("light", "dark"),
|
|
position = c("bottom-right", "bottom-left",
|
|
"top-right", "top-left")) {
|
|
type <- match.arg(type)
|
|
variant <- match.arg(variant)
|
|
position <- match.arg(position)
|
|
|
|
img_file <- switch(
|
|
paste(type, variant, sep = "_"),
|
|
wordmark_light = "civilytics-wordmark.png",
|
|
wordmark_dark = "civilytics-wordmark-reverse.png",
|
|
mark_light = "civilytics-mark.png",
|
|
mark_dark = "civilytics-mark-reverse.png"
|
|
)
|
|
|
|
align_left <- grepl("left", position)
|
|
|
|
if (align_left) {
|
|
xmin <- 0
|
|
xmax <- if (type == "mark") 0.07 else 0.35
|
|
} else {
|
|
xmin <- if (type == "mark") 0.93 else 0.65
|
|
xmax <- 1
|
|
}
|
|
|
|
ggplot2::ggplot() +
|
|
ggplot2::theme_void() +
|
|
ggplot2::annotation_custom(
|
|
get_png(system.file("img", img_file, package = "civilytics")),
|
|
xmin = xmin, xmax = xmax
|
|
)
|
|
}
|
|
|
|
#' Add a Civilytics logo to a ggplot (pipe-friendly)
|
|
#'
|
|
#' A convenience wrapper that creates the logo grob and attaches it to a
|
|
#' corner of the plot in one call. Designed for use with the base pipe `|>`.
|
|
#'
|
|
#' **Important:** R's `|>` has *higher* precedence than `+`, so you must
|
|
#' wrap the ggplot chain in parentheses before piping:
|
|
#'
|
|
#' ```
|
|
#' (ggplot(mpg, aes(displ, hwy)) +
|
|
#' geom_point() +
|
|
#' theme_civilytics()) |>
|
|
#' civilytics_logo()
|
|
#' ```
|
|
#'
|
|
#' @param plot A ggplot object.
|
|
#' @param type Character. `"wordmark"` (default) or `"mark"`. Passed to
|
|
#' [make_logo_grob()].
|
|
#' @param variant Character. `"light"` (default) or `"dark"`. Passed to
|
|
#' [make_logo_grob()].
|
|
#' @param position Character. Corner placement for the logo: `"bottom-right"`
|
|
#' (default), `"bottom-left"`, `"top-right"`, or `"top-left"`.
|
|
#' @param margin_param Numeric or `NULL`. Manual margin adjustment passed to
|
|
#' [add_logo()].
|
|
#' @param font_scale Numeric. Inflate text sizes by this factor to compensate
|
|
#' for viewport shrinkage when composing with [gridExtra::arrangeGrob()].
|
|
#' Default `1.1` (~10 \% inflation). Set to `1` to disable.
|
|
#'
|
|
#' @return A grob (from [gridExtra::arrangeGrob()]) ready to draw with
|
|
#' [grid::grid.draw()].
|
|
#' @export
|
|
#'
|
|
#' @examples
|
|
#' \dontrun{
|
|
#' library(ggplot2); library(grid)
|
|
#'
|
|
#' # Pipe usage — parentheses required around the ggplot chain
|
|
#' (ggplot(mpg, aes(displ, hwy)) +
|
|
#' geom_point() +
|
|
#' theme_civilytics()) |>
|
|
#' civilytics_logo() |>
|
|
#' grid.draw()
|
|
#'
|
|
#' # Top-right placement
|
|
#' (ggplot(mpg, aes(displ, hwy)) +
|
|
#' geom_point() +
|
|
#' theme_civilytics()) |>
|
|
#' civilytics_logo(position = "top-right") |>
|
|
#' grid.draw()
|
|
#'
|
|
#' # Bottom-left with mark
|
|
#' (ggplot(mpg, aes(displ, hwy)) +
|
|
#' geom_point() +
|
|
#' theme_civilytics()) |>
|
|
#' civilytics_logo(type = "mark", position = "bottom-left") |>
|
|
#' grid.draw()
|
|
#'
|
|
#' # Dark theme with mark in top-left
|
|
#' (ggplot(mpg, aes(displ, hwy)) +
|
|
#' geom_point() +
|
|
#' theme_civilytics_dark()) |>
|
|
#' civilytics_logo(variant = "dark", type = "mark",
|
|
#' position = "top-left") |>
|
|
#' grid.draw()
|
|
#' }
|
|
civilytics_logo <- function(plot,
|
|
type = c("wordmark", "mark"),
|
|
variant = c("light", "dark"),
|
|
position = c("bottom-right", "bottom-left",
|
|
"top-right", "top-left"),
|
|
margin_param = NULL,
|
|
font_scale = 1.1) {
|
|
position <- match.arg(position)
|
|
logo <- make_logo_grob(type = type, variant = variant, position = position)
|
|
add_logo(plot, logo, margin_param = margin_param, font_scale = font_scale,
|
|
position = position)
|
|
}
|
|
|