In edward130603/BayesSpace: Clustering and Resolution Enhancement of Spatial Transcriptomes

Make hex sticker

Make spot grid

7 rows x (6 or 7) columns of hexes assigned to three clusters.

Each hex is regular, oriented vertically (vertices at top and bottom center, and left/right sides parallel to y-axis), and is 1 unit wide (measured from edge to edge).

suppressPackageStartupMessages({
  library(dplyr)
  library(ggplot2)
})

# First, make grids of hex centers.
make_grid <- function(nx, ny) {
    xs <- seq_len(nx)
    ys <- seq_len(ny)
    pos <- expand.grid(xs, ys)
    colnames(pos) <- c("x.pos", "y.pos")
    pos
}

n <- 7

# Make two grids, one for rows with 6 hexes and one for rows with 7
# then interleave by offsetting y coordinates
pos1 <- make_grid(n, floor(n/2))
pos2 <- make_grid(n - 1, ceiling(n/2))
pos1$y.pos <- pos1$y.pos * 2
pos2$y.pos <- (pos2$y.pos - 1) * 2 + 1

# Sort by column then by row, and assign cluster labels
positions <- rbind(pos1, pos2)
positions <- arrange(positions, y.pos, x.pos)
positions$spot <- seq_len(nrow(positions))
positions$cluster <- c(3, 3, 1, 1, 2, 2,
                      3, 3, 3, 1, 1, 1, 2,
                       3, 3, 1, 1, 1, 2, 
                      1, 1, 3, 1, 1, 2, 2,
                       1, 1, 3, 1, 2, 2,
                      1, 1, 3, 1, 1, 2, 2,
                       1, 1, 1, 2, 2, 2)

# R = circumradius, distance from center to vertex
# r = inradius, distance from center to edge midpoint
r <- 1/2
R <- (2 / sqrt(3)) * r

# Offset rows with 7 clusters by 0.5
idx <- positions$y.pos %% 2 == 0
positions[idx, "x.pos"] <- positions[idx, "x.pos"] - 0.5

# Shift centers up so rows are adjacent
positions[, "y.pos"] <- positions[, "y.pos"] * R * (3/2)

# vertices of each hex (with respect to center coordinates)
# start at top center, loop clockwise
hex_vertices <- data.frame(x.offset=c(0, r, r, 0, -r, -r),
                           y.offset=c(-R, -R/2, R/2, R, R/2, -R/2))

# Compute vertex coordinates in frame of plot
poly_positions <- merge(positions, hex_vertices)
poly_positions$x.vertex = poly_positions$x.pos + poly_positions$x.offset
poly_positions$y.vertex = poly_positions$y.pos + poly_positions$y.offset

Subspot outlines for all spots.

# Make lists of triangle vertices (with respect to hex center)
tri_offsets <- do.call(rbind, list(
    data.frame(x.offset=c(0, 0, r), y.offset=c(0, -R, -R/2), subspot=1),
    data.frame(x.offset=c(0, r, r), y.offset=c(0, -R/2, R/2), subspot=2),
    data.frame(x.offset=c(0, r, 0), y.offset=c(0, R/2, R), subspot=3),
    data.frame(x.offset=c(0, 0, -r), y.offset=c(0, R, R/2), subspot=4),
    data.frame(x.offset=c(0, -r, -r), y.offset=c(0, R/2, -R/2), subspot=5),
    data.frame(x.offset=c(0, -r, 0), y.offset=c(0, -R/2, -R), subspot=6)
    ))

# Define subspot coordinates for all hex centers
tri_positions <- merge(positions, tri_offsets)
tri_positions$x.vertex = tri_positions$x.pos + tri_positions$x.offset
tri_positions$y.vertex = tri_positions$y.pos + tri_positions$y.offset
tri_positions$subspot.id <- paste0(tri_positions$spot, ".", tri_positions$subspot)

Pick a few spots for enhancement. Assign clusters to subspots, and plot the enhanced spots over the regular spots.

tri_spots <- c(2, 4, 10, 38, 34, 42)
tri_positions[tri_positions$spot == 2, "cluster"] <- rep(c(3, 1, 3, 3, 3, 3), each=3)
tri_positions[tri_positions$spot == 4, "cluster"] <- rep(c(1, 1, 1, 3, 1, 1), each=3)
tri_positions[tri_positions$spot == 10, "cluster"] <- rep(c(3, 3, 1, 1, 1, 1), each=3)
tri_positions[tri_positions$spot == 38, "cluster"] <- rep(c(2, 2, 2, 2, 1, 2), each=3)
tri_positions[tri_positions$spot == 34, "cluster"] <- rep(c(3, 3, 1, 1, 3, 1), each=3)
tri_positions[tri_positions$spot == 42, "cluster"] <- rep(c(2, 2, 1, 2, 1, 3), each=3)

tri_pos <- tri_positions[tri_positions$spot %in% tri_spots, ]

Fill in around the upper vertices and sides so there are no gaps within the hex sticker.

corners <- data.frame(x.pos=c(3.5, 3.5), 
                      y.pos=c(0 * R * 3/2, (n+1) * R * 3/2),
                      cluster=c(1, 2),
                      spot=c(1, 2))
corners <- data.frame(x.pos=c(2.5, 3.5, 4.5, 2.5, 3.5, 4.5), 
                      y.pos=rep(c(0 * R * 3/2, (n+1) * R * 3/2), each=3),
                      cluster=c(1, 1, 2, 1, 2, 2),
                      spot=seq_len(6))
corner_positions <- merge(corners, hex_vertices)

sides <- data.frame(x.pos=c(0, 0, 7, 7),
                    y.pos=rep(c(3 * R * 3/2, 5  * R * 3/2), 2),
                    cluster=c(1, 1, 2, 2),
                    spot=seq_len(4) + 6)
side_positions <- merge(sides, hex_vertices)

corner_positions <- rbind(corner_positions, side_positions)
corner_positions$x.vertex = corner_positions$x.pos + corner_positions$x.offset
corner_positions$y.vertex = corner_positions$y.pos + corner_positions$y.offset

Remove parts that stick out past hex sticker border.

x_vertices = c(3.5, 7, 7, 3.5, 0, 0, 3.5)
y_vertices = c(-1, 2.5, 9.5, 13, 9.5, 2.5, -1) * R
border <- data.frame(x=x_vertices, y=y_vertices, cluster=3, spot=1)

in_hex <- Vectorize(function(x, y) {
  # boundary check needs a bit of buffer
  stat <- sp::point.in.polygon(c(x), c(y), x_vertices, y_vertices + c(0, 0, r, r, r, 0, 0))  
  return(stat > 0)
})

poly_pos2 <- poly_positions %>% filter(in_hex(x.vertex, y.vertex))
corner_pos2 <- corner_positions %>% filter(in_hex(x.vertex, y.vertex))

Make plot of spot hexes.

palette <- c("#264653", "#E76F51", "#E9C46A")
enhanced.color <- "#F4A261"

# https://coolors.co/3d5a80-98c1d9-e0fbfc-ee6c4d-293241
palette <- c("#293241", "#3D5A80", "#A82E10")
palette <- c("#293241", "#3D5A80", "#95290E")
# palette <- c("#293241", "#3D5A80", "#83240C")
enhanced.color <- "#98C1D9"

# https://coolors.co/5f0f40-9a031e-fb8b24-e36414-0f4c5c
# palette <- c("#5F0F40", "#0F4C5C", "#9A031E")
# enhanced.color <- "#FB8B24"

label <- data.frame(x=c(3.5), y=c(-3.5), label="BayesSpace")

hexplot <- ggplot(data=poly_pos2, aes(x=x.vertex, y=-y.vertex, group=spot, fill=factor(cluster))) + 
    # geom_polygon(data=border, aes(x=x, y=-y), fill="#000000") +
    geom_polygon() +
    geom_polygon(data=corner_pos2) +
    geom_polygon(data=tri_pos, aes(group=subspot.id), color=enhanced.color, size=1) +
    coord_equal() +
    scale_fill_manual(values=palette) +
    guides(fill=FALSE, color=FALSE) +
    theme_void() +
    hexSticker::theme_transparent()

    # TODO: figure out how to add shadow text
    # annotate("text", 3.5, -3.5, 
    #          hjust="middle", vjust="center", 
    #          label="BayesSpace", 
    #          family="alata",
    #          color="#FFFFFF", size=10) +
    # shadowtext::shadowtextGrob("BayesSpace", 3.5, -3.5)

hexplot

sysfonts::font_add_google("Alata", "alata")

Make sticker!

family <- "alata"
scale <- 2.19

p.color <- "#E0FBFC"
fname <- "logo.png"

# p.color <- enhanced.color
# fname <- "BayesSpace_logo_alt.png"

s <- hexSticker::sticker(hexplot, package="BayesSpace", 
             p_family=family, p_size=22, 
             s_x=1, s_y=1, s_width=1.3*scale, s_height=1*scale,
             p_y=1,
             p_color=p.color,
             h_color=enhanced.color, h_size=2,
             filename=fname) +

# overwrite file with better size
ggsave(fname, width=(6/1.1547005), height=6, bg="transparent")
s

edward130603/BayesSpace documentation built on Oct. 23, 2024, 7:04 a.m.