Browse code

Update barcodeRank and EmptyDrops

Yichen Wang authored on 14/10/2022 09:54:10
Showing1 changed files
... ...
@@ -1,21 +1,22 @@
1
-
2
-.runBarcodeRankDrops <- function(barcode.matrix, lower=lower,
3
-                                 fit.bounds=fit.bounds,
4
-                                 df=df) {
5
-
1
+.runBarcodeRankDrops <- function(barcode.matrix, lower = lower,
2
+                                 fit.bounds = fit.bounds,
3
+                                 df = df) {
4
+  
6 5
   ## Convert to sparse matrix if not already in that format
7 6
   barcode.matrix <- .convertToMatrix(barcode.matrix)
8
-
9
-  output <- DropletUtils::barcodeRanks(m = barcode.matrix, lower=lower,
10
-                                       fit.bounds=fit.bounds,
11
-                                       df=df)
12
-
13
-  knee.ix <- as.integer(output@listData$total >= S4Vectors::metadata(output)$knee)
14
-  inflection.ix <- as.integer(output@listData$total >= S4Vectors::metadata(output)$inflection)
15
-  rank.ix<- as.integer(output$rank)
16
-  total.ix<- as.integer(output$total)
17
-  fitted.ix<- as.integer(output$fitted)
18
-
7
+  
8
+  output <- DropletUtils::barcodeRanks(m = barcode.matrix, lower = lower,
9
+                                       fit.bounds = fit.bounds,
10
+                                       df = df)
11
+  
12
+  knee.ix <- as.integer(output@listData$total >= 
13
+                          S4Vectors::metadata(output)$knee)
14
+  inflection.ix <- as.integer(output@listData$total >= 
15
+                                S4Vectors::metadata(output)$inflection)
16
+  rank.ix <- as.integer(output$rank)
17
+  total.ix <- as.integer(output$total)
18
+  fitted.ix <- as.integer(output$fitted)
19
+  
19 20
   result <- cbind(knee.ix, inflection.ix, rank.ix, total.ix, fitted.ix)
20 21
   colnames(result) <- c("dropletUtils_barcodeRank_knee",
21 22
                         "dropletUtils_barcodeRank_inflection",
... ...
@@ -25,44 +26,41 @@
25 26
   result.list <- list(result,
26 27
                       S4Vectors::metadata(output)$knee,
27 28
                       S4Vectors::metadata(output)$inflection)
28
-  names(result.list) <- c("matrix","knee","inflection")
29
+  names(result.list) <- c("matrix", "knee", "inflection")
29 30
   return(result.list)
30 31
 }
31 32
 
32 33
 
33 34
 #' @title Identify empty droplets using \link[DropletUtils]{barcodeRanks}.
34 35
 #' @description Run \link[DropletUtils]{barcodeRanks} on a count matrix
35
-#'  provided in a \link[SingleCellExperiment]{SingleCellExperiment} object.
36
-#'  Distinguish between droplets containing cells and ambient RNA in a
37
-#'  droplet-based single-cell RNA sequencing experiment.
38
-#' @param inSCE A \link[SingleCellExperiment]{SingleCellExperiment} object.
39
-#'  Must contain a raw counts matrix before empty droplets have been removed.
40
-#' @param useAssay  A string specifying which assay in the SCE to use.
41
-#' @param sample Character vector. Indicates which sample each cell belongs to
42
-#'  \link[DropletUtils]{emptyDrops} will be run on cells from each sample separately.
43
-#'  If NULL, then all cells will be processed together. Default \code{NULL}.
44
-#' @param lower See \link[DropletUtils]{emptyDrops} for more information. Default \code{100}.
45
-#' @param fitBounds See \link[DropletUtils]{emptyDrops} for more information. Default \code{NULL}.
46
-#' @param df See \link[DropletUtils]{emptyDrops} for more information. Default \code{20}.
47
-#' @return A \link[SingleCellExperiment]{SingleCellExperiment} object with the
48
-#'  \link[DropletUtils]{barcodeRanks} output table appended to the
49
-#'  \link{colData} slot. The columns include
50
-#'  \emph{dropletUtils_BarcodeRank_Knee} and \emph{dropletUtils_BarcodeRank_Knee}
51
-#'  Please refer to the documentation of \link[DropletUtils]{barcodeRanks} for
52
-#'  details.
36
+#' provided in a \linkS4class{SingleCellExperiment} object. Distinguish between 
37
+#' droplets containing cells and ambient RNA in a droplet-based single-cell RNA 
38
+#' sequencing experiment.
39
+#' @param inSCE A \linkS4class{SingleCellExperiment} object. Must contain a raw 
40
+#' counts matrix before empty droplets have been removed.
41
+#' @param sample Character vector or colData variable name. Indicates which 
42
+#' sample each cell belongs to. Default \code{NULL}.
43
+#' @param useAssay A string specifying which assay in the SCE to use. Default 
44
+#' \code{"counts"}
45
+#' @param lower See \link[DropletUtils]{barcodeRanks} for more information. 
46
+#' Default \code{100}.
47
+#' @param fitBounds See \link[DropletUtils]{barcodeRanks} for more information. 
48
+#' Default \code{NULL}.
49
+#' @param df See \link[DropletUtils]{barcodeRanks} for more information. Default 
50
+#' \code{20}.
51
+#' @return A \linkS4class{SingleCellExperiment} object with the
52
+#' \link[DropletUtils]{barcodeRanks} output table appended to the
53
+#' \link{colData} slot. The columns include
54
+#' \code{dropletUtils_BarcodeRank_Knee} and 
55
+#' \code{dropletUtils_barcodeRank_inflection}. Please refer to the documentation
56
+#' of \link[DropletUtils]{barcodeRanks} for details.
57
+#' @seealso \code{\link[DropletUtils]{barcodeRanks}}, 
58
+#' \code{\link{runDropletQC}}, \code{\link{plotBarcodeRankDropsResults}}
53 59
 #' @examples
54
-#' # The following unfiltered PBMC_1k_v3 data were downloaded from
55
-#' # https://support.10xgenomics.com/single-cell-gene-expression/datasets/3.0.0
56
-#' # /pbmc_1k_v3
57
-#' # Only the top 10 cells with most counts and the last 10 cells with non-zero
58
-#' # counts are included in this example.
59
-#' # This example only serves as an proof of concept and a tutoriol on how to
60
-#' # run the function. The results should not be
61
-#' # used for drawing scientific conclusions.
62 60
 #' data(scExample, package = "singleCellTK")
63 61
 #' sce <- runBarcodeRankDrops(inSCE = sce)
64 62
 #' @export
65
-#' @importFrom SummarizedExperiment colData colData<-
63
+#' @importFrom SummarizedExperiment colData colData<- assay
66 64
 runBarcodeRankDrops <- function(inSCE,
67 65
                                 sample = NULL,
68 66
                                 useAssay = "counts",
... ...
@@ -70,68 +68,75 @@ runBarcodeRankDrops <- function(inSCE,
70 68
                                 fitBounds = NULL,
71 69
                                 df = 20
72 70
 ) {
73
-  if(!is.null(sample)) {
74
-    if(length(sample) != ncol(inSCE)) {
75
-      stop("'sample' must be the same length as the number of columns in 'inSCE'")
76
-    }
77
-  } else {
78
-    sample = rep(1, ncol(inSCE))
79
-  }
80
-
71
+  
81 72
   message(paste0(date(), " ... Running 'barcodeRanks'"))
82
-
73
+  
83 74
   ##  Getting current arguments values
84
-  #argsList <- as.list(formals(fun = sys.function(sys.parent()), envir = parent.frame()))
85 75
   argsList <- mget(names(formals()),sys.frame(sys.nframe()))
86
-
87
-  rank <- list()
88
-
76
+  argsList <- argsList[!names(argsList) %in% c("inSCE")]
77
+  argsList$packageVersion <- utils::packageDescription("DropletUtils")$Version
78
+  
79
+  sample <- .manageCellVar(inSCE, var = sample)
80
+  if (is.null(sample)) {
81
+    sample <- rep(1, ncol(inSCE))
82
+  }
83
+  
89 84
   ## Define result matrix for all samples
90
-  output <- S4Vectors::DataFrame(row.names = colnames(inSCE),
91
-                                 dropletUtils_BarcodeRank_Knee = integer(ncol(inSCE)),
92
-                                 dropletUtils_BarcodeRank_Inflection = integer(ncol(inSCE)))
93
-
85
+  output <- S4Vectors::DataFrame(
86
+    row.names = colnames(inSCE),
87
+    dropletUtils_BarcodeRank_Knee = integer(ncol(inSCE)),
88
+    dropletUtils_BarcodeRank_Inflection = integer(ncol(inSCE))
89
+  )
90
+  
94 91
   ## Loop through each sample and run barcodeRank
95 92
   samples <- unique(sample)
96
-  metaOutList <- list()
97
-  for (i in seq_len(length(samples))) {
98
-    sceSampleInd <- sample == samples[i]
93
+  for (s in samples) {
94
+    sceSampleInd <- sample == s
99 95
     sceSample <- inSCE[, sceSampleInd]
100
-
96
+    
101 97
     ## Define meta matrix for each subinSCE
102
-    metaOutput <- S4Vectors::DataFrame(row.names = colnames(sceSample),
103
-                                       dropletUtils_barcodeRank_rank = integer(ncol(sceSample)),
104
-                                       dropletUtils_barcodeRank_total = integer(ncol(sceSample)),
105
-                                       dropletUtils_barcodeRank_fitted = integer(ncol(sceSample)),
106
-                                       dropletUtils_barcodeRank_knee = integer(ncol(sceSample)),
107
-                                       dropletUtils_barcodeRank_inflection = integer(ncol(sceSample)))
98
+    metaOutput <- S4Vectors::DataFrame(
99
+      row.names = colnames(sceSample),
100
+      dropletUtils_barcodeRank_rank = integer(ncol(sceSample)),
101
+      dropletUtils_barcodeRank_total = integer(ncol(sceSample)),
102
+      dropletUtils_barcodeRank_fitted = integer(ncol(sceSample)),
103
+      dropletUtils_barcodeRank_knee = integer(ncol(sceSample)),
104
+      dropletUtils_barcodeRank_inflection = integer(ncol(sceSample))
105
+    )
108 106
     metaOutput$sample <- colData(sceSample)[["Sample"]]
109
-
110
-    mat <- SummarizedExperiment::assay(sceSample, i = useAssay)
111
-    result <- .runBarcodeRankDrops(barcode.matrix = mat, lower=lower,
112
-                                   fit.bounds=fitBounds,
113
-                                   df=df)
114
-
107
+    
108
+    mat <- assay(sceSample, i = useAssay)
109
+    result <- .runBarcodeRankDrops(barcode.matrix = mat, lower = lower,
110
+                                   fit.bounds = fitBounds,
111
+                                   df = df)
112
+    
115 113
     result.matrix <- result$matrix
116
-    output[sceSampleInd, ] <- result.matrix[, c("dropletUtils_barcodeRank_knee", "dropletUtils_barcodeRank_inflection")]
117
-
118
-    metaCols <- c("dropletUtils_barcodeRank_rank", "dropletUtils_barcodeRank_total",
114
+    output[sceSampleInd, ] <- 
115
+      result.matrix[, c("dropletUtils_barcodeRank_knee",
116
+                        "dropletUtils_barcodeRank_inflection")]
117
+    
118
+    metaCols <- c("dropletUtils_barcodeRank_rank", 
119
+                  "dropletUtils_barcodeRank_total",
119 120
                   "dropletUtils_barcodeRank_fitted")
120
-    metaOutput[sceSampleInd, metaCols] <- result.matrix[, metaCols]
121
-    metaOutput[sceSampleInd,"dropletUtils_barcodeRank_knee"] <- rep(result$knee, sum(sceSampleInd))
122
-    metaOutput[sceSampleInd,"dropletUtils_barcodeRank_inflection"] <- rep(result$inflection, sum(sceSampleInd))
123
-
121
+    metaOutput[, metaCols] <- result.matrix[, metaCols]
122
+    metaOutput[,"dropletUtils_barcodeRank_knee"] <- rep(result$knee,
123
+                                                        sum(sceSampleInd))
124
+    metaOutput[,"dropletUtils_barcodeRank_inflection"] <- rep(result$inflection,
125
+                                                              sum(sceSampleInd))
126
+    
124 127
     # Remove duplicated Rank
125
-    metaOutput <- metaOutput[!duplicated(metaOutput$dropletUtils_barcodeRank_rank), ]
126
-
127
-    metaOutList[[samples[i]]] <- metaOutput
128
+    metaOutput <- 
129
+      metaOutput[!duplicated(metaOutput$dropletUtils_barcodeRank_rank), ]
130
+    if (!identical(samples, 1)) {
131
+      S4Vectors::metadata(inSCE)$sctk$runBarcodeRankDrops[[s]] <- 
132
+        list(metaOutput = metaOutput, argsList = argsList)
133
+    }
128 134
   }
129
-
130
-  colData(inSCE) = cbind(colData(inSCE), output)
131
-  S4Vectors::metadata(inSCE)$runBarcodeRanksMetaOutput <- metaOutList
132
-
133
-  inSCE@metadata$runBarcodeRankDrops <- argsList[-1]
134
-  inSCE@metadata$runBarcodeRankDrops$packageVersion <- utils::packageDescription("DropletUtils")$Version
135
-
135
+  if (identical(samples, 1)) {
136
+    S4Vectors::metadata(inSCE)$sctk$runBarcodeRankDrops$all_cells <- 
137
+      list(metaOutput = metaOutput, argsList = argsList)
138
+  }
139
+  
140
+  colData(inSCE) <- cbind(colData(inSCE), output)
136 141
   return(inSCE)
137 142
 }
Browse code

Fixing devtools::check errors

Yusuke Koga authored on 15/12/2020 13:51:45
Showing1 changed files
... ...
@@ -104,8 +104,8 @@ runBarcodeRankDrops <- function(inSCE,
104 104
                                        dropletUtils_barcodeRank_total = integer(ncol(sceSample)),
105 105
                                        dropletUtils_barcodeRank_fitted = integer(ncol(sceSample)),
106 106
                                        dropletUtils_barcodeRank_knee = integer(ncol(sceSample)),
107
-                                       dropletUtils_barcodeRank_inflection = integer(ncol(sceSample)),
108
-                                       sample = colData(sceSample)[["Sample"]])
107
+                                       dropletUtils_barcodeRank_inflection = integer(ncol(sceSample)))
108
+    metaOutput$sample <- colData(sceSample)[["Sample"]]
109 109
 
110 110
     mat <- SummarizedExperiment::assay(sceSample, i = useAssay)
111 111
     result <- .runBarcodeRankDrops(barcode.matrix = mat, lower=lower,
Browse code

New parameters featureLocation/Display in getBiomarker

Yusuke Koga authored on 14/12/2020 23:27:40
Showing1 changed files
... ...
@@ -2,20 +2,20 @@
2 2
 .runBarcodeRankDrops <- function(barcode.matrix, lower=lower,
3 3
                                  fit.bounds=fit.bounds,
4 4
                                  df=df) {
5
-  
5
+
6 6
   ## Convert to sparse matrix if not already in that format
7 7
   barcode.matrix <- .convertToMatrix(barcode.matrix)
8
-  
8
+
9 9
   output <- DropletUtils::barcodeRanks(m = barcode.matrix, lower=lower,
10 10
                                        fit.bounds=fit.bounds,
11 11
                                        df=df)
12
-  
12
+
13 13
   knee.ix <- as.integer(output@listData$total >= S4Vectors::metadata(output)$knee)
14 14
   inflection.ix <- as.integer(output@listData$total >= S4Vectors::metadata(output)$inflection)
15 15
   rank.ix<- as.integer(output$rank)
16 16
   total.ix<- as.integer(output$total)
17 17
   fitted.ix<- as.integer(output$fitted)
18
-  
18
+
19 19
   result <- cbind(knee.ix, inflection.ix, rank.ix, total.ix, fitted.ix)
20 20
   colnames(result) <- c("dropletUtils_barcodeRank_knee",
21 21
                         "dropletUtils_barcodeRank_inflection",
... ...
@@ -77,27 +77,27 @@ runBarcodeRankDrops <- function(inSCE,
77 77
   } else {
78 78
     sample = rep(1, ncol(inSCE))
79 79
   }
80
-  
80
+
81 81
   message(paste0(date(), " ... Running 'barcodeRanks'"))
82
-  
82
+
83 83
   ##  Getting current arguments values
84 84
   #argsList <- as.list(formals(fun = sys.function(sys.parent()), envir = parent.frame()))
85 85
   argsList <- mget(names(formals()),sys.frame(sys.nframe()))
86
-  
86
+
87 87
   rank <- list()
88
-  
88
+
89 89
   ## Define result matrix for all samples
90 90
   output <- S4Vectors::DataFrame(row.names = colnames(inSCE),
91 91
                                  dropletUtils_BarcodeRank_Knee = integer(ncol(inSCE)),
92 92
                                  dropletUtils_BarcodeRank_Inflection = integer(ncol(inSCE)))
93
-  
93
+
94 94
   ## Loop through each sample and run barcodeRank
95 95
   samples <- unique(sample)
96 96
   metaOutList <- list()
97 97
   for (i in seq_len(length(samples))) {
98 98
     sceSampleInd <- sample == samples[i]
99 99
     sceSample <- inSCE[, sceSampleInd]
100
-    
100
+
101 101
     ## Define meta matrix for each subinSCE
102 102
     metaOutput <- S4Vectors::DataFrame(row.names = colnames(sceSample),
103 103
                                        dropletUtils_barcodeRank_rank = integer(ncol(sceSample)),
... ...
@@ -105,33 +105,33 @@ runBarcodeRankDrops <- function(inSCE,
105 105
                                        dropletUtils_barcodeRank_fitted = integer(ncol(sceSample)),
106 106
                                        dropletUtils_barcodeRank_knee = integer(ncol(sceSample)),
107 107
                                        dropletUtils_barcodeRank_inflection = integer(ncol(sceSample)),
108
-                                       sample = colData(sceSample)[["sample"]])
109
-    
108
+                                       sample = colData(sceSample)[["Sample"]])
109
+
110 110
     mat <- SummarizedExperiment::assay(sceSample, i = useAssay)
111 111
     result <- .runBarcodeRankDrops(barcode.matrix = mat, lower=lower,
112 112
                                    fit.bounds=fitBounds,
113 113
                                    df=df)
114
-    
114
+
115 115
     result.matrix <- result$matrix
116 116
     output[sceSampleInd, ] <- result.matrix[, c("dropletUtils_barcodeRank_knee", "dropletUtils_barcodeRank_inflection")]
117
-    
118
-    metaCols <- c("dropletUtils_barcodeRank_rank", "dropletUtils_barcodeRank_total", 
117
+
118
+    metaCols <- c("dropletUtils_barcodeRank_rank", "dropletUtils_barcodeRank_total",
119 119
                   "dropletUtils_barcodeRank_fitted")
120 120
     metaOutput[sceSampleInd, metaCols] <- result.matrix[, metaCols]
121 121
     metaOutput[sceSampleInd,"dropletUtils_barcodeRank_knee"] <- rep(result$knee, sum(sceSampleInd))
122 122
     metaOutput[sceSampleInd,"dropletUtils_barcodeRank_inflection"] <- rep(result$inflection, sum(sceSampleInd))
123
-    
123
+
124 124
     # Remove duplicated Rank
125 125
     metaOutput <- metaOutput[!duplicated(metaOutput$dropletUtils_barcodeRank_rank), ]
126
-    
126
+
127 127
     metaOutList[[samples[i]]] <- metaOutput
128 128
   }
129
-  
129
+
130 130
   colData(inSCE) = cbind(colData(inSCE), output)
131 131
   S4Vectors::metadata(inSCE)$runBarcodeRanksMetaOutput <- metaOutList
132
-  
132
+
133 133
   inSCE@metadata$runBarcodeRankDrops <- argsList[-1]
134 134
   inSCE@metadata$runBarcodeRankDrops$packageVersion <- utils::packageDescription("DropletUtils")$Version
135
-  
135
+
136 136
   return(inSCE)
137 137
 }
Browse code

Edit links to documentation

unknown authored on 22/10/2020 03:39:09
Showing1 changed files
... ...
@@ -46,7 +46,7 @@
46 46
 #' @param df See \link[DropletUtils]{emptyDrops} for more information. Default \code{20}.
47 47
 #' @return A \link[SingleCellExperiment]{SingleCellExperiment} object with the
48 48
 #'  \link[DropletUtils]{barcodeRanks} output table appended to the
49
-#'  \link[SummarizedExperiment]{colData} slot. The columns include
49
+#'  \link{colData} slot. The columns include
50 50
 #'  \emph{dropletUtils_BarcodeRank_Knee} and \emph{dropletUtils_BarcodeRank_Knee}
51 51
 #'  Please refer to the documentation of \link[DropletUtils]{barcodeRanks} for
52 52
 #'  details.
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
... ...
@@ -2,20 +2,20 @@
2 2
 .runBarcodeRankDrops <- function(barcode.matrix, lower=lower,
3 3
                                  fit.bounds=fit.bounds,
4 4
                                  df=df) {
5
-
5
+  
6 6
   ## Convert to sparse matrix if not already in that format
7 7
   barcode.matrix <- .convertToMatrix(barcode.matrix)
8
-
8
+  
9 9
   output <- DropletUtils::barcodeRanks(m = barcode.matrix, lower=lower,
10 10
                                        fit.bounds=fit.bounds,
11 11
                                        df=df)
12
-
12
+  
13 13
   knee.ix <- as.integer(output@listData$total >= S4Vectors::metadata(output)$knee)
14 14
   inflection.ix <- as.integer(output@listData$total >= S4Vectors::metadata(output)$inflection)
15 15
   rank.ix<- as.integer(output$rank)
16 16
   total.ix<- as.integer(output$total)
17 17
   fitted.ix<- as.integer(output$fitted)
18
-
18
+  
19 19
   result <- cbind(knee.ix, inflection.ix, rank.ix, total.ix, fitted.ix)
20 20
   colnames(result) <- c("dropletUtils_barcodeRank_knee",
21 21
                         "dropletUtils_barcodeRank_inflection",
... ...
@@ -77,47 +77,61 @@ runBarcodeRankDrops <- function(inSCE,
77 77
   } else {
78 78
     sample = rep(1, ncol(inSCE))
79 79
   }
80
-
80
+  
81 81
   message(paste0(date(), " ... Running 'barcodeRanks'"))
82
-
82
+  
83 83
   ##  Getting current arguments values
84 84
   #argsList <- as.list(formals(fun = sys.function(sys.parent()), envir = parent.frame()))
85 85
   argsList <- mget(names(formals()),sys.frame(sys.nframe()))
86
-
86
+  
87 87
   rank <- list()
88
-
88
+  
89 89
   ## Define result matrix for all samples
90 90
   output <- S4Vectors::DataFrame(row.names = colnames(inSCE),
91 91
                                  dropletUtils_BarcodeRank_Knee = integer(ncol(inSCE)),
92 92
                                  dropletUtils_BarcodeRank_Inflection = integer(ncol(inSCE)))
93
-
94
-  metaOutput <- S4Vectors::DataFrame(row.names = colnames(inSCE),
95
-                                     dropletUtils_barcodeRank_rank = integer(ncol(inSCE)),
96
-                                     dropletUtils_barcodeRank_total = integer(ncol(inSCE)),
97
-                                     dropletUtils_barcodeRank_fitted = integer(ncol(inSCE)))
93
+  
98 94
   ## Loop through each sample and run barcodeRank
99 95
   samples <- unique(sample)
96
+  metaOutList <- list()
100 97
   for (i in seq_len(length(samples))) {
101 98
     sceSampleInd <- sample == samples[i]
102 99
     sceSample <- inSCE[, sceSampleInd]
103
-
100
+    
101
+    ## Define meta matrix for each subinSCE
102
+    metaOutput <- S4Vectors::DataFrame(row.names = colnames(sceSample),
103
+                                       dropletUtils_barcodeRank_rank = integer(ncol(sceSample)),
104
+                                       dropletUtils_barcodeRank_total = integer(ncol(sceSample)),
105
+                                       dropletUtils_barcodeRank_fitted = integer(ncol(sceSample)),
106
+                                       dropletUtils_barcodeRank_knee = integer(ncol(sceSample)),
107
+                                       dropletUtils_barcodeRank_inflection = integer(ncol(sceSample)),
108
+                                       sample = colData(sceSample)[["sample"]])
109
+    
104 110
     mat <- SummarizedExperiment::assay(sceSample, i = useAssay)
105 111
     result <- .runBarcodeRankDrops(barcode.matrix = mat, lower=lower,
106 112
                                    fit.bounds=fitBounds,
107 113
                                    df=df)
108
-
114
+    
109 115
     result.matrix <- result$matrix
110 116
     output[sceSampleInd, ] <- result.matrix[, c("dropletUtils_barcodeRank_knee", "dropletUtils_barcodeRank_inflection")]
111
-    metaOutput[sceSampleInd, ] <- result.matrix[, c("dropletUtils_barcodeRank_rank", "dropletUtils_barcodeRank_total", "dropletUtils_barcodeRank_fitted")]
117
+    
118
+    metaCols <- c("dropletUtils_barcodeRank_rank", "dropletUtils_barcodeRank_total", 
119
+                  "dropletUtils_barcodeRank_fitted")
120
+    metaOutput[sceSampleInd, metaCols] <- result.matrix[, metaCols]
121
+    metaOutput[sceSampleInd,"dropletUtils_barcodeRank_knee"] <- rep(result$knee, sum(sceSampleInd))
122
+    metaOutput[sceSampleInd,"dropletUtils_barcodeRank_inflection"] <- rep(result$inflection, sum(sceSampleInd))
123
+    
124
+    # Remove duplicated Rank
125
+    metaOutput <- metaOutput[!duplicated(metaOutput$dropletUtils_barcodeRank_rank), ]
126
+    
127
+    metaOutList[[samples[i]]] <- metaOutput
112 128
   }
113
-
129
+  
114 130
   colData(inSCE) = cbind(colData(inSCE), output)
115
-  S4Vectors::metadata(inSCE)$runBarcodeRanksMetaOutput = metaOutput
116
-
131
+  S4Vectors::metadata(inSCE)$runBarcodeRanksMetaOutput <- metaOutList
132
+  
117 133
   inSCE@metadata$runBarcodeRankDrops <- argsList[-1]
118
-  inSCE@metadata$runBarcodeRankDrops$knee <- result$knee
119
-  inSCE@metadata$runBarcodeRankDrops$inflection <- result$inflection
120 134
   inSCE@metadata$runBarcodeRankDrops$packageVersion <- utils::packageDescription("DropletUtils")$Version
121
-
135
+  
122 136
   return(inSCE)
123 137
 }
Browse code

Add knee and inflection point to metadata

Yusuke Koga authored on 06/07/2020 20:30:41
Showing1 changed files
... ...
@@ -1,29 +1,32 @@
1 1
 
2
-.runBarcodeRankDrops <- function(barcode.matrix, lower=lower, 
3
-                                 fit.bounds=fit.bounds, 
2
+.runBarcodeRankDrops <- function(barcode.matrix, lower=lower,
3
+                                 fit.bounds=fit.bounds,
4 4
                                  df=df) {
5
-  
5
+
6 6
   ## Convert to sparse matrix if not already in that format
7 7
   barcode.matrix <- .convertToMatrix(barcode.matrix)
8
-  
9
-  output <- DropletUtils::barcodeRanks(m = barcode.matrix, lower=lower, 
10
-                                       fit.bounds=fit.bounds, 
8
+
9
+  output <- DropletUtils::barcodeRanks(m = barcode.matrix, lower=lower,
10
+                                       fit.bounds=fit.bounds,
11 11
                                        df=df)
12
-  
12
+
13 13
   knee.ix <- as.integer(output@listData$total >= S4Vectors::metadata(output)$knee)
14 14
   inflection.ix <- as.integer(output@listData$total >= S4Vectors::metadata(output)$inflection)
15 15
   rank.ix<- as.integer(output$rank)
16 16
   total.ix<- as.integer(output$total)
17 17
   fitted.ix<- as.integer(output$fitted)
18
-  
18
+
19 19
   result <- cbind(knee.ix, inflection.ix, rank.ix, total.ix, fitted.ix)
20 20
   colnames(result) <- c("dropletUtils_barcodeRank_knee",
21
-                        "dropletUtils_barcodeRank_inflection", 
22
-                        "dropletUtils_barcodeRank_rank", 
21
+                        "dropletUtils_barcodeRank_inflection",
22
+                        "dropletUtils_barcodeRank_rank",
23 23
                         "dropletUtils_barcodeRank_total",
24 24
                         "dropletUtils_barcodeRank_fitted")
25
-  
26
-  return(result)
25
+  result.list <- list(result,
26
+                      S4Vectors::metadata(output)$knee,
27
+                      S4Vectors::metadata(output)$inflection)
28
+  names(result.list) <- c("matrix","knee","inflection")
29
+  return(result.list)
27 30
 }
28 31
 
29 32
 
... ...
@@ -39,7 +42,7 @@
39 42
 #'  \link[DropletUtils]{emptyDrops} will be run on cells from each sample separately.
40 43
 #'  If NULL, then all cells will be processed together. Default \code{NULL}.
41 44
 #' @param lower See \link[DropletUtils]{emptyDrops} for more information. Default \code{100}.
42
-#' @param fitBounds See \link[DropletUtils]{emptyDrops} for more information. Default \code{NULL}. 
45
+#' @param fitBounds See \link[DropletUtils]{emptyDrops} for more information. Default \code{NULL}.
43 46
 #' @param df See \link[DropletUtils]{emptyDrops} for more information. Default \code{20}.
44 47
 #' @return A \link[SingleCellExperiment]{SingleCellExperiment} object with the
45 48
 #'  \link[DropletUtils]{barcodeRanks} output table appended to the
... ...
@@ -62,9 +65,9 @@
62 65
 #' @importFrom SummarizedExperiment colData colData<-
63 66
 runBarcodeRankDrops <- function(inSCE,
64 67
                                 sample = NULL,
65
-                                useAssay = "counts", 
66
-                                lower = 100, 
67
-                                fitBounds = NULL, 
68
+                                useAssay = "counts",
69
+                                lower = 100,
70
+                                fitBounds = NULL,
68 71
                                 df = 20
69 72
 ) {
70 73
   if(!is.null(sample)) {
... ...
@@ -74,9 +77,9 @@ runBarcodeRankDrops <- function(inSCE,
74 77
   } else {
75 78
     sample = rep(1, ncol(inSCE))
76 79
   }
77
-  
80
+
78 81
   message(paste0(date(), " ... Running 'barcodeRanks'"))
79
-  
82
+
80 83
   ##  Getting current arguments values
81 84
   #argsList <- as.list(formals(fun = sys.function(sys.parent()), envir = parent.frame()))
82 85
   argsList <- mget(names(formals()),sys.frame(sys.nframe()))
... ...
@@ -87,7 +90,7 @@ runBarcodeRankDrops <- function(inSCE,
87 90
   output <- S4Vectors::DataFrame(row.names = colnames(inSCE),
88 91
                                  dropletUtils_BarcodeRank_Knee = integer(ncol(inSCE)),
89 92
                                  dropletUtils_BarcodeRank_Inflection = integer(ncol(inSCE)))
90
-  
93
+
91 94
   metaOutput <- S4Vectors::DataFrame(row.names = colnames(inSCE),
92 95
                                      dropletUtils_barcodeRank_rank = integer(ncol(inSCE)),
93 96
                                      dropletUtils_barcodeRank_total = integer(ncol(inSCE)),
... ...
@@ -97,21 +100,24 @@ runBarcodeRankDrops <- function(inSCE,
97 100
   for (i in seq_len(length(samples))) {
98 101
     sceSampleInd <- sample == samples[i]
99 102
     sceSample <- inSCE[, sceSampleInd]
100
-    
103
+
101 104
     mat <- SummarizedExperiment::assay(sceSample, i = useAssay)
102 105
     result <- .runBarcodeRankDrops(barcode.matrix = mat, lower=lower,
103
-                                   fit.bounds=fitBounds, 
106
+                                   fit.bounds=fitBounds,
104 107
                                    df=df)
105
-    
106
-    output[sceSampleInd, ] <- result[, c("dropletUtils_barcodeRank_knee", "dropletUtils_barcodeRank_inflection")]
107
-    metaOutput[sceSampleInd, ] <- result[, c("dropletUtils_barcodeRank_rank", "dropletUtils_barcodeRank_total", "dropletUtils_barcodeRank_fitted")]
108
+
109
+    result.matrix <- result$matrix
110
+    output[sceSampleInd, ] <- result.matrix[, c("dropletUtils_barcodeRank_knee", "dropletUtils_barcodeRank_inflection")]
111
+    metaOutput[sceSampleInd, ] <- result.matrix[, c("dropletUtils_barcodeRank_rank", "dropletUtils_barcodeRank_total", "dropletUtils_barcodeRank_fitted")]
108 112
   }
109
-  
113
+
110 114
   colData(inSCE) = cbind(colData(inSCE), output)
111 115
   S4Vectors::metadata(inSCE)$runBarcodeRanksMetaOutput = metaOutput
112
-  
116
+
113 117
   inSCE@metadata$runBarcodeRankDrops <- argsList[-1]
118
+  inSCE@metadata$runBarcodeRankDrops$knee <- result$knee
119
+  inSCE@metadata$runBarcodeRankDrops$inflection <- result$inflection
114 120
   inSCE@metadata$runBarcodeRankDrops$packageVersion <- utils::packageDescription("DropletUtils")$Version
115
-  
121
+
116 122
   return(inSCE)
117 123
 }
Browse code

Updated import statements to handle new dependencies on Summarized or SingleCellExperiment after removing SCtkExperiment

Joshua D. Campbell authored on 02/07/2020 06:04:00
Showing1 changed files
... ...
@@ -59,6 +59,7 @@
59 59
 #' data(scExample, package = "singleCellTK")
60 60
 #' sce <- runBarcodeRankDrops(inSCE = sce)
61 61
 #' @export
62
+#' @importFrom SummarizedExperiment colData colData<-
62 63
 runBarcodeRankDrops <- function(inSCE,
63 64
                                 sample = NULL,
64 65
                                 useAssay = "counts", 
Browse code

Fixed errors in .ggScatter. Removed emptyDropsExample and updated examples using this to use scExample instead.

Joshua D. Campbell authored on 28/06/2020 22:37:11
Showing1 changed files
... ...
@@ -56,8 +56,8 @@
56 56
 #' # This example only serves as an proof of concept and a tutoriol on how to
57 57
 #' # run the function. The results should not be
58 58
 #' # used for drawing scientific conclusions.
59
-#' data(emptyDropsSceExample, package = "singleCellTK")
60
-#' sce <- runBarcodeRankDrops(inSCE = emptyDropsSceExample)
59
+#' data(scExample, package = "singleCellTK")
60
+#' sce <- runBarcodeRankDrops(inSCE = sce)
61 61
 #' @export
62 62
 runBarcodeRankDrops <- function(inSCE,
63 63
                                 sample = NULL,
Browse code

Merge branch 'compbiomed-devel' into devel

rz2333 authored on 09/06/2020 15:25:06
Showing0 changed files
Browse code

Merge conflict from upstream

rz2333 authored on 08/06/2020 22:00:41
Showing0 changed files
Browse code

R CMD check fix

Yichen Wang authored on 08/06/2020 16:02:58
Showing1 changed files
... ...
@@ -104,7 +104,7 @@ runBarcodeRankDrops <- function(inSCE,
104 104
   }
105 105
   
106 106
   colData(inSCE) = cbind(colData(inSCE), output)
107
-  metadata(inSCE)$runBarcodeRanksMetaOutput = metaOutput
107
+  S4Vectors::metadata(inSCE)$runBarcodeRanksMetaOutput = metaOutput
108 108
   
109 109
   inSCE@metadata$runBarcodeRankDrops <- argsList[-1]
110 110
   inSCE@metadata$runBarcodeRankDrops$packageVersion <- utils::packageDescription("DropletUtils")$Version
Browse code

fixed bugs in emtydrops and barcodeRanks

Anastasia Leshchyk authored on 03/06/2020 19:44:24
Showing1 changed files
... ...
@@ -1,22 +1,29 @@
1
-.runBarcodeRankDrops <- function(barcode.matrix, lower=100, 
2
-                                 fit.bounds=NULL, 
3
-                                 df=20) {
1
+
2
+.runBarcodeRankDrops <- function(barcode.matrix, lower=lower, 
3
+                                 fit.bounds=fit.bounds, 
4
+                                 df=df) {
4 5
   
5 6
   ## Convert to sparse matrix if not already in that format
6 7
   barcode.matrix <- .convertToMatrix(barcode.matrix)
7 8
   
8
-  output <- DropletUtils::barcodeRanks(m = barcode.matrix, lower=100, 
9
-                                       fit.bounds=NULL, 
10
-                                       df=20)
9
+  output <- DropletUtils::barcodeRanks(m = barcode.matrix, lower=lower, 
10
+                                       fit.bounds=fit.bounds, 
11
+                                       df=df)
11 12
   
12 13
   knee.ix <- as.integer(output@listData$total >= S4Vectors::metadata(output)$knee)
13 14
   inflection.ix <- as.integer(output@listData$total >= S4Vectors::metadata(output)$inflection)
14
-  result <- cbind(knee.ix, inflection.ix)
15
+  rank.ix<- as.integer(output$rank)
16
+  total.ix<- as.integer(output$total)
17
+  fitted.ix<- as.integer(output$fitted)
18
+  
19
+  result <- cbind(knee.ix, inflection.ix, rank.ix, total.ix, fitted.ix)
15 20
   colnames(result) <- c("dropletUtils_barcodeRank_knee",
16
-                        "dropletUtils_barcodeRank_inflection")
17
-  rank <- output[!duplicated(output@listData$rank), c('rank', 'total')]
21
+                        "dropletUtils_barcodeRank_inflection", 
22
+                        "dropletUtils_barcodeRank_rank", 
23
+                        "dropletUtils_barcodeRank_total",
24
+                        "dropletUtils_barcodeRank_fitted")
18 25
   
19
-  return(list(result, rank))
26
+  return(result)
20 27
 }
21 28
 
22 29
 
... ...
@@ -52,8 +59,6 @@
52 59
 #' data(emptyDropsSceExample, package = "singleCellTK")
53 60
 #' sce <- runBarcodeRankDrops(inSCE = emptyDropsSceExample)
54 61
 #' @export
55
-
56
-
57 62
 runBarcodeRankDrops <- function(inSCE,
58 63
                                 sample = NULL,
59 64
                                 useAssay = "counts", 
... ...
@@ -73,14 +78,16 @@ runBarcodeRankDrops <- function(inSCE,
73 78
   
74 79
   ##  Getting current arguments values
75 80
   argsList <- as.list(formals(fun = sys.function(sys.parent()), envir = parent.frame()))
76
-  rank <- list()
77
-
81
+  
78 82
   ## Define result matrix for all samples
79 83
   output <- S4Vectors::DataFrame(row.names = colnames(inSCE),
80 84
                                  dropletUtils_BarcodeRank_Knee = integer(ncol(inSCE)),
81
-                                 dropletUtils_BarcodeRank_Inflection = integer(ncol(inSCE)),
82
-                                 dropletUtils_BarcodeRank_Rank = integer(ncol(inSCE)))
85
+                                 dropletUtils_BarcodeRank_Inflection = integer(ncol(inSCE)))
83 86
   
87
+  metaOutput <- S4Vectors::DataFrame(row.names = colnames(inSCE),
88
+                                     dropletUtils_barcodeRank_rank = integer(ncol(inSCE)),
89
+                                     dropletUtils_barcodeRank_total = integer(ncol(inSCE)),
90
+                                     dropletUtils_barcodeRank_fitted = integer(ncol(inSCE)))
84 91
   ## Loop through each sample and run barcodeRank
85 92
   samples <- unique(sample)
86 93
   for (i in seq_len(length(samples))) {
... ...
@@ -88,18 +95,19 @@ runBarcodeRankDrops <- function(inSCE,
88 95
     sceSample <- inSCE[, sceSampleInd]
89 96
     
90 97
     mat <- SummarizedExperiment::assay(sceSample, i = useAssay)
91
-    resultList <- .runBarcodeRankDrops(barcode.matrix = mat, lower=lower,
92
-                                       fit.bounds=fitBounds, 
93
-                                       df=df)
98
+    result <- .runBarcodeRankDrops(barcode.matrix = mat, lower=lower,
99
+                                   fit.bounds=fitBounds, 
100
+                                   df=df)
94 101
     
95
-    output[sceSampleInd, ] <- resultList[[1]]
96
-    rank[[samples[i]]] <- resultList[[2]]
102
+    output[sceSampleInd, ] <- result[, c("dropletUtils_barcodeRank_knee", "dropletUtils_barcodeRank_inflection")]
103
+    metaOutput[sceSampleInd, ] <- result[, c("dropletUtils_barcodeRank_rank", "dropletUtils_barcodeRank_total", "dropletUtils_barcodeRank_fitted")]
97 104
   }
98 105
   
99 106
   colData(inSCE) = cbind(colData(inSCE), output)
107
+  metadata(inSCE)$runBarcodeRanksMetaOutput = metaOutput
100 108
   
101 109
   inSCE@metadata$runBarcodeRankDrops <- argsList[-1]
102 110
   inSCE@metadata$runBarcodeRankDrops$packageVersion <- utils::packageDescription("DropletUtils")$Version
103
-  inSCE@metadata$runBarcodeRankDrops$rank <- rank
111
+  
104 112
   return(inSCE)
105
-}
106 113
\ No newline at end of file
114
+}
Browse code

fix metadata function

rz2333 authored on 29/05/2020 16:01:01
Showing1 changed files
... ...
@@ -72,7 +72,9 @@ runBarcodeRankDrops <- function(inSCE,
72 72
   message(paste0(date(), " ... Running 'barcodeRanks'"))
73 73
   
74 74
   ##  Getting current arguments values
75
-  argsList <- as.list(formals(fun = sys.function(sys.parent()), envir = parent.frame()))
75
+  #argsList <- as.list(formals(fun = sys.function(sys.parent()), envir = parent.frame()))
76
+  argsList <- mget(names(formals()),sys.frame(sys.nframe()))
77
+
76 78
   rank <- list()
77 79
 
78 80
   ## Define result matrix for all samples
Browse code

Modify SCTK_runQC.R and runQC.R to support yaml files. Also update dropletUtils_barcodeRank.R for better visualization

rz2333 authored on 13/05/2020 14:53:57
Showing1 changed files
... ...
@@ -1,4 +1,3 @@
1
-
2 1
 .runBarcodeRankDrops <- function(barcode.matrix, lower=100, 
3 2
                                  fit.bounds=NULL, 
4 3
                                  df=20) {
... ...
@@ -12,12 +11,12 @@
12 11
   
13 12
   knee.ix <- as.integer(output@listData$total >= S4Vectors::metadata(output)$knee)
14 13
   inflection.ix <- as.integer(output@listData$total >= S4Vectors::metadata(output)$inflection)
15
-  
16 14
   result <- cbind(knee.ix, inflection.ix)
17 15
   colnames(result) <- c("dropletUtils_barcodeRank_knee",
18 16
                         "dropletUtils_barcodeRank_inflection")
17
+  rank <- output[!duplicated(output@listData$rank), c('rank', 'total')]
19 18
   
20
-  return(result)
19
+  return(list(result, rank))
21 20
 }
22 21
 
23 22
 
... ...
@@ -53,6 +52,8 @@
53 52
 #' data(emptyDropsSceExample, package = "singleCellTK")
54 53
 #' sce <- runBarcodeRankDrops(inSCE = emptyDropsSceExample)
55 54
 #' @export
55
+
56
+
56 57
 runBarcodeRankDrops <- function(inSCE,
57 58
                                 sample = NULL,
58 59
                                 useAssay = "counts", 
... ...
@@ -72,11 +73,13 @@ runBarcodeRankDrops <- function(inSCE,
72 73
   
73 74
   ##  Getting current arguments values
74 75
   argsList <- as.list(formals(fun = sys.function(sys.parent()), envir = parent.frame()))
75
-  
76
+  rank <- list()
77
+
76 78
   ## Define result matrix for all samples
77 79
   output <- S4Vectors::DataFrame(row.names = colnames(inSCE),
78 80
                                  dropletUtils_BarcodeRank_Knee = integer(ncol(inSCE)),
79
-                                 dropletUtils_BarcodeRank_Inflection = integer(ncol(inSCE)))
81
+                                 dropletUtils_BarcodeRank_Inflection = integer(ncol(inSCE)),
82
+                                 dropletUtils_BarcodeRank_Rank = integer(ncol(inSCE)))
80 83
   
81 84
   ## Loop through each sample and run barcodeRank
82 85
   samples <- unique(sample)
... ...
@@ -85,17 +88,18 @@ runBarcodeRankDrops <- function(inSCE,
85 88
     sceSample <- inSCE[, sceSampleInd]
86 89
     
87 90
     mat <- SummarizedExperiment::assay(sceSample, i = useAssay)
88
-    result <- .runBarcodeRankDrops(barcode.matrix = mat, lower=lower,
89
-                                   fit.bounds=fitBounds, 
90
-                                   df=df)
91
+    resultList <- .runBarcodeRankDrops(barcode.matrix = mat, lower=lower,
92
+                                       fit.bounds=fitBounds, 
93
+                                       df=df)
91 94
     
92
-    output[sceSampleInd, ] <- result
95
+    output[sceSampleInd, ] <- resultList[[1]]
96
+    rank[[samples[i]]] <- resultList[[2]]
93 97
   }
94 98
   
95 99
   colData(inSCE) = cbind(colData(inSCE), output)
96 100
   
97 101
   inSCE@metadata$runBarcodeRankDrops <- argsList[-1]
98 102
   inSCE@metadata$runBarcodeRankDrops$packageVersion <- utils::packageDescription("DropletUtils")$Version
99
-  
103
+  inSCE@metadata$runBarcodeRankDrops$rank <- rank
100 104
   return(inSCE)
101
-}
105
+}
102 106
\ No newline at end of file
Browse code

Fixed and merge conflict from compbiomed-devel

rz2333 authored on 01/05/2020 03:00:48
Showing1 changed files
... ...
@@ -28,11 +28,13 @@
28 28
 #'  droplet-based single-cell RNA sequencing experiment.
29 29
 #' @param inSCE A \link[SingleCellExperiment]{SingleCellExperiment} object.
30 30
 #'  Must contain a raw counts matrix before empty droplets have been removed.
31
+#' @param useAssay  A string specifying which assay in the SCE to use.
31 32
 #' @param sample Character vector. Indicates which sample each cell belongs to
32 33
 #'  \link[DropletUtils]{emptyDrops} will be run on cells from each sample separately.
33
-#'  If NULL, then all cells will be processed together. Default NULL.
34
-#' @param ... Additional arguments to pass to \link[DropletUtils]{barcodeRanks}.
35
-#' @param useAssay  A string specifying which assay in the SCE to use.
34
+#'  If NULL, then all cells will be processed together. Default \code{NULL}.
35
+#' @param lower See \link[DropletUtils]{emptyDrops} for more information. Default \code{100}.
36
+#' @param fitBounds See \link[DropletUtils]{emptyDrops} for more information. Default \code{NULL}. 
37
+#' @param df See \link[DropletUtils]{emptyDrops} for more information. Default \code{20}.
36 38
 #' @return A \link[SingleCellExperiment]{SingleCellExperiment} object with the
37 39
 #'  \link[DropletUtils]{barcodeRanks} output table appended to the
38 40
 #'  \link[SummarizedExperiment]{colData} slot. The columns include
... ...
@@ -54,9 +56,9 @@
54 56
 runBarcodeRankDrops <- function(inSCE,
55 57
                                 sample = NULL,
56 58
                                 useAssay = "counts", 
57
-                                lower=100, 
58
-                                fit.bounds=NULL, 
59
-                                df=20
59
+                                lower = 100, 
60
+                                fitBounds = NULL, 
61
+                                df = 20
60 62
 ) {
61 63
   if(!is.null(sample)) {
62 64
     if(length(sample) != ncol(inSCE)) {
... ...
@@ -83,9 +85,9 @@ runBarcodeRankDrops <- function(inSCE,
83 85
     sceSample <- inSCE[, sceSampleInd]
84 86
     
85 87
     mat <- SummarizedExperiment::assay(sceSample, i = useAssay)
86
-    result <- .runBarcodeRankDrops(barcode.matrix = mat, lower=100,
87
-                                   fit.bounds=NULL, 
88
-                                   df=20)
88
+    result <- .runBarcodeRankDrops(barcode.matrix = mat, lower=lower,
89
+                                   fit.bounds=fitBounds, 
90
+                                   df=df)
89 91
     
90 92
     output[sceSampleInd, ] <- result
91 93
   }
... ...
@@ -93,7 +95,7 @@ runBarcodeRankDrops <- function(inSCE,
93 95
   colData(inSCE) = cbind(colData(inSCE), output)
94 96
   
95 97
   inSCE@metadata$runBarcodeRankDrops <- argsList[-1]
96
-  inSCE@metadata$runBarcodeRankDrops$packageVersion <- packageDescription("DropletUtils")$Version
98
+  inSCE@metadata$runBarcodeRankDrops$packageVersion <- utils::packageDescription("DropletUtils")$Version
97 99
   
98 100
   return(inSCE)
99 101
 }
Browse code

Resolve conflict from upstream devel

rz2333 authored on 17/04/2020 18:43:57
Showing1 changed files
... ...
@@ -1,18 +1,22 @@
1 1
 
2
-.runBarcodeRankDrops <- function(barcode.matrix, ...) {
3
-
2
+.runBarcodeRankDrops <- function(barcode.matrix, lower=100, 
3
+                                 fit.bounds=NULL, 
4
+                                 df=20) {
5
+  
4 6
   ## Convert to sparse matrix if not already in that format
5 7
   barcode.matrix <- .convertToMatrix(barcode.matrix)
6 8
   
7
-  output <- DropletUtils::barcodeRanks(m = barcode.matrix, ...)
8
-
9
+  output <- DropletUtils::barcodeRanks(m = barcode.matrix, lower=100, 
10
+                                       fit.bounds=NULL, 
11
+                                       df=20)
12
+  
9 13
   knee.ix <- as.integer(output@listData$total >= S4Vectors::metadata(output)$knee)
10 14
   inflection.ix <- as.integer(output@listData$total >= S4Vectors::metadata(output)$inflection)
11
-
15
+  
12 16
   result <- cbind(knee.ix, inflection.ix)
13 17
   colnames(result) <- c("dropletUtils_barcodeRank_knee",
14 18
                         "dropletUtils_barcodeRank_inflection")
15
-
19
+  
16 20
   return(result)
17 21
 }
18 22
 
... ...
@@ -48,9 +52,11 @@
48 52
 #' sce <- runBarcodeRankDrops(inSCE = emptyDropsSceExample)
49 53
 #' @export
50 54
 runBarcodeRankDrops <- function(inSCE,
51
-    sample = NULL,
52
-    useAssay = "counts",
53
-    ...
55
+                                sample = NULL,
56
+                                useAssay = "counts", 
57
+                                lower=100, 
58
+                                fit.bounds=NULL, 
59
+                                df=20
54 60
 ) {
55 61
   if(!is.null(sample)) {
56 62
     if(length(sample) != ncol(inSCE)) {
... ...
@@ -59,27 +65,35 @@ runBarcodeRankDrops <- function(inSCE,
59 65
   } else {
60 66
     sample = rep(1, ncol(inSCE))
61 67
   }
62
-
68
+  
63 69
   message(paste0(date(), " ... Running 'barcodeRanks'"))
64
-
70
+  
71
+  ##  Getting current arguments values
72
+  argsList <- as.list(formals(fun = sys.function(sys.parent()), envir = parent.frame()))
73
+  
65 74
   ## Define result matrix for all samples
66 75
   output <- S4Vectors::DataFrame(row.names = colnames(inSCE),
67
-            dropletUtils_BarcodeRank_Knee = integer(ncol(inSCE)),
68
-            dropletUtils_BarcodeRank_Inflection = integer(ncol(inSCE)))
69
-
76
+                                 dropletUtils_BarcodeRank_Knee = integer(ncol(inSCE)),
77
+                                 dropletUtils_BarcodeRank_Inflection = integer(ncol(inSCE)))
78
+  
70 79
   ## Loop through each sample and run barcodeRank
71 80
   samples <- unique(sample)
72 81
   for (i in seq_len(length(samples))) {
73 82
     sceSampleInd <- sample == samples[i]
74 83
     sceSample <- inSCE[, sceSampleInd]
75
-
84
+    
76 85
     mat <- SummarizedExperiment::assay(sceSample, i = useAssay)
77
-    result <- .runBarcodeRankDrops(barcode.matrix = mat, ...)
78
-
86
+    result <- .runBarcodeRankDrops(barcode.matrix = mat, lower=100,
87
+                                   fit.bounds=NULL, 
88
+                                   df=20)
89
+    
79 90
     output[sceSampleInd, ] <- result
80 91
   }
81
-
92
+  
82 93
   colData(inSCE) = cbind(colData(inSCE), output)
83
-
94
+  
95
+  inSCE@metadata$runBarcodeRankDrops <- argsList[-1]
96
+  inSCE@metadata$runBarcodeRankDrops$packageVersion <- packageDescription("DropletUtils")$Version
97
+  
84 98
   return(inSCE)
85 99
 }
Browse code

standardized output parameter capitalization

Joshua D. Campbell authored on 06/03/2020 02:37:23
Showing1 changed files
... ...
@@ -10,8 +10,8 @@
10 10
   inflection.ix <- as.integer(output@listData$total >= S4Vectors::metadata(output)$inflection)
11 11
 
12 12
   result <- cbind(knee.ix, inflection.ix)
13
-  colnames(result) <- c("dropletUtils_BarcodeRank_Knee",
14
-                        "dropletUtils_BarcodeRank_Knee")
13
+  colnames(result) <- c("dropletUtils_barcodeRank_knee",
14
+                        "dropletUtils_barcodeRank_inflection")
15 15
 
16 16
   return(result)
17 17
 }
Browse code

Merge branch 'importQC' of github.com:ykoga07/singleCellTK into importQC

zhewa authored on 24/02/2020 06:37:54
Showing0 changed files
Browse code

Made new utility funciton for converting to dgCMatrix and not losing dimnames (as would happen if the matrix was wrapped in delayed array). Updated all conversion code to use this function. Updated documentation. Fixed one bug in 'runCxdsBcdsHybrid'

Joshua D. Campbell authored on 24/02/2020 02:41:26
Showing1 changed files
... ...
@@ -2,7 +2,7 @@
2 2
 .runBarcodeRankDrops <- function(barcode.matrix, ...) {
3 3
 
4 4
   ## Convert to sparse matrix if not already in that format
5
-  barcode.matrix <- methods::as(barcode.matrix, "dgCMatrix")
5
+  barcode.matrix <- .convertToMatrix(barcode.matrix)
6 6
   
7 7
   output <- DropletUtils::barcodeRanks(m = barcode.matrix, ...)
8 8
 
Browse code

Changed instances of to , and to in QC fxns to make sure parameter names are consistent

Yusuke Koga authored on 22/02/2020 17:54:38
Showing1 changed files
... ...
@@ -22,13 +22,13 @@
22 22
 #'  provided in a \link[SingleCellExperiment]{SingleCellExperiment} object.
23 23
 #'  Distinguish between droplets containing cells and ambient RNA in a
24 24
 #'  droplet-based single-cell RNA sequencing experiment.
25
-#' @param sce A \link[SingleCellExperiment]{SingleCellExperiment} object.
25
+#' @param inSCE A \link[SingleCellExperiment]{SingleCellExperiment} object.
26 26
 #'  Must contain a raw counts matrix before empty droplets have been removed.
27 27
 #' @param sample Character vector. Indicates which sample each cell belongs to
28 28
 #'  \link[DropletUtils]{emptyDrops} will be run on cells from each sample separately.
29 29
 #'  If NULL, then all cells will be processed together. Default NULL.
30 30
 #' @param ... Additional arguments to pass to \link[DropletUtils]{barcodeRanks}.
31
-#' @param assayName  A string specifying which assay in the SCE to use.
31
+#' @param useAssay  A string specifying which assay in the SCE to use.
32 32
 #' @return A \link[SingleCellExperiment]{SingleCellExperiment} object with the
33 33
 #'  \link[DropletUtils]{barcodeRanks} output table appended to the
34 34
 #'  \link[SummarizedExperiment]{colData} slot. The columns include
... ...
@@ -45,41 +45,41 @@
45 45
 #' # run the function. The results should not be
46 46
 #' # used for drawing scientific conclusions.
47 47
 #' data(emptyDropsSceExample, package = "singleCellTK")
48
-#' sce <- runBarcodeRankDrops(sce = emptyDropsSceExample)
48
+#' sce <- runBarcodeRankDrops(inSCE = emptyDropsSceExample)
49 49
 #' @export
50
-runBarcodeRankDrops <- function(sce,
50
+runBarcodeRankDrops <- function(inSCE,
51 51
     sample = NULL,
52
-    assayName = "counts",
52
+    useAssay = "counts",
53 53
     ...
54 54
 ) {
55 55
   if(!is.null(sample)) {
56
-    if(length(sample) != ncol(sce)) {
57
-      stop("'sample' must be the same length as the number of columns in 'sce'")
56
+    if(length(sample) != ncol(inSCE)) {
57
+      stop("'sample' must be the same length as the number of columns in 'inSCE'")
58 58
     }
59 59
   } else {
60
-    sample = rep(1, ncol(sce))
60
+    sample = rep(1, ncol(inSCE))
61 61
   }
62 62
 
63 63
   message(paste0(date(), " ... Running 'barcodeRanks'"))
64 64
 
65 65
   ## Define result matrix for all samples
66
-  output <- S4Vectors::DataFrame(row.names = colnames(sce),
67
-            dropletUtils_BarcodeRank_Knee = integer(ncol(sce)),
68
-            dropletUtils_BarcodeRank_Inflection = integer(ncol(sce)))
66
+  output <- S4Vectors::DataFrame(row.names = colnames(inSCE),
67
+            dropletUtils_BarcodeRank_Knee = integer(ncol(inSCE)),
68
+            dropletUtils_BarcodeRank_Inflection = integer(ncol(inSCE)))
69 69
 
70 70
   ## Loop through each sample and run barcodeRank
71 71
   samples <- unique(sample)
72 72
   for (i in seq_len(length(samples))) {
73 73
     sceSampleInd <- sample == samples[i]
74
-    sceSample <- sce[, sceSampleInd]
74
+    sceSample <- inSCE[, sceSampleInd]
75 75
 
76
-    mat <- SummarizedExperiment::assay(sceSample, i = assayName)
76
+    mat <- SummarizedExperiment::assay(sceSample, i = useAssay)
77 77
     result <- .runBarcodeRankDrops(barcode.matrix = mat, ...)
78 78
 
79 79
     output[sceSampleInd, ] <- result
80 80
   }
81 81
 
82
-  colData(sce) = cbind(colData(sce), output)
82
+  colData(inSCE) = cbind(colData(inSCE), output)
83 83
 
84
-  return(sce)
84
+  return(inSCE)
85 85
 }
Browse code

Fixed examples

Joshua D. Campbell authored on 15/02/2020 01:03:26
Showing1 changed files
... ...
@@ -1,10 +1,9 @@
1 1
 
2 2
 .runBarcodeRankDrops <- function(barcode.matrix, ...) {
3 3
 
4
-  if (class(barcode.matrix) != "dgCMatrix") {
5
-    barcode.matrix <- methods::as(barcode.matrix, "dgCMatrix")
6
-  }
7
-
4
+  ## Convert to sparse matrix if not already in that format
5
+  barcode.matrix <- methods::as(barcode.matrix, "dgCMatrix")
6
+  
8 7
   output <- DropletUtils::barcodeRanks(m = barcode.matrix, ...)
9 8
 
10 9
   knee.ix <- as.integer(output@listData$total >= S4Vectors::metadata(output)$knee)
Browse code

Fixed package/function references

Joshua D. Campbell authored on 03/02/2020 21:03:41
Showing1 changed files
... ...
@@ -2,13 +2,13 @@
2 2
 .runBarcodeRankDrops <- function(barcode.matrix, ...) {
3 3
 
4 4
   if (class(barcode.matrix) != "dgCMatrix") {
5
-    barcode.matrix <- as(barcode.matrix, "dgCMatrix")
5
+    barcode.matrix <- methods::as(barcode.matrix, "dgCMatrix")
6 6
   }
7 7
 
8 8
   output <- DropletUtils::barcodeRanks(m = barcode.matrix, ...)
9 9
 
10
-  knee.ix <- as.integer(output@listData$total >= metadata(output)$knee)
11
-  inflection.ix <- as.integer(output@listData$total >= metadata(output)$inflection)
10
+  knee.ix <- as.integer(output@listData$total >= S4Vectors::metadata(output)$knee)
11
+  inflection.ix <- as.integer(output@listData$total >= S4Vectors::metadata(output)$inflection)
12 12
 
13 13
   result <- cbind(knee.ix, inflection.ix)
14 14
   colnames(result) <- c("dropletUtils_BarcodeRank_Knee",
Browse code

update docs

87875172 authored on 15/01/2020 20:58:19
Showing1 changed files
... ...
@@ -32,7 +32,7 @@
32 32
 #' @param assayName  A string specifying which assay in the SCE to use.
33 33
 #' @return A \link[SingleCellExperiment]{SingleCellExperiment} object with the
34 34
 #'  \link[DropletUtils]{barcodeRanks} output table appended to the
35
-#'  \link[SingleCellExperiment]{colData} slot. The columns include
35
+#'  \link[SummarizedExperiment]{colData} slot. The columns include
36 36
 #'  \emph{dropletUtils_BarcodeRank_Knee} and \emph{dropletUtils_BarcodeRank_Knee}
37 37
 #'  Please refer to the documentation of \link[DropletUtils]{barcodeRanks} for
38 38
 #'  details.
Browse code

fix bug and update docs

87875172 authored on 06/01/2020 17:33:23
Showing1 changed files
... ...
@@ -19,10 +19,10 @@
19 19
 
20 20
 
21 21
 #' @title Identify empty droplets using \link[DropletUtils]{barcodeRanks}.
22
-#' @description Run \link[DropletUtils]{barcodeRanks} on a count matrix 
23
-#'  provided in a\link[SingleCellExperiment]{SingleCellExperiment} object.
22
+#' @description Run \link[DropletUtils]{barcodeRanks} on a count matrix
23
+#'  provided in a \link[SingleCellExperiment]{SingleCellExperiment} object.
24 24
 #'  Distinguish between droplets containing cells and ambient RNA in a
25
-#'  droplet-based single-cell RNA sequencing experiment. 
25
+#'  droplet-based single-cell RNA sequencing experiment.
26 26
 #' @param sce A \link[SingleCellExperiment]{SingleCellExperiment} object.
27 27
 #'  Must contain a raw counts matrix before empty droplets have been removed.
28 28
 #' @param sample Character vector. Indicates which sample each cell belongs to
... ...
@@ -56,31 +56,31 @@ runBarcodeRankDrops <- function(sce,
56 56
   if(!is.null(sample)) {
57 57
     if(length(sample) != ncol(sce)) {
58 58
       stop("'sample' must be the same length as the number of columns in 'sce'")
59
-    }  
59
+    }
60 60
   } else {
61 61
     sample = rep(1, ncol(sce))
62 62
   }
63
-  
64
-  message(paste0(date(), " ... Running 'barcodeRanks'"))    
65
-  
66
-  ## Define result matrix for all samples  
63
+
64
+  message(paste0(date(), " ... Running 'barcodeRanks'"))
65
+
66
+  ## Define result matrix for all samples
67 67
   output <- S4Vectors::DataFrame(row.names = colnames(sce),
68 68
             dropletUtils_BarcodeRank_Knee = integer(ncol(sce)),
69 69
             dropletUtils_BarcodeRank_Inflection = integer(ncol(sce)))
70
-            
70
+
71 71
   ## Loop through each sample and run barcodeRank
72 72
   samples <- unique(sample)
73 73
   for (i in seq_len(length(samples))) {
74 74
     sceSampleInd <- sample == samples[i]
75 75
     sceSample <- sce[, sceSampleInd]
76 76
 
77
-    mat <- SummarizedExperiment::assay(sceSample, i = assayName)  
77
+    mat <- SummarizedExperiment::assay(sceSample, i = assayName)
78 78
     result <- .runBarcodeRankDrops(barcode.matrix = mat, ...)
79
-      
79
+
80 80
     output[sceSampleInd, ] <- result
81 81
   }
82
-  
82
+
83 83
   colData(sce) = cbind(colData(sce), output)
84
-  
84
+
85 85
   return(sce)
86 86
 }
Browse code

Refactored all droplet and cell wrappers to be more efficient. Also added 'barcodeRank' as another method for determining empty droplets.

Joshua D. Campbell authored on 24/12/2019 06:29:20
Showing1 changed files
1 1
new file mode 100644
... ...
@@ -0,0 +1,86 @@
1
+
2
+.runBarcodeRankDrops <- function(barcode.matrix, ...) {
3
+
4
+  if (class(barcode.matrix) != "dgCMatrix") {
5
+    barcode.matrix <- as(barcode.matrix, "dgCMatrix")
6
+  }
7
+
8
+  output <- DropletUtils::barcodeRanks(m = barcode.matrix, ...)
9
+
10
+  knee.ix <- as.integer(output@listData$total >= metadata(output)$knee)
11
+  inflection.ix <- as.integer(output@listData$total >= metadata(output)$inflection)
12
+
13
+  result <- cbind(knee.ix, inflection.ix)
14
+  colnames(result) <- c("dropletUtils_BarcodeRank_Knee",
15
+                        "dropletUtils_BarcodeRank_Knee")
16
+
17
+  return(result)
18
+}
19
+
20
+
21
+#' @title Identify empty droplets using \link[DropletUtils]{barcodeRanks}.
22
+#' @description Run \link[DropletUtils]{barcodeRanks} on a count matrix 
23
+#'  provided in a\link[SingleCellExperiment]{SingleCellExperiment} object.
24
+#'  Distinguish between droplets containing cells and ambient RNA in a
25
+#'  droplet-based single-cell RNA sequencing experiment. 
26
+#' @param sce A \link[SingleCellExperiment]{SingleCellExperiment} object.
27
+#'  Must contain a raw counts matrix before empty droplets have been removed.
28
+#' @param sample Character vector. Indicates which sample each cell belongs to
29
+#'  \link[DropletUtils]{emptyDrops} will be run on cells from each sample separately.
30
+#'  If NULL, then all cells will be processed together. Default NULL.
31
+#' @param ... Additional arguments to pass to \link[DropletUtils]{barcodeRanks}.
32
+#' @param assayName  A string specifying which assay in the SCE to use.
33
+#' @return A \link[SingleCellExperiment]{SingleCellExperiment} object with the
34
+#'  \link[DropletUtils]{barcodeRanks} output table appended to the
35
+#'  \link[SingleCellExperiment]{colData} slot. The columns include
36
+#'  \emph{dropletUtils_BarcodeRank_Knee} and \emph{dropletUtils_BarcodeRank_Knee}
37
+#'  Please refer to the documentation of \link[DropletUtils]{barcodeRanks} for
38
+#'  details.
39
+#' @examples
40
+#' # The following unfiltered PBMC_1k_v3 data were downloaded from
41
+#' # https://support.10xgenomics.com/single-cell-gene-expression/datasets/3.0.0
42
+#' # /pbmc_1k_v3
43
+#' # Only the top 10 cells with most counts and the last 10 cells with non-zero
44
+#' # counts are included in this example.
45
+#' # This example only serves as an proof of concept and a tutoriol on how to
46
+#' # run the function. The results should not be
47
+#' # used for drawing scientific conclusions.
48
+#' data(emptyDropsSceExample, package = "singleCellTK")
49
+#' sce <- runBarcodeRankDrops(sce = emptyDropsSceExample)
50
+#' @export
51
+runBarcodeRankDrops <- function(sce,
52
+    sample = NULL,
53
+    assayName = "counts",
54
+    ...
55
+) {
56
+  if(!is.null(sample)) {
57
+    if(length(sample) != ncol(sce)) {
58
+      stop("'sample' must be the same length as the number of columns in 'sce'")
59
+    }  
60
+  } else {
61
+    sample = rep(1, ncol(sce))
62
+  }
63
+  
64
+  message(paste0(date(), " ... Running 'barcodeRanks'"))    
65
+  
66
+  ## Define result matrix for all samples  
67
+  output <- S4Vectors::DataFrame(row.names = colnames(sce),
68
+            dropletUtils_BarcodeRank_Knee = integer(ncol(sce)),
69
+            dropletUtils_BarcodeRank_Inflection = integer(ncol(sce)))
70
+            
71
+  ## Loop through each sample and run barcodeRank
72
+  samples <- unique(sample)
73
+  for (i in seq_len(length(samples))) {
74
+    sceSampleInd <- sample == samples[i]
75
+    sceSample <- sce[, sceSampleInd]
76
+
77
+    mat <- SummarizedExperiment::assay(sceSample, i = assayName)  
78
+    result <- .runBarcodeRankDrops(barcode.matrix = mat, ...)
79
+      
80
+    output[sceSampleInd, ] <- result
81
+  }
82
+  
83
+  colData(sce) = cbind(colData(sce), output)
84
+  
85
+  return(sce)
86
+}