AmyMikhail
commented
4 months ago Another way of doing this is to modify the call to aes() and add groupings based on the individual row number in the data.frame. We start with a function that takes a ggplot geom_histogram object as input, adds groupings to the data and to the aes:
geom_squares <- function(plot) {
# Check if the plot uses geom_histogram
if (!("GeomBar" %in% class(plot$layers[[1]]$geom))) {
stop("The first layer of the input plot must be geom_histogram.")
}
# Make a deep copy of the plot:
plot2 = unserialize(serialize(plot, NULL))
# Add 'grouping' column to the plot data
plot2$data$grouping = as.numeric(row.names(plot2$data))
# Locate mapping and update aesthetics to include group = grouping:
if(!is.null(plot2$mapping)){
# Modify the base aesthetics:
plot2$mapping = modifyList(
plot2$mapping,
aes(group = grouping))
} else {
# Modify the aesthetics in layer 1 (call to geom_histogram()):
plot2$layers[[1]]$mapping = modifyList(
plot2$layers[[1]]$mapping,
aes(group = grouping))
}
# Add white borders to the squares:
plot2$layers[[1]]$aes_params = c(
plot2$layers[[1]]$aes_params,
colour = 'white'
)
# Make sure closure is appropriate for epicurve:
plot2$layers[[1]]$stat_params = c(
plot2$layers[[1]]$stat_params,
closed = 'left'
)
# Rebuild the plot
built = ggplot2::ggplot_build(plot2)
# Return the modified plot
return(plot2)
}
This function will work irrespective of whether the aesthetics are defined in the original call to ggplot() or in the first layer (call to geom_histogram()). It will also keep any other parameters that the user has added to the input plot (it just adds the groups and white borders).
Below some example data to test it on:
# Load required libraries:
pacman::p_load(tidyverse)
# Set seed for reproducibility:
set.seed(123)
# Set start date:
start_date <- as.Date("2024-01-01")
# Set end date:
end_date <- as.Date("2024-04-01")
# Create example data.frame:
data <- data.frame(
onset_date = sample(seq(start_date, end_date, by = "day"),
100,
replace = TRUE),
category = sample(c("A", "B"),
100,
replace = TRUE))
# Create epicurve_breaks
epicurve_breaks <- seq.Date(
from = start_date,
to = end_date,
by = "week")
To apply the function:
# Scenario 1: x and fill defined in ggplot() call
p1 <- ggplot(data,
mapping = aes(x = onset_date, fill = category)) +
geom_histogram(breaks = epicurve_breaks)
# Add squares to scenario 1 plot:
p1squared <- geom_squares(p1)
# Print the plot:
p1squared
# Scenario 2: x and fill defined in geom_histogram() layer
p2 <- ggplot(data) +
geom_histogram(mapping = aes(x = onset_date, fill = category),
breaks = epicurve_breaks)
# Add squares to scenario 2 plot:
p2squared <- geom_squares(p2)
# Print the plot:
p2squared
The only problem is the stacks are not ordered by fill column any more, see below:
Adapted from {incidence} but makes it possible to use directly with {ggplot2} maintaining the use of scale_x_date() functions. Seems to work dates or month (presumably works with whatever geom_histogram() is fed to it.... but need to add tests.
Also need to re-structure so can used it with the ggplot2 + rather than %>%