作者，Evil Genius
关于空间共定位（细胞和配受体）的展示方式已经提供了好几种了，列在下面，供大家参考
这一篇我们来展示最后一种共定位的方式，如下图
同样的做法，我们可以展示细胞类型的共定位或者配受体的共定位，右图体现了共定位的趋势，我们来实现以下，我随便选了两种细胞类型，绘图结果如下;
当然了，随机选择的不太合适，绘图的时候同样需要多种颜色一起搭配，真正共定位效果强的绘图效果会非常好，我们来实现一下：
suppressMessages({
library(Seurat)
library(dplyr)
library(ggplot2)
})
cortex_sp = readRDS(spatial_rds)
一样的内容，如果展示细胞类型的空间共定位就需要包含单细胞空间联合的分析信息，然后提取有效信息。
decon_mtrx = t(cortex_sp@assays$predictions@data)
cell_types_all <- colnames(decon_mtrx)[which(colnames(decon_mtrx) != "max")]
decon_df <- decon_mtrx %>%
data.frame(check.names = F) %>%
tibble::rownames_to_column("barcodes")
#decon_df$barcodes = rownames(tmp)
cortex_sp@meta.data <- cortex_sp@meta.data %>%
tibble::rownames_to_column("barcodes") %>%
dplyr::left_join(decon_df, by = "barcodes") %>%
tibble::column_to_rownames("barcodes")
###plot dot
slice <- names(cortex_sp@images)[1]
metadata_ds <- data.frame(cortex_sp@meta.data)
colnames(metadata_ds) <- colnames(cortex_sp@meta.data)
cell_types_interest <- cell_types_all
metadata_ds <- metadata_ds %>% tibble::rownames_to_column("barcodeID") %>%
dplyr::mutate(rsum = base::rowSums(.[, cell_types_interest,
drop = FALSE])) %>% dplyr::filter(rsum != 0) %>%
dplyr::select("barcodeID") %>% dplyr::left_join(metadata_ds %>%
tibble::rownames_to_column("barcodeID"), by = "barcodeID") %>%
tibble::column_to_rownames("barcodeID")
spatial_coord <- data.frame(cortex_sp@images[[slice]]@coordinates) %>%
tibble::rownames_to_column("barcodeID") %>% dplyr::mutate(imagerow_scaled = imagerow *
cortex_sp@images[[slice]]@scale.factors$lowres, imagecol_scaled = imagecol *
cortex_sp@images[[slice]]@scale.factors$lowres) %>% dplyr::inner_join(metadata_ds %>%
tibble::rownames_to_column("barcodeID"), by = "barcodeID")
接下来我们绘图,相比于之前的图，这个图比较复杂
knn = 6
pair=c("IIa","IIb")
pt.size=2
alpha.min=0.1
max.cut=0.95
####选择两种细胞类型
LRpair = c('IIa','IIb')
location = spatial_coord[,c('imagerow','imagecol')]
topn=floor(0.2*dim(location)[1])
expr = spatial_coord[,LRpair]
ncell<-dim(expr)[1]
nnmatrix<-RANN::nn2(location,k=knn)$nn.idx
countsum<-Matrix::colSums(expr)
####normalize
expr<-Matrix::t(log(Matrix::t(expr)/countsum*median(countsum)+1))
ligand<-expr[,LRpair[1]]
receptor<-expr[,LRpair[2]]
LRexp<-rbind(ligand,receptor)
neighexp<-apply(nnmatrix,1,function(x){apply(LRexp[,x[2:knn]],1,max)})
LRadd<-pmax(LRexp[1,]*neighexp[2,],LRexp[2,]*neighexp[1,])
LRadd_max<-quantile(LRadd,probs=max.cut)
LRadd[LRadd>LRadd_max]<-LRadd_max
if(sum(ligand>0)>topn){n1<-order(ligand,sample(ncell,ncell),decreasing=T)[1:topn]}else{n1<-which(ligand>0)}
if(sum(receptor>0)>topn){n2<-order(receptor,sample(ncell,ncell),decreasing=T)[1:topn]}else{n2<-which(receptor>0)}
expcol<-rep(0,ncell)
expcol[n1]<-1
expcol[n2]<-2
expcol[intersect(n1,n2)]<-3
tmp<-data.frame(x=location[,1],y=location[,2],Exp=as.factor(expcol))
tmpLRadd<-data.frame(x=location[,1],y=location[,2],LR=LRadd)
alpha=(LRadd-min(LRadd))/(max(LRadd)-min(LRadd))*(1-alpha.min)+alpha.min
绘图
p1<-ggplot(tmp,aes(x=x,y=y,col=Exp))+geom_point(size=pt.size)+scale_color_manual(values=c("gray","red","green","blue"),labels=c("Bothlow","IIa_high","IIb_High","BothHigh"))+ggtitle(paste0(LRpair,collapse="_"))+xlab("")+ylab("")+theme(axis.line=element_blank(),axis.text.x=element_blank(),axis.text.y=element_blank(),axis.ticks.x=element_blank(),axis.ticks.y=element_blank()) + theme_minimal() + theme(axis.text = element_blank(),axis.title = element_blank(),panel.grid = element_blank())
p2<-ggplot(tmpLRadd,aes(x=x,y=y,col=LR))+geom_point(size=pt.size,alpha=alpha)+scale_color_gradient2(midpoint=quantile(LRadd,probs=0.5),low="gray",high="red",mid="gray")+xlab("")+ylab("")+theme(axis.line=element_blank(),axis.text.x=element_blank(),axis.text.y=element_blank(),axis.ticks.x=element_blank(),axis.ticks.y=element_blank())+labs(color="colocalization") + theme_minimal() + theme(axis.text = element_blank(),axis.title = element_blank(),panel.grid = element_blank())
p1+p2&scale_y_reverse()
调整成共定位效果强的pair图片效果会好很多
生活很好，有你更好
网友评论