[381c22]: / R / DIscBIO-generic-Exprmclust.R

Download this file

127 lines (124 with data), 4.0 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
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
#' @title Performing Model-based clustering on expression values
#' @description this function first uses principal component analysis (PCA) to
#' reduce dimensionality of original data. It then performs model-based
#' clustering on the transformed expression values.
#' @param object \code{DISCBIO} class object.
#' @param K An integer vector specifying all possible cluster numbers. Default
#' is 3.
#' @param modelNames model to be used in model-based clustering. By default
#' "ellipsoidal, varying volume, shape, and orientation" is used.
#' @param reduce A logical vector that allows performing the PCA on the
#' expression data. Default is TRUE.
#' @param cluster A vector showing the ID of cells in the clusters.
#' @param quiet if `TRUE`, suppresses intermediary output
#' @importFrom mclust Mclust mclustBIC
#' @importFrom stats dist prcomp lm
#' @importFrom igraph graph.adjacency minimum.spanning.tree
#' @return If `object` is of class DISCBIO, the output is the same object with
#' the MBclusters slot filled. If the `object` is a data frame, the function
#' returns a named list containing the four objects that together correspond
#' to the contents of the MBclusters slot.
#'
setGeneric(
name = "Exprmclust",
def = function(
object,
K = 3,
modelNames = "VVV",
reduce = TRUE,
cluster = NULL,
quiet = FALSE) {
standardGeneric("Exprmclust")
}
)
#' @export
#' @rdname Exprmclust
setMethod(
f = "Exprmclust",
signature = "DISCBIO",
definition = function(object, K, modelNames, reduce, cluster, quiet) {
pcareduceres <- calc_pcareduceres(object@fdata, reduce)
if (is.null(cluster)) {
K <- K[K > 1]
res <- Mclust(
data = pcareduceres,
G = K,
modelNames = modelNames,
warn = FALSE,
verbose = !quiet
)
if (is.null(res)) stop("Unable to cluster. Try a lower value for K.")
clusterid <- apply(res$z, 1, which.max)
clunum <- res$G
} else {
clunum <- length(unique(cluster))
clusterid <- cluster
}
clucenter <- matrix(0, ncol = ncol(pcareduceres), nrow = clunum)
for (cid in 1:clunum) {
clucenter[cid, ] <- colMeans(
pcareduceres[names(clusterid[clusterid == cid]), , drop = FALSE]
)
}
dp <- as.matrix(dist(clucenter))
gp <- graph.adjacency(dp, mode = "undirected", weighted = TRUE)
dp_mst <- minimum.spanning.tree(gp)
full_List <- list(
pcareduceres = pcareduceres,
MSTtree = dp_mst,
clusterid = clusterid,
clucenter = clucenter
)
object@MBclusters <- full_List
return(object)
}
)
#' @export
#' @rdname Exprmclust
setMethod(
f = "Exprmclust",
signature = "data.frame",
definition = function(object,
K = 3,
modelNames = "VVV",
reduce = TRUE,
cluster = NULL,
quiet = FALSE) {
pcareduceres <- calc_pcareduceres(object, reduce)
if (is.null(cluster)) {
K <- K[K > 1]
res <- Mclust(
data = pcareduceres,
G = K,
modelNames = modelNames,
warn = FALSE,
verbose = !quiet
)
if (is.null(res)) {
stop("Unable to cluster. Try a lower value for K.")
}
clusterid <- apply(res$z, 1, which.max)
clunum <- res$G
} else {
clunum <- length(unique(cluster))
clusterid <- cluster
}
clucenter <- matrix(0, ncol = ncol(pcareduceres), nrow = clunum)
for (cid in 1:clunum) {
clucenter[cid, ] <- colMeans(
pcareduceres[names(clusterid[clusterid == cid]), , drop = FALSE]
)
}
dp <- as.matrix(dist(clucenter))
gp <-
graph.adjacency(dp, mode = "undirected", weighted = TRUE)
dp_mst <- minimum.spanning.tree(gp)
object <- list(
pcareduceres = pcareduceres,
MSTtree = dp_mst,
clusterid = clusterid,
clucenter = clucenter
)
return(object)
}
)