library(scater) library(SingleCellExperiment) library(ggthemes) library(ggplot2) library(ggridges) library(plyr) library(raster) library(gridExtra) library(sp) library(spatstat) library(uwot) library(pheatmap) #source("R/image_analysis_function.R") set.seed(2020)
load("data/mibiSCE.rda") mibi.sce
## class: SingleCellExperiment
## dim: 49 201656
## metadata(0):
## assays(1): mibi_exprs
## rownames(49): C Na ... Ta Au
## rowData names(4): channel_name is_protein hgnc_symbol wagner_overlap
## colnames: NULL
## colData names(36): SampleID cellLabelInImage ...
## Survival_days_capped_2016.1.1 Censored
## reducedDimNames(0):
## altExpNames(0):
cat("Patients information")
## Patients information
table(mibi.sce$SampleID)
##
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
## 5167 3028 6315 6643 5406 5998 3410 3136 6139 4580 5112 6995 7665 6270 3315 8212
## 17 18 19 20 21 22 23 24 25 26 27 28 29 31 32 33
## 7071 5539 4400 5103 5423 3072 4490 4613 2658 5119 4332 6061 4819 3415 5158 2046
## 34 35 36 37 38 39 40 41 42 43 44
## 2856 7716 2939 6280 4330 4030 4285 4532 1380 1381 1217
cat("Cell types informaton")
## Cell types informaton
# table(mibi.sce$tumor_group) # table(mibi.sce$immune_group) # rename the cell types mibi.sce$cellTypes <- ifelse(as.character(mibi.sce$immune_group) != "not immune", as.character(mibi.sce$immune_group), as.character(mibi.sce$tumor_group)) table(mibi.sce$cellTypes)
##
## B CD3 CD4
## 9134 3867 12443
## CD8 DC DC/Mono
## 15787 1275 5052
## Endothelial Keratin-positive tumor Macrophages
## 2089 102736 20687
## Mesenchymal-like Mono/Neu Neutrophils
## 8479 3113 3020
## NK Other immune Tregs
## 674 6943 1341
## Tumor Unidentified
## 3177 1839
mibi.sce$cellTypes_group <- ifelse(as.character(mibi.sce$immune_group) != "not immune", "Micro-environment", "Tumour") selected_chanel_mibi <- rownames(mibi.sce)[rowData(mibi.sce)$is_protein == 1]
# color for mibi cell types cellTypes_group_mibi_color <- tableau_color_pal("Tableau 10")(length(unique(mibi.sce$cellTypes_group))) cellTypes_group_mibi_color <- c(cellTypes_group_mibi_color, "black") names(cellTypes_group_mibi_color) <- c(unique(mibi.sce$cellTypes_group), "Background") cellTypes_mibi_color <- tableau_color_pal("Classic 20")(length(unique(mibi.sce$cellTypes))) cellTypes_mibi_color <- c(cellTypes_mibi_color, "black") names(cellTypes_mibi_color) <- c(unique(mibi.sce$cellTypes), "Background")
Visualising all cells using UMAP
## Dimension Reduction using UMAP mibi.sce <- runUMAP(mibi.sce, exprs_values = "mibi_exprs", subset_row = selected_chanel_mibi) g1 <- plotUMAP(mibi.sce, colour_by = "cellTypes") + theme(aspect.ratio = 1) g2 <- plotUMAP(mibi.sce, colour_by = "cellTypes_group") + theme(aspect.ratio = 1) g3 <- plotUMAP(mibi.sce, colour_by = "SampleID") + theme(aspect.ratio = 1) grid.arrange(g1, g2, g3, ncol = 2)
Cell type composition
df_mibi <- data.frame(colData(mibi.sce)) g1 <- ggplot(df_mibi, aes(x = SampleID, fill = cellTypes)) + geom_bar() + theme_bw() + scale_fill_manual(values = cellTypes_mibi_color) + theme(legend.position = "right") g2 <- ggplot(df_mibi, aes(x = SampleID, fill = cellTypes_group)) + geom_bar() + theme_bw() + scale_fill_manual(values = cellTypes_group_mibi_color) + theme(legend.position = "right") grid.arrange(g1, g2, ncol = 2)
## R version 4.0.2 (2020-06-22)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 20.04 LTS
##
## Matrix products: default
## BLAS/LAPACK: /usr/lib/x86_64-linux-gnu/openblas-openmp/libopenblasp-r0.3.8.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=C
## [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] parallel stats4 stats graphics grDevices utils datasets
## [8] methods base
##
## other attached packages:
## [1] pheatmap_1.0.12 uwot_0.1.8
## [3] spatstat_1.64-1 rpart_4.1-15
## [5] nlme_3.1-148 spatstat.data_1.4-3
## [7] gridExtra_2.3 raster_3.3-13
## [9] sp_1.4-2 plyr_1.8.6
## [11] ggridges_0.5.2 ggthemes_4.2.0
## [13] scater_1.17.4 ggplot2_3.3.2
## [15] SingleCellExperiment_1.11.6 SummarizedExperiment_1.19.6
## [17] DelayedArray_0.15.7 matrixStats_0.56.0
## [19] Matrix_1.2-18 Biobase_2.49.0
## [21] GenomicRanges_1.41.5 GenomeInfoDb_1.25.8
## [23] IRanges_2.23.10 S4Vectors_0.27.12
## [25] BiocGenerics_0.35.4
##
## loaded via a namespace (and not attached):
## [1] bitops_1.0-6 fs_1.5.0
## [3] RcppAnnoy_0.0.16 RColorBrewer_1.1-2
## [5] rprojroot_1.3-2 tools_4.0.2
## [7] backports_1.1.8 R6_2.4.1
## [9] irlba_2.3.3 vipor_0.4.5
## [11] mgcv_1.8-31 colorspace_1.4-1
## [13] withr_2.2.0 tidyselect_1.1.0
## [15] compiler_4.0.2 BiocNeighbors_1.7.0
## [17] desc_1.2.0 labeling_0.3
## [19] scales_1.1.1 pkgdown_1.5.1
## [21] goftest_1.2-2 stringr_1.4.0
## [23] digest_0.6.25 spatstat.utils_1.17-0
## [25] rmarkdown_2.3 XVector_0.29.3
## [27] pkgconfig_2.0.3 htmltools_0.5.0
## [29] rlang_0.4.7 DelayedMatrixStats_1.11.1
## [31] farver_2.0.3 generics_0.0.2
## [33] BiocParallel_1.23.2 dplyr_1.0.1
## [35] RCurl_1.98-1.2 magrittr_1.5
## [37] BiocSingular_1.5.0 GenomeInfoDbData_1.2.3
## [39] scuttle_0.99.11 Rcpp_1.0.5
## [41] ggbeeswarm_0.6.0 munsell_0.5.0
## [43] abind_1.4-5 viridis_0.5.1
## [45] lifecycle_0.2.0 stringi_1.4.6
## [47] yaml_2.2.1 MASS_7.3-51.6
## [49] zlibbioc_1.35.0 grid_4.0.2
## [51] crayon_1.3.4 deldir_0.1-28
## [53] lattice_0.20-41 cowplot_1.0.0
## [55] splines_4.0.2 tensor_1.5
## [57] knitr_1.29 pillar_1.4.6
## [59] codetools_0.2-16 glue_1.4.1
## [61] evaluate_0.14 vctrs_0.3.2
## [63] gtable_0.3.0 purrr_0.3.4
## [65] polyclip_1.10-0 assertthat_0.2.1
## [67] xfun_0.16 rsvd_1.0.3
## [69] RSpectra_0.16-0 viridisLite_0.3.0
## [71] tibble_3.0.3 beeswarm_0.2.3
## [73] memoise_1.1.0 ellipsis_0.3.1