R Notebook
print(sessionInfo())## R version 4.0.3 (2020-10-10)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Debian GNU/Linux 9 (stretch)
##
## Matrix products: default
## BLAS: /usr/local/lib64/R-4.0.3/lib/libRblas.so
## LAPACK: /usr/local/lib64/R-4.0.3/lib/libRlapack.so
##
## locale:
## [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C
## [3] LC_TIME=en_US.UTF-8 LC_COLLATE=en_US.UTF-8
## [5] LC_MONETARY=en_US.UTF-8 LC_MESSAGES=en_US.UTF-8
## [7] LC_PAPER=en_US.UTF-8 LC_NAME=C
## [9] LC_ADDRESS=C LC_TELEPHONE=C
## [11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## loaded via a namespace (and not attached):
## [1] digest_0.6.31 R6_2.5.1 jsonlite_1.8.4 evaluate_0.20
## [5] cachem_1.0.7 rlang_1.1.1 cli_3.6.1 rstudioapi_0.13
## [9] jquerylib_0.1.4 bslib_0.4.2 rmarkdown_2.21 tools_4.0.3
## [13] xfun_0.39 yaml_2.3.7 fastmap_1.1.1 compiler_4.0.3
## [17] htmltools_0.5.5 knitr_1.42 sass_0.4.5library(SpaTalk)## Loading required package: ggalluvial## Loading required package: ggplot2## Loading required package: doParallel## Loading required package: foreach## Loading required package: iterators## Loading required package: parallellibrary(anndata)
setwd("/home/linbu/AMB/")
download.file("https://figshare.com/ndownloader/files/38738136", destfile = "AMB_HC.h5ad")
download.file("https://figshare.com/ndownloader/files/42786751", destfile = "HC1_transfer_to_AMB.csv")
#adata_sc = read_h5ad('/home/linbu/AMB/AMB_HC.h5ad')
adata_sc = read_h5ad(paste0(getwd(), '/AMB_HC.h5ad'))
#sc2st_transfer = read.csv('/home/linbu/AMB/HC1_transfer_to_AMB.csv', row.names = 1)
sc2st_transfer = read.csv(paste0(getwd(), '/HC1_transfer_to_AMB.csv'), row.names = 1)select = (sc2st_transfer[['simp_name']] != 'nan') & as.logical(sc2st_transfer[['ClosestSC']]) & (sc2st_transfer[['Dis2ClosestBead']] < 15)
print(sum(select))## [1] 7156sc2st_transfer = sc2st_transfer[select, ]
adata_sc = adata_sc[row.names(sc2st_transfer)]library(Matrix)
st_meta = data.frame(cell = row.names(sc2st_transfer),
x = sc2st_transfer$xcoord,
y = sc2st_transfer$ycoord)
obj_st <- createSpaTalk(st_data = as.matrix(t(adata_sc$X),
dimnames = list(adata_sc$var_names,
adata_sc$obs_names)),
st_meta = st_meta,
species = "Mouse",
if_st_is_sc = T,
spot_max_cell = 1,
celltype = sc2st_transfer$simp_name)## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.3 GiB## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.1 GiB## Warning in createSpaTalk(st_data = as.matrix(t(adata_sc$X), dimnames =
## list(adata_sc$var_names, : celltype of CA3 Principal cells, CA1 Principal
## cells, Dentate hilum, Medial entorhinal cortex, Dentate Principal cells, CA2
## Principal cells, Lateral CA3 Principal cells, Anterior Subiculum, Entorhinal
## cortex, Deep layer subiculum, and Resident macrophage have been replaced by
## CA3_Principal_cells, CA1_Principal_cells, Dentate_hilum,
## Medial_entorhinal_cortex, Dentate_Principal_cells, CA2_Principal_cells,
## Lateral_CA3_Principal_cells, Anterior_Subiculum, Entorhinal_cortex,
## Deep_layer_subiculum, and Resident_macrophageobj_st <- find_lr_path(object = obj_st, lrpairs = lrpairs, pathways = pathways)## Checking input data
## Begin to filter lrpairs and pathways
## ***Done***print(unique(obj_st@meta[["rawmeta"]][["celltype"]]))## [1] "CA3_Principal_cells" "CA1_Principal_cells"
## [3] "Dentate_hilum" "Medial_entorhinal_cortex"
## [5] "Interneuron" "Dentate_Principal_cells"
## [7] "CA2_Principal_cells" "Subiculum"
## [9] "Lateral_CA3_Principal_cells" "Anterior_Subiculum"
## [11] "Entorhinal_cortex" "Deep_layer_subiculum"
## [13] "Neuron" "Endothelial_Stalk"
## [15] "Oligodendrocyte" "Astrocyte"
## [17] "Ependymal" "Polydendrocyte"
## [19] "Mural" "Endothelial_Tip"
## [21] "Neurogenesis" "Postsubiculum"
## [23] "MyelinProcesses" "Microglia"
## [25] "Resident_macrophage"# Infer cell-cell communications
obj_st <- dec_cci_all(object = obj_st)## Note: there are 25 cell types and 600 pair-wise cell pairs
## Begin to find LR pairssave_cci_result = function(cci_output_dir = 'AMB_MH/cci_result/'){
if (!dir.exists(cci_output_dir)){
dir.create(cci_output_dir)
} else {
print("Dir already exists!")
}
write.csv(obj_st@lrpair, paste0(cci_output_dir, 'st_lrpair.csv'))
saveRDS(obj_st@cellpair, file = paste0(cci_output_dir, 'st_cellpair.RData'))
write.csv(obj_st@tf, paste0(cci_output_dir, 'st_tf.csv'))
saveRDS(obj_st@lr_path, file = paste0(cci_output_dir, 'st_lr_path.RData'))
saveRDS(obj_st@para, file = paste0(cci_output_dir, 'st_para.RData'))
}
save_cci_result('AMB_MH/cci_result_closest/')## [1] "Dir already exists!"obj_temp <- createSpaTalk(st_data = as.matrix(t(adata_sc$X),
dimnames = list(adata_sc$var_names,
adata_sc$obs_names)),
st_meta = st_meta,
species = "Mouse",
if_st_is_sc = T,
spot_max_cell = 1,
celltype = sc2st_transfer$simp_name)## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.3 GiB## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.1 GiB## Warning in createSpaTalk(st_data = as.matrix(t(adata_sc$X), dimnames =
## list(adata_sc$var_names, : celltype of CA3 Principal cells, CA1 Principal
## cells, Dentate hilum, Medial entorhinal cortex, Dentate Principal cells, CA2
## Principal cells, Lateral CA3 Principal cells, Anterior Subiculum, Entorhinal
## cortex, Deep layer subiculum, and Resident macrophage have been replaced by
## CA3_Principal_cells, CA1_Principal_cells, Dentate_hilum,
## Medial_entorhinal_cortex, Dentate_Principal_cells, CA2_Principal_cells,
## Lateral_CA3_Principal_cells, Anterior_Subiculum, Entorhinal_cortex,
## Deep_layer_subiculum, and Resident_macrophageload_cci_result = function(obj = obj_temp, cci_output_dir = 'AMB_MH/cci_result/'){
st_lrpair = read.csv(paste0(cci_output_dir, 'st_lrpair.csv'), row.names = 1)
st_cellpair = readRDS(paste0(cci_output_dir, 'st_cellpair.RData'))
st_tf = read.csv(paste0(cci_output_dir, 'st_tf.csv'), row.names = 1)
st_lr_path = readRDS(paste0(cci_output_dir, 'st_lr_path.RData'))
st_para = readRDS(paste0(cci_output_dir, 'st_para.RData'))
obj@lrpair = st_lrpair
obj@cellpair = st_cellpair
obj@tf = st_tf
obj@lr_path = st_lr_path
obj@para = st_para
}
load_cci_result(obj_temp, 'AMB_MH/cci_result_closest/')st_lrpair_sorted = obj_st@lrpair[order(obj_st@lrpair$score, decreasing = TRUE),]
head(st_lrpair_sorted, 20)obj_lr_path <- get_lr_path(object = obj_st,
celltype_sender = 'Astrocyte',
celltype_receiver = 'Interneuron',
ligand = 'Bmp7',
receptor = 'Bmpr2')
obj_lr_path$tf_path# Point plot with spatial distribution of celltype_sender and celltype_receiver
output_dir = 'AMB_MH/figures_closest/'
if (!dir.exists(output_dir)){
dir.create(output_dir)
} else {
print("Dir already exists!")
}## [1] "Dir already exists!"png(file=paste0(output_dir, "SDist_sender_receiver.png"),
width=10000, height=8000, pointsize =12, res = 200)
plot_ccdist(object = obj_st,
celltype_sender = 'Astrocyte',
celltype_receiver = 'Interneuron',
size = 2,
arrow_length = 0.08)
dev.off()## png
## 2plot_ccdist(object = obj_st,
celltype_sender = 'Astrocyte',
celltype_receiver = 'Interneuron',
size = 0.2,
arrow_length = 0.01)
png(file=paste0(output_dir, "cci_lrpairs.png"),
width=800, height=680, pointsize = 12, res = 150)
plot_cci_lrpairs(object = obj_st, celltype_sender = 'Astrocyte', celltype_receiver = 'Interneuron', fontsize_number = 20)
dev.off()## png
## 3# Heatmap with LR pairs of celltype_sender and celltype_receiver
plot_cci_lrpairs(object = obj_st, celltype_sender = 'Astrocyte', celltype_receiver = 'Interneuron')png(file=paste0(output_dir, "SDist_sender_receiver_LRpair.png"),
width=10000, height=8000, pointsize =12, res = 200)
plot_lrpair(object = obj_st,
celltype_sender = 'Astrocyte',
ligand = 'Hbegf',
celltype_receiver = 'Interneuron',
receptor = 'Erbb4',
if_plot_density = T,
size = 2,
arrow_length = 0.08)
dev.off()## png
## 2# Point plot with LR pair from celltype_sender to celltype_receiver
plot_lrpair(object = obj_st,
celltype_sender = 'Astrocyte',
ligand = 'Hbegf',
celltype_receiver = 'Interneuron',
receptor = 'Erbb4',
if_plot_density = T,
size = 0.2,
arrow_length = 0.01)
png(file=paste0(output_dir, "cci_spatial_dis.png"),
width=800, height=680, pointsize = 12, res = 150)
vln = plot_lrpair_vln(object = obj_st,
celltype_sender = 'Astrocyte',
ligand = 'Hbegf',
celltype_receiver = 'Interneuron',
receptor = 'Erbb4')##
## Wilcoxon rank sum test with continuity correction
##
## data: celltype_dist1 and celltype_dist2
## W = 6.8583e+10, p-value < 2.2e-16
## alternative hypothesis: true location shift is greater than 0vln
dev.off()## png
## 2# Violin plot with spatial distance of LR pair between senders and receivers and between all cell-cell pairs
vln
options(ggrepel.max.overlaps = Inf)
png(file=paste0(output_dir, "SDist_pathway.png"),
width=2500, height=2000, pointsize =12, res = 150)
pathway_plot = plot_lr_path(object = obj_st,
celltype_sender = 'Astrocyte',
ligand = 'Hbegf',
celltype_receiver = 'Interneuron',
receptor = 'Erbb4',
color = c('cornflowerblue', 'burlywood'),
size = 5)
pathway_plot
dev.off()## png
## 2# Plot network with LR and downstream pathways
pathway_plot
png(file=paste0(output_dir, "SDist_sender_path2gene.png"),
width=2500, height=2000, pointsize =12, res = 160)
path2gene_plot = plot_path2gene(object = obj_st,
celltype_sender = 'Astrocyte',
ligand = 'Hbegf',
celltype_receiver = 'Interneuron',
receptor = 'Erbb4')
path2gene_plot
dev.off()## png
## 2# River plot of significantly activated pathways and related downstream genes of receptors
path2gene_plot
Neuron and Interneuron (Score: 0.99999)
# Violin plot with spatial distance of LR pair between senders and receivers and between all cell-cell pairs
plot_lrpair_vln(object = obj_st,
celltype_sender = 'Neuron',
ligand = 'Adam17',
celltype_receiver = 'Interneuron',
receptor = 'Erbb4')##
## Wilcoxon rank sum test with continuity correction
##
## data: celltype_dist1 and celltype_dist2
## W = 54499728, p-value < 2.2e-16
## alternative hypothesis: true location shift is greater than 0
CA1 principal cells and Neuron (Score: 0.69)
# Violin plot with spatial distance of LR pair between senders and receivers and between all cell-cell pairs
plot_lrpair_vln(object = obj_st,
celltype_sender = 'Neuron',
ligand = 'Fyn',
celltype_receiver = 'Interneuron',
receptor = 'Thy1')##
## Wilcoxon rank sum test with continuity correction
##
## data: celltype_dist1 and celltype_dist2
## W = 2.0994e+11, p-value < 2.2e-16
## alternative hypothesis: true location shift is greater than 0
getwd()## [1] "/isilonsund/NextGenSeqData/project-data/linbu/CoreFacility/SpaTalk"The preview shows you a rendered HTML copy of the contents of the editor. Consequently, unlike Knit, Preview does not run any R code chunks. Instead, the output of the chunk when it was last run in the editor is displayed.