1. singleCellTK
  2. R
  3. dropletUtils_barcodeRank.R
Browse code

Update barcodeRank and EmptyDrops

Yichen Wang authored on 14/10/2022 09:54:10
Showing1 changed files
R/dropletUtils_barcodeRank.R
History View file @229625bd3
... ... 
@@ -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
R/dropletUtils_barcodeRank.R
History View file @4f40472d6
... ... 
@@ -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
R/dropletUtils_barcodeRank.R
History View file @c3644b724
... ... 
@@ -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
R/dropletUtils_barcodeRank.R
History View file @6fe21ae1e
... ... 
@@ -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
R/dropletUtils_barcodeRank.R
History View file @feff3b1d9
... ... 
@@ -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
R/dropletUtils_barcodeRank.R
History View file @b8bc5b91b
... ... 
@@ -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
R/dropletUtils_barcodeRank.R
History View file @05baeaebf
... ... 
@@ -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
R/dropletUtils_barcodeRank.R
History View file @42b943b76
... ... 
@@ -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
R/dropletUtils_barcodeRank.R
History View file @575be27c5
... ... 
@@ -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
R/dropletUtils_barcodeRank.R
History View file @ed8269d4a
... ... 
@@ -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
R/dropletUtils_barcodeRank.R
History View file @65aaf0dd9
... ... 
@@ -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
R/dropletUtils_barcodeRank.R
History View file @03fbf0855
... ... 
@@ -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
R/dropletUtils_barcodeRank.R
History View file @8d7cbd298
... ... 
@@ -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
R/dropletUtils_barcodeRank.R
History View file @06ab60301
... ... 
@@ -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
R/dropletUtils_barcodeRank.R
History View file @24a9c486c
... ... 
@@ -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
R/dropletUtils_barcodeRank.R
History View file @fef86099a
... ... 
@@ -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
R/dropletUtils_barcodeRank.R
History View file @fa0ed498f
... ... 
@@ -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
R/dropletUtils_barcodeRank.R
History View file @b3ed78d58
... ... 
@@ -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
R/dropletUtils_barcodeRank.R
History View file @0bfe3bc88
... ... 
@@ -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
R/dropletUtils_barcodeRank.R
History View file @538f78bd6
... ... 
@@ -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
R/dropletUtils_barcodeRank.R
History View file @bfecf1eb5
... ... 
@@ -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
R/dropletUtils_barcodeRank.R
History View file @7f011212d
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 
+}