Figure S4 HiRES
Figure S4 HiRES showcases the geomeTriD package,
demonstrating how it presents 3D models along with multiple genomic
signals mapped onto single-cell 3D structures.
Present single cell 3D structure for HiRES data
This dataset was generated using HiRES, an assay that
stands for “Hi-C and RNA-seq employed simultaneously.” HiRES enables the
simultaneous profiling of single-cell Hi-C and RNA-seq data. The
resulting Hi-C data can be used to predict 3D genome structures using
Dip-C, and the corresponding RNA-seq data can be visualized
along these structures using the geomeTriD package.
## load data for HiRES
extdata <- system.file('extdata', 'GSE223917', package = 'geomeTriD.documentation')
HiRES <- readRDS(file.path(extdata, 'HiRES.radial_glias.G1.chrX.rds')) # Dip-C predicted 3D structure
exprs <- readRDS(file.path(extdata, 'expr.radial_glias.G1.chrX.rds'))# RNA-seq data
pairs <- readRDS(file.path(extdata, 'sel.imput.pairs.chrX.rds')) # selected impute pairs
### supperloop
supperloops <- GRanges(c('chrX:50555744-50635321',
'chrX:75725458-75764699', # 4933407K13RiK, NR_029443
'chrX:103422010-103484957',
'chrX:105040854-105117090')) # 5530601H04RiK, NR_015467 and Pbdc1
names(supperloops) <- c('Firre', 'Dxz4', 'Xist/Tsix', 'x75')
supperloops$label <- names(supperloops)
supperloops$col <- 2:5 ## set colors for each element
supperloops$type <- 'gene' ## set it as gene
## plot region
range <- as(seqinfo(TxDb.Mmusculus.UCSC.mm10.knownGene)['chrX'], 'GRanges')
## annotations
genes <- genes(TxDb.Mmusculus.UCSC.mm10.knownGene)## 66 genes were dropped because they have exons located on both strands of the
## same reference sequence or on more than one reference sequence, so cannot be
## represented by a single genomic range.
## Use 'single.strand.genes.only=FALSE' to get all the genes in a GRangesList
## object, or use suppressMessages() to suppress this message.
genes_symbols <- mget(genes$gene_id, org.Mm.egSYMBOL, ifnotfound = NA)
genes$symbols <- sapply(genes_symbols, `[`, i=1)
geneX <- genes[seqnames(genes)=='chrX']
geneX$label <- geneX$symbols
geneX <- geneX[geneX$symbols %in% rownames(exprs)]
## get data for female, must have mat and pat info for chromosome X.
HiRES.mat <- lapply(HiRES, function(.ele) {
.ele <- .ele[.ele$parental=='(mat)']
.ele$parental <- NULL
.ele
})
HiRES.pat <- lapply(HiRES, function(.ele) {
.ele <- .ele[.ele$parental=='(pat)']
.ele$parental <- NULL
.ele
})
## remove the cells without chrX structures
l.mat <- lengths(HiRES.mat)
l.pat <- lengths(HiRES.pat)
k <- l.mat>0 & l.pat>0
HiRES.mat <- HiRES.mat[k]
HiRES.pat <- HiRES.pat[k]
# Make all GRanges object in a list same length by filling with NA
HiRES <- paddingGRangesList(c(HiRES.mat, HiRES.pat))
HiRES.mat.xyzs <- HiRES$xyzs[seq_along(HiRES.mat)]
HiRES.pat.xyzs <- HiRES$xyzs[-seq_along(HiRES.mat)]
## prepare the maternal and paternal GRanges object with x, y, z coordinates.
HiRES.mat <- lapply(HiRES.mat.xyzs, function(.ele){
gr <- HiRES$gr
mcols(gr) <- .ele[, c('x', 'y', 'z')]
gr
})
HiRES.pat <- lapply(HiRES.pat.xyzs, function(.ele){
gr <- HiRES$gr
mcols(gr) <- .ele[, c('x', 'y', 'z')]
gr
})
## backbone color
resolution <- 3
backbone_colors <- matlab.like2(n=resolution*length(HiRES.mat[[1]]))
backbone_bws <- backbone_colors ## defines the color assigned to the chrX allele
backbone_bws[1001:(length(backbone_colors)-1000)] <- 'gray'
## help function to check the volume of the 3D structure
getV <- function(points){
vol <- convhulln(points, options='Fa')$vol
}
## calculate the Root Mean Square Deviation (RMSD)
RMSD_mat_pat <- mapply(function(mat, pat){
mat <- as.data.frame(mcols(mat))
pat <- as.data.frame(mcols(pat))
mat <- fill_NA(mat)
pat <- fill_NA(pat)
pat <- alignCoor(pat, mat) # do alignment first
## normalized to its centroid
mat.center <- colMeans(mat, na.rm = TRUE)
pat.center <- colMeans(pat, na.rm = TRUE)
mat <- t(t(mat) - mat.center)
pat <- t(t(pat) - pat.center)
mean(sqrt(rowSums((mat - pat)^2)), na.rm = TRUE)
}, HiRES.mat, HiRES.pat)
## data frame for Xist expression level, total expression level and
## the RMSD between mat and pat
XlinkExpr <- data.frame(Xist=exprs['Xist', ], total=colSums(exprs), RMSD=RMSD_mat_pat)
XlinkExpr <- XlinkExpr[order(XlinkExpr$total), ]
## plot the correlation between RMSD and total chrX expression level
fit <- lm(RMSD ~ total, data = XlinkExpr)
plot(XlinkExpr$total, XlinkExpr$RMSD,
xlab='Total expression level of X-lined gene',
ylab='RMSD between maternal and paternal')
abline(fit, col = "blue", lwd=2)
widgets <- lapply(c(head(rownames(XlinkExpr), n=2),
tail(rownames(XlinkExpr), n=2)), function(cell_id){
## expressions in single cell
exprSig <- geneX
exprSig$score <- exprs[geneX$symbols, cell_id]
## load the 3D structure for maternal and paternal
mat_cell <- HiRES.mat[[cell_id]]
mcols(mat_cell) <- fill_NA(as.data.frame(mcols(mat_cell)))
pat_cell <- HiRES.pat[[cell_id]]
mcols(pat_cell) <- fill_NA(as.data.frame(mcols(pat_cell)))
## check the volumn of the chrX,
## bigger one is Xa
## condensed one is Xi
v_mat <- getV(as.matrix(mcols(mat_cell)))
v_pat <- getV(as.matrix(mcols(pat_cell)))
## add additional information,
## Here we use the selected interactions by impute phases for maternal
mat_only_pairs <- pairs$mat[[cell_id]]
mat_only_pairs$color <- 'black'
mat_only_pairs$lwd <- 4
mat_cell <- view3dStructure(mat_cell,
feature.gr=supperloops,
lwd.gene = 4,
renderer = 'none',
region = range,
resolution=resolution,
genomicSigs = if(v_mat>v_pat) {
list(mat_rna_reads=exprSig, mat_pairs=mat_only_pairs)
} else {list(mat_pairs=mat_only_pairs)},
signalTransformFun = c,
reverseGenomicSigs = FALSE,
show_coor=FALSE,
lwd.backbone = 0.25,
col.backbone = if(v_mat>v_pat) backbone_bws else backbone_colors)
## and paternal only interactions by impute phases
pat_only_pairs <- pairs$pat[[cell_id]]
pat_only_pairs$color <- 'black'
pat_only_pairs$lwd <- 4
pat_cell <- view3dStructure(pat_cell,
feature.gr=supperloops,
lwd.gene = 4,
renderer = 'none',
region = range,
resolution=resolution,
genomicSigs = if(v_mat<=v_pat) {
list(pat_rna_reads=exprSig, pat_pairs=pat_only_pairs)
} else {list(pat_pairs=pat_only_pairs)},
signalTransformFun = c,
reverseGenomicSigs = FALSE,
show_coor=FALSE,
lwd.backbone = 0.25,
col.backbone = if(v_mat>v_pat) backbone_colors else backbone_bws)
# widget <-showPairs(mat_cell, pat_cell, title = paste(c('mat', 'pat'), cell_id))
# tempfile <- paste0('cell.', cell_id, '.html')
# htmlwidgets::saveWidget(widget, file=tempfile, selfcontained = FALSE, libdir = 'js')
showPairs(mat_cell, pat_cell,
title = paste(c('mat', 'pat'), cell_id),
height=NULL)
})
## low expression of X-linked genes
widgets[[1]]
#widgets[[2]]
## high expression of X-linked genes
#widgets[[3]]
widgets[[4]]SessionInfo
## R version 4.5.1 (2025-06-13)
## Platform: x86_64-pc-linux-gnu
## Running under: Ubuntu 24.04.2 LTS
##
## Matrix products: default
## BLAS: /usr/lib/x86_64-linux-gnu/openblas-pthread/libblas.so.3
## LAPACK: /usr/lib/x86_64-linux-gnu/openblas-pthread/libopenblasp-r0.3.26.so; LAPACK version 3.12.0
##
## 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
##
## time zone: Etc/UTC
## tzcode source: system (glibc)
##
## attached base packages:
## [1] grid stats4 stats graphics grDevices utils datasets
## [8] methods base
##
## other attached packages:
## [1] geometry_0.5.2
## [2] org.Mm.eg.db_3.21.0
## [3] TxDb.Mmusculus.UCSC.mm10.knownGene_3.10.0
## [4] GenomicFeatures_1.61.4
## [5] AnnotationDbi_1.71.0
## [6] Biobase_2.69.0
## [7] colorRamps_2.3.4
## [8] GenomicRanges_1.61.1
## [9] Seqinfo_0.99.1
## [10] IRanges_2.43.0
## [11] S4Vectors_0.47.0
## [12] BiocGenerics_0.55.0
## [13] generics_0.1.4
## [14] geomeTriD.documentation_0.0.5
## [15] geomeTriD_1.3.15
##
## loaded via a namespace (and not attached):
## [1] BiocIO_1.19.0 bitops_1.0-9
## [3] filelock_1.0.3 tibble_3.3.0
## [5] R.oo_1.27.1 XML_3.99-0.18
## [7] rpart_4.1.24 lifecycle_1.0.4
## [9] httr2_1.1.2 aricode_1.0.3
## [11] globals_0.18.0 lattice_0.22-7
## [13] ensembldb_2.33.1 MASS_7.3-65
## [15] backports_1.5.0 magrittr_2.0.3
## [17] Hmisc_5.2-3 sass_0.4.10
## [19] rmarkdown_2.29 jquerylib_0.1.4
## [21] yaml_2.3.10 plotrix_3.8-4
## [23] Gviz_1.53.1 DBI_1.2.3
## [25] RColorBrewer_1.1-3 abind_1.4-8
## [27] R.utils_2.13.0 AnnotationFilter_1.33.0
## [29] biovizBase_1.57.1 RCurl_1.98-1.17
## [31] rgl_1.3.24 nnet_7.3-20
## [33] VariantAnnotation_1.55.1 rappdirs_0.3.3
## [35] grImport_0.9-7 listenv_0.9.1
## [37] parallelly_1.45.0 pkgdown_2.1.3
## [39] codetools_0.2-20 DelayedArray_0.35.2
## [41] xml2_1.3.8 tidyselect_1.2.1
## [43] UCSC.utils_1.5.0 farver_2.1.2
## [45] matrixStats_1.5.0 BiocFileCache_2.99.5
## [47] base64enc_0.1-3 GenomicAlignments_1.45.1
## [49] jsonlite_2.0.0 trackViewer_1.45.1
## [51] progressr_0.15.1 Formula_1.2-5
## [53] systemfonts_1.2.3 dbscan_1.2.2
## [55] tools_4.5.1 progress_1.2.3
## [57] ragg_1.4.0 strawr_0.0.92
## [59] Rcpp_1.1.0 glue_1.8.0
## [61] gridExtra_2.3 SparseArray_1.9.0
## [63] xfun_0.52 MatrixGenerics_1.21.0
## [65] GenomeInfoDb_1.45.7 dplyr_1.1.4
## [67] fastmap_1.2.0 latticeExtra_0.6-30
## [69] rhdf5filters_1.21.0 digest_0.6.37
## [71] R6_2.6.1 textshaping_1.0.1
## [73] colorspace_2.1-1 jpeg_0.1-11
## [75] dichromat_2.0-0.1 biomaRt_2.65.0
## [77] RSQLite_2.4.1 R.methodsS3_1.8.2
## [79] data.table_1.17.8 rtracklayer_1.69.1
## [81] prettyunits_1.2.0 InteractionSet_1.37.0
## [83] httr_1.4.7 htmlwidgets_1.6.4
## [85] S4Arrays_1.9.1 pkgconfig_2.0.3
## [87] gtable_0.3.6 blob_1.2.4
## [89] XVector_0.49.0 htmltools_0.5.8.1
## [91] ProtGenerics_1.41.0 clue_0.3-66
## [93] scales_1.4.0 png_0.1-8
## [95] knitr_1.50 rstudioapi_0.17.1
## [97] rjson_0.2.23 checkmate_2.3.2
## [99] magic_1.6-1 curl_6.4.0
## [101] cachem_1.1.0 rhdf5_2.53.1
## [103] stringr_1.5.1 parallel_4.5.1
## [105] foreign_0.8-90 restfulr_0.0.16
## [107] desc_1.4.3 pillar_1.11.0
## [109] vctrs_0.6.5 RANN_2.6.2
## [111] dbplyr_2.5.0 cluster_2.1.8.1
## [113] htmlTable_2.4.3 evaluate_1.0.4
## [115] cli_3.6.5 compiler_4.5.1
## [117] Rsamtools_2.25.1 rlang_1.1.6
## [119] crayon_1.5.3 future.apply_1.20.0
## [121] interp_1.1-6 fs_1.6.6
## [123] stringi_1.8.7 deldir_2.0-4
## [125] BiocParallel_1.43.4 txdbmaker_1.5.6
## [127] Biostrings_2.77.2 lazyeval_0.2.2
## [129] Matrix_1.7-3 BSgenome_1.77.1
## [131] hms_1.1.3 bit64_4.6.0-1
## [133] future_1.58.0 ggplot2_3.5.2
## [135] Rhdf5lib_1.31.0 KEGGREST_1.49.1
## [137] SummarizedExperiment_1.39.1 igraph_2.1.4
## [139] memoise_2.0.1 bslib_0.9.0
## [141] bit_4.6.0