空间转录组共定位展示分析图

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()