@@ -1,10 +1,10 @@

 .constructSCE <- function(

-  matrices,

-  features,

-  barcodes,

-  metadata,

-  reducedDims) {

-

+    matrices,

+    features,

+    barcodes,

+    metadata,

+    reducedDims) {

+  

   sce <- SingleCellExperiment::SingleCellExperiment(assays = matrices)

   SummarizedExperiment::rowData(sce) <- S4Vectors::DataFrame(features)

   SummarizedExperiment::colData(sce) <- S4Vectors::DataFrame(barcodes)

@@ -34,7 +34,7 @@

   } else {

     fill <- NA

   }

-

+  

   ### combine row

   if (isTRUE(combineRow) & (!is.null(row))) {

     missRow <- row[!row %in% rownames(x)]

@@ -43,14 +43,14 @@

     if (!isTRUE(sparse)) {

       missMat <- as.matrix(missMat)

     }

-

+    

     mat <- rbind(matOrigin, missMat)

     if (anyDuplicated(rownames(mat))) {

       mat <- mat[!duplicated(rownames(mat)), ]

     }

     matOrigin <- mat[row, ]

   }

-

+  

   ### combine cols

   if (isTRUE(combineCol) & (!is.null(col))) {

     missCol <- col[!col %in% colnames(x)]

@@ -59,7 +59,7 @@

     if (!isTRUE(sparse)) {

       missMat <- as.matrix(missMat)

     }

-

+    

     mat <- cbind(matOrigin, missMat)

     if (anyDuplicated(colnames(mat))) {

       mat <- mat[, !duplicated(colnames(mat))]

@@ -76,12 +76,12 @@

     rw[['rownames']] <- rownames(rw)

     return(rw)

   })

-

+  

   ## Get merged rowData

   by.r <- unique(c('rownames', by.r))

   unionFe <- Reduce(function(r1, r2) merge(r1, r2, by=by.r, all=TRUE), feList)

   allGenes <- unique(unlist(lapply(feList, rownames)))

-

+  

   ## rowData

   newFe <- unionFe

   if (nrow(newFe) != length(allGenes)) {

@@ -102,7 +102,7 @@

     cD[['rownames']] <- rownames(cD)

     return(cD)

   })

-

+  

   by.c <- unique(c("rownames", by.c))

   unionCb <- Reduce(function(c1, c2) merge(c1, c2, by=by.c, all=TRUE), cbList)

   rownames(unionCb) <- unionCb[['rownames']]

@@ -118,19 +118,19 @@

   reduceList <- lapply(sceList, SingleCellExperiment::reducedDims)

   ## get every reducedDim exists in at least one SCEs

   UnionReducedDims <- unique(unlist(lapply(sceList, SingleCellExperiment::reducedDimNames)))

-

+  

   ## for each reducedDim, get union row/cols

   reducedDims <- list()

   for (reduceDim in UnionReducedDims) {

     x <- lapply(sceList, function(x) {if (reduceDim %in% SingleCellExperiment::reducedDimNames(x)) {SingleCellExperiment::reducedDim(x, reduceDim)}})

     reducedDims[[reduceDim]] <- .getDimUnion(x)

   }

-

+  

   ## Merge reducedDim for each SCE

   redList <- list()

   for (idx in seq_along(sceList)){

     redMat <- reduceList[[idx]]

-

+    

     for (DimName in UnionReducedDims) {

       if (DimName %in% names(redMat)) {

         redMat[[DimName]] <- .getMatUnion(reducedDims[[DimName]], redMat[[DimName]],

@@ -142,10 +142,10 @@

                                           dimnames = list(colnames(sceList[[idx]]), reducedDims[[DimName]][[2]]))

       }

     }

-

+    

     redList[[idx]] <- redMat

   }

-

+  

   return(redList)

 }

@@ -157,7 +157,7 @@

     unique(unlist(lapply(sceList, rownames))),

     unique(unlist(lapply(sceList, colnames)))

   )

-

+  

   asList <- list()

   for (idx in seq_along(assayList)){

     assay <- assayList[[idx]]

@@ -174,7 +174,7 @@

     }

     asList[[idx]] <- assay

   }

-

+  

   return(asList)

 }

@@ -197,27 +197,48 @@

 # }

 .mergeMetaSCE <- function(SCE_list) {

+  # Merge highest level metadata entries (except "sctk") by sample names in

+  # SCE_list. For analysis results in "sctk", merge by SCE_list sample name if 

+  # given "all_cells" in one object, else, use existing sample names. 

+  samples <- names(SCE_list)

   sampleMeta <- lapply(SCE_list, S4Vectors::metadata)

   metaNames <- unique(unlist(lapply(sampleMeta, names)))

+  sampleSctkMeta <- lapply(SCE_list, function(x) {S4Vectors::metadata(x)$sctk})

+  sctkMetaNames <- unique(unlist(lapply(sampleMeta, 

+                                        function(x) names(x$sctk))))

+  sampleMeta$sctk <- NULL

+  metaNames <- metaNames[!metaNames %in% c("sctk")]

   NewMeta <- list()

-

+  for (meta in sctkMetaNames) {

+    for (i in seq_along(sampleSctkMeta)) {

+      # `i` is for identifying each SCE object, usually matching a sample in 

+      # the pipeline. `sampleAvail` for samples stored in metadata entry, in

+      # case users are merging merged objects. 

+      sampleAvail <- names(sampleSctkMeta[[i]][[meta]])

+      if (length(sampleAvail) == 1) {

+        NewMeta$sctk[[meta]][[samples[i]]] <- sampleSctkMeta[[i]][[meta]][[1]]

+      } else if (length(sampleAvail) > 1) {

+        names(sampleSctkMeta[[i]][[meta]]) <- 

+          paste(names(sampleSctkMeta)[i], 

+                names(sampleSctkMeta[[i]][[meta]]), sep = "_")

+        NewMeta$sctk[[meta]] <- c(NewMeta$sctk[[meta]], 

+                                  sampleSctkMeta[[i]][[meta]])

+      }

+    }

+  }

   for (meta in metaNames) {

     for (i in seq_along(sampleMeta)) {

-      NewMeta[[meta]][[i]] <- sampleMeta[[i]][[meta]]

+      NewMeta[[meta]][[samples[i]]] <- sampleMeta[[i]][[meta]]

     }

   }

-

-  if ("runBarcodeRanksMetaOutput" %in% metaNames) {

-    NewMeta[["runBarcodeRanksMetaOutput"]] <- unlist(NewMeta[["runBarcodeRanksMetaOutput"]])

-  }

-

+  

   if ("assayType" %in% metaNames) {

     assayType <- lapply(SCE_list, function(x){S4Vectors::metadata(x)$assayType})

     assayType <- BiocGenerics::Reduce(dplyr::union, assayType)

     NewMeta[["assayType"]] <- assayType

   }

-

+  

   return(NewMeta)

 }

@@ -241,7 +262,7 @@

 #' @export

 combineSCE <- function(sceList, by.r = NULL, by.c = NULL, combined = TRUE){

-  if(length(sceList) == 1){

+  if (length(sceList) == 1) {

     return(sceList[[1]])

   }

   ##  rowData

@@ -252,16 +273,21 @@ combineSCE <- function(sceList, by.r = NULL, by.c = NULL, combined = TRUE){

   redMatList <- .mergeRedimSCE(sceList)

   ## assay

   assayList <- .mergeAssaySCE(sceList)

-

+  samples <- names(sceList)

+  if (is.null(samples)) {

+    samples <- paste0("sample", seq_along(sceList))

+  }

   New_SCE <- list()

   for (i in seq(length(sceList))) {

     ## create new sce

-    New_SCE[[i]] <- .constructSCE(matrices = assayList[[i]], features = newFeList,

-                                  barcodes = newCbList[[i]],

-                                  metadata = S4Vectors::metadata(sceList[[i]]),

-                                  reducedDims = redMatList[[i]])

+    sampleName <- samples[i]

+    New_SCE[[sampleName]] <- .constructSCE(matrices = assayList[[i]], 

+                                           features = newFeList,

+                                           barcodes = newCbList[[i]],

+                                           metadata = S4Vectors::metadata(sceList[[i]]),

+                                           reducedDims = redMatList[[i]])

   }

-

+  

   if (isTRUE(combined)) {

     sce <- do.call(SingleCellExperiment::cbind, New_SCE)

     meta <- .mergeMetaSCE(New_SCE)

@@ -110,7 +110,7 @@ runSoupX <- function(inSCE,

                      pCut = 0.01) {

     SingleBGBatchForAllBatch <- FALSE

     adjustMethod <- match.arg(adjustMethod)

-    if(!is.null(sample)) {

+    if (!is.null(sample)) {

         sample <- .manageCellVar(inSCE, var = sample)

         if (is.factor(sample)) {

             sample <- as.character(sample)

@@ -129,7 +129,7 @@ runSoupX <- function(inSCE,

                              "in background colData")

                     }

                     bgBatch <- SummarizedExperiment::colData(background)[[bgBatch]]

-                } else if(length(bgBatch) != ncol(background)) {

+                } else if (length(bgBatch) != ncol(background)) {

                     stop("'bgBatch' must be the same length as ",

                          "the number of columns in 'background'")

                 }

@@ -429,11 +429,11 @@ setMethod("getSoupX",

                    sampleID = NULL,

                    background = FALSE){

     if (isTRUE(background)) {

-        all.results <- S4Vectors::metadata(inSCE)$sctk$SoupX_bg

+        all.results <- S4Vectors::metadata(inSCE)$sctk$runSoupX_bg

     } else {

-        all.results <- S4Vectors::metadata(inSCE)$sctk$SoupX

+        all.results <- S4Vectors::metadata(inSCE)$sctk$runSoupX

     }

-    if(is.null(all.results)) {

+    if (is.null(all.results)) {

         stop("No result from 'SoupX' is found. Please run `runSoupX()` first, ",

              "or check the setting of `background`.")

     }

@@ -441,7 +441,8 @@ setMethod("getSoupX",

     if (!is.null(sampleID)) {

         if (!all(sampleID  %in% names(all.results))) {

             stop("Sample(s) not found in the results for tool 'SoupX': ",

-                 paste(sampleID[!sampleID %in% names(all.results)], collapse = ", "))

+                 paste(sampleID[!sampleID %in% names(all.results)], 

+                       collapse = ", "))

         }

         results <- all.results[sampleID]

     }

@@ -458,9 +459,9 @@ setReplaceMethod("getSoupX",

                           background = FALSE,

                           value) {

                      if (isTRUE(background)) {

-                         inSCE@metadata$sctk$SoupX_bg[[sampleID]] <- value

+                         inSCE@metadata$sctk$runSoupX_bg[[sampleID]] <- value

                      } else {

-                         inSCE@metadata$sctk$SoupX[[sampleID]] <- value

+                         inSCE@metadata$sctk$runSoupX[[sampleID]] <- value

                      }

                      return(inSCE)

                  })

@@ -549,17 +550,16 @@ plotSoupXResults <- function(inSCE,

                             )

 {

     combinePlot <- match.arg(combinePlot)

-    sampleID <- unique(sample)

-    results <- getSoupX(inSCE, sampleID = sampleID, background = background)

+    sample <- .manageCellVar(inSCE, var = sample)

+    samples <- unique(sample)

+    results <- getSoupX(inSCE, sampleID = samples, background = background)

     # Doing this redundancy-like step because: If sample given NULL when running

     # runSoupX(), the actual sample label saved will be "all_cells", which users

     # won't know.

-    samples <- names(results)

     samplePlots <- list()

     for (s in samples) {

-        sampleRes <- results[[s]]

-        param <- sampleRes$param

-        sampleIdx <- param$sample == s

+        param <- results[[s]]$param

+        sampleIdx <- sample == s

         tmpSCE <- inSCE[,sampleIdx]

         markerTable <- results[[s]]$markersUsed

         markerTable <- markerTable[order(markerTable$qval),]

@@ -574,7 +574,7 @@ plotSoupXResults <- function(inSCE,

         while (length(markerToUse) < nMarkerToUse) {

             nIter <- nIter + 1

             # c is the cluster to look at in this iteration

-            c <- uniqCluster[(nIter-1)%%length(uniqCluster) + 1]

+            c <- uniqCluster[(nIter - 1) %% length(uniqCluster) + 1]

             markerPerCluster <- markerTable[markerTable$cluster == c,]

             topMarker <- markerPerCluster[1, "gene"]

             markerToUse <- c(markerToUse, topMarker)

@@ -595,19 +595,19 @@ plotSoupXResults <- function(inSCE,

                                         title = "Cluster",

                                         labelClusters = labelClusters,

                                         clusterLabelSize = clusterLabelSize,

-                                        xlab=xlab,

-                                        ylab=ylab,

-                                        dim1=dim1,

-                                        dim2=dim2,

-                                        defaultTheme=defaultTheme,

-                                        dotSize=dotSize,

-                                        transparency=transparency,

-                                        baseSize=baseSize,

-                                        titleSize=titleSize,

-                                        axisLabelSize=axisLabelSize,

-                                        axisSize=axisSize,

-                                        legendSize=legendSize,

-                                        legendTitleSize=legendTitleSize)

+                                        xlab = xlab,

+                                        ylab = ylab,

+                                        dim1 = dim1,

+                                        dim2 = dim2,

+                                        defaultTheme = defaultTheme,

+                                        dotSize = dotSize,

+                                        transparency = transparency,

+                                        baseSize = baseSize,

+                                        titleSize = titleSize,

+                                        axisLabelSize = axisLabelSize,

+                                        axisSize = axisSize,

+                                        legendSize = legendSize,

+                                        legendTitleSize = legendTitleSize)

             )

         for (g in markerToUse) {

             # Soup fraction was calculated basing on SoupX's original method.

@@ -207,7 +207,7 @@ MitoImport <- opt[["detectMitoLevel"]]

 MitoType <- opt[["mitoType"]]

 QCReport <- opt[["QCReport"]]

-print("The output directory is")

+message("The output directory is")

 print(directory)

 if (!is.null(basepath)) { basepath <- unlist(strsplit(opt[["basePath"]], ",")) }

@@ -1146,7 +1146,7 @@ for (sample in samples){

 ```{r, "SoupX-description", include=FALSE, warning=FALSE, message=FALSE}

-description_SoupX<- singleCellTK:::descriptionSoupX()

+description_SoupX <- singleCellTK:::descriptionSoupX()

 ```

 ```{r, "SoupX", results="asis", fig.align="center", warning=FALSE, message=FALSE, echo=FALSE}

@@ -1157,21 +1157,15 @@ soupXData <- c("soupX_nUMIs", "soupX_contamination")

 # soupX cluster label might be supplied by users, thus not checking it.

 skipSoupX <- any(!soupXData %in% names(colData(sce.qc)))

-if (length(samples) == 1) {

-  soupXSample <- "all_cells"

-} else {

-  soupXSample <- samples

-}

-

 if (skipSoupX) {

   #cat("runDecontX did not complete successfully. The section of DecontX is skipped")

   plotSoupX <- NULL

 } else {

   cat(paste0('## ', i, ' \n'))

-  plotSoupX<- tryCatch(

+  plotSoupX <- tryCatch(

     {plotSoupXResults(inSCE = sce.qc, 

-                     soupXSample, 

-                     combinePlot = "none")},

+                      sceSample, 

+                      combinePlot = "none")},

     error = function(e) {

       cat("runSoupX did not complete successfully. The section of SoupX is skipped\n\n")

       skipSoupX <<- TRUE