spatial autocorrelation
Ludvig Larsson
6/4/2020
library(zeallot)
library(ggplot2)
library(STutility)
library(spdep)
library(ggpubr)
load("~/workflowr/STUtility_web_site/pre_data/preSaved_10xHippo_norm_reductions_1_section.RData")Spatial autocorrelation
First we define a modified version of the CorSpatialGenes function from STutility to retrun the tablag matrix as well as the scaled gene expression matrix.
CorSpatialGenes <- function (
object,
assay = NULL,
slot = 'scale.data',
features = NULL,
nNeighbours = NULL,
maxdist = NULL
) {
st.object <- GetStaffli(object)
# Obtain data
if (is.null(features)) {
features <- VariableFeatures(object)
}
assay <- DefaultAssay(object)
data.use <- GetAssayData(object, slot = slot, assay = assay)
data.use <- data.use[features, ]
# Create a combined network for the samples
CN <- do.call(rbind, GetSpatNet(object = object, nNeighbours = nNeighbours, maxdist = maxdist))
resCN <- as.matrix(data.frame(reshape2::dcast(CN, formula = from ~ to, value.var = "distance", fill = 0), row.names = 1))
resCN[resCN > 0] <- 1
empty.CN <- matrix(0, nrow = ncol(data.use), ncol = ncol(data.use), dimnames = list(colnames(data.use), colnames(data.use)))
colnames(resCN) <- gsub(pattern = "\\.", replacement = "-", x = colnames(resCN))
colnames(resCN) <- gsub(pattern = "^X", replacement = "", x = colnames(resCN))
empty.CN[rownames(resCN), colnames(resCN)] <- resCN
listw <- mat2listw(empty.CN)
fun <- function (x) lag.listw(listw, x, TRUE)
# Calculate the lag matrix from the network
tablag <- do.call(rbind, lapply(1:nrow(data.use), function(i) {
fun(x = data.use[i, ])
}))
rownames(tablag) <- rownames(data.use)
colnames(tablag) <- colnames(data.use)
sp.cor <- unlist(lapply(1:nrow(data.use), function(i) {
cor(data.use[i, ], tablag[i, ])
}))
res <- data.frame(gene = rownames(data.use), cor = sp.cor, stringsAsFactors = F)
res <- res[order(sp.cor, decreasing = T), ]
rownames(res) <- res$gene
return(list(data.use, tablag, res))
}If we apply this to our normalized Seurat object, the spatial autocorrelation will be computed on the VariableFeatures defined during SCTransform. We can see how the genes rank based on spatial autocorrelation in the spatgenes data.frame.
c(data, tablag, spatgenes) %<-% CorSpatialGenes(se, features = rownames(se@assays$SCT@scale.data))Here I have selected 6 genes with an “autocorrelation” score above 0.8.
genes.use <- c("Mbp", "Slc6a3", "Tmsb4x", "Prkcd", "Trh", "Olfm1")
st.object <- GetStaffli(se)
gg <- do.call(rbind, lapply(seq_along(genes.use), function(i) {
cbind(data.frame(raw_expr = data[genes.use[i], ],
tablag_expr = tablag[genes.use[i], ],
gene = genes.use[i]), st.object@meta.data[, c("pixel_x", "pixel_y", "sample")])
}))
p.list <- lapply(genes.use, function(g) {
d <- subset(gg, gene %in% g & sample %in% "1")
p1 <- ggplot() +
geom_point(data = d, aes(pixel_x, 2000 - pixel_y, color = raw_expr)) +
facet_wrap(~sample) +
scale_color_gradientn(colours = rev(RColorBrewer::brewer.pal(n = 11, name = "RdBu")), limits = c(-max(abs(d$raw_expr)), max(abs(d$raw_expr)))) +
theme_void() +
theme(strip.text = element_blank(), plot.margin = margin(t = 1, r = 1, b = 0, l = 1, unit = "cm")) +
labs(title = paste0("scaled gene expression [", g, "]"), color = "")
p2 <- ggplot() +
geom_point(data = d, aes(pixel_x, 2000 - pixel_y, color = tablag_expr)) +
facet_wrap(~sample) +
scale_color_gradientn(colours = rev(RColorBrewer::brewer.pal(n = 11, name = "RdBu")), limits = c(-max(abs(d$tablag_expr)), max(abs(d$tablag_expr)))) +
theme_void() +
theme(strip.text = element_blank(), plot.margin = margin(t = 1, r = 1, b = 0, l = 1, unit = "cm")) +
labs(title = paste0("spatial lag of scaled gene expression [", g, "]"), color = "")
p3 <- ggplot() +
geom_point(data = d, aes(raw_expr, tablag_expr)) +
geom_smooth(data = d, aes(raw_expr, tablag_expr), method = lm) +
stat_cor(data = d, aes(raw_expr, tablag_expr)) +
theme_classic() +
theme(plot.margin = margin(t = 1, r = 1, b = 0, l = 1, unit = "cm")) +
labs(x = "scaled gene expression", y = "spatial lag of scaled gene expression", title = paste0("correlation between scaled gene expression \nand spatial lag of scaled gene expression [", g, "]"))
cowplot::plot_grid(p1, p2, p3, ncol = 3, rel_widths = c(1, 1, 1.2))
})## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'cowplot::plot_grid(plotlist = p.list, ncol = 1)