--- a +++ b/R/DIscBIO-generic-pseudoTimeOrdering.R @@ -0,0 +1,62 @@ +#' @title Pseudo-time ordering +#' @description This function takes the exact output of exprmclust function and +#' construct Pseudo-time ordering by mapping all cells onto the path that +#' connects cluster centers. +#' @param object \code{DISCBIO} class object. +#' @param quiet if `TRUE`, suppresses intermediary output +#' @param export if `TRUE`, exports order table to csv +#' @param filename Name of the exported file (if `export=TRUE`) +#' @importFrom TSCAN TSCANorder +#' @return The DISCBIO-class object input with the kordering slot filled. +setGeneric("pseudoTimeOrdering", function( + object, + quiet = FALSE, + export = FALSE, + filename = "Cellular_pseudo-time_ordering") { + standardGeneric("pseudoTimeOrdering") +}) + +#' @export +#' @rdname pseudoTimeOrdering +setMethod( + "pseudoTimeOrdering", + signature = "DISCBIO", + definition = function(object, quiet, export, filename) { + # ====================================================================== + # Validating + # ====================================================================== + ran_k <- length(object@kmeans$kpart) > 0 + ran_m <- length(object@MBclusters) > 0 + if (ran_k) { + Obj <- object@fdata + Names <- object@cpart + lpsmclust <- Exprmclust(Obj, K = 4, reduce = FALSE, cluster = Names) + lpsorder <- TSCANorder(lpsmclust) + } else if (ran_m) { + Obj <- object@fdata + Names <- names(object@MBclusters$clusterid) + lpsmclust <- object@MBclusters + lpsorder <- TSCANorder(lpsmclust) + } else { + stop("run clustexp before this pseudoTimeOrdering") + } + # ====================================================================== + # Ordering + # ====================================================================== + sampleNames <- colnames(Obj) + orderID <- lpsorder + order <- seq_len(length(lpsorder)) + orderTable <- data.frame(order, orderID) + if (export) write.csv(orderTable, file = paste0(filename, ".csv")) + if (!quiet) print(orderTable) + FinalOrder <- orderTable[match(sampleNames, orderTable$orderID), ] + out_order <- FinalOrder[, 1] + names(out_order) <- names(Names) + if (ran_k) { + object@kordering <- out_order + } else if (ran_m) { + object@MBordering <- out_order + } + return(object) + } +)