#' @importClassesFrom SingleCellExperiment SingleCellExperiment
#' @export
setClass("gsexperiment", contains = c("SingleCellExperiment"))
#' @export
gsexperiment <- function(gs, pop = "root"){
.Defunct("gs_to_sce")
}
#' @importFrom S4Vectors DataFrame SimpleList
#' @importFrom SingleCellExperiment SingleCellExperiment
#' @export
gs_to_sce <- function(gs, pop = "root"){
leaf <- gs_get_leaf_nodes(gs, pop, path = "auto", showHidden = FALSE)
sns <- sampleNames(gs)
selist <- lapply(sns, function(sn){
gh <- gs[[sn]]
cf <- gh_pop_get_data(gh, pop)
ca <- CytoArray(cf)
#rowData
pd <- pData(parameters(cf))
## somehow can't coerse df to DF
# pd$name <- as.character(pd$name)
# pd$desc <- as.character(pd$desc)
# as(pd, "DataFrame")
rd <- DataFrame(#name = pd$name
desc = pd$desc
# , range = pd$range
# , minRange = pd$minRange
# , maxRange = pd$maxRange
, row.names = pd$name #rownames(pd)
)
#colData
#label each cell with leaf nodes
ncell <- nrow(cf)
idx.ancestor <- gh_pop_get_indices(gh, pop)
idx <- rep(F, ncell)
pop.col <- rep(NA_character_, ncell)
for(node in leaf)
{
#global idx
idx1 <- gh_pop_get_indices(gh, node)
#convert to local
idx1 <- idx1[idx.ancestor]
#check if idx overlap among leaf
if(any(idx1&idx))
stop(node, " cells overlap with other leaf nodes!")
#label the cells with current node
pop.col[idx1] <- node
}
#convert to factor to save space
pop.col <- factor(pop.col, levels = leaf)
cd <- DataFrame(pop = pop.col, sample = factor(rep(sn, ncell), levels = sns))
SingleCellExperiment(assays = SimpleList(intensity = ca), rowData = rd, colData = cd)
})
#cbind samples
se <- do.call(cbind, selist)
as(se, "gsexperiment")
}
setMethod("GatingSet",c("SingleCellExperiment"),function(x, ...){
sce_to_gs(x, ...)
})
#' convert SingleCellExperiment to a GatingSet
#'
#' note that only selected assay and rowData columns will be extracted into the GatingSet
#' @param sce SingleCellExperiment object
#' @param assay_type select assay to use
#' @param sample select the column from colData to represent sample ID
#' @param channel select the column from rowData to represent channels
#' @param marker select the column from rowData to represent markers
#' @export
sce_to_gs <- function(sce
, assay_type = "intensity" # expr matrix to use
, sample = "sample" # the column from colData to represent sample ID
, channel = NA # the column from rowData to represent channels
, marker = NA # the column from rowData to represent markers
, ...)
{
if(!assay_type %in% assayNames(sce))
stop("assay_type: ", assay_type, " doesn't exist in sce object!")
##parse channel and marker
rd <- rowData(sce)
if(is.na(channel))
chnls <- rownames(rd)
else
chnls <- rd[[channel]]
mkrs <- rd[[marker]]
names(mkrs) <- chnls
#split sce by sample col
sn_vec <- colData(sce)[[sample]]
cflist <- sapply(as.character(unique(sn_vec)), function(sn){
sce1 <- sce[, sn_vec == sn]
#convert assay into cytoframes
mat <- assays(sce1)[[assay_type]]
mat <- t(mat)
mat <- as.matrix(mat)
fr <- flowFrame(mat)
markernames(fr) <- mkrs
cf <- flowFrame_to_cytoframe(fr)
rownames(cf) <- rownames(mat)
cf
})
cs <- cytoset(cflist)
GatingSet(cs)
}
gs_get_cell_pop_labels <- function(gs){
}
#' @importFrom dplyr select
#' @importFrom tidyr pivot_wider
#' @importFrom tibble column_to_rownames
#' @importFrom TreeSummarizedExperiment TreeSummarizedExperiment
#' @export
gstreeexperiment <- function(gs, ancestor = "root", path = "auto"){
path <- match.arg(path, c("auto", "full"))
this_phylo <- gs_get_phylo(gs, ancestor, tip.label = path)
leaves <- gs_get_leaf_nodes(gs, ancestor, path = path)
counts <- gs_pop_get_count_fast(gs, subpopulations = leaves, path = path)
counts <- counts %>%
select(name, Count, Population) %>%
pivot_wider(names_from = name, values_from = Count) %>%
column_to_rownames("Population")
tse <- TreeSummarizedExperiment(assays = list(counts), rowTree = this_phylo, colData = pData(gs))
tse
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.