Quicker hatching

[ellispatrick]

We might be able to do faster hatching using ggpatterns. Below is some prelim code. The main development would be defining nice looking hatching patterns with what is available. Their defaults aren't great for our purposes.

library(ggpattern)
library(tidySingleCellExperiment)
library(class)


######## Map predicted regions to a regular grid
#' @importFrom class knn
#' @importFrom grid linesGrob gpar gList
#' @importFrom spatstat.geom as.mask
regionGrid <- function(pp, nbp = 250) {
  ow <- pp$window
  m <- spatstat.geom::as.mask(ow, dimyx = c(nbp, nbp))$m
  x <-
    seq(
      from = ow$xrange[1],
      to = ow$xrange[2],
      length.out = nrow(m)
    )
  y <-
    seq(
      from = ow$yrange[1],
      to = ow$yrange[2],
      length.out = ncol(m)
    )
  grid <- expand.grid(x = x, y = y)
  grid <- data.frame(x = grid[, 1], y = grid[, 2])
  df <- as.data.frame(pp)
  k <- rep(NA, length(m))
  K <-
    class::knn(
      train = df[, c("x", "y")],
      test = grid[t(m)[seq_len(length(m))],],
      cl = pp$region,
      k = 1
    )
  k[t(m)[seq_len(length(m))]] <- as.character(K)
  data.frame(grid, regions = k)
}


######## Convert grid of regions into a polygon mask for a particular region.
#' @importFrom spatstat.geom owin as.polygonal
regionPoly <- function(grid, region) {
  rx <- range(grid$x)
  ry <- range(grid$y)
  mat <-
    matrix(
      grid$regions == region,
      nrow = length(unique(grid$x)),
      ncol = length(unique(grid$y)),
      byrow = TRUE
    )
  mat[is.na(mat)] <- FALSE
  ow <- spatstat.geom::owin(xrange = rx,
                            yrange = ry,
                            mask = mat)
  return(spatstat.geom::as.polygonal(ow))
}


data("kerenSPE", package = "StatialBioc2023")
set.seed(51773)
# Preparing features for lisaClust
kerenSPE <- lisaClust::lisaClust(kerenSPE, k = 5)


# Filter colData to image 6
coords  <- kerenSPE |>
  filter(imageID == 6) |>
  colData()

# Set some parameters
window <- "convex"
nbp <- 300

# Make the window for the ppp
ow <- makeWindow(coords, window)

# Create a ppp
pp <-
  spatstat.geom::ppp(coords$x,
                     coords$y,
                     window = ow,
                     marks = coords$region)

pp$region <- pp$marks
pp$cellType <- coords$cellType

# Convert to mask
rG <- regionGrid(pp, nbp)

# Convert grids for each region into polygons and create columns that 
# identify each polygon and the region it belongs to.
tree <- sapply(unique(pp$region), function(y){
  rPoly <- regionPoly(rG, y)
  rPoly <- lapply(rPoly$bdry, function(x){
    data.frame(x)
  })
  rPoly <- bind_rows(rPoly, .id = "id")
  }, simplify = FALSE) |>
  bind_rows(.id = "region") |>
  mutate(group = paste(region, id, sep = "_"))

# Make the plot. 
# The key parameter is fill = NA which allows to see the cells.
# We would need to make some nice hatching patterns and better spacings etc.
p1 <- ggplot() +
  geom_point(data = data.frame(coords), aes(x,y, colour = cellType))+
  geom_polygon_pattern(data = tree,
    aes(x, y, group = group, pattern = region, pattern_angle = region), 
        colour          = 'black', 
        pattern_density = 0.05, 
        pattern_spacing = 0.02,
        pattern_size = 0.05,
        fill    = NA,
        pattern_colour  = 'black'
    ) + theme_bw(18)
    
p1