In ccb-hms/SpatialData: Collection of spatially resolved omics datasets

knitr::opts_chunk$set(
    collapse = TRUE,
    comment = "#>",
    crop = NULL ## Related to https://stat.ethz.ch/pipermail/bioc-devel/2020-April/016656.html
)

Setup

library(vroom)
library(SpatialExperiment)
library(ggpubr)

Start with downloading from and unzipping the dataset from: https://datadryad.org/stash/dataset/doi:10.5061/dryad.8t8s248

data.file <- "Moffitt_and_Bambah-Mukku_et_al_merfish_all_cells.csv"

Data

Def. hypothalamic preoptic region: is a part of the anterior hypothalamus that controls essential social behaviors and homeostatic functions.

Dimensions: 1,027,848 cells; 161 genes

Cell segmentation based on total polyadenylated mRNA and DAPI nuclei costains (where are the images?)

Genes: the original publication says: Combinatorial smFISH imaging was used to identify 135 genes, followed by sequential rounds of two-color FISH to identify 20 additional genes (but here we have 161 genes?)

dat <- vroom::vroom(data.file)
dat <- data.frame(dat)
dim(dat)
dat[1:5,1:5]
ind <- grep("Neuron_cluster_ID", colnames(dat))
genes <- colnames(dat)[(ind + 1):ncol(dat)]
genes
length(genes)

Note: we also have complementary scRNA-seq of ~31,000 cells dissociated and captured from the preoptic region of the hypothalamus from multiple male and female mice available on GEO (GSE113576).

1. Cell-by-gene matrix. Rows: genes; Cols: cells

exprs <- t(as.matrix(dat[,genes]))
dim(exprs)
exprs[1:5,1:5]

1. Cell metadata.

cdat <- dat[,seq_len(ind)]
head(cdat)

Data has been obtained from 36 mice (16 female, 20 male)

table(cdat$Animal_ID, cdat$Animal_sex)

Animal behavior by sex:

table(cdat$Behavior, cdat$Animal_sex)

Cell type assignment:

table(cdat$Cell_class)

Def. Bregma: The bregma is the anatomical point on the skull at which the coronal suture is intersected perpendicularly by the sagittal suture. Used here as a reference point for the twelve 1.8- by 1.8-mm imaged slices along the z-axis.

The anterior position of the preoptic region is at Bregma +0.26.

table(cdat$Bregma)

Some cosmetics on the column names

colnames(cdat)[c(2:3,5:7)] <- c("sample_id", "sex", "z", "x", "y")
colnames(cdat) <- tolower(colnames(cdat))

It figures that we need to center the data for each bregma slice:

sids <- unique(cdat$sample_id)
for(i in sids)
{
    ind <- cdat$sample_id == i
    ccdat <- cdat[ind,]
    spl <- split(ccdat, ccdat$z)

    for(i in seq_along(spl)) 
    {   
        spl[[i]]$x <- scale(spl[[i]]$x, scale = FALSE)
        spl[[i]]$y <- scale(spl[[i]]$y, scale = FALSE)
    }

    cdat[ind,] <- do.call(rbind, spl)
}

1. Construct SpatialExperiment:

spe <- SpatialExperiment(assays = list(exprs = exprs),
                         colData = cdat,
                         spatialCoordsNames = c("x", "y", "z"))
spe

1. Inspect SpatialExperiment:

assay(spe)[1:5,1:5]
colData(spe)
head(spatialCoords(spe))

1. Visualize as in Figure 3E of the paper for six different anterior-posterior positions from a single female mouse.

cdat <- subset(cdat, cell_class != "Ambiguous")
cdat$cell_class <- sub(" [1-4]$", "", cdat$cell_class)
cdat1 <- subset(cdat, sample_id == 1)
cdat1 <- subset(cdat1, z %in% c(0.26, 0.16, 0.06, -0.04, -0.14, -0.24))
cdat1$z <- as.character(cdat1$z)
zum <- paste(0:5 * 100, "um")
names(zum) <- as.character(c(0.26, 0.16, 0.06, -0.04, -0.14, -0.24))
cdat1$z <- unname(zum[cdat1$z]) 

pal <- ggpubr::get_palette("simpsons", 9)
names(pal) <- c("Endothelial", "Excitatory", "OD Immature", "Astrocyte", "Mural", 
                "Microglia", "Ependymal", "Inhibitory", "OD Mature")

ggpubr::ggscatter(cdat1, x = "x", y = "y", color = "cell_class", facet.by = "z",
                  shape = 20, size = 1, palette = pal) +
                  guides(color = guide_legend(override.aes = list(size = 3)))

ccb-hms/SpatialData documentation built on May 6, 2022, 4:53 a.m.