-
Notifications
You must be signed in to change notification settings - Fork 74
/
runDimReduce.R
212 lines (210 loc) · 10.4 KB
/
runDimReduce.R
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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
#' Generic Wrapper function for running dimensionality reduction
#' @details Wrapper function to run one of the available dimensionality
#' reduction algorithms integrated within SCTK from \code{\link{scaterPCA}},
#' \code{\link{runSeuratPCA}}, \code{\link{runSeuratICA}}, \code{\link{runTSNE}},
#' \code{\link{runSeuratTSNE}}, \code{\link{runUMAP}} and
#' \code{\link{runSeuratUMAP}}. Users can use an assay by specifying
#' \code{useAssay}, use the assay in an altExp by specifying both
#' \code{useAltExp} and \code{useAssay}, or use a low-dimensionality
#' representation by specifying \code{useReducedDim}.
#' @param inSCE Input \linkS4class{SingleCellExperiment} object.
#' @param method One from \code{"scaterPCA"}, \code{"seuratPCA"},
#' \code{"seuratICA"}, \code{"rTSNE"}, \code{"seuratTSNE"}, \code{"scaterUMAP"},
#' \code{"seuratUMAP"}, \code{"scanpyPCA"}, \code{"scanpyUMAP"} and \code{"scanpyTSNE"}.
#' @param useAssay Assay to use for computation. If \code{useAltExp} is
#' specified, \code{useAssay} has to exist in
#' \code{assays(altExp(inSCE, useAltExp))}. Default \code{"counts"}.
#' @param useAltExp The subset to use for computation, usually for the
#' selected variable features. Default \code{NULL}.
#' @param useReducedDim The low dimension representation to use for embedding
#' computation. Default \code{NULL}.
#' @param reducedDimName The name of the result matrix. Required.
#' @param useFeatureSubset Subset of feature to use for dimension reduction. A
#' character string indicating a \code{rowData} variable that stores the logical
#' vector of HVG selection, or a vector that can subset the rows of
#' \code{inSCE}. Default \code{NULL}.
#' @param scale Logical scalar, whether to standardize the expression values.
#' Default \code{TRUE}.
#' @param nComponents Specify the number of dimensions to compute with the
#' selected method in case of PCA/ICA and the number of components to
#' use in the case of TSNE/UMAP methods.
#' @param seed Random seed for reproducibility of results.
#' Default \code{NULL} will use global seed in use by the R environment.
#' @param ... The other arguments for running a specific algorithm. Please refer
#' to the one you use.
#' @return The input \linkS4class{SingleCellExperiment} object with
#' \code{reducedDim} updated with the result.
#' @export
#' @examples
#' data(scExample, package = "singleCellTK")
#' sce <- subsetSCECols(sce, colData = "type != 'EmptyDroplet'")
#' sce <- runNormalization(sce, useAssay = "counts",
#' outAssayName = "logcounts",
#' normalizationMethod = "logNormCounts")
#' sce <- runDimReduce(inSCE = sce, method = "scaterPCA",
#' useAssay = "logcounts", scale = TRUE,
#' reducedDimName = "PCA")
runDimReduce <- function(inSCE,
method = c("scaterPCA",
"seuratPCA",
"seuratICA",
"scanpyPCA",
"rTSNE",
"seuratTSNE",
"scaterUMAP",
"seuratUMAP",
"scanpyUMAP",
"scanpyTSNE"),
useAssay = NULL, useReducedDim = NULL,
useAltExp = NULL, reducedDimName = method,
nComponents = 20, useFeatureSubset = NULL,
scale = FALSE, seed = 12345, ...)
{
method <- match.arg(method)
args <- list(...)
if (method %in% c("scaterPCA", "seuratPCA", "seuratICA") &
!is.null(useReducedDim)) {
stop("`useReducedDim` is not allowed for linear dimension reduction.")
}
if (method == "scaterPCA") {
inSCE <- scaterPCA(inSCE = inSCE, useAssay = useAssay,
useAltExp = useAltExp, reducedDimName = reducedDimName,
nComponents = nComponents,
useFeatureSubset = useFeatureSubset, scale = scale,
seed = seed, ...)
} else if (method == "scaterUMAP") {
inSCE <- runUMAP(inSCE = inSCE, useAssay = useAssay, useAltExp = useAltExp,
useReducedDim = useReducedDim, initialDims = 25,
useFeatureSubset = useFeatureSubset, scale = scale,
reducedDimName = reducedDimName, seed = seed, ...)
} else if (method == "scanpyPCA"){
inSCE <- runScanpyPCA(inSCE = inSCE,
useAssay = useAssay,
reducedDimName = reducedDimName,
nPCs = nComponents,
method = "auto",
use_highly_variable = FALSE
)
} else if (method == "scanpyTSNE"){
inSCE <- runScanpyTSNE(inSCE = inSCE, useAssay = useAssay,
useReducedDim = useReducedDim, reducedDimName = reducedDimName, ...)
} else if (method == "scanpyUMAP"){
inSCE <- runScanpyUMAP(inSCE = inSCE, useAssay = useAssay,
useReducedDim = useReducedDim, reducedDimName = reducedDimName, ...)
} else if (method == "rTSNE") {
inSCE <- runTSNE(inSCE = inSCE, useAssay = useAssay, useAltExp = useAltExp,
useReducedDim = useReducedDim,
useFeatureSubset = useFeatureSubset, scale = scale,
reducedDimName = reducedDimName, seed = seed, ...)
} else {
# Seurat part
# TODO: Honestly, the input checks should have been implemented for
# functions being wrapped because they are being exposed to users as well.
# We should not being performing redundant checks when wrapping them again.
useMat <- .selectSCEMatrix(inSCE, useAssay = useAssay,
useReducedDim = useReducedDim,
useAltExp = useAltExp, returnMatrix = FALSE)
useAssay <- useMat$names$useAssay
if (!is.null(useAltExp)) {
tempSCE <- SingleCellExperiment::altExp(inSCE, useAltExp)
} else if (!is.null(useAssay)) {
tempSCE <- inSCE
}
if (method %in% c("seuratPCA", "seuratICA")) {
## SeuratPCA/ICA
if (method == "seuratPCA") {
p <- paste0(date(), " ... Computing Seurat PCA.")
message(p)
tempSCE <- runSeuratPCA(tempSCE, useAssay = useAssay,
reducedDimName = reducedDimName,
nPCs = nComponents,
useFeatureSubset = useFeatureSubset,
scale = scale, seed = seed, ...)
} else if (method == "seuratICA") {
p <- paste0(date(), " ... Computing Seurat ICA.")
message(p)
tempSCE <- runSeuratICA(tempSCE, useAssay = useAssay,
reducedDimName = reducedDimName,
nics = nComponents,
useFeatureSubset = useFeatureSubset,
scale = scale, seed = seed, ...)
}
seuratObj <- tempSCE@metadata$seurat
if (!is.null(useAltExp)) {
altExp(inSCE, useAltExp)@metadata$seurat <- seuratObj
} else if (!is.null(useAssay)) {
inSCE@metadata$seurat <- seuratObj
}
} else {
## SeuratUMAP/TSNE
if (is.null(useReducedDim)) {
### using assay
if (!"useReduction" %in% names(args)) {
stop("Must specify `useReduction` when using `useAssay` in seuratUMAP/TSNE")
}
if (args$useReduction == "pca") {
p <- paste0(date(), " ... Computing Seurat PCA.")
message(p)
tempSCE <- runSeuratPCA(inSCE = tempSCE,
useAssay = useAssay,
reducedDimName = paste0(useAssay, "_seuratPCA"),
useFeatureSubset = useFeatureSubset, seed = seed)
} else if (args$useReduction == "ica") {
p <- paste0(date(), " ... Computing Seurat ICA.")
message(p)
tempSCE <- runSeuratICA(inSCE = tempSCE,
useAssay = useAssay,
reducedDimName = paste0(useAssay, "_seuratICA"),
useFeatureSubset = useFeatureSubset, seed = seed)
}
if (method == "seuratUMAP") {
p <- paste0(date(), " ... Computing Seurat UMAP.")
message(p)
tempSCE <- runSeuratUMAP(inSCE = tempSCE,
reducedDimName = reducedDimName,
seed = seed, ...)
} else {
p <- paste0(date(), " ... Computing Seurat tSNE.")
message(p)
tempSCE <- runSeuratTSNE(inSCE = tempSCE,
reducedDimName = reducedDimName,
seed = seed, ...)
}
} else {
### using external reducedDim
if (!is.null(args$useReduction)) {
stop("Cannot specify `useReduction` when using `useReducedDim` in seuratUMAP/TSNE")
}
tempSCE <- inSCE
seuratObj <- convertSCEToSeurat(inSCE)
tempSCE@metadata$seurat$obj <- seuratObj
reDim <- SingleCellExperiment::reducedDim(inSCE, useReducedDim)
colnames(reDim) <- paste0(useReducedDim, "_", seq_len(length(colnames(reDim))))
rownames(reDim) <- gsub('_', '-', rownames(reDim))
key <- gsub('_', '', useReducedDim)
# hard-code "pca"
tempSCE@metadata$seurat$obj@reductions$pca <-
Seurat::CreateDimReducObject(embeddings = reDim,
key = paste0(key, "_"), assay = "RNA")
if (method == "seuratUMAP") {
# hard-code useReduction="pca"
p <- paste0(date(), " ... Computing Seurat UMAP.")
message(p)
tempSCE <- runSeuratUMAP(inSCE = tempSCE, useReduction = "pca",
reducedDimName = reducedDimName,
seed = seed, ...)
} else {
# hard-code useReduction="pca"
p <- paste0(date(), " ... Computing Seurat tSNE.")
message(p)
tempSCE <- runSeuratTSNE(inSCE = tempSCE, useReduction = "pca",
reducedDimName = reducedDimName,
seed = seed, ...)
}
}
}
SingleCellExperiment::reducedDim(inSCE, reducedDimName) <-
SingleCellExperiment::reducedDim(tempSCE, reducedDimName)
}
return(inSCE)
}