PostQC_OMIP095
Mikias HW
2024-04-21
Prep Workspace
Load Libraries
library(Spectre)
library(tidymodels)
tidymodels_prefer()
library(recipes)
library(flowCore)
library(FlowSOM)
library(janitor)
library(flowVS)
library(xlsx)
library(flowViz)
library(corrplot)
library(embed)
library(tidytext)
library(flowWorkspace)
library(CytoML)
library(ggcyto)
library(tidyverse)
library(flowAI)
library(bestNormalize)
library(patchwork)
library(ggforce)
library(SingleCellExperiment)Preferred functions
library(conflicted)
# Set function preferences (if needed)
conflicts_prefer(dplyr::select)
conflicts_prefer(dplyr::filter)Directories
# Save working directory (if needed)
wDir <- getwd()
# Set working directory (if needed)
setwd(wDir)
# Set QC directory
qcDir <- paste(wDir, "FlowJo_QC/QC_Gating", sep = "/")
qcFCS <- paste(qcDir, "QC_FCS", sep = "/")
qcGates <- paste(wDir, "FlowJo_QC/FlowJo_Web_files", sep = "/")
# Save QC png list
qcPNG <- list.files(qcGates, pattern = "*.png", full=TRUE)
# flowAI results
resAI <- paste(wDir, "resultsQC", sep = "/")Project Background
OMIP-095
OMIP-095:
40-Color spectral flow cytometry delineates all major leukocyte populations in murine lymphoid tissues
Aris J. Kare, Lisa Nichols, Ricardo Zermeno, Marina N. Raie, Spencer K. Tumbale, Katherine W. Ferrara
First published: 28 September 2023
https://doi.org/10.1002/cyto.a.24788
Flow Repository ID: FR-FCM-Z63EQuality Control
# Define markdown PNG display function
generate_PNGs <- function(png_paths) {
image_html <- lapply(png_paths, function(path) {
paste0("<img src=\"", path, "\" alt=\"Image\"/>\n")
})
return(unlist(image_html))
}
png_paths <- qcPNG
image_html <- generate_PNGs(png_paths)
cat(image_html, sep = "\n")
Quality Control II
# # Select Flowjo Workspace file
# fjWSP <- list.files(qcDir, pattern="QC_Gated.wsp",full=TRUE)
#
# # Select QC's FCS files
# FCSfiles <- list.files(qcFCS, pattern="*.fcs",full=TRUE)
#
# # Create Flowjo Workspace object
# ws <- open_flowjo_xml(fjWSP)
#
# # View sample information
# fj_ws_get_samples(ws, group_id = 1)
#
# # Construct Gating Set object
# gs <- flowjo_to_gatingset(ws, group_id = 1)
#
# # Exctact FCS parameters
# keys <- fj_ws_get_keywords(ws, 1)
#
# # QC Steps
# plot(gs)
#
# gs_get_pop_paths(gs, path = "full")
#
# gatelist <- gs_get_pop_paths(gs, path = "auto")
#
# gate1 <- gatelist[1]
# gate2 <- gatelist[2]
# gate3 <- gatelist[3]
# gate4 <- gatelist[4]
# gate5 <- gatelist[5]
#
# autoplot(gs, gate2, bins = 100)
#
# gh <- gs[[5]]
#
# autoplot(gh)
#
# # Gating states
# gs_pop_get_stats(gs, xml = TRUE)
#
# # Detectors
# gs_pop_get_data(gs)
#
# # File names
# sampleNames(gs)Load FCS files
# Create flowSet object
fs <- read.flowSet(
path = qcFCS,
pattern = "*.fcs",
transformation = FALSE,
truncate_max_range = FALSE
)
# rm(fs)
fs[[1]]## flowFrame object 'Blood_QC.fcs'
## with 338343 cells and 40 observables:
## name desc range minRange maxRange
## $P1 FJComp-APC-A TCRyd 1e+05 -111 99999
## $P2 FJComp-APC-Fire 810-A CD38 1e+05 -111 99999
## $P3 FJComp-APC-eFluor 78.. FceR1a 1e+05 -111 99999
## $P4 FJComp-Alexa Fluor 5.. CD45 1e+05 -111 99999
## $P5 FJComp-BB700-A NK1.1 1e+05 -111 99999
## ... ... ... ... ... ...
## $P36 FJComp-Super Bright .. CD27 100000 -111 99999
## $P37 FJComp-eFluor 450-A F4_80 100000 -111 99999
## $P38 FJComp-eFluor 506-A CD11c 100000 -111 99999
## $P39 FJComp-eFluor 660-A Siglec-F 100000 -111 99999
## $P40 Time NA 103 0 102
## 331 keywords are stored in the 'description' slot# get more info
pData(fs)## name
## Blood_QC.fcs Blood_QC.fcs
## Bone Marrow_QC.fcs Bone Marrow_QC.fcs
## Inguinal Lymph Node_QC.fcs Inguinal Lymph Node_QC.fcs
## Peyer Patch_QC.fcs Peyer Patch_QC.fcs
## Spleen_QC.fcs Spleen_QC.fcs
## Thymus_QC.fcs Thymus_QC.fcsflowAI final QC
# # Create flowSet object
# fsPre <- read.flowSet(
# path = qcFCS,
# pattern = "*.fcs",
# transformation = FALSE,
# truncate_max_range = FALSE
# )
#
# # rm(fs)
# fsPre[[1]]
#
# # Can some time
# # Saves folder of QC results and QC'd FCS files in working directory
#
# fs <- flow_auto_qc(fsPre, sideFM = "lower")
# Show QC results
QCfile <- paste(resAI, "QCmini.txt", sep = "/")
resAIqc <- read.csv(QCfile, sep = "\t", check.names = FALSE)
resAIqc## Name file n. of events % anomalies
## 1 Blood_QC 338343 9.63
## 2 Bone Marrow_QC 291235 9.00
## 3 Inguinal Lymph Node_QC 296967 6.55
## 4 Peyer Patch_QC 180915 6.30
## 5 Spleen_QC 316535 8.06
## 6 Thymus_QC 457345 4.57
## analysis from % anomalies flow Rate
## 1 Flow Rate, Flow Signal and Flow Margin 1.92
## 2 Flow Rate, Flow Signal and Flow Margin 1.68
## 3 Flow Rate, Flow Signal and Flow Margin 0.93
## 4 Flow Rate, Flow Signal and Flow Margin 0.47
## 5 Flow Rate, Flow Signal and Flow Margin 1.84
## 6 Flow Rate, Flow Signal and Flow Margin 1.12
## % anomalies Signal % anomalies Margins
## 1 0 7.87
## 2 0 7.44
## 3 0 5.67
## 4 0 5.86
## 5 0 6.32
## 6 0 3.50Samples metadata
# Prep empty df
metadata <- data.frame()
# Iterate through flowset to extract metadata
for (i in 1:length(fs)) {
flow_frame <- fs[[i]]
tube_name <- flow_frame@description[["TUBENAME"]] # Tube Name
cell_count <- flow_frame@description[["$TOT"]] # Event Counts
sample_group <- flow_frame@description[["GROUPNAME"]] # Sample Group
fcs_version <- flow_frame@description[["FCSversion"]] # FCS File Version
collection <- flow_frame@description[["$DATE"]] # Collection Date
cytometer <- flow_frame@description[["$CYT"]] # Cytometer
software <- flow_frame@description[["CREATOR"]] # Cytometer Software
institute <- flow_frame@description[["$INST"]] # Institution
operator <- flow_frame@description[["$OP"]] # Operator
row_data <- data.frame(tube_name, cell_count, sample_group,
fcs_version, collection, cytometer,
software, institute, operator)
metadata <- bind_rows(metadata, row_data)
rm(flow_frame, row_data)
}
metadata## tube_name cell_count sample_group fcs_version collection
## 1 Blood 338343 Fully Stained 3.1 22-Nov-2022
## 2 Bone Marrow 291235 Fully Stained 3.1 22-Nov-2022
## 3 Inguinal Lymph Node 296967 Fully Stained 3.1 22-Nov-2022
## 4 Peyer Patch 180915 Fully Stained 3.1 22-Nov-2022
## 5 Spleen 316535 Fully Stained 3.1 22-Nov-2022
## 6 Thymus 457345 Fully Stained 3.1 22-Nov-2022
## cytometer software institute operator
## 1 Aurora SpectroFlo 3.0.3 Stanford Beckman Center ariskare
## 2 Aurora SpectroFlo 3.0.3 Stanford Beckman Center ariskare
## 3 Aurora SpectroFlo 3.0.3 Stanford Beckman Center ariskare
## 4 Aurora SpectroFlo 3.0.3 Stanford Beckman Center ariskare
## 5 Aurora SpectroFlo 3.0.3 Stanford Beckman Center ariskare
## 6 Aurora SpectroFlo 3.0.3 Stanford Beckman Center ariskareMarkers & Detectors lists
# List detectors
pmts <- fs[[1]]@parameters@data[["name"]]
# List markers
markers <- fs[[1]]@parameters@data[["desc"]]
# Remove Time components
markers <- na.omit(markers)
pmts <- pmts[pmts != "Time"]
# Combine into dataframe
detList <- data.frame(markers, pmts) # Merge
detList## markers pmts
## $P1S TCRyd FJComp-APC-A
## $P2S CD38 FJComp-APC-Fire 810-A
## $P3S FceR1a FJComp-APC-eFluor 780-A
## $P4S CD45 FJComp-Alexa Fluor 532-A
## $P5S NK1.1 FJComp-BB700-A
## $P6S CD274 FJComp-BUV395-A
## $P7S CD24 FJComp-BUV496-A
## $P8S CD115 FJComp-BUV563-A
## $P9S Siglec-H FJComp-BUV615-A
## $P10S CD11b FJComp-BUV661-A
## $P11S CD19 FJComp-BUV737-A
## $P12S CD26 FJComp-BUV805-A
## $P13S CD25 FJComp-BV421-A
## $P14S CD279 FJComp-BV480-A
## $P15S CD44 FJComp-BV510-A
## $P16S CD45R FJComp-BV570-A
## $P17S Ly6C FJComp-BV605-A
## $P18S CD62L FJComp-BV650-A
## $P19S CD117 FJComp-BV750-A
## $P20S CD134 FJComp-BV786-A
## $P21S CD40 FJComp-FITC-A
## $P22S CD4 FJComp-NFB610-70S-A
## $P23S CD8a FJComp-NFY690-A
## $P24S CD135 FJComp-PE-A
## $P25S CD80 FJComp-PE-Cy5-A
## $P26S CD86 FJComp-PE-Cy7-A
## $P27S IgM FJComp-PE-Dazzle594-A
## $P28S CX3CR1 FJComp-PE-Fire 700-A
## $P29S Ly6G FJComp-PE-Fire 810-A
## $P30S I-A_I-E FJComp-PerCP-A
## $P31S CD103 FJComp-PerCP-eFluor 710-A
## $P32S CD127 FJComp-R718-A
## $P33S CD326 FJComp-Real Blue 780-A
## $P34S CD3e FJComp-Real Yellow 586-A
## $P35S IgD FJComp-Spark NIR 685-A
## $P36S CD27 FJComp-Super Bright 702-A
## $P37S F4_80 FJComp-eFluor 450-A
## $P38S CD11c FJComp-eFluor 506-A
## $P39S Siglec-F FJComp-eFluor 660-AExpression Data
#fs[[1]]@exprs
exprsDat <- data.frame()
for (i in 1:length(fs)) {
flow_frame <- fs[[i]]
tube_name <- flow_frame@description[["TUBENAME"]] # Tube Name
cell_exprs <- flow_frame@exprs # Expression Data
row_data <- data.frame(tube_name, cell_exprs)
exprsDat <- bind_rows(exprsDat, row_data)
rm(flow_frame, row_data, cell_exprs, tube_name)
}
head(exprsDat)## tube_name FJComp.APC.A FJComp.APC.Fire.810.A FJComp.APC.eFluor.780.A
## 1 Blood 11480.533 234051.938 -10191.609
## 2 Blood 13019.014 240657.047 2221.141
## 3 Blood 3416.014 202223.250 -8235.789
## 4 Blood 21706.668 175544.609 1027.781
## 5 Blood -4353.312 188302.469 10564.914
## 6 Blood -38793.957 -2380.162 1578.878
## FJComp.Alexa.Fluor.532.A FJComp.BB700.A FJComp.BUV395.A FJComp.BUV496.A
## 1 136579.25 -11293.027 1973.916 27138.512
## 2 137511.92 -4083.916 -2351.963 45962.508
## 3 132663.02 7445.529 2545.013 74914.703
## 4 128300.52 -1817.552 4331.116 77882.203
## 5 96132.03 10089.965 5341.585 18271.068
## 6 117033.38 4871.744 2218.938 -5465.608
## FJComp.BUV563.A FJComp.BUV615.A FJComp.BUV661.A FJComp.BUV737.A
## 1 945.5635 3504.0728 12203.528 93285.812
## 2 -365.9834 350.7081 4842.629 55951.742
## 3 695.9561 -2147.2146 3499.968 38013.348
## 4 3539.0811 1658.3478 -4472.007 49103.270
## 5 1140.8105 551.9513 22273.936 37579.562
## 6 67466.9922 -2383.4619 456594.500 -4906.087
## FJComp.BUV805.A FJComp.BV421.A FJComp.BV480.A FJComp.BV510.A FJComp.BV570.A
## 1 17905.99 -2357.6416 492.0635 22096.848 103096.320
## 2 29710.69 -1700.2715 942.9128 6736.737 129707.852
## 3 25882.93 -3374.3750 3950.0393 32437.980 115530.352
## 4 12570.81 1417.1084 1149.7568 16426.645 109746.992
## 5 16817.34 954.3252 -421.1902 15123.273 72495.695
## 6 13975.14 -606.0043 -2326.2349 320536.781 7083.188
## FJComp.BV605.A FJComp.BV650.A FJComp.BV750.A FJComp.BV786.A FJComp.FITC.A
## 1 3112.885 461958.625 -2531.035 5916.9453 8702.1875
## 2 -1132.107 247249.938 -3150.543 3029.0312 408.2617
## 3 3039.393 343254.531 1905.082 4090.0117 7038.5869
## 4 -2283.056 200593.141 9741.875 -11544.1172 10682.0547
## 5 1544.223 181252.438 8668.078 -5091.0977 7848.8462
## 6 21722.080 8390.496 -2294.036 695.8052 1218.9391
## FJComp.NFB610.70S.A FJComp.NFY690.A FJComp.PE.A FJComp.PE.Cy5.A
## 1 -52.31396 -1891.6914 11470.7266 215.1543
## 2 -1811.99170 -10430.0977 -1790.0332 2883.4912
## 3 2427.39355 5442.4434 1700.8311 2795.7983
## 4 6954.48438 9592.5586 -1341.3203 2617.6367
## 5 -3574.67383 870.4141 799.5938 1714.2549
## 6 -2236.79150 13429.6367 -135.5530 5539.4531
## FJComp.PE.Cy7.A FJComp.PE.Dazzle594.A FJComp.PE.Fire.700.A
## 1 8863.749 15078.691 681.8594
## 2 -3888.642 6219.803 7659.5000
## 3 10344.598 1364.239 301.4844
## 4 7423.635 6036.978 -3108.6680
## 5 -1125.487 4279.802 6165.3672
## 6 9103.701 4901.643 41124.3906
## FJComp.PE.Fire.810.A FJComp.PerCP.A FJComp.PerCP.eFluor.710.A FJComp.R718.A
## 1 -4390.367 32979.340 12094.637 904.9097
## 2 15768.477 11918.059 1615.949 13275.4199
## 3 -4609.445 67321.016 -11677.701 -1570.0010
## 4 -4673.555 21134.365 5965.002 -691.6533
## 5 21051.961 71611.938 -12868.072 8262.3555
## 6 8127.129 -5952.126 8862.180 8922.8662
## FJComp.Real.Blue.780.A FJComp.Real.Yellow.586.A FJComp.Spark.NIR.685.A
## 1 -332.1641 -3186.68701 338278.47
## 2 -2190.0742 -72.92773 208372.91
## 3 5918.7578 -1484.24536 37146.88
## 4 4092.1074 3400.48999 405375.22
## 5 -3944.2539 -2580.21167 446261.75
## 6 -3351.0361 -2252.86450 -30050.49
## FJComp.Super.Bright.702.A FJComp.eFluor.450.A FJComp.eFluor.506.A
## 1 13535.004 -354.0861 -4580.115
## 2 1099.455 -1526.3994 1099.463
## 3 9463.344 -5245.0332 3286.268
## 4 5277.951 -2003.4238 185.395
## 5 -1133.256 -218.2346 1074.655
## 6 4994.746 9371.8174 8254.838
## FJComp.eFluor.660.A Time
## 1 -10212.533 155981
## 2 -1768.672 155982
## 3 3629.920 155982
## 4 -30105.777 155982
## 5 -13914.715 155983
## 6 41293.047 155987Subsample
Transformation
# Apply Transformation paramets
BiExTrans <- biexponentialTransform("defaultBiexponentialTransform")
# Apply transformation to selected detectors
fsBiExTrans <- transform(fs, transformList(pmts, BiExTrans))
# ##############
ArcSinTrans <- arcsinhTransform("defaultArcsinhTransform", a=1, b=5)
# ##############
fsTransArc <- transform(fs, transformList(pmts, ArcSinTrans))
# Visualize CD25 before transformation
ggcyto(fs, aes(x = "CD25")) +
geom_freqpoly() +
labs(title = "Raw CD25")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
ggcyto(fs, aes(x = "I-A_I-E")) +
geom_freqpoly() +
labs(title = "Raw I-A_I-E")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
# Visualize CD25 after transformation.
ggcyto(fsBiExTrans, aes(x = "CD25")) +
geom_freqpoly() +
labs(title = "BioExponentially Transformed CD25")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
ggcyto(fsBiExTrans, aes(x = "I-A_I-E")) +
geom_freqpoly() +
labs(title = "BioExponentially Transformed I-A/I-E")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Visualize transformations
# flowViz lattice
flowViz::densityplot(~`.`, fs[[1]]) 
flowViz::densityplot(~`.`, fsBiExTrans[[1]]) 
flowViz::densityplot(~`.`, fsTransArc[[1]])
Extract transformed expression data
exprsDatTrans <- data.frame()
for (i in 1:length(fsBiExTrans)) {
flow_frame <- fsBiExTrans[[i]]
tube_name <- flow_frame@description[["TUBENAME"]] # Tube Name
cell_exprs <- flow_frame@exprs # Expression Data
row_data <- data.frame(tube_name, cell_exprs)
exprsDatTrans <- bind_rows(exprsDatTrans, row_data)
rm(flow_frame, row_data, cell_exprs, tube_name)
}
head(exprsDatTrans)## tube_name FJComp.APC.A FJComp.APC.Fire.810.A FJComp.APC.eFluor.780.A
## 1 Blood 10.041557 13.056444 -9.922448
## 2 Blood 10.167313 13.084274 8.398946
## 3 Blood 8.829372 12.910274 -9.709397
## 4 Blood 10.678521 12.768796 7.628313
## 5 Blood -9.071824 12.838952 9.958440
## 6 Blood -11.259164 -8.468072 8.057629
## FJComp.Alexa.Fluor.532.A FJComp.BB700.A FJComp.BUV395.A FJComp.BUV496.A
## 1 12.51781 -10.025089 8.280908 10.901853
## 2 12.52461 -9.007944 -8.456154 11.428727
## 3 12.48871 9.608490 8.535037 11.917253
## 4 12.45527 -8.198393 9.066712 11.956100
## 5 12.16662 9.912472 9.276444 10.506221
## 6 12.36336 9.184354 8.397954 -9.299408
## FJComp.BUV563.A FJComp.BUV615.A FJComp.BUV661.A FJComp.BUV737.A
## 1 7.544938 8.854822 10.102652 12.136547
## 2 -6.595707 6.553123 9.178363 11.625393
## 3 7.238411 -8.365074 8.853650 11.238837
## 4 8.864763 8.106714 -9.098725 11.494828
## 5 7.732647 7.006607 10.704318 11.227360
## 6 11.812543 -8.469457 13.724700 -9.191379
## FJComp.BUV805.A FJComp.BV421.A FJComp.BV480.A FJComp.BV510.A FJComp.BV570.A
## 1 10.48604 -8.458565 6.891753 10.696336 12.236547
## 2 10.99241 -8.131686 7.542131 9.508477 12.466182
## 3 10.85448 -8.817108 8.974615 11.080227 12.350435
## 4 10.13227 7.949522 7.740458 10.399812 12.299078
## 5 10.42331 7.554162 -6.736223 10.317119 11.884430
## 6 10.23818 -7.100035 -8.445156 13.370899 9.558626
## FJComp.BV605.A FJComp.BV650.A FJComp.BV750.A FJComp.BV786.A FJComp.FITC.A
## 1 8.736452 13.736379 -8.529526 9.378713 9.764478
## 2 -7.724989 13.111301 -8.748476 8.709145 6.705044
## 3 8.712560 13.439353 8.245445 9.009436 9.552309
## 4 -8.426423 12.902181 9.877336 -10.047081 9.969458
## 5 8.035424 12.800786 9.760551 -9.228396 9.661283
## 6 10.679230 9.728005 -8.431220 7.238194 7.798888
## FJComp.NFB610.70S.A FJComp.NFY690.A FJComp.PE.A FJComp.PE.Cy5.A
## 1 -4.650502 -8.238381 10.040703 6.064511
## 2 -8.195329 -9.945595 -8.183136 8.659898
## 3 8.487721 9.295159 8.132015 8.629011
## 4 9.540289 9.861890 -7.894558 8.563174
## 5 -8.874769 7.462130 7.377270 8.139878
## 6 -8.405961 10.198365 -5.602524 9.312772
## FJComp.PE.Cy7.A FJComp.PE.Dazzle594.A FJComp.PE.Fire.700.A
## 1 9.782873 10.314167 7.217952
## 2 -8.958950 9.428636 9.636871
## 3 9.937360 7.911501 6.401868
## 4 9.605547 9.398799 -8.735096
## 5 -7.719124 9.054794 9.419845
## 6 9.809584 9.190473 11.317502
## FJComp.PE.Fire.810.A FJComp.PerCP.A FJComp.PerCP.eFluor.710.A FJComp.R718.A
## 1 -9.080300 11.096779 10.093683 7.500994
## 2 10.358943 10.078968 8.080801 10.186815
## 3 -9.129013 11.810377 -10.058588 -8.051982
## 4 -9.142825 10.651801 9.386803 -7.232210
## 5 10.647895 11.872165 -10.155651 9.712617
## 6 9.696117 -9.384642 9.782696 9.789520
## FJComp.Real.Blue.780.A FJComp.Real.Yellow.586.A FJComp.Spark.NIR.685.A
## 1 -6.498780 -8.759883 13.42475
## 2 -8.384816 -4.982660 12.94023
## 3 9.379019 -7.995809 11.21578
## 4 9.009948 8.824817 13.60572
## 5 -8.973149 -8.548774 13.70181
## 6 -8.810168 -8.413117 -11.00378
## FJComp.Super.Bright.702.A FJComp.eFluor.450.A FJComp.eFluor.506.A
## 1 10.206179 -6.562712 -9.122630
## 2 7.695723 -8.023814 7.695730
## 3 9.848328 -9.258192 8.790652
## 4 9.264452 -8.295752 5.915652
## 5 -7.726003 -6.078726 7.672909
## 6 9.209289 9.838610 9.711707
## FJComp.eFluor.660.A Time
## 1 -9.924501 155981
## 2 -8.171130 155982
## 3 8.890105 155982
## 4 -11.005617 155982
## 5 -10.233845 155983
## 6 11.321595 155987Modeling Clasifier
# Split data into training/testing/validation sets
set.seed(1601)
fs_split <- initial_validation_split(exprsDatTrans, strata = tube_name, prop = c(0.025, 0.025))
fs_split## <Training/Validation/Testing/Total>
## <47030/47031/1787279/1881340># Return data frames:
fs_train <- training(fs_split)
fs_test <- testing(fs_split)
fs_validation <- validation(fs_split)
# Check distribution of samples in train set
fs_train |>
dplyr::count(tube_name)## tube_name n
## 1 Blood 8504
## 2 Bone Marrow 7256
## 3 Inguinal Lymph Node 7435
## 4 Peyer Patch 4464
## 5 Spleen 7990
## 6 Thymus 11381set.seed(1602)
# Return an 'rset' object to use with the tune functions:
fs_val <- validation_set(fs_split)
fs_split$splits[[1]]## NULL# Corrolation plot between all detectors
fs_train |>
select(-tube_name) |>
cor() |>
corrplot(order = "hclust", type = "upper", diag = FALSE)
Single Cell Experiment
# Construct Single Cell Experiment Object
sce <- SingleCellExperiment(fs_train)
sce## class: SingleCellExperiment
## dim: 47030 41
## metadata(0):
## assays(1): ''
## rownames(47030): 1 2 ... 47029 47030
## rowData names(0):
## colnames(41): tube_name FJComp.APC.A ... FJComp.eFluor.660.A Time
## colData names(0):
## reducedDimNames(0):
## mainExpName: NULL
## altExpNames(0):# dim(assay(sce))
# colnames(colData(sce))
# colnames(rowData(sce))Tidy PCA
# fs_rec <- recipe(tube_name ~ ., data = fs_train) |>
# step_zv(all_numeric_predictors()) |>
# step_orderNorm(all_numeric_predictors()) |>
# step_normalize(all_numeric_predictors())
#
# fs_rec
#
# fs_rec_trained <- prep(fs_rec)
#
# fs_rec_trained
#
# fs_rec_bakes <- bake(fs_rec_trained, fs_test)
#
#
# fs_rec_trained |>
# step_pca(all_numeric_predictors(), num_comp = 4) |>
# ggplot(aes(x = .panel_x, y = .panel_y)) +
# geom_point(alpha = 0.4, size = 0.5)
#
#
# plot_validation_results <- function(recipe, dat = fs_validation) {
# recipe %>%
# # Estimate any additional steps
# prep() %>%
# # Process the data (the validation set by default)
# bake(new_data = dat) %>%
# # Create the scatterplot matrix
# ggplot(aes(x = .panel_x, y = .panel_y, color = tube_name, fill = tube_name)) +
# geom_point(alpha = 0.4, size = 0.5) +
# geom_autodensity(alpha = .3) +
# facet_matrix(vars(-tube_name), layer.diag = 2) +
# scale_color_brewer(palette = "Dark2") +
# scale_fill_brewer(palette = "Dark2")
# }
#
#
#
# fs_rec_trained %>%
# step_pca(all_numeric_predictors(), num_comp = 4) %>%
# plot_validation_results() +
# ggtitle("Principal Component Analysis")flowSOM
# # Run FlowSOM clustering
# resSOM <- FlowSOM(fsBiExTrans)
#
# # Plot results
# PlotStars(resSOM,
# backgroundValues = resSOM$metaclustering)
#
# # Get metaclustering per cell
# flowSOM.clustering <- GetMetaclusters(resSOM)
# Dimensionality reduction
#
# # Dimensionality reduction
#
# cell.sub <- do.subsample(cell.dat, sub.targets, tissue.col)
# cell.sub
#
# cell.sub <- run.umap(cell.sub, cluster.cols)
# cell.sub
#
# # DR plots
#
# make.colour.plot(cell.sub, "UMAP_X", "UMAP_Y", "FlowSOM_metacluster", col.type = 'factor', add.label = TRUE)
# make.multi.plot(cell.sub, "UMAP_X", "UMAP_Y", cellular.cols)
# make.multi.plot(cell.sub, "UMAP_X", "UMAP_Y", "FlowSOM_metacluster", tissue.col, col.type = 'factor')
#
# # Expression heatmap
#
# exp <- do.aggregate(cell.dat, cellular.cols, by = "FlowSOM_metacluster")
# make.pheatmap(exp, "FlowSOM_metacluster", cellular.cols)