[28e211]: / R / DIscBIO-generic-pseudoTimeOrdering.R

Download this file

63 lines (61 with data), 2.3 kB

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
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)
}
)