Experimental Pattern - Crosshatch using {grid}

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

Summary:

• perfomance: terrible
• crosshatch intersections look a lot nicer

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' @rdname create_pattern_none
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
create_pattern_crosshatch_via_grid <- function(params, boundary_df, aspect_ratio,
                                               legend = FALSE) {

  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # Create stripes in 1 direction
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  stripes_as_polygonGrob1 <- 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
  )

  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # Create stripes in other direction
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  stripes_as_polygonGrob2 <- create_stripes_as_polygonGrob(
    angle   = params$pattern_angle + 90,
    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)

  crosshatch_grob <- grobTree(
    stripes_as_polygonGrob1,
    stripes_as_polygonGrob2
  )

  crosshatch_grob <- gridGeometry::polyclipGrob(
    stripes_as_polygonGrob1, stripes_as_polygonGrob2,
    op = 'union'
  )

  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # Find the intersection of the boundary and the complete set of points
  # and convert it into matrix form
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  intersection_grob <- gridGeometry::polyclipGrob(
    boundary_grob, crosshatch_grob,
    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(gridcrosshatch = create_pattern_crosshatch_via_grid))


df <- data.frame(trt = c("a", "b", "c"), outcome = c(2.3, 1.9, 3.2))

p <- ggplot(df, aes(trt, outcome)) +
    geom_col_pattern(pattern = 'gridcrosshatch', fill='white', colour='black', pattern_spacing = 0.025) +
    theme_bw() +
    labs(title = "ggpattern::geom_col_pattern()") +
    theme(legend.key.size = unit(1.5, 'cm')) +
    coord_fixed(ratio = 1/2)

  # system.time({
  #   pdf("working/cross1.pdf")
  #   print(p)
  #   dev.off()
  # })