This vignette will cover the usage of cell-cell communication data from CellChat (Jin et al. 2021; Jin, Plikus, and Nie 2025) in spatial transcriptomics and plot ligant-receptor pairs in neighbors spots using PathwaySpace (Tercan et al. 2025; Ellrott et al. 2025) architecture.
This vignette uses preprocessed data from CellChat and Seurat (Hao et al. 2023), please see previous scripts.
# Load packages
library(RGraphSpace)
library(PathwaySpace)
library(dplyr)
library(igraph)
library(Seurat)
# Set the path of your working directory
path <- "D:/SpatialTranscriptomic_Doc/R_PROJECTS/Colon_VisiumHD/"
load(paste(path,"stxbrain_Normalized_GraphSpace.RData",sep=""))
spot_cellchat <- readRDS(paste(path,"spot-spot_commu_Allbrain.rds",sep=""))
# Set a reusable theme for spatial plots
spatial_theme <- theme_gspace_coords(theme = "th3", is_norm = TRUE,
xlab = "Spot coordinates 1", ylab = "Spot coordinates 2")
# Left: 'seurat_clusters' annotation overlaid on tissue image
cpal1 <- DiscretePalette(nlevels(gs$seurat_clusters), "polychrome")
ggplot(gs) +
annotation_gspace_image(gs) +
geom_nodespace(mapping = aes(colour = seurat_clusters), size=0.8, pch=19) +
scale_colour_discrete(palette = cpal1) +
theme_gspace_legend(discrete_colour = TRUE) +
spatial_theme
head(spot_cellchat)
#> # A tibble: 6 × 14
#> source_spot target_spot distance_um source target ligand receptor prob
#> <chr> <chr> <dbl> <chr> <chr> <chr> <chr> <dbl>
#> 1 AAACAAGTATCTCCC… ACTAGTTGCG… 99.5 s_1 s_1 Fgf1 Fgfr1 0.0144
#> 2 AAACAAGTATCTCCC… ACTAGTTGCG… 99.5 s_1 s_1 Fgf1 Fgfr2 0.0160
#> 3 AAACAAGTATCTCCC… ACTAGTTGCG… 99.5 s_1 s_1 Fgf1 Fgfr3 0.0243
#> 4 AAACAAGTATCTCCC… ACTAGTTGCG… 99.5 s_1 s_1 Gas6 Axl 0.00520
#> 5 AAACAAGTATCTCCC… ACTAGTTGCG… 99.5 s_1 s_1 Mdk Sdc4 0.0144
#> 6 AAACAAGTATCTCCC… ACTAGTTGCG… 99.5 s_1 s_1 Mdk Ptprz1 0.0317
#> # ℹ 6 more variables: pval <dbl>, interaction_name <fct>,
#> # interaction_name_2 <chr>, pathway_name <chr>, annotation <chr>,
#> # evidence <chr>
The proximityNetwork function receives a GraphSpace/PathwaySpace object with no edges and retrieves a GraphSpace/PathwaySpace object with edges between the nearest neighbor spots.
proximityNetwork <- function(gs){
# Get nodes slot from GraphSpace object
nodes <- gs@nodes
# Calculate the six most proximal neighbors of each spot, k=7 is set
# because the spot itself also is considered as a neighbor with dist=0.
# Eachs central spot is expected to have six neighbors due to the placement
# of the spots on Visium slides.
nnei = 6
nnpg <- RANN::nn2(nodes[,c("x","y")], nodes[,c("x","y")], k=nnei+1)
nn.dists <- as.data.frame(nnpg$nn.dists[,2:(nnei+1)])
nn.idx <- as.data.frame(nnpg$nn.idx[,2:(nnei+1)])
# The boundary spots are expected to have less than six neighbors, so the mean
# distance of the first neighbors is calculated to find witch edges should be included or not.
mdist<-1/(mean(1/nn.dists$V1))
nn.dmean <- nn.dists
message("Calculating the nearest neighbors distances...")
# Each spot have at least one neighbor
nn.dmean[,1]<-TRUE
cols <- 2:ncol(nn.dists)
nn.dmean[cols] <- (nn.dists[cols] >= 0.95 * mdist) &
(nn.dists[cols] <= 1.05 * mdist)
m_matrix <-nn.dmean * nn.idx
# The nn.dmean have the info of the edges that should be included in the graph.
# The nn.idx have the indices of the nodes.
# Now these data will be converted to a edge list compatible with igraph nomenclature.
message("Creating edges list...")
m_matrix$idx <- row.names(m_matrix)
edges_long <- tidyr::pivot_longer(m_matrix,names_to = "from",values_to = "to",cols = -idx)
edges_long <- edges_long %>% dplyr::select(-from) %>% dplyr::filter(to!=0)
colnames(edges_long) <- c("from","to")
if(sum(nn.dmean) != length(edges_long$from)){
message("Unexpected number of edges, something is depracated...")
stop()
}
# The graph of proximity have a undirected profile, so edges_long have several duplicate edges in "from-to" and "to-from".
edges_unique <- edges_long %>%
dplyr::mutate(
v1 = pmin(from, to),
v2 = pmax(from, to)
) %>%
dplyr::distinct(v1, v2) %>%
dplyr::transmute(
from = v1,
to = v2
)
edges_unique[] <- lapply(edges_unique, as.numeric)
message("Assigning spot names to edges...")
edges_unique$from <- nodes$name[edges_unique$from]
edges_unique$to <- nodes$name[edges_unique$to]
# Building the new igraph object with the selected edges
nodes <- nodes %>% dplyr::relocate(name) %>% dplyr::select(-vertex)
gs_graph <- igraph::graph_from_data_frame(
d = edges_unique,
vertices = nodes,
directed = FALSE
)
# Converting the igraph object to GraphSpace object
gs2 <- RGraphSpace::GraphSpace(gs_graph)
gs@edges <- gs2@edges
gs@graph <- gs_graph
return(gs)
}
# Plotting Visium dataset before inserting edges
ggplot(gs) +
annotation_gspace_image(gs) +
geom_edgespace() +
scale_colour_discrete(palette = cpal1) +
theme_gspace_legend(discrete_colour = TRUE) +
spatial_theme +
coord_cartesian(xlim=c(0.4,0.6), ylim = c(0.4,0.6)) +
geom_nodespace(mapping = aes(colour = seurat_clusters), size=3, pch=19)
# Insert edges to all nearest neighbors
gs <- proximityNetwork(gs)
#> Calculating the nearest neighbors distances...
#> Creating edges list...
#> Assigning spot names to edges...
#> Validating the 'igraph' object...
#> Creating a 'GraphSpace' object...
# Create a backup object
gs3<- gs
# Plotting Visium dataset after inserting edges
ggplot(gs) +
annotation_gspace_image(gs) +
geom_edgespace() +
scale_colour_discrete(palette = cpal1) +
theme_gspace_legend(discrete_colour = TRUE) +
spatial_theme +
coord_cartesian(xlim=c(0.4,0.6), ylim = c(0.4,0.6)) +
geom_nodespace(mapping = aes(colour = seurat_clusters), size=3, pch=19)
Cell-cell communications from CellChat are filtered by the proximity edges stored in the GraphSpace/PathwaySpace object. Thus, remain only cell-cell communications in which the ligand and the receptor are expressed in two neighbor spots.
# Build all ligand-receptor pairs in the proximity edges
edges <- gs@edges
merge_edges <- edges %>%
left_join(spot_cellchat,
by = c("name1" = "source_spot","name2" = "target_spot"))
merge_edges <- merge_edges %>% dplyr::select(-c(vertex1,vertex2))
merge_edges$arrowType <- 1
# Store unique ligand-receptor pairs
un_merge <- merge_edges %>% select(ligand,receptor,interaction_name) %>% unique()
un_merge <- na.omit(un_merge)
head(un_merge)
#> ligand receptor interaction_name
#> 1 Fgf1 Fgfr1 FGF1_FGFR1
#> 2 Fgf1 Fgfr2 FGF1_FGFR2
#> 3 Fgf1 Fgfr3 FGF1_FGFR3
#> 4 Gas6 Axl GAS6_AXL
#> 5 Mdk Sdc4 MDK_SDC4
#> 6 Mdk Ptprz1 MDK_PTPRZ1
# Get nodes slot from gs
nodes <- gs@nodes %>% dplyr::relocate(name) %>% dplyr::select(-vertex)
Here, each ligand-receptor pairs are plotted individually. Each iteration stores the specific ligand-receptor pair and filter edges from merge_edges that include the ligand and the receptor. These edges are used to update the GraphSpace object, removing unused edges and nodes from it. Thus, the object remain only with the neighbor nodes that express the ligand and/or the receptor.
Then, the PathwaySpace is built and the silhouette is calculated considering only the nodes involved in the cell-cell commmunication. In PathwaySpace it is possible to make only one projection per feature at time, so the ligand and receptor counts were summed up. The projection were used using vertex circularProjection() and each plot were saved.
l_vec<-length(un_merge$interaction_name)
#Setting l_vec to 5 only to avoid time consuming loop, please change it if you expect to visualize all ligand-receptor plots
l_vec <- 3
for (i in 1:l_vec) {
gs <- gs3
interest <- un_merge$interaction_name[i]
ligand <- un_merge$ligand[i]
receptor <- un_merge$receptor[i]
message("Iteration number:",i, " Interaction: ",interest)
if(grepl("_",receptor)){
message("Receptor with name out of standard")
next
}
sel_merge <- merge_edges %>% filter(interaction_name == interest)
nodes_sel <- unique(c(sel_merge$name1,sel_merge$name2))
nodes_sel <- nodes[nodes$name %in% nodes_sel,]
gs_graph <- igraph::graph_from_data_frame(
d = sel_merge,
vertices = nodes_sel,
directed = TRUE
)
# Converting the igraph object to GraphSpace object
gs2 <- RGraphSpace::GraphSpace(gs_graph)
gs@edges <- gs2@edges
gs@graph <- gs_graph
gs@nodes <-gs2@nodes
rm(sel_merge,nodes_sel,gs2)
# Create a PathwaySpace object
pspace_obj <- buildPathwaySpace(gs)
# Get distance to the nearest spot
nspot <- getNearestNode(pspace_obj)
pdist <- mean(nspot$dist) # average distance
# Add a graph silhouette to the PathwaySpace object
pspace_obj <- silhouetteMapping(pspace_obj, baseline = 0.1)
# Sum ligant and receptor signals
inter_data <- pspace_obj@fdata[,ligand]
inter_data <-inter_data[pspace_obj@nodes$name]
inter_data2 <- pspace_obj@fdata[,receptor]
inter_data2 <-inter_data2[pspace_obj@nodes$name]
inter_data <- inter_data +inter_data2
# Assign vertexSignal
vertexSignal(pspace_obj)<-inter_data
# Compute circularProjection
pspace_obj <- circularProjection(pspace_obj,
decay.fun=weibullDecay(decay=0.5, pdist = pdist),
aggregate.fun = signalAggregation("wmean"),
k=gs_vcount(pspace_obj))
g<-ggplot(pspace_obj) +
annotation_gspace_image(pspace_obj) +
annotation_pspace_signal(pspace_obj, si.alpha = 0.25) +
spatial_theme +
labs(title = interest)
print(g)
ggsave(paste("images/",interest,".png",sep=""),plot=g)
rm(pspace_obj)
gc()
}
#> Iteration number:1 Interaction: FGF1_FGFR1
#> Validating the 'igraph' object...
#> Creating a 'GraphSpace' object...
#> Validating arguments...
#> Creating a 'PathwaySpace' object...
#> Validating arguments...
#> Mapping graph silhouette...
#> Mapping 'x' and 'y' coordinates...
#> Silhouette: 28.06% of the landscape area!
#> Validating arguments...
#> Using circular projection...
#> Mapping 'x' and 'y' coordinates...
#> Running signal convolution...
#> Saving 7 x 5 in image
#> Iteration number:2 Interaction: FGF1_FGFR2
#>
#> Validating the 'igraph' object...
#> Creating a 'GraphSpace' object...
#> Validating arguments...
#> Creating a 'PathwaySpace' object...
#> Validating arguments...
#> Mapping graph silhouette...
#> Mapping 'x' and 'y' coordinates...
#> Silhouette: 19.89% of the landscape area!
#> Validating arguments...
#> Using circular projection...
#> Mapping 'x' and 'y' coordinates...
#> Running signal convolution...
#> Saving 7 x 5 in image
#> Iteration number:3 Interaction: FGF1_FGFR3
#>
#> Validating the 'igraph' object...
#> Creating a 'GraphSpace' object...
#> Validating arguments...
#> Creating a 'PathwaySpace' object...
#> Validating arguments...
#> Mapping graph silhouette...
#> Mapping 'x' and 'y' coordinates...
#> Silhouette: 20.94% of the landscape area!
#> Validating arguments...
#> Using circular projection...
#> Mapping 'x' and 'y' coordinates...
#> Running signal convolution...
#> Saving 7 x 5 in image
#> R version 4.5.3 (2026-03-11 ucrt)
#> Platform: x86_64-w64-mingw32/x64
#> Running under: Windows 11 x64 (build 26200)
#>
#> Matrix products: default
#> LAPACK version 3.12.1
#>
#> locale:
#> [1] LC_COLLATE=Portuguese_Brazil.utf8 LC_CTYPE=Portuguese_Brazil.utf8
#> [3] LC_MONETARY=Portuguese_Brazil.utf8 LC_NUMERIC=C
#> [5] LC_TIME=Portuguese_Brazil.utf8
#>
#> time zone: America/Sao_Paulo
#> tzcode source: internal
#>
#> attached base packages:
#> [1] stats graphics grDevices utils datasets methods base
#>
#> other attached packages:
#> [1] Seurat_5.5.1 SeuratObject_5.4.0 sp_2.2-1 igraph_2.3.3
#> [5] dplyr_1.2.1 PathwaySpace_1.4.1 RGraphSpace_1.4.1 ggplot2_4.0.3
#>
#> loaded via a namespace (and not attached):
#> [1] RColorBrewer_1.1-3 rstudioapi_0.19.0 jsonlite_2.0.0
#> [4] magrittr_2.0.5 spatstat.utils_3.2-3 ggbeeswarm_0.7.3
#> [7] farver_2.1.2 rmarkdown_2.31 ragg_1.5.2
#> [10] vctrs_0.7.3 ROCR_1.0-12 spatstat.explore_3.8-1
#> [13] htmltools_0.5.9 sass_0.4.10 sctransform_0.4.3
#> [16] parallelly_1.48.0 KernSmooth_2.23-26 bslib_0.11.0
#> [19] htmlwidgets_1.6.4 ica_1.0-3 plyr_1.8.9
#> [22] plotly_4.12.0 zoo_1.8-15 cachem_1.1.0
#> [25] mime_0.13 lifecycle_1.0.5 pkgconfig_2.0.3
#> [28] Matrix_1.7-4 R6_2.6.1 fastmap_1.2.0
#> [31] fitdistrplus_1.2-6 future_1.70.0 shiny_1.14.0
#> [34] digest_0.6.39 colorspace_2.1-2 ggnewscale_0.5.2
#> [37] patchwork_1.3.2 tensor_1.5.1 RSpectra_0.16-2
#> [40] irlba_2.3.7 textshaping_1.0.5 progressr_1.0.0
#> [43] spatstat.sparse_3.2-0 httr_1.4.8 polyclip_1.10-7
#> [46] abind_1.4-8 compiler_4.5.3 withr_3.0.3
#> [49] S7_0.2.2 fastDummies_1.7.6 MASS_7.3-65
#> [52] tools_4.5.3 vipor_0.4.7 lmtest_0.9-40
#> [55] otel_0.2.0 beeswarm_0.4.0 httpuv_1.6.17
#> [58] future.apply_1.20.2 goftest_1.2-3 glue_1.8.1
#> [61] nlme_3.1-168 promises_1.5.0 grid_4.5.3
#> [64] Rtsne_0.17 cluster_2.1.8.2 reshape2_1.4.5
#> [67] generics_0.1.4 gtable_0.3.6 spatstat.data_3.1-9
#> [70] tidyr_1.3.2 data.table_1.18.4 tidygraph_1.3.1
#> [73] utf8_1.2.6 spatstat.geom_3.8-1 RcppAnnoy_0.0.23
#> [76] ggrepel_0.9.8 RANN_2.6.2 pillar_1.11.1
#> [79] stringr_1.6.0 spam_2.11-4 RcppHNSW_0.7.0
#> [82] later_1.4.8 splines_4.5.3 lattice_0.22-9
#> [85] survival_3.8-6 deldir_2.0-4 tidyselect_1.2.1
#> [88] miniUI_0.1.2 pbapply_1.7-4 knitr_1.51
#> [91] gridExtra_2.3.1 scattermore_1.2 xfun_0.59
#> [94] matrixStats_1.5.0 stringi_1.8.7 lazyeval_0.2.3
#> [97] yaml_2.3.12 evaluate_1.0.5 codetools_0.2-20
#> [100] tibble_3.3.1 cli_3.6.6 uwot_0.2.4
#> [103] xtable_1.8-8 reticulate_1.46.0 systemfonts_1.3.2
#> [106] jquerylib_0.1.4 Rcpp_1.1.2 globals_0.19.1
#> [109] spatstat.random_3.5-0 png_0.1-9 ggrastr_1.0.2
#> [112] spatstat.univar_3.2-0 parallel_4.5.3 dotCall64_1.2
#> [115] listenv_1.0.0 viridisLite_0.4.3 scales_1.4.0
#> [118] ggridges_0.5.7 purrr_1.2.2 rlang_1.2.0
#> [121] cowplot_1.2.0