R/dropletUtils_barcodeRank.R
229625bd
 .runBarcodeRankDrops <- function(barcode.matrix, lower = lower,
                                  fit.bounds = fit.bounds,
                                  df = df) {
   
b3ed78d5
   ## Convert to sparse matrix if not already in that format
fef86099
   barcode.matrix <- .convertToMatrix(barcode.matrix)
229625bd
   
   output <- DropletUtils::barcodeRanks(m = barcode.matrix, lower = lower,
                                        fit.bounds = fit.bounds,
                                        df = df)
   
   knee.ix <- as.integer(output@listData$total >= 
                           S4Vectors::metadata(output)$knee)
   inflection.ix <- as.integer(output@listData$total >= 
                                 S4Vectors::metadata(output)$inflection)
   rank.ix <- as.integer(output$rank)
   total.ix <- as.integer(output$total)
   fitted.ix <- as.integer(output$fitted)
   
ed8269d4
   result <- cbind(knee.ix, inflection.ix, rank.ix, total.ix, fitted.ix)
24a9c486
   colnames(result) <- c("dropletUtils_barcodeRank_knee",
b8bc5b91
                         "dropletUtils_barcodeRank_inflection",
                         "dropletUtils_barcodeRank_rank",
ed8269d4
                         "dropletUtils_barcodeRank_total",
                         "dropletUtils_barcodeRank_fitted")
b8bc5b91
   result.list <- list(result,
                       S4Vectors::metadata(output)$knee,
                       S4Vectors::metadata(output)$inflection)
229625bd
   names(result.list) <- c("matrix", "knee", "inflection")
b8bc5b91
   return(result.list)
7f011212
 }
 
 
 #' @title Identify empty droplets using \link[DropletUtils]{barcodeRanks}.
bfecf1eb
 #' @description Run \link[DropletUtils]{barcodeRanks} on a count matrix
229625bd
 #' provided in a \linkS4class{SingleCellExperiment} object. Distinguish between 
 #' droplets containing cells and ambient RNA in a droplet-based single-cell RNA 
 #' sequencing experiment.
 #' @param inSCE A \linkS4class{SingleCellExperiment} object. Must contain a raw 
 #' counts matrix before empty droplets have been removed.
 #' @param sample Character vector or colData variable name. Indicates which 
 #' sample each cell belongs to. Default \code{NULL}.
 #' @param useAssay A string specifying which assay in the SCE to use. Default 
 #' \code{"counts"}
 #' @param lower See \link[DropletUtils]{barcodeRanks} for more information. 
 #' Default \code{100}.
 #' @param fitBounds See \link[DropletUtils]{barcodeRanks} for more information. 
 #' Default \code{NULL}.
 #' @param df See \link[DropletUtils]{barcodeRanks} for more information. Default 
 #' \code{20}.
 #' @return A \linkS4class{SingleCellExperiment} object with the
 #' \link[DropletUtils]{barcodeRanks} output table appended to the
 #' \link{colData} slot. The columns include
 #' \code{dropletUtils_BarcodeRank_Knee} and 
 #' \code{dropletUtils_barcodeRank_inflection}. Please refer to the documentation
 #' of \link[DropletUtils]{barcodeRanks} for details.
 #' @seealso \code{\link[DropletUtils]{barcodeRanks}}, 
 #' \code{\link{runDropletQC}}, \code{\link{plotBarcodeRankDropsResults}}
7f011212
 #' @examples
42b943b7
 #' data(scExample, package = "singleCellTK")
 #' sce <- runBarcodeRankDrops(inSCE = sce)
7f011212
 #' @export
229625bd
 #' @importFrom SummarizedExperiment colData colData<- assay
fa0ed498
 runBarcodeRankDrops <- function(inSCE,
06ab6030
                                 sample = NULL,
b8bc5b91
                                 useAssay = "counts",
                                 lower = 100,
                                 fitBounds = NULL,
8d7cbd29
                                 df = 20
7f011212
 ) {
229625bd
   
bfecf1eb
   message(paste0(date(), " ... Running 'barcodeRanks'"))
229625bd
   
06ab6030
   ##  Getting current arguments values
65aaf0dd
   argsList <- mget(names(formals()),sys.frame(sys.nframe()))
229625bd
   argsList <- argsList[!names(argsList) %in% c("inSCE")]
   argsList$packageVersion <- utils::packageDescription("DropletUtils")$Version
   
   sample <- .manageCellVar(inSCE, var = sample)
   if (is.null(sample)) {
     sample <- rep(1, ncol(inSCE))
   }
   
bfecf1eb
   ## Define result matrix for all samples
229625bd
   output <- S4Vectors::DataFrame(
     row.names = colnames(inSCE),
     dropletUtils_BarcodeRank_Knee = integer(ncol(inSCE)),
     dropletUtils_BarcodeRank_Inflection = integer(ncol(inSCE))
   )
   
7f011212
   ## Loop through each sample and run barcodeRank
   samples <- unique(sample)
229625bd
   for (s in samples) {
     sceSampleInd <- sample == s
fa0ed498
     sceSample <- inSCE[, sceSampleInd]
229625bd
     
feff3b1d
     ## Define meta matrix for each subinSCE
229625bd
     metaOutput <- S4Vectors::DataFrame(
       row.names = colnames(sceSample),
       dropletUtils_barcodeRank_rank = integer(ncol(sceSample)),
       dropletUtils_barcodeRank_total = integer(ncol(sceSample)),
       dropletUtils_barcodeRank_fitted = integer(ncol(sceSample)),
       dropletUtils_barcodeRank_knee = integer(ncol(sceSample)),
       dropletUtils_barcodeRank_inflection = integer(ncol(sceSample))
     )
4f40472d
     metaOutput$sample <- colData(sceSample)[["Sample"]]
229625bd
     
     mat <- assay(sceSample, i = useAssay)
     result <- .runBarcodeRankDrops(barcode.matrix = mat, lower = lower,
                                    fit.bounds = fitBounds,
                                    df = df)
     
b8bc5b91
     result.matrix <- result$matrix
229625bd
     output[sceSampleInd, ] <- 
       result.matrix[, c("dropletUtils_barcodeRank_knee",
                         "dropletUtils_barcodeRank_inflection")]
     
     metaCols <- c("dropletUtils_barcodeRank_rank", 
                   "dropletUtils_barcodeRank_total",
feff3b1d
                   "dropletUtils_barcodeRank_fitted")
229625bd
     metaOutput[, metaCols] <- result.matrix[, metaCols]
     metaOutput[,"dropletUtils_barcodeRank_knee"] <- rep(result$knee,
                                                         sum(sceSampleInd))
     metaOutput[,"dropletUtils_barcodeRank_inflection"] <- rep(result$inflection,
                                                               sum(sceSampleInd))
     
feff3b1d
     # Remove duplicated Rank
229625bd
     metaOutput <- 
       metaOutput[!duplicated(metaOutput$dropletUtils_barcodeRank_rank), ]
     if (!identical(samples, 1)) {
       S4Vectors::metadata(inSCE)$sctk$runBarcodeRankDrops[[s]] <- 
         list(metaOutput = metaOutput, argsList = argsList)
     }
7f011212
   }
229625bd
   if (identical(samples, 1)) {
     S4Vectors::metadata(inSCE)$sctk$runBarcodeRankDrops$all_cells <- 
       list(metaOutput = metaOutput, argsList = argsList)
   }
   
   colData(inSCE) <- cbind(colData(inSCE), output)
fa0ed498
   return(inSCE)
ed8269d4
 }