Browse code

Fix combineSCE related SCTK_QC pipeline

Yichen Wang authored on 17/10/2022 07:25:02
Showing1 changed files
... ...
@@ -1,10 +1,10 @@
1 1
 .constructSCE <- function(
2
-  matrices,
3
-  features,
4
-  barcodes,
5
-  metadata,
6
-  reducedDims) {
7
-
2
+    matrices,
3
+    features,
4
+    barcodes,
5
+    metadata,
6
+    reducedDims) {
7
+  
8 8
   sce <- SingleCellExperiment::SingleCellExperiment(assays = matrices)
9 9
   SummarizedExperiment::rowData(sce) <- S4Vectors::DataFrame(features)
10 10
   SummarizedExperiment::colData(sce) <- S4Vectors::DataFrame(barcodes)
... ...
@@ -34,7 +34,7 @@
34 34
   } else {
35 35
     fill <- NA
36 36
   }
37
-
37
+  
38 38
   ### combine row
39 39
   if (isTRUE(combineRow) & (!is.null(row))) {
40 40
     missRow <- row[!row %in% rownames(x)]
... ...
@@ -43,14 +43,14 @@
43 43
     if (!isTRUE(sparse)) {
44 44
       missMat <- as.matrix(missMat)
45 45
     }
46
-
46
+    
47 47
     mat <- rbind(matOrigin, missMat)
48 48
     if (anyDuplicated(rownames(mat))) {
49 49
       mat <- mat[!duplicated(rownames(mat)), ]
50 50
     }
51 51
     matOrigin <- mat[row, ]
52 52
   }
53
-
53
+  
54 54
   ### combine cols
55 55
   if (isTRUE(combineCol) & (!is.null(col))) {
56 56
     missCol <- col[!col %in% colnames(x)]
... ...
@@ -59,7 +59,7 @@
59 59
     if (!isTRUE(sparse)) {
60 60
       missMat <- as.matrix(missMat)
61 61
     }
62
-
62
+    
63 63
     mat <- cbind(matOrigin, missMat)
64 64
     if (anyDuplicated(colnames(mat))) {
65 65
       mat <- mat[, !duplicated(colnames(mat))]
... ...
@@ -76,12 +76,12 @@
76 76
     rw[['rownames']] <- rownames(rw)
77 77
     return(rw)
78 78
   })
79
-
79
+  
80 80
   ## Get merged rowData
81 81
   by.r <- unique(c('rownames', by.r))
82 82
   unionFe <- Reduce(function(r1, r2) merge(r1, r2, by=by.r, all=TRUE), feList)
83 83
   allGenes <- unique(unlist(lapply(feList, rownames)))
84
-
84
+  
85 85
   ## rowData
86 86
   newFe <- unionFe
87 87
   if (nrow(newFe) != length(allGenes)) {
... ...
@@ -102,7 +102,7 @@
102 102
     cD[['rownames']] <- rownames(cD)
103 103
     return(cD)
104 104
   })
105
-
105
+  
106 106
   by.c <- unique(c("rownames", by.c))
107 107
   unionCb <- Reduce(function(c1, c2) merge(c1, c2, by=by.c, all=TRUE), cbList)
108 108
   rownames(unionCb) <- unionCb[['rownames']]
... ...
@@ -118,19 +118,19 @@
118 118
   reduceList <- lapply(sceList, SingleCellExperiment::reducedDims)
119 119
   ## get every reducedDim exists in at least one SCEs
120 120
   UnionReducedDims <- unique(unlist(lapply(sceList, SingleCellExperiment::reducedDimNames)))
121
-
121
+  
122 122
   ## for each reducedDim, get union row/cols
123 123
   reducedDims <- list()
124 124
   for (reduceDim in UnionReducedDims) {
125 125
     x <- lapply(sceList, function(x) {if (reduceDim %in% SingleCellExperiment::reducedDimNames(x)) {SingleCellExperiment::reducedDim(x, reduceDim)}})
126 126
     reducedDims[[reduceDim]] <- .getDimUnion(x)
127 127
   }
128
-
128
+  
129 129
   ## Merge reducedDim for each SCE
130 130
   redList <- list()
131 131
   for (idx in seq_along(sceList)){
132 132
     redMat <- reduceList[[idx]]
133
-
133
+    
134 134
     for (DimName in UnionReducedDims) {
135 135
       if (DimName %in% names(redMat)) {
136 136
         redMat[[DimName]] <- .getMatUnion(reducedDims[[DimName]], redMat[[DimName]],
... ...
@@ -142,10 +142,10 @@
142 142
                                           dimnames = list(colnames(sceList[[idx]]), reducedDims[[DimName]][[2]]))
143 143
       }
144 144
     }
145
-
145
+    
146 146
     redList[[idx]] <- redMat
147 147
   }
148
-
148
+  
149 149
   return(redList)
150 150
 }
151 151
 
... ...
@@ -157,7 +157,7 @@
157 157
     unique(unlist(lapply(sceList, rownames))),
158 158
     unique(unlist(lapply(sceList, colnames)))
159 159
   )
160
-
160
+  
161 161
   asList <- list()
162 162
   for (idx in seq_along(assayList)){
163 163
     assay <- assayList[[idx]]
... ...
@@ -174,7 +174,7 @@
174 174
     }
175 175
     asList[[idx]] <- assay
176 176
   }
177
-
177
+  
178 178
   return(asList)
179 179
 }
180 180
 
... ...
@@ -197,27 +197,48 @@
197 197
 # }
198 198
 
199 199
 .mergeMetaSCE <- function(SCE_list) {
200
+  # Merge highest level metadata entries (except "sctk") by sample names in
201
+  # SCE_list. For analysis results in "sctk", merge by SCE_list sample name if 
202
+  # given "all_cells" in one object, else, use existing sample names. 
203
+  samples <- names(SCE_list)
200 204
   sampleMeta <- lapply(SCE_list, S4Vectors::metadata)
201 205
   metaNames <- unique(unlist(lapply(sampleMeta, names)))
206
+  sampleSctkMeta <- lapply(SCE_list, function(x) {S4Vectors::metadata(x)$sctk})
207
+  sctkMetaNames <- unique(unlist(lapply(sampleMeta, 
208
+                                        function(x) names(x$sctk))))
209
+  sampleMeta$sctk <- NULL
210
+  metaNames <- metaNames[!metaNames %in% c("sctk")]
202 211
   NewMeta <- list()
203
-
212
+  for (meta in sctkMetaNames) {
213
+    for (i in seq_along(sampleSctkMeta)) {
214
+      # `i` is for identifying each SCE object, usually matching a sample in 
215
+      # the pipeline. `sampleAvail` for samples stored in metadata entry, in
216
+      # case users are merging merged objects. 
217
+      sampleAvail <- names(sampleSctkMeta[[i]][[meta]])
218
+      if (length(sampleAvail) == 1) {
219
+        NewMeta$sctk[[meta]][[samples[i]]] <- sampleSctkMeta[[i]][[meta]][[1]]
220
+      } else if (length(sampleAvail) > 1) {
221
+        names(sampleSctkMeta[[i]][[meta]]) <- 
222
+          paste(names(sampleSctkMeta)[i], 
223
+                names(sampleSctkMeta[[i]][[meta]]), sep = "_")
224
+        NewMeta$sctk[[meta]] <- c(NewMeta$sctk[[meta]], 
225
+                                  sampleSctkMeta[[i]][[meta]])
226
+      }
227
+    }
228
+  }
204 229
   for (meta in metaNames) {
205 230
     for (i in seq_along(sampleMeta)) {
206
-      NewMeta[[meta]][[i]] <- sampleMeta[[i]][[meta]]
231
+      NewMeta[[meta]][[samples[i]]] <- sampleMeta[[i]][[meta]]
207 232
     }
208 233
   }
209
-
210
-  if ("runBarcodeRanksMetaOutput" %in% metaNames) {
211
-    NewMeta[["runBarcodeRanksMetaOutput"]] <- unlist(NewMeta[["runBarcodeRanksMetaOutput"]])
212
-  }
213
-
234
+  
214 235
   if ("assayType" %in% metaNames) {
215 236
     assayType <- lapply(SCE_list, function(x){S4Vectors::metadata(x)$assayType})
216 237
     assayType <- BiocGenerics::Reduce(dplyr::union, assayType)
217 238
     
218 239
     NewMeta[["assayType"]] <- assayType
219 240
   }
220
-
241
+  
221 242
   return(NewMeta)
222 243
 }
223 244
 
... ...
@@ -241,7 +262,7 @@
241 262
 #' @export
242 263
 
243 264
 combineSCE <- function(sceList, by.r = NULL, by.c = NULL, combined = TRUE){
244
-  if(length(sceList) == 1){
265
+  if (length(sceList) == 1) {
245 266
     return(sceList[[1]])
246 267
   }
247 268
   ##  rowData
... ...
@@ -252,16 +273,21 @@ combineSCE <- function(sceList, by.r = NULL, by.c = NULL, combined = TRUE){
252 273
   redMatList <- .mergeRedimSCE(sceList)
253 274
   ## assay
254 275
   assayList <- .mergeAssaySCE(sceList)
255
-
276
+  samples <- names(sceList)
277
+  if (is.null(samples)) {
278
+    samples <- paste0("sample", seq_along(sceList))
279
+  }
256 280
   New_SCE <- list()
257 281
   for (i in seq(length(sceList))) {
258 282
     ## create new sce
259
-    New_SCE[[i]] <- .constructSCE(matrices = assayList[[i]], features = newFeList,
260
-                                  barcodes = newCbList[[i]],
261
-                                  metadata = S4Vectors::metadata(sceList[[i]]),
262
-                                  reducedDims = redMatList[[i]])
283
+    sampleName <- samples[i]
284
+    New_SCE[[sampleName]] <- .constructSCE(matrices = assayList[[i]], 
285
+                                           features = newFeList,
286
+                                           barcodes = newCbList[[i]],
287
+                                           metadata = S4Vectors::metadata(sceList[[i]]),
288
+                                           reducedDims = redMatList[[i]])
263 289
   }
264
-
290
+  
265 291
   if (isTRUE(combined)) {
266 292
     sce <- do.call(SingleCellExperiment::cbind, New_SCE)
267 293
     meta <- .mergeMetaSCE(New_SCE)
Browse code

Fixed R CMD check issues

Irzam Sarfraz authored on 20/12/2021 22:24:01
Showing1 changed files
... ...
@@ -236,6 +236,7 @@
236 236
 #' @return A \link[SingleCellExperiment]{SingleCellExperiment} object which combines all
237 237
 #' objects in sceList. The colData is merged.
238 238
 #' @examples
239
+#' data(scExample, package = "singleCellTK")
239 240
 #' combinedsce <- combineSCE(list(sce,sce), by.r = NULL, by.c = NULL, combined = TRUE)
240 241
 #' @export
241 242
 
Browse code

Changed intersection to union

Irzam Sarfraz authored on 24/10/2021 09:30:28
Showing1 changed files
... ...
@@ -213,7 +213,7 @@
213 213
 
214 214
   if ("assayType" %in% metaNames) {
215 215
     assayType <- lapply(SCE_list, function(x){S4Vectors::metadata(x)$assayType})
216
-    assayType <- Reduce(intersect, assayType)
216
+    assayType <- BiocGenerics::Reduce(dplyr::union, assayType)
217 217
     
218 218
     NewMeta[["assayType"]] <- assayType
219 219
   }
Browse code

Fix BiocCheck error

Irzam Sarfraz authored on 23/10/2021 15:42:54
Showing1 changed files
... ...
@@ -212,7 +212,7 @@
212 212
   }
213 213
 
214 214
   if ("assayType" %in% metaNames) {
215
-    assayType <- lapply(SCE_list, function(x){metadata(x)$assayType})
215
+    assayType <- lapply(SCE_list, function(x){S4Vectors::metadata(x)$assayType})
216 216
     assayType <- Reduce(intersect, assayType)
217 217
     
218 218
     NewMeta[["assayType"]] <- assayType
Browse code

Fixed a bug in combineSCE() caused by the older code related to the assay tags - converted list to tibble

Irzam Sarfraz authored on 23/10/2021 13:54:34
Showing1 changed files
... ...
@@ -212,18 +212,9 @@
212 212
   }
213 213
 
214 214
   if ("assayType" %in% metaNames) {
215
-    tags <- unique(unlist(lapply(SCE_list,
216
-                                 function(x) {
217
-                                   names(S4Vectors::metadata(x)[["assayType"]])
218
-                                 })))
219
-    assayType <- list()
220
-    for (sample in SCE_list) {
221
-      assayType.each <- S4Vectors::metadata(sample)[["assayType"]]
222
-      for (t in tags) {
223
-        assayType[[t]] <- c(assayType[[t]], assayType.each[[t]])
224
-      }
225
-    }
226
-    assayType <- lapply(assayType, unique)
215
+    assayType <- lapply(SCE_list, function(x){metadata(x)$assayType})
216
+    assayType <- Reduce(intersect, assayType)
217
+    
227 218
     NewMeta[["assayType"]] <- assayType
228 219
   }
229 220
 
... ...
@@ -277,4 +268,4 @@ combineSCE <- function(sceList, by.r = NULL, by.c = NULL, combined = TRUE){
277 268
     return(sce)
278 269
   }
279 270
   return(New_SCE)
280
-}
281 271
\ No newline at end of file
272
+}
Browse code

Fix bugs in combineSCE. Update SCTK_runQC.R to include an col in colData indicate whether a barcode is a true cell in the cellSCE object. Update QC documentation

rz2333 authored on 22/09/2021 20:21:28
Showing1 changed files
... ...
@@ -234,16 +234,21 @@
234 234
 #' @param sceList A list contains \link[SingleCellExperiment]{SingleCellExperiment} objects.
235 235
 #' Currently, combineSCE function only support combining SCE objects with assay in dgCMatrix format.
236 236
 #' It does not support combining SCE with assay in delayedArray format.
237
-#' @param by.r Specifications of the columns used for merging rowData. See 'Details'.
238
-#' @param by.c Specifications of the columns used for merging colData. See 'Details'.
239
-#' @param combined logical; if TRUE, it will combine the list of SingleCellExperiment objects. See 'Details'.
237
+#' @param by.r Specifications of the columns used for merging rowData. If set as NULL, 
238
+#' the rownames of rowData tables will be used to merging rowData. Default is NULL. 
239
+#' @param by.c Specifications of the columns used for merging colData. If set as NULL, 
240
+#' the rownames of colData tables will be used to merging colData. Default is NULL.
241
+#' @param combined logical; if TRUE, it will combine the list of SingleCellExperiment objects 
242
+#' and return a SingleCellExperiment. If FALSE, it will return a list of SingleCellExperiment whose
243
+#' rowData, colData, assay and reducedDim data slot are compatible within SCE objects in the list. 
244
+#' Default is TRUE.
240 245
 #' @return A \link[SingleCellExperiment]{SingleCellExperiment} object which combines all
241 246
 #' objects in sceList. The colData is merged.
242 247
 #' @examples
243 248
 #' combinedsce <- combineSCE(list(sce,sce), by.r = NULL, by.c = NULL, combined = TRUE)
244 249
 #' @export
245 250
 
246
-combineSCE <- function(sceList, by.r, by.c, combined){
251
+combineSCE <- function(sceList, by.r = NULL, by.c = NULL, combined = TRUE){
247 252
   if(length(sceList) == 1){
248 253
     return(sceList[[1]])
249 254
   }
Browse code

Merge from devel

Yichen Wang authored on 01/04/2021 17:43:19
Showing0 changed files
Browse code

Adapt combineSCE to tagging sys

Yichen Wang authored on 23/03/2021 21:43:32
Showing1 changed files
... ...
@@ -211,6 +211,22 @@
211 211
     NewMeta[["runBarcodeRanksMetaOutput"]] <- unlist(NewMeta[["runBarcodeRanksMetaOutput"]])
212 212
   }
213 213
 
214
+  if ("assayType" %in% metaNames) {
215
+    tags <- unique(unlist(lapply(SCE_list,
216
+                                 function(x) {
217
+                                   names(S4Vectors::metadata(x)[["assayType"]])
218
+                                 })))
219
+    assayType <- list()
220
+    for (sample in SCE_list) {
221
+      assayType.each <- S4Vectors::metadata(sample)[["assayType"]]
222
+      for (t in tags) {
223
+        assayType[[t]] <- c(assayType[[t]], assayType.each[[t]])
224
+      }
225
+    }
226
+    assayType <- lapply(assayType, unique)
227
+    NewMeta[["assayType"]] <- assayType
228
+  }
229
+
214 230
   return(NewMeta)
215 231
 }
216 232
 
Browse code

UI update for previous related DE function update; plus many minor bug fixes

Yichen Wang authored on 17/03/2021 16:51:52
Showing1 changed files
... ...
@@ -215,9 +215,9 @@
215 215
 }
216 216
 
217 217
 #' Combine a list of SingleCellExperiment objects as one SingleCellExperiment object
218
-#' @param sceList A list contains \link[SingleCellExperiment]{SingleCellExperiment} objects. 
219
-#' Currently, combineSCE function only support combining SCE objects with assay in dgCMatrix format. 
220
-#' It does not support combining SCE with assay in delayedArray format. 
218
+#' @param sceList A list contains \link[SingleCellExperiment]{SingleCellExperiment} objects.
219
+#' Currently, combineSCE function only support combining SCE objects with assay in dgCMatrix format.
220
+#' It does not support combining SCE with assay in delayedArray format.
221 221
 #' @param by.r Specifications of the columns used for merging rowData. See 'Details'.
222 222
 #' @param by.c Specifications of the columns used for merging colData. See 'Details'.
223 223
 #' @param combined logical; if TRUE, it will combine the list of SingleCellExperiment objects. See 'Details'.
... ...
@@ -228,6 +228,9 @@
228 228
 #' @export
229 229
 
230 230
 combineSCE <- function(sceList, by.r, by.c, combined){
231
+  if(length(sceList) == 1){
232
+    return(sceList[[1]])
233
+  }
231 234
   ##  rowData
232 235
   newFeList <- .mergeRowDataSCE(sceList, by.r)
233 236
   ## colData
Browse code

merge latest master

Yichen Wang authored on 08/02/2021 21:14:12
Showing0 changed files
Browse code

Update combineSCE. Fix it so that it does not remove colnames when SCE does not have colData

rz2333 authored on 20/01/2021 04:15:21
Showing1 changed files
... ...
@@ -108,7 +108,7 @@
108 108
   rownames(unionCb) <- unionCb[['rownames']]
109 109
   newCbList <- list()
110 110
   for (i in seq_along(sceList)) {
111
-    newCbList[[i]] <- unionCb[colnames(sceList[[i]]),]
111
+    newCbList[[i]] <- unionCb[colnames(sceList[[i]]), , drop=FALSE]
112 112
   }
113 113
   return(newCbList)
114 114
 }
Browse code

Merge master; fix conflict; fix bug

Yichen Wang authored on 12/11/2020 23:58:02
Showing0 changed files
Browse code

Update documentation for combineSCE.R

rz2333 authored on 21/10/2020 19:50:42
Showing1 changed files
... ...
@@ -215,7 +215,9 @@
215 215
 }
216 216
 
217 217
 #' Combine a list of SingleCellExperiment objects as one SingleCellExperiment object
218
-#' @param sceList A list contains \link[SingleCellExperiment]{SingleCellExperiment} objects
218
+#' @param sceList A list contains \link[SingleCellExperiment]{SingleCellExperiment} objects. 
219
+#' Currently, combineSCE function only support combining SCE objects with assay in dgCMatrix format. 
220
+#' It does not support combining SCE with assay in delayedArray format. 
219 221
 #' @param by.r Specifications of the columns used for merging rowData. See 'Details'.
220 222
 #' @param by.c Specifications of the columns used for merging colData. See 'Details'.
221 223
 #' @param combined logical; if TRUE, it will combine the list of SingleCellExperiment objects. See 'Details'.
Browse code

Integrate changes from sctk_qc_1.7.6. Fix bugs in QC and QC report. Fix bugs of vapply

rz2333 authored on 17/10/2020 00:43:30
Showing1 changed files
... ...
@@ -14,9 +14,9 @@
14 14
 }
15 15
 
16 16
 .getDimUnion <- function(dataList){
17
-  Row <- vapply(dataList, function(x) {rownames(x)})
17
+  Row <- lapply(dataList, function(x) {rownames(x)})
18 18
   RowUnion <- base::Reduce(union, Row)
19
-  Col <- vapply(dataList, function(x) {colnames(x)})
19
+  Col <- lapply(dataList, function(x) {colnames(x)})
20 20
   ColUnion <- base::Reduce(union, Col)
21 21
   return(list(RowUnion, ColUnion))
22 22
 }
Browse code

Merge from upstream

rz2333 authored on 16/10/2020 03:10:12
Showing0 changed files
Browse code

Add Runnable functions

Yusuke Koga authored on 15/10/2020 16:44:51
Showing1 changed files
... ...
@@ -4,7 +4,7 @@
4 4
   barcodes,
5 5
   metadata,
6 6
   reducedDims) {
7
-  
7
+
8 8
   sce <- SingleCellExperiment::SingleCellExperiment(assays = matrices)
9 9
   SummarizedExperiment::rowData(sce) <- S4Vectors::DataFrame(features)
10 10
   SummarizedExperiment::colData(sce) <- S4Vectors::DataFrame(barcodes)
... ...
@@ -21,9 +21,9 @@
21 21
   return(list(RowUnion, ColUnion))
22 22
 }
23 23
 
24
-.getMatUnion <- function(dimsList, x, 
25
-                         combineRow, combineCol, 
26
-                         sparse = FALSE, 
24
+.getMatUnion <- function(dimsList, x,
25
+                         combineRow, combineCol,
26
+                         sparse = FALSE,
27 27
                          fill = c("NA", "0")){
28 28
   row <- dimsList[[1]]
29 29
   col <- dimsList[[2]]
... ...
@@ -34,8 +34,8 @@
34 34
   } else {
35 35
     fill <- NA
36 36
   }
37
-  
38
-  ### combine row 
37
+
38
+  ### combine row
39 39
   if (isTRUE(combineRow) & (!is.null(row))) {
40 40
     missRow <- row[!row %in% rownames(x)]
41 41
     missMat <- Matrix::Matrix(fill, nrow = length(missRow), ncol = ncol(matOrigin),
... ...
@@ -43,15 +43,15 @@
43 43
     if (!isTRUE(sparse)) {
44 44
       missMat <- as.matrix(missMat)
45 45
     }
46
-    
46
+
47 47
     mat <- rbind(matOrigin, missMat)
48 48
     if (anyDuplicated(rownames(mat))) {
49 49
       mat <- mat[!duplicated(rownames(mat)), ]
50 50
     }
51 51
     matOrigin <- mat[row, ]
52 52
   }
53
-  
54
-  ### combine cols 
53
+
54
+  ### combine cols
55 55
   if (isTRUE(combineCol) & (!is.null(col))) {
56 56
     missCol <- col[!col %in% colnames(x)]
57 57
     missMat <- Matrix::Matrix(fill, nrow = nrow(matOrigin), ncol = length(missCol),
... ...
@@ -59,7 +59,7 @@
59 59
     if (!isTRUE(sparse)) {
60 60
       missMat <- as.matrix(missMat)
61 61
     }
62
-    
62
+
63 63
     mat <- cbind(matOrigin, missMat)
64 64
     if (anyDuplicated(colnames(mat))) {
65 65
       mat <- mat[, !duplicated(colnames(mat))]
... ...
@@ -76,17 +76,17 @@
76 76
     rw[['rownames']] <- rownames(rw)
77 77
     return(rw)
78 78
   })
79
-  
79
+
80 80
   ## Get merged rowData
81 81
   by.r <- unique(c('rownames', by.r))
82 82
   unionFe <- Reduce(function(r1, r2) merge(r1, r2, by=by.r, all=TRUE), feList)
83 83
   allGenes <- unique(unlist(lapply(feList, rownames)))
84
-  
84
+
85 85
   ## rowData
86 86
   newFe <- unionFe
87 87
   if (nrow(newFe) != length(allGenes)) {
88 88
     warning("Conflicts were found when merging two rowData. ",
89
-            "Resolved the conflicts by choosing the first entries.", 
89
+            "Resolved the conflicts by choosing the first entries.",
90 90
             "To avoid conflicts, please provide the 'by.r' arguments to ",
91 91
             "specify columns in rowData that does not have conflict between two singleCellExperiment object. ")
92 92
     newFe <- newFe[!duplicated(newFe$rownames), ]
... ...
@@ -102,7 +102,7 @@
102 102
     cD[['rownames']] <- rownames(cD)
103 103
     return(cD)
104 104
   })
105
-  
105
+
106 106
   by.c <- unique(c("rownames", by.c))
107 107
   unionCb <- Reduce(function(c1, c2) merge(c1, c2, by=by.c, all=TRUE), cbList)
108 108
   rownames(unionCb) <- unionCb[['rownames']]
... ...
@@ -118,34 +118,34 @@
118 118
   reduceList <- lapply(sceList, SingleCellExperiment::reducedDims)
119 119
   ## get every reducedDim exists in at least one SCEs
120 120
   UnionReducedDims <- unique(unlist(lapply(sceList, SingleCellExperiment::reducedDimNames)))
121
-  
121
+
122 122
   ## for each reducedDim, get union row/cols
123 123
   reducedDims <- list()
124 124
   for (reduceDim in UnionReducedDims) {
125 125
     x <- lapply(sceList, function(x) {if (reduceDim %in% SingleCellExperiment::reducedDimNames(x)) {SingleCellExperiment::reducedDim(x, reduceDim)}})
126 126
     reducedDims[[reduceDim]] <- .getDimUnion(x)
127 127
   }
128
-  
128
+
129 129
   ## Merge reducedDim for each SCE
130 130
   redList <- list()
131 131
   for (idx in seq_along(sceList)){
132 132
     redMat <- reduceList[[idx]]
133
-    
133
+
134 134
     for (DimName in UnionReducedDims) {
135 135
       if (DimName %in% names(redMat)) {
136 136
         redMat[[DimName]] <- .getMatUnion(reducedDims[[DimName]], redMat[[DimName]],
137 137
                                           combineRow = FALSE, combineCol = TRUE,
138 138
                                           sparse = FALSE, fill = "NA")
139 139
       } else {
140
-        redMat[[DimName]] <- base::matrix(NA, nrow = ncol(sceList[[idx]]), 
140
+        redMat[[DimName]] <- base::matrix(NA, nrow = ncol(sceList[[idx]]),
141 141
                                           ncol = length(reducedDims[[DimName]][[2]]),
142 142
                                           dimnames = list(colnames(sceList[[idx]]), reducedDims[[DimName]][[2]]))
143 143
       }
144 144
     }
145
-    
145
+
146 146
     redList[[idx]] <- redMat
147 147
   }
148
-  
148
+
149 149
   return(redList)
150 150
 }
151 151
 
... ...
@@ -154,21 +154,21 @@
154 154
                         lapply(sceList, SummarizedExperiment::assayNames))
155 155
   assayList <- lapply(sceList, assays)
156 156
   assayDims <- list(
157
-    unique(unlist(lapply(sceList, rownames))), 
157
+    unique(unlist(lapply(sceList, rownames))),
158 158
     unique(unlist(lapply(sceList, colnames)))
159 159
   )
160
-  
160
+
161 161
   asList <- list()
162 162
   for (idx in seq_along(assayList)){
163 163
     assay <- assayList[[idx]]
164 164
     for (assayName in UnionAssays) {
165 165
       if (assayName %in% names(assay)) {
166 166
         assay[[assayName]] <- .getMatUnion(assayDims, assay[[assayName]],
167
-                                           combineRow = TRUE, combineCol = FALSE, 
167
+                                           combineRow = TRUE, combineCol = FALSE,
168 168
                                            sparse = TRUE, fill = "0")
169 169
       } else{
170
-        assay[[assayName]] <- Matrix::Matrix(0, nrow = length(assayDims[[1]]), 
171
-                                             ncol = ncol(sceList[[idx]]), 
170
+        assay[[assayName]] <- Matrix::Matrix(0, nrow = length(assayDims[[1]]),
171
+                                             ncol = ncol(sceList[[idx]]),
172 172
                                              dimnames = list(assayDims[[1]], colnames(sceList[[idx]]))) #assayDims[[assayName]])
173 173
       }
174 174
     }
... ...
@@ -181,46 +181,48 @@
181 181
 # .mergeMetaSCE <- function(sceList) {
182 182
 #   metaList <- lapply(sceList, S4Vectors::metadata)
183 183
 #   metaNames <- unlist(lapply(metaList, names))
184
-  
184
+
185 185
 #   if ("runBarcodeRanksMetaOutput" %in% metaNames) {
186 186
 #     barcodeMetas <- lapply(metaList, function(x) {x[["runBarcodeRanksMetaOutput"]]})
187 187
 #     barcodeMetas <- do.call(rbind, barcodeMetas)
188
-    
188
+
189 189
 #     for (i in seq_along(metaList)) {
190
-#       metaList[[i]][["runBarcodeRanksMetaOutput"]] <- NULL  
190
+#       metaList[[i]][["runBarcodeRanksMetaOutput"]] <- NULL
191 191
 #     }
192
-    
192
+
193 193
 #     metaList[["runBarcodeRanksMetaOutput"]] <- barcodeMetas
194 194
 #   }
195
-  
195
+
196 196
 #   return(metaList)
197 197
 # }
198 198
 
199 199
 .mergeMetaSCE <- function(SCE_list) {
200
-  sampleMeta <- lapply(SCE_list, S4Vectors::metadata) 
200
+  sampleMeta <- lapply(SCE_list, S4Vectors::metadata)
201 201
   metaNames <- unique(unlist(lapply(sampleMeta, names)))
202 202
   NewMeta <- list()
203
-  
203
+
204 204
   for (meta in metaNames) {
205 205
     for (i in seq_along(sampleMeta)) {
206 206
       NewMeta[[meta]][[i]] <- sampleMeta[[i]][[meta]]
207 207
     }
208 208
   }
209
-  
209
+
210 210
   if ("runBarcodeRanksMetaOutput" %in% metaNames) {
211 211
     NewMeta[["runBarcodeRanksMetaOutput"]] <- unlist(NewMeta[["runBarcodeRanksMetaOutput"]])
212 212
   }
213
-  
213
+
214 214
   return(NewMeta)
215 215
 }
216 216
 
217 217
 #' Combine a list of SingleCellExperiment objects as one SingleCellExperiment object
218
-#' @param sceList A list contains \link[SingleCellExperiment]{SingleCellExperiment} objects 
218
+#' @param sceList A list contains \link[SingleCellExperiment]{SingleCellExperiment} objects
219 219
 #' @param by.r Specifications of the columns used for merging rowData. See 'Details'.
220 220
 #' @param by.c Specifications of the columns used for merging colData. See 'Details'.
221
-#' @param combined logical; if TRUE, it will combine the list of SingleCellExperiment objects. See 'Details'.  
222
-#' @return A \link[SingleCellExperiment]{SingleCellExperiment} object which combines all 
223
-#' objects in sceList. The colData is merged.  
221
+#' @param combined logical; if TRUE, it will combine the list of SingleCellExperiment objects. See 'Details'.
222
+#' @return A \link[SingleCellExperiment]{SingleCellExperiment} object which combines all
223
+#' objects in sceList. The colData is merged.
224
+#' @examples
225
+#' combinedsce <- combineSCE(list(sce,sce), by.r = NULL, by.c = NULL, combined = TRUE)
224 226
 #' @export
225 227
 
226 228
 combineSCE <- function(sceList, by.r, by.c, combined){
... ...
@@ -229,19 +231,19 @@ combineSCE <- function(sceList, by.r, by.c, combined){
229 231
   ## colData
230 232
   newCbList <- .mergeColDataSCE(sceList, by.c)
231 233
   ## reducedDim
232
-  redMatList <- .mergeRedimSCE(sceList) 
234
+  redMatList <- .mergeRedimSCE(sceList)
233 235
   ## assay
234
-  assayList <- .mergeAssaySCE(sceList) 
235
-  
236
+  assayList <- .mergeAssaySCE(sceList)
237
+
236 238
   New_SCE <- list()
237 239
   for (i in seq(length(sceList))) {
238 240
     ## create new sce
239 241
     New_SCE[[i]] <- .constructSCE(matrices = assayList[[i]], features = newFeList,
240
-                                  barcodes = newCbList[[i]], 
242
+                                  barcodes = newCbList[[i]],
241 243
                                   metadata = S4Vectors::metadata(sceList[[i]]),
242 244
                                   reducedDims = redMatList[[i]])
243 245
   }
244
-  
246
+
245 247
   if (isTRUE(combined)) {
246 248
     sce <- do.call(SingleCellExperiment::cbind, New_SCE)
247 249
     meta <- .mergeMetaSCE(New_SCE)
Browse code

Changed all T/F to TRUE/FALSE

Joshua D. Campbell authored on 13/10/2020 02:45:44
Showing1 changed files
... ...
@@ -79,7 +79,7 @@
79 79
   
80 80
   ## Get merged rowData
81 81
   by.r <- unique(c('rownames', by.r))
82
-  unionFe <- Reduce(function(r1, r2) merge(r1, r2, by=by.r, all=T), feList)
82
+  unionFe <- Reduce(function(r1, r2) merge(r1, r2, by=by.r, all=TRUE), feList)
83 83
   allGenes <- unique(unlist(lapply(feList, rownames)))
84 84
   
85 85
   ## rowData
... ...
@@ -104,7 +104,7 @@
104 104
   })
105 105
   
106 106
   by.c <- unique(c("rownames", by.c))
107
-  unionCb <- Reduce(function(c1, c2) merge(c1, c2, by=by.c, all=T), cbList)
107
+  unionCb <- Reduce(function(c1, c2) merge(c1, c2, by=by.c, all=TRUE), cbList)
108 108
   rownames(unionCb) <- unionCb[['rownames']]
109 109
   newCbList <- list()
110 110
   for (i in seq_along(sceList)) {
... ...
@@ -234,7 +234,7 @@ combineSCE <- function(sceList, by.r, by.c, combined){
234 234
   assayList <- .mergeAssaySCE(sceList) 
235 235
   
236 236
   New_SCE <- list()
237
-  for (i in 1:length(sceList)) {
237
+  for (i in seq(length(sceList))) {
238 238
     ## create new sce
239 239
     New_SCE[[i]] <- .constructSCE(matrices = assayList[[i]], features = newFeList,
240 240
                                   barcodes = newCbList[[i]], 
... ...
@@ -249,4 +249,4 @@ combineSCE <- function(sceList, by.r, by.c, combined){
249 249
     return(sce)
250 250
   }
251 251
   return(New_SCE)
252
-}
253 252
\ No newline at end of file
253
+}
Browse code

merge from upstream

rz2333 authored on 01/10/2020 14:37:46
Showing0 changed files
Browse code

Update SCTK QC pipeline, combineSCE and QC reports

rz2333 authored on 29/09/2020 20:14:12
Showing1 changed files
... ...
@@ -6,8 +6,8 @@
6 6
   reducedDims) {
7 7
   
8 8
   sce <- SingleCellExperiment::SingleCellExperiment(assays = matrices)
9
-  SummarizedExperiment::rowData(sce) <- features
10
-  SummarizedExperiment::colData(sce) <- barcodes
9
+  SummarizedExperiment::rowData(sce) <- S4Vectors::DataFrame(features)
10
+  SummarizedExperiment::colData(sce) <- S4Vectors::DataFrame(barcodes)
11 11
   S4Vectors::metadata(sce) <- metadata
12 12
   SingleCellExperiment::reducedDims(sce) <- reducedDims
13 13
   return(sce)
Browse code

Update combineSCE function to merge metadata slot. Update runBarcodeRank and its plotting function

rz2333 authored on 29/09/2020 03:48:43
Showing1 changed files
1 1
new file mode 100644
... ...
@@ -0,0 +1,252 @@
1
+.constructSCE <- function(
2
+  matrices,
3
+  features,
4
+  barcodes,
5
+  metadata,
6
+  reducedDims) {
7
+  
8
+  sce <- SingleCellExperiment::SingleCellExperiment(assays = matrices)
9
+  SummarizedExperiment::rowData(sce) <- features
10
+  SummarizedExperiment::colData(sce) <- barcodes
11
+  S4Vectors::metadata(sce) <- metadata
12
+  SingleCellExperiment::reducedDims(sce) <- reducedDims
13
+  return(sce)
14
+}
15
+
16
+.getDimUnion <- function(dataList){
17
+  Row <- sapply(dataList, function(x) {rownames(x)})
18
+  RowUnion <- base::Reduce(union, Row)
19
+  Col <- sapply(dataList, function(x) {colnames(x)})
20
+  ColUnion <- base::Reduce(union, Col)
21
+  return(list(RowUnion, ColUnion))
22
+}
23
+
24
+.getMatUnion <- function(dimsList, x, 
25
+                         combineRow, combineCol, 
26
+                         sparse = FALSE, 
27
+                         fill = c("NA", "0")){
28
+  row <- dimsList[[1]]
29
+  col <- dimsList[[2]]
30
+  matOrigin <- x
31
+  fill <- match.arg(fill)
32
+  if (fill == "0") {
33
+    fill <- 0
34
+  } else {
35
+    fill <- NA
36
+  }
37
+  
38
+  ### combine row 
39
+  if (isTRUE(combineRow) & (!is.null(row))) {
40
+    missRow <- row[!row %in% rownames(x)]
41
+    missMat <- Matrix::Matrix(fill, nrow = length(missRow), ncol = ncol(matOrigin),
42
+                            dimnames = list(missRow, colnames(matOrigin)))
43
+    if (!isTRUE(sparse)) {
44
+      missMat <- as.matrix(missMat)
45
+    }
46
+    
47
+    mat <- rbind(matOrigin, missMat)
48
+    if (anyDuplicated(rownames(mat))) {
49
+      mat <- mat[!duplicated(rownames(mat)), ]
50
+    }
51
+    matOrigin <- mat[row, ]
52
+  }
53
+  
54
+  ### combine cols 
55
+  if (isTRUE(combineCol) & (!is.null(col))) {
56
+    missCol <- col[!col %in% colnames(x)]
57
+    missMat <- Matrix::Matrix(fill, nrow = nrow(matOrigin), ncol = length(missCol),
58
+                            dimnames = list(rownames(matOrigin), missCol))
59
+    if (!isTRUE(sparse)) {
60
+      missMat <- as.matrix(missMat)
61
+    }
62
+    
63
+    mat <- cbind(matOrigin, missMat)
64
+    if (anyDuplicated(colnames(mat))) {
65
+      mat <- mat[, !duplicated(colnames(mat))]
66
+    }
67
+    matOrigin <- mat[, col]
68
+  }
69
+  return(matOrigin)
70
+}
71
+
72
+
73
+.mergeRowDataSCE <- function(sceList, by.r) {
74
+  feList <- lapply(sceList, function(x){
75
+    rw <- SummarizedExperiment::rowData(x)
76
+    rw[['rownames']] <- rownames(rw)
77
+    return(rw)
78
+  })
79
+  
80
+  ## Get merged rowData
81
+  by.r <- unique(c('rownames', by.r))
82
+  unionFe <- Reduce(function(r1, r2) merge(r1, r2, by=by.r, all=T), feList)
83
+  allGenes <- unique(unlist(lapply(feList, rownames)))
84
+  
85
+  ## rowData
86
+  newFe <- unionFe
87
+  if (nrow(newFe) != length(allGenes)) {
88
+    warning("Conflicts were found when merging two rowData. ",
89
+            "Resolved the conflicts by choosing the first entries.", 
90
+            "To avoid conflicts, please provide the 'by.r' arguments to ",
91
+            "specify columns in rowData that does not have conflict between two singleCellExperiment object. ")
92
+    newFe <- newFe[!duplicated(newFe$rownames), ]
93
+  }
94
+  rownames(newFe) <- newFe[['rownames']]
95
+  newFe <- newFe[allGenes,]
96
+  return(newFe)
97
+}
98
+
99
+.mergeColDataSCE <- function(sceList, by.c) {
100
+  cbList <- lapply(sceList, function(x) {
101
+    cD <- SummarizedExperiment::colData(x)
102
+    cD[['rownames']] <- rownames(cD)
103
+    return(cD)
104
+  })
105
+  
106
+  by.c <- unique(c("rownames", by.c))
107
+  unionCb <- Reduce(function(c1, c2) merge(c1, c2, by=by.c, all=T), cbList)
108
+  rownames(unionCb) <- unionCb[['rownames']]
109
+  newCbList <- list()
110
+  for (i in seq_along(sceList)) {
111
+    newCbList[[i]] <- unionCb[colnames(sceList[[i]]),]
112
+  }
113
+  return(newCbList)
114
+}
115
+
116
+.mergeRedimSCE <- function(sceList, reduceList) {
117
+  ## get reducedDims for each SCE SummarizedExperiment::
118
+  reduceList <- lapply(sceList, SingleCellExperiment::reducedDims)
119
+  ## get every reducedDim exists in at least one SCEs
120
+  UnionReducedDims <- unique(unlist(lapply(sceList, SingleCellExperiment::reducedDimNames)))
121
+  
122
+  ## for each reducedDim, get union row/cols
123
+  reducedDims <- list()
124
+  for (reduceDim in UnionReducedDims) {
125
+    x <- lapply(sceList, function(x) {if (reduceDim %in% SingleCellExperiment::reducedDimNames(x)) {SingleCellExperiment::reducedDim(x, reduceDim)}})
126
+    reducedDims[[reduceDim]] <- .getDimUnion(x)
127
+  }
128
+  
129
+  ## Merge reducedDim for each SCE
130
+  redList <- list()
131
+  for (idx in seq_along(sceList)){
132
+    redMat <- reduceList[[idx]]
133
+    
134
+    for (DimName in UnionReducedDims) {
135
+      if (DimName %in% names(redMat)) {
136
+        redMat[[DimName]] <- .getMatUnion(reducedDims[[DimName]], redMat[[DimName]],
137
+                                          combineRow = FALSE, combineCol = TRUE,
138
+                                          sparse = FALSE, fill = "NA")
139
+      } else {
140
+        redMat[[DimName]] <- base::matrix(NA, nrow = ncol(sceList[[idx]]), 
141
+                                          ncol = length(reducedDims[[DimName]][[2]]),
142
+                                          dimnames = list(colnames(sceList[[idx]]), reducedDims[[DimName]][[2]]))
143
+      }
144
+    }
145
+    
146
+    redList[[idx]] <- redMat
147
+  }
148
+  
149
+  return(redList)
150
+}
151
+
152
+.mergeAssaySCE <- function(sceList) {
153
+  UnionAssays <- Reduce(function(d1, d2) base::union(d1, d2),
154
+                        lapply(sceList, SummarizedExperiment::assayNames))
155
+  assayList <- lapply(sceList, assays)
156
+  assayDims <- list(
157
+    unique(unlist(lapply(sceList, rownames))), 
158
+    unique(unlist(lapply(sceList, colnames)))
159
+  )
160
+  
161
+  asList <- list()
162
+  for (idx in seq_along(assayList)){
163
+    assay <- assayList[[idx]]
164
+    for (assayName in UnionAssays) {
165
+      if (assayName %in% names(assay)) {
166
+        assay[[assayName]] <- .getMatUnion(assayDims, assay[[assayName]],
167
+                                           combineRow = TRUE, combineCol = FALSE, 
168
+                                           sparse = TRUE, fill = "0")
169
+      } else{
170
+        assay[[assayName]] <- Matrix::Matrix(0, nrow = length(assayDims[[1]]), 
171
+                                             ncol = ncol(sceList[[idx]]), 
172
+                                             dimnames = list(assayDims[[1]], colnames(sceList[[idx]]))) #assayDims[[assayName]])
173
+      }
174
+    }
175
+    asList[[idx]] <- assay
176
+  }
177
+
178
+  return(asList)
179
+}
180
+
181
+# .mergeMetaSCE <- function(sceList) {
182
+#   metaList <- lapply(sceList, S4Vectors::metadata)
183
+#   metaNames <- unlist(lapply(metaList, names))
184
+  
185
+#   if ("runBarcodeRanksMetaOutput" %in% metaNames) {
186
+#     barcodeMetas <- lapply(metaList, function(x) {x[["runBarcodeRanksMetaOutput"]]})
187
+#     barcodeMetas <- do.call(rbind, barcodeMetas)
188
+    
189
+#     for (i in seq_along(metaList)) {
190
+#       metaList[[i]][["runBarcodeRanksMetaOutput"]] <- NULL  
191
+#     }
192
+    
193
+#     metaList[["runBarcodeRanksMetaOutput"]] <- barcodeMetas
194
+#   }
195
+  
196
+#   return(metaList)
197
+# }
198
+
199
+.mergeMetaSCE <- function(SCE_list) {
200
+  sampleMeta <- lapply(SCE_list, S4Vectors::metadata) 
201
+  metaNames <- unique(unlist(lapply(sampleMeta, names)))
202
+  NewMeta <- list()
203
+  
204
+  for (meta in metaNames) {
205
+    for (i in seq_along(sampleMeta)) {
206
+      NewMeta[[meta]][[i]] <- sampleMeta[[i]][[meta]]
207
+    }
208
+  }
209
+  
210
+  if ("runBarcodeRanksMetaOutput" %in% metaNames) {
211
+    NewMeta[["runBarcodeRanksMetaOutput"]] <- unlist(NewMeta[["runBarcodeRanksMetaOutput"]])
212
+  }
213
+  
214
+  return(NewMeta)
215
+}
216
+
217
+#' Combine a list of SingleCellExperiment objects as one SingleCellExperiment object
218
+#' @param sceList A list contains \link[SingleCellExperiment]{SingleCellExperiment} objects 
219
+#' @param by.r Specifications of the columns used for merging rowData. See 'Details'.
220
+#' @param by.c Specifications of the columns used for merging colData. See 'Details'.
221
+#' @param combined logical; if TRUE, it will combine the list of SingleCellExperiment objects. See 'Details'.  
222
+#' @return A \link[SingleCellExperiment]{SingleCellExperiment} object which combines all 
223
+#' objects in sceList. The colData is merged.  
224
+#' @export
225
+
226
+combineSCE <- function(sceList, by.r, by.c, combined){
227
+  ##  rowData
228
+  newFeList <- .mergeRowDataSCE(sceList, by.r)
229
+  ## colData
230
+  newCbList <- .mergeColDataSCE(sceList, by.c)
231
+  ## reducedDim
232
+  redMatList <- .mergeRedimSCE(sceList) 
233
+  ## assay
234
+  assayList <- .mergeAssaySCE(sceList) 
235
+  
236
+  New_SCE <- list()
237
+  for (i in 1:length(sceList)) {
238
+    ## create new sce
239
+    New_SCE[[i]] <- .constructSCE(matrices = assayList[[i]], features = newFeList,
240
+                                  barcodes = newCbList[[i]], 
241
+                                  metadata = S4Vectors::metadata(sceList[[i]]),
242
+                                  reducedDims = redMatList[[i]])
243
+  }
244
+  
245
+  if (isTRUE(combined)) {
246
+    sce <- do.call(SingleCellExperiment::cbind, New_SCE)
247
+    meta <- .mergeMetaSCE(New_SCE)
248
+    S4Vectors::metadata(sce) <- meta
249
+    return(sce)
250
+  }
251
+  return(New_SCE)
252
+}
0 253
\ No newline at end of file