jared
41fe2b6170
R-CMD-check / R CMD check (push) Successful in 4m4s
The previous fix applied the plot's background to the logo grob directly, which made it opaque and covered caption/axis text that overlaps into the logo area via negative margins. Instead, wrap the entire arrangeGrob composition in a grobTree with a background rectGrob behind it. This fills transparent areas (logo strip, padding gaps) with the plot's background color while keeping the logo grob itself transparent so overlapping text remains visible.
364 lines
13 KiB
R
364 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)
|
|
|
|
# Capture the plot's background color so we can fill the entire composed
|
|
# grob with it. The logo grob must stay transparent (theme_void) so that
|
|
# caption/axis text overlapping via negative margins remains visible.
|
|
bg_fill <- plot$theme$plot.background$fill
|
|
|
|
# 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"))
|
|
}
|
|
composed <- 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"))
|
|
}
|
|
composed <- arrangeGrob(plot, logo, heights = c(0.93, 0.1),
|
|
padding = unit(0.1, "line"))
|
|
}
|
|
|
|
# Wrap with a full-bleed background rect so any transparent areas (the
|
|
# logo strip, padding gaps) pick up the plot's background color instead
|
|
# of the device default (white).
|
|
if (!is.null(bg_fill) && !is.na(bg_fill)) {
|
|
bg_rect <- grid::rectGrob(gp = grid::gpar(fill = bg_fill, col = NA))
|
|
grid::grobTree(bg_rect, composed)
|
|
} else {
|
|
composed
|
|
}
|
|
}
|
|
|
|
#' 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) {
|
|
# Capture the background color from the first plot
|
|
bg_fill <- plot_list[[1]]$theme$plot.background$fill
|
|
|
|
# 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)
|
|
}
|
|
|
|
composed <- arrangeGrob(hold, logo, heights = c(0.93, .07))
|
|
|
|
if (!is.null(bg_fill) && !is.na(bg_fill)) {
|
|
bg_rect <- grid::rectGrob(gp = grid::gpar(fill = bg_fill, col = NA))
|
|
grid::grobTree(bg_rect, composed)
|
|
} else {
|
|
composed
|
|
}
|
|
}
|
|
|
|
|
|
#' 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)
|
|
}
|
|
|