Merge pull request #32 from boyiguo1/v1.3.1

V1.3.1

NAMESPACE

@@ -4,7 +4,9 @@ S3method(make_escheR,SingleCellExperiment)
 S3method(make_escheR,SpatialExperiment)
 S3method(make_escheR,data.frame)
 export(add_fill)
+export(add_fill_bin)
 export(add_ground)
+export(add_ground_bin)
 export(add_symbol)
 export(make_escheR)
 importFrom(SingleCellExperiment,reducedDim)
@@ -14,17 +16,23 @@ importFrom(SpatialExperiment,scaleFactors)
 importFrom(SpatialExperiment,spatialCoords)
 importFrom(SummarizedExperiment,colData)
 importFrom(ggplot2,aes)
+importFrom(ggplot2,after_stat)
+importFrom(ggplot2,coord_fixed)
 importFrom(ggplot2,element_blank)
 importFrom(ggplot2,element_text)
 importFrom(ggplot2,geom_point)
 importFrom(ggplot2,ggplot)
+importFrom(ggplot2,scale_color_discrete)
+importFrom(ggplot2,scale_fill_gradient)
 importFrom(ggplot2,scale_fill_viridis_c)
 importFrom(ggplot2,scale_fill_viridis_d)
 importFrom(ggplot2,scale_shape)
 importFrom(ggplot2,scale_y_reverse)
+importFrom(ggplot2,stat_summary_hex)
 importFrom(ggplot2,theme)
 importFrom(ggplot2,theme_bw)
 importFrom(ggplot2,theme_set)
+importFrom(ggplot2,theme_void)
 importFrom(ggplot2,unit)
 importFrom(ggplot2,xlab)
 importFrom(ggplot2,ylab)

R/add_fill_bin.R

@@ -0,0 +1,26 @@
+#' @param bins numeric vector giving number of bins in both vertical and
+#'             horizontal directions. Set to 30 by default.
+#'
+#' @rdname add_fill
+#' @export
+#' @importFrom ggplot2 stat_summary_hex scale_fill_gradient after_stat
+add_fill_bin <- function(
+    p,
+    var,
+    bins = 30,
+    point_size = 2.8,
+    ...){
+  p +
+    stat_summary_hex(
+      aes(z = !!sym(var), fill = after_stat(value)),
+      color = "transparent",
+      geom = "point",
+      shape = 21,
+      size = 2.8,
+      fun = sum,
+      bins = bins
+    ) +
+    scale_fill_gradient(name = var)
+}
+
+utils::globalVariables("value")

R/add_group_bin.R

@@ -0,0 +1,35 @@
+#' @param bins numeric vector giving number of bins in both vertical and
+#'             horizontal directions. Set to 30 by default.
+#' @param ... Reserved for future arguments.
+#'
+#' @rdname add_ground
+#' @export
+#' @importFrom ggplot2 scale_color_discrete
+add_ground_bin <- function(
+    p,
+    var,
+    bins = 30,
+    stroke = 1,
+    point_size = 3
+    ,...){
+  p +
+    stat_summary_hex(
+    aes(
+      z = !!sym(var),
+      group = -1,
+      color = after_stat(value),
+      fill = after_stat(rep(NA_integer_, length(value)))
+    ),
+    geom = "point",
+    shape = 21,
+    size = point_size,
+    stroke = stroke,
+    # Majority Voting
+    fun = function(x){
+      ll <- data.frame(table(x))
+      as.character(ll[which.max(ll$Freq),"x"])
+    },
+    bins = bins
+  ) +
+    scale_color_discrete(name = var)
+}

R/make_escheR.R

@@ -140,7 +140,8 @@ make_escheR.SingleCellExperiment <- function(
 #' @rdname make_escheR
 #' @importFrom rlang .data
 #' @importFrom ggplot2 aes element_blank element_text geom_point ggplot
-#' @importFrom ggplot2 scale_shape theme theme_bw theme_set unit xlab ylab scale_y_reverse
+#' @importFrom ggplot2 scale_shape theme theme_bw theme_set unit xlab ylab
+#' @importFrom ggplot2 scale_y_reverse coord_fixed theme_void
 #' @importFrom SpatialExperiment imgRaster spatialCoords scaleFactors
 #' @export
 #'

vignettes/more_than_visium.Rmd

@@ -33,6 +33,8 @@ library(scran)
 
 spe <- Visium_humanDLPFC() |> 
   logNormCounts()
+spe <- spe[, spe$in_tissue == 1]
+spe <- spe[, !is.na(spe$ground_truth)]
 top.gene <- getTopHVGs(spe, n=500)
 
 set.seed(100) # See below.
@@ -46,6 +48,74 @@ make_escheR(
   theme_minimal()
 ```
 
+# Hex Binning
+```{r}
+spe$counts_MOBP <- counts(spe)[which(rowData(spe)$gene_name=="MOBP"),]
+spe$ground_truth <- factor(spe$ground_truth)
+# Hex Binning version
+# make_escheR(
+#   spe,
+#   dimred = "PCA"
+# ) +
+#   # Create hex binning
+# stat_summary_hex(
+#   aes(z = ground_truth, group = -1, color = after_stat(value), fill = after_stat(rep(NA_integer_, length(value)))
+#       ),
+#   linewidth = 1.2,
+#   fun = function(x){
+#     # browser()
+#     ll <- data.frame(table(x))
+#     as.character(ll[which.max(ll$Freq),"x"])
+#   }, bins = 30
+# ) +
+# # Create hex binning
+# stat_summary_hex(
+#    aes(z = counts_MOBP, fill = after_stat(value)),
+#    color = "transparent",
+#    fun = sum, bins = 30) +
+#   scale_size_area
+
+
+# Point Binning version
+make_escheR(
+  spe,
+  dimred = "PCA"
+) |> 
+  add_ground_bin(
+    var = "ground_truth") |> 
+  add_fill_bin(
+    var = "counts_MOBP"
+  ) +
+   scale_fill_gradient(low = "white", high = "black", name = "MOBP Count")+
+  scale_color_discrete(name = "Spatial Domains") +
+  theme_minimal()
+
+# 
+#   stat_summary_hex(
+#     aes(z = ground_truth, group = -1, color = after_stat(value), fill = after_stat(rep(NA_integer_, length(value)))
+#     ),
+#     geom = "point",
+#     shape = 21,
+#     size = 3,
+#     stroke = 1,
+#     # linewidth = 1.2,
+#     fun = function(x){
+#       # browser()
+#       ll <- data.frame(table(x))
+#       as.character(ll[which.max(ll$Freq),"x"])
+#     }, bins = 30
+#   ) +
+#   stat_summary_hex(
+#     aes(z = counts_MOBP, fill = after_stat(value)),
+#     color = "transparent",
+#     geom = "point",
+#     shape = 21,
+#     size = 2.8,
+#     fun = sum, bins = 30)
+```
+> Note 1: The strategy of binning to avoid overplotting is previously proposed in [`schex`](https://www.bioconductor.org/packages/release/bioc/html/schex.html). While we provide an impelmentation in `escheR`, we would caution our users that the binning strategy could lead to intermixing of cluster memberships. In our impelmentation, the majority membership of the datapoints belonging to a bin is selected as the label. Users should use the binning strategy under their own discretion, and interpret the visualization carefully. 
+> Note 2: `add_fill_bin()` shoudl be applied after `add_ground_bin()` for the better visualization outcome.
+
 # Image-based `SpatialExperiment` Object
 To demonstrate the principle that `escheR` can be used to visualize image-based spatially-resolved data pending optimization, we include two image-based spatially resolved transcriptomics data generated via seqFish platform and Slide-seq V2 platform respectively. The two datasets have been previously curated in the [`STexampleData`](https://bioconductor.org/packages/release/data/experiment/vignettes/STexampleData/inst/doc/STexampleData_overview.html) package