suppressPackageStartupMessages(library(ArchR))
#Load previous progress from ArchR Book Tutorial
#SEE https://www.archrproject.com/bookdown/index.html
load("Chapter-15-Trajectory.Rdata")
###############################################
# Plot UMAP from Book
###############################################
p <- plotEmbedding(ArchRProj=projHeme5, name = "Clusters2")
## ArchR logging to : ArchRLogs/ArchR-plotEmbedding-263067fd74dac-Date-2020-10-01_Time-13-00-08.log
## If there is an issue, please report to github with logFile!
## Getting UMAP Embedding
## ColorBy = cellColData
## Plotting Embedding
## 1
## ArchR logging successful to : ArchRLogs/ArchR-plotEmbedding-263067fd74dac-Date-2020-10-01_Time-13-00-08.log
p
###############################################
# Monocle3
###############################################
#Add Monocle Myeloid Trajectory
cdsMyeloid <- getMonocleTrajectories(
ArchRProj = projHeme5,
groupBy = "Clusters2",
clusterParams = list(k = 50),
useGroups = c("Progenitor", "GMP", "Mono"),
principalGroup = "Progenitor",
embedding = "UMAP"
)
## Running Monocole3 Trajectory Infrastructure!
## Adding Embedding
## Clustering Embedding
## Learning Graphs
##
|
| | 0%
|
|======================================================================| 100%
## Getting Principal Node
## Ordering Cells
## Warning: `select_()` is deprecated as of dplyr 0.7.0.
## Please use `select()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.
## Plotting Results - /oak/stanford/groups/howchang/users/jgranja/ArchRTutorial/ArchRBook/testBook2/HemeTutorial/Monocole3/Plot-Results-Trajectory.pdf
projHeme5 <- addMonocleTrajectory(
ArchRProj = projHeme5,
monocleCDS = cdsMyeloid,
name = "MonocleMyeloid",
groupBy = "Clusters2",
useGroups = c("Progenitor", "GMP", "Mono"),
force = TRUE
)
#Add Monocle Lymphoid Trajectory
cdsLymphoid <- getMonocleTrajectories(
ArchRProj = projHeme5,
groupBy = "Clusters2",
clusterParams = list(k = 50),
useGroups = c("Progenitor", "CLP", "PreB", "B"),
principalGroup = "Progenitor",
embedding = "UMAP"
)
## Running Monocole3 Trajectory Infrastructure!
## Adding Embedding
## Clustering Embedding
## Learning Graphs
##
|
| | 0%
|
|======================================================================| 100%
## Getting Principal Node
## Ordering Cells
## Plotting Results - /oak/stanford/groups/howchang/users/jgranja/ArchRTutorial/ArchRBook/testBook2/HemeTutorial/Monocole3/Plot-Results-Trajectory.pdf
projHeme5 <- addMonocleTrajectory(
ArchRProj = projHeme5,
monocleCDS = cdsLymphoid,
name = "MonocleLymphoid",
groupBy = "Clusters2",
useGroups = c("Progenitor", "CLP", "PreB", "B"),
force = TRUE
)
###############################################
# SlingShot
###############################################
#Add Monocle Lymphoid Trajectory
projHeme5 <- addSlingShotTrajectories(
ArchRProj = projHeme5,
groupBy = "Clusters2",
name = "SlingLymphoid",
useGroups = c("Progenitor", "CLP", "PreB", "B"),
principalGroup = "Progenitor",
embedding = "UMAP"
)
## Using full covariance matrix
#Add Monocle Myeloid Trajectory
projHeme5 <- addSlingShotTrajectories(
ArchRProj = projHeme5,
groupBy = "Clusters2",
name = "SlingMyeloid",
useGroups = c("Progenitor", "GMP", "Mono"),
principalGroup = "Progenitor",
embedding = "UMAP"
)
## Using full covariance matrix
###############################################
# Compare Lymphoid Trajectory Output
###############################################
#One To One Comparisons
dL <- data.frame(
ArchR = projHeme5$LymphoidU,
SlingShot = projHeme5$SlingLymphoid.Curve1,
Monocle = projHeme5$MonocleLymphoid,
Groups = projHeme5$Clusters2
)
corL <- cor(dL[, 1:3], use="complete.obs")
corL
## ArchR SlingShot Monocle
## ArchR 1.0000000 0.9969570 0.9815009
## SlingShot 0.9969570 1.0000000 0.9869325
## Monocle 0.9815009 0.9869325 1.0000000
#Plot One To One Comparisons
idx <- !is.na(rowSums(dL[,1:3])) #Remove NA rows
dL <- dL[idx, ,drop=FALSE]
p1 <- ggPoint(dL[,1], dL[,2], paste0(dL[,"Groups"]), pal = paletteDiscrete(projHeme5$Clusters2), xlabel="ArchR", ylabel="Sling", labelAsFactors=F, labelMeans=F)
p2 <- ggPoint(dL[,1], dL[,3], paste0(dL[,"Groups"]), pal = paletteDiscrete(projHeme5$Clusters2), xlabel="ArchR", ylabel="Mon",labelAsFactors=F, labelMeans=F)
p3 <- ggPoint(dL[,2], dL[,3], paste0(dL[,"Groups"]), pal = paletteDiscrete(projHeme5$Clusters2), xlabel="Sling", ylabel="Mon",labelAsFactors=F, labelMeans=F)
ggAlignPlots(p1,p2,p3,type="h")
#Plot Trajectories
p1 <- plotTrajectory(projHeme5, name = "LymphoidU", trajectory = "LymphoidU", imputeWeights = NULL, addArrow = FALSE)[[1]]
## ArchR logging to : ArchRLogs/ArchR-plotTrajectory-2630678463851-Date-2020-10-01_Time-13-00-52.log
## If there is an issue, please report to github with logFile!
## Plotting
## Warning: Removed 7682 rows containing non-finite values (stat_summary_hex).
## Plotting Trajectory
## ArchR logging successful to : ArchRLogs/ArchR-plotTrajectory-2630678463851-Date-2020-10-01_Time-13-00-52.log
p2 <- plotTrajectory(projHeme5, name = "SlingLymphoid.Curve1", trajectory = "SlingLymphoid.Curve1", imputeWeights = NULL, addArrow = FALSE)[[1]]
## ArchR logging to : ArchRLogs/ArchR-plotTrajectory-263062b4c33e3-Date-2020-10-01_Time-13-00-53.log
## If there is an issue, please report to github with logFile!
## Plotting
## Warning: Removed 7396 rows containing non-finite values (stat_summary_hex).
## Plotting Trajectory
## ArchR logging successful to : ArchRLogs/ArchR-plotTrajectory-263062b4c33e3-Date-2020-10-01_Time-13-00-53.log
p3 <- plotTrajectory(projHeme5, name = "MonocleLymphoid", trajectory = "MonocleLymphoid", imputeWeights = NULL, addArrow = FALSE)[[1]]
## ArchR logging to : ArchRLogs/ArchR-plotTrajectory-263064bed3993-Date-2020-10-01_Time-13-00-54.log
## If there is an issue, please report to github with logFile!
## Plotting
## Warning: Removed 7396 rows containing non-finite values (stat_summary_hex).
## Plotting Trajectory
## ArchR logging successful to : ArchRLogs/ArchR-plotTrajectory-263064bed3993-Date-2020-10-01_Time-13-00-54.log
ggAlignPlots(p1,p2,p3,type="h")
## Warning: Removed 7682 rows containing non-finite values (stat_summary_hex).
## Warning: Removed 7396 rows containing non-finite values (stat_summary_hex).
## Warning: Removed 7396 rows containing non-finite values (stat_summary_hex).
###############################################
# Compare Myeloid Trajectory Output
###############################################
#One To One Comparisons
dM <- data.frame(
ArchR = projHeme5$MyeloidU,
SlingShot = projHeme5$SlingMyeloid.Curve1,
Monocle = projHeme5$MonocleMyeloid,
Groups = projHeme5$Clusters2
)
corL <- cor(dM[, 1:3], use="complete.obs")
corL
## ArchR SlingShot Monocle
## ArchR 1.0000000 0.9994856 0.9795007
## SlingShot 0.9994856 1.0000000 0.9797926
## Monocle 0.9795007 0.9797926 1.0000000
#Plot One To One Comparisons
idx <- !is.na(rowSums(dM[,1:3])) #Remove NA rows
dM <- dM[idx, ,drop=FALSE]
p1 <- ggPoint(dM[,1], dM[,2], paste0(dM[,"Groups"]), pal = paletteDiscrete(projHeme5$Clusters2), xlabel="ArchR", ylabel="Sling", labelAsFactors=F, labelMeans=F)
p2 <- ggPoint(dM[,1], dM[,3], paste0(dM[,"Groups"]), pal = paletteDiscrete(projHeme5$Clusters2), xlabel="ArchR", ylabel="Mon",labelAsFactors=F, labelMeans=F)
p3 <- ggPoint(dM[,2], dM[,3], paste0(dM[,"Groups"]), pal = paletteDiscrete(projHeme5$Clusters2), xlabel="Sling", ylabel="Mon",labelAsFactors=F, labelMeans=F)
ggAlignPlots(p1,p2,p3,type="h")
#Plot Trajectories
p1 <- plotTrajectory(projHeme5, name = "MyeloidU", trajectory = "MyeloidU", imputeWeights = NULL, addArrow = FALSE)[[1]]
## ArchR logging to : ArchRLogs/ArchR-plotTrajectory-26306667dcdd8-Date-2020-10-01_Time-13-01-19.log
## If there is an issue, please report to github with logFile!
## Plotting
## Warning: Removed 5665 rows containing non-finite values (stat_summary_hex).
## Plotting Trajectory
## ArchR logging successful to : ArchRLogs/ArchR-plotTrajectory-26306667dcdd8-Date-2020-10-01_Time-13-01-19.log
p2 <- plotTrajectory(projHeme5, name = "SlingMyeloid.Curve1", trajectory = "SlingMyeloid.Curve1", imputeWeights = NULL, addArrow = FALSE)[[1]]
## ArchR logging to : ArchRLogs/ArchR-plotTrajectory-26306131034d4-Date-2020-10-01_Time-13-01-20.log
## If there is an issue, please report to github with logFile!
## Plotting
## Warning: Removed 5155 rows containing non-finite values (stat_summary_hex).
## Plotting Trajectory
## ArchR logging successful to : ArchRLogs/ArchR-plotTrajectory-26306131034d4-Date-2020-10-01_Time-13-01-20.log
p3 <- plotTrajectory(projHeme5, name = "MonocleMyeloid", trajectory = "MonocleMyeloid", imputeWeights = NULL, addArrow = FALSE)[[1]]
## ArchR logging to : ArchRLogs/ArchR-plotTrajectory-2630610f3c9ec-Date-2020-10-01_Time-13-01-22.log
## If there is an issue, please report to github with logFile!
## Plotting
## Warning: Removed 5155 rows containing non-finite values (stat_summary_hex).
## Plotting Trajectory
## ArchR logging successful to : ArchRLogs/ArchR-plotTrajectory-2630610f3c9ec-Date-2020-10-01_Time-13-01-22.log
ggAlignPlots(p1,p2,p3,type="h")
## Warning: Removed 5665 rows containing non-finite values (stat_summary_hex).
## Warning: Removed 5155 rows containing non-finite values (stat_summary_hex).
## Warning: Removed 5155 rows containing non-finite values (stat_summary_hex).
#Print Session Info
sessionInfo()
## R version 3.6.1 (2019-07-05)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: CentOS Linux 7 (Core)
##
## Matrix products: default
## BLAS/LAPACK: /share/software/user/open/openblas/0.2.19/lib/libopenblasp-r0.2.19.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] grid parallel stats4 stats graphics grDevices utils
## [8] datasets methods base
##
## other attached packages:
## [1] gtable_0.3.0 slingshot_1.4.0
## [3] princurve_2.1.4 gridExtra_2.3
## [5] monocle3_0.2.2 SingleCellExperiment_1.8.0
## [7] ArchR_1.0.0 magrittr_1.5
## [9] rhdf5_2.30.1 Matrix_1.2-17
## [11] data.table_1.12.8 SummarizedExperiment_1.16.1
## [13] DelayedArray_0.12.3 BiocParallel_1.20.1
## [15] matrixStats_0.56.0 Biobase_2.46.0
## [17] GenomicRanges_1.38.0 GenomeInfoDb_1.22.1
## [19] IRanges_2.20.2 S4Vectors_0.24.4
## [21] BiocGenerics_0.32.0 ggplot2_3.3.2
##
## loaded via a namespace (and not attached):
## [1] viridis_0.5.1 viridisLite_0.3.0 gtools_3.8.2
## [4] assertthat_0.2.1 GenomeInfoDbData_1.2.2 yaml_2.2.1
## [7] ggrepel_0.8.1 pillar_1.4.3 lattice_0.20-38
## [10] glue_1.4.0 digest_0.6.25 RColorBrewer_1.1-2
## [13] XVector_0.26.0 colorspace_1.4-1 htmltools_0.4.0
## [16] plyr_1.8.6 pkgconfig_2.0.3 GetoptLong_0.1.8
## [19] zlibbioc_1.32.0 purrr_0.3.3 scales_1.1.0
## [22] RANN_2.6.1 ggrastr_0.1.7 proxy_0.4-23
## [25] tibble_3.0.3 generics_0.0.2 farver_2.0.3
## [28] ellipsis_0.3.0 withr_2.1.2 leidenbase_0.1.1
## [31] hexbin_1.28.1 crayon_1.3.4 evaluate_0.14
## [34] nlme_3.1-140 Cairo_1.5-10 tools_3.6.1
## [37] GlobalOptions_0.1.1 lifecycle_0.2.0 ComplexHeatmap_2.2.0
## [40] stringr_1.4.0 Rhdf5lib_1.8.0 munsell_0.5.0
## [43] cluster_2.1.0 compiler_3.6.1 rlang_0.4.7
## [46] RCurl_1.98-1.1 rjson_0.2.20 circlize_0.4.8
## [49] igraph_1.2.4.2 bitops_1.0-6 labeling_0.3
## [52] rmarkdown_2.1 reshape2_1.4.3 R6_2.4.1
## [55] knitr_1.27 dplyr_1.0.1 clue_0.3-57
## [58] ape_5.3 shape_1.4.4 stringi_1.4.6
## [61] Rcpp_1.0.4 vctrs_0.3.2 png_0.1-7
## [64] tidyselect_1.1.0 xfun_0.12