library(ggplot2)
library(ggpattern)
#>
#> Attaching package: 'ggpattern'
#> The following objects are masked from 'package:ggplot2':
#>
#> flip_data, flipped_names, gg_dep, has_flipped_aes, remove_missing,
#> should_stop, waiver
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' Create a sf MULTIPOLYGON object where each polygon is an individual stripe.
#'
#' The stripes are created as polygons so that when clipped to rects/polygons,
#' the ends of the stripe are clipped correctly to the boundary.
#'
#' @inheritParams create_circles_grob
#'
#' @return `sf` multipolygon object
#'
#' @import sf
#' @importFrom utils tail
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
create_stripes_as_polygonGrob <- function(angle=45, spacing=0.1, density=0.3, xoffset=0, yoffset=0,
aspect_ratio) {
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Clearly distinguise:
# - The user supplies the stripe angle.
# - We determine the spine angle
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
stripe_angle <- ( angle %% 180)
spine_angle <- ((angle + 90) %% 180)
angle <- NULL
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Should the spine start at the bottom left or the bottom right?
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if (spine_angle < 90) {
spine_origin <- c(xoffset, yoffset)
} else {
spine_origin <- c(1 + xoffset, yoffset)
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Convert angles to radians
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
stripe_angle <- stripe_angle * pi/180
spine_angle <- spine_angle * pi/180
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# aspect ratio will determine maximum line length
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if (aspect_ratio < 1) {
ll <- 1/aspect_ratio
} else {
ll <- aspect_ratio
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Hypotenuse
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ll <- sqrt(ll*ll + 1)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# We are going to create stripes that begin and end outside the viewport
# no matter what the angle. Make them long, and then we'll truncate them
# later when we intersect with the area to be shaded
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
rib_offset <- c(ll * cos(stripe_angle), ll * aspect_ratio * sin(stripe_angle))
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Create a spine. As we walk along the spine we'll extend stripes out
# at right angles.
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
spine_end <- c(spine_origin[1] + ll * cos(spine_angle),
spine_origin[2] + ll * aspect_ratio * sin(spine_angle))
Nribs <- ll/spacing
spine_mat <- cbind(
seq(spine_origin[1], spine_end[1], length.out = Nribs),
seq(spine_origin[2], spine_end[2], length.out = Nribs)
)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# One edge of the stripe is positioned x% of the way along, where this
# percent is controlled by the pattern_density
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
spine_offset <- c(density * spacing * cos(spine_angle),
density * spacing * sin(spine_angle) * aspect_ratio)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# We have enough now to construct a polygon for each stripe element
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
stripe_corner_a <- t(t(spine_mat) + rib_offset)
stripe_corner_b <- t(t(spine_mat) - rib_offset)
stripe_corner_c <- t(t(spine_mat) - rib_offset + spine_offset)
stripe_corner_d <- t(t(spine_mat) + rib_offset + spine_offset)
stripe_coords_full <- lapply(seq(nrow(stripe_corner_a)), function(i) {
coords <- rbind(
stripe_corner_a[i,],
stripe_corner_b[i,],
stripe_corner_c[i,],
stripe_corner_d[i,],
stripe_corner_a[i,]
)
cbind(coords, i)
})
stripe_coords <- do.call(rbind, stripe_coords_full)
grid::polygonGrob(
x = stripe_coords[,1],
y = stripe_coords[,2],
id = stripe_coords[,3]
)
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' @rdname create_pattern_none
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
create_pattern_stripes_via_grid <- function(params, boundary_df, aspect_ratio,
legend = FALSE) {
stripes_as_polygonGrob <- create_stripes_as_polygonGrob(
angle = params$pattern_angle,
spacing = params$pattern_spacing,
density = params$pattern_density,
xoffset = params$pattern_xoffset,
yoffset = params$pattern_yoffset,
aspect_ratio = aspect_ratio
)
boundary_grob <- convert_polygon_df_to_polygon_grob(boundary_df)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Find the intersection of the boundary and the complete set of points
# and convert it into matrix form
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
intersection_grob <- gridGeometry::polyclipGrob(
boundary_grob, stripes_as_polygonGrob,
gp = grid::gpar(
fill = scales::alpha(params$pattern_fill , params$pattern_alpha),
col = scales::alpha(params$pattern_colour, params$pattern_alpha),
lwd = params$pattern_lwd,
lty = params$pattern_linetype
)
)
intersection_grob
}
library(ggplot2)
library(dplyr)
#>
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#>
#> filter, lag
#> The following objects are masked from 'package:base':
#>
#> intersect, setdiff, setequal, union
library(ggpattern)
options(ggpattern_grid_funcs = list(gridstripes = create_pattern_stripes_via_grid))
plot_df <- mpg %>% filter(manufacturer %in% c('lincoln', 'mercury', 'audi'))
# plot_df <- mpg %>% filter(manufacturer %in% c('mercury'))
ggplot(plot_df, aes(x = manufacturer)) +
geom_bar_pattern(
aes(
pattern_fill = manufacturer
),
pattern = 'gridstripes',
fill = 'white',
colour = 'black',
pattern_density = 0.3,
pattern_spacing = 0.01,
pattern_alpha = 0.3,
pattern_colour = NA,
pattern_angle = 60,
# pattern_xoffset = 0.07,
pattern_key_scale_factor = 1.2
) +
theme_bw() +
labs(title = "ggpattern::geom_bar_pattern()") +
scale_pattern_density_discrete() +
# scale_pattern_manual(values = c(lincoln = 'gridstripes', mercury = 'gridstripes', audi = 'gridstripes')) +
theme(
legend.position = 'none'
# legend.justification = c(1, 1),
# legend.position = c(1, 1),
# legend.key.size = unit(3, 'cm')
) +
coord_fixed(ratio = 1/8) +
NULL
# system.time({
# print(p)
# })
#
#
# system.time({
# pdf("working/test-grid.pdf")
# print(p)
# dev.off()
# })