fix bug in removemissing; add S4 methods for verUnsharedFeature; Upda…

…te UINMF vignette

NAMESPACE

@@ -47,6 +47,7 @@ export("rawPeak<-")
 export("scaleData<-")
 export("scaleUnsharedData<-")
 export("varFeatures<-")
+export("varUnsharedFeatures<-")
 export(as.liger)
 export(as.ligerDataset)
 export(calcARI)
@@ -174,6 +175,7 @@ export(subsetMemLigerDataset)
 export(suggestK)
 export(suggestLambda)
 export(varFeatures)
+export(varUnsharedFeatures)
 exportClasses(ligerATACDataset)
 exportClasses(ligerCommand)
 exportClasses(ligerDataset)
@@ -200,6 +202,7 @@ exportMethods("rawPeak<-")
 exportMethods("scaleData<-")
 exportMethods("scaleUnsharedData<-")
 exportMethods("varFeatures<-")
+exportMethods("varUnsharedFeatures<-")
 exportMethods(cellMeta)
 exportMethods(commands)
 exportMethods(dataset)
@@ -223,6 +226,7 @@ exportMethods(scaleData)
 exportMethods(scaleUnsharedData)
 exportMethods(show)
 exportMethods(varFeatures)
+exportMethods(varUnsharedFeatures)
 importClassesFrom(S4Vectors,DataFrame)
 importFrom(Matrix,colSums)
 importFrom(Matrix,rowSums)

R/integration.R

@@ -1156,20 +1156,16 @@ runUINMF.liger <- function(
                           nIteration = nIteration,
                           nRandomStarts = nRandomStarts,
                           seed = seed, verbose = verbose, ...)
-    for (i in seq_along(object)) {
-        ld <- dataset(object, i)
-        ld@H <- res$H[[i]]
-        ld@V <- res$V[[i]]
+    for (d in names(object)) {
+        ld <- dataset(object, d)
+        ld@H <- res$H[[d]]
+        ld@V <- res$V[[d]]
         if (!is.null(ld@scaleUnsharedData)) {
-            ld@U <- res$U[[i]]
-            rownames(ld@U) <- ld@varUnsharedFeatures
+            ld@U <- res$U[[d]]
         }
-        colnames(ld@H) <- colnames(ld)
-        rownames(ld@V) <- varFeatures(object)
-        datasets(object, check = FALSE)[[i]] <- ld
+        datasets(object, check = FALSE)[[d]] <- ld
     }
     object@W <- res$W
-    rownames(ld@W) <- varFeatures(object)
     object@uns$factorization <- list(k = k, lambda = lambda)
     return(object)
 }
@@ -1208,13 +1204,13 @@ runUINMF.liger <- function(
     unsharedFeatures <- lapply(unsharedList, rownames)
     factorNames <- paste0("Factor_", seq(k))
     barcodes <- lapply(object, colnames)
-    for (i in seq_along(object)) {
-        bestRes$H[[i]] <- t(bestRes$H[[i]])
-        dimnames(bestRes$H[[i]]) <- list(factorNames, barcodes[[i]])
-        dimnames(bestRes$V[[i]]) <- list(features, factorNames)
-        dimnames(bestRes$U[[i]]) <- list(unsharedFeatures[[i]], factorNames)
-        rownames(bestRes$U[[i]]) <- unsharedFeatures[[i]]
-        colnames(bestRes$U[[i]]) <- factorNames
+    for (d in names(object)) {
+        bestRes$H[[d]] <- t(bestRes$H[[d]])
+        dimnames(bestRes$H[[d]]) <- list(factorNames, barcodes[[d]])
+        dimnames(bestRes$V[[d]]) <- list(features, factorNames)
+        if (d %in% names(bestRes$U)) {
+            dimnames(bestRes$U[[d]]) <- list(unsharedFeatures[[d]], factorNames)
+        }
     }
     dimnames(bestRes$W) <- list(features, factorNames)
     return(bestRes)

R/liger-class.R

@@ -1180,6 +1180,7 @@ setReplaceMethod(
         return(x)
     }
 )
+
 #' @export
 #' @rdname liger-class
 #' @section Variable feature access:
@@ -1231,6 +1232,80 @@ setReplaceMethod(
     }
 )
 
+
+
+#' @export
+#' @rdname liger-class
+setGeneric("varUnsharedFeatures", function(x, dataset = NULL) {
+    standardGeneric("varUnsharedFeatures")
+})
+
+#' @export
+#' @rdname liger-class
+setGeneric(
+    "varUnsharedFeatures<-",
+    function(x, dataset, check = TRUE, value) {
+        standardGeneric("varUnsharedFeatures<-")
+    }
+)
+
+#' @export
+#' @rdname liger-class
+setMethod("varUnsharedFeatures", signature(x = "liger"),
+          function(x, dataset = NULL) {
+              dataset <- .checkUseDatasets(x, dataset)
+              vufList <- lapply(dataset, function(d) x@datasets[[d]]@varUnsharedFeatures)
+
+              if (length(vufList) == 1) return(vufList[[1]])
+              else {
+                  names(vufList) <- dataset
+                  return(vufList)
+              }
+          }
+)
+
+#' @export
+#' @rdname liger-class
+setMethod("varUnsharedFeatures",
+          signature(x = "ligerDataset", dataset = "missing"),
+          function(x, dataset = NULL) x@varUnsharedFeatures)
+
+#' @export
+#' @rdname liger-class
+setReplaceMethod(
+    "varUnsharedFeatures",
+    signature(x = "liger", dataset = "ANY", check = "ANY", value = "character"),
+    function(x, dataset, check = TRUE, value) {
+        dataset <- .checkUseDatasets(x, dataset)
+        x@datasets[[dataset]]@varUnsharedFeatures <- value
+        if (isTRUE(check)) {
+            if (!all(value %in% rownames(x@datasets[[dataset]]))) {
+                warning("Not all features passed are found in dataset \"",
+                        dataset, "\".")
+            }
+        }
+        return(x)
+    }
+)
+
+#' @export
+#' @rdname liger-class
+setReplaceMethod(
+    "varUnsharedFeatures",
+    signature(x = "ligerDataset", dataset = "missing", check = "ANY", value = "character"),
+    function(x, dataset = NULL, check = TRUE, value) {
+        x@varUnsharedFeatures <- value
+        if (isTRUE(check)) {
+            if (!all(value %in% rownames(x))) {
+                warning("Not all features passed are found.")
+            }
+        }
+        return(x)
+    }
+)
+
+
+
 #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 # S3 methods ####
 #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

R/preprocess.R

@@ -263,11 +263,11 @@ removeMissing <- function(
     }
     orient <- match.arg(orient)
     useDatasets <- .checkUseDatasets(object, useDatasets)
-    minCells <- .checkArgLen(minCells, length(useDatasets))
     minCells <- minCells %||% rep(0, length(useDatasets))
+    minCells <- .checkArgLen(minCells, length(useDatasets))
     names(minCells) <- useDatasets
-    minFeatures <- .checkArgLen(minFeatures, length(useDatasets))
     minFeatures <- minFeatures %||% rep(0, length(useDatasets))
+    minFeatures <- .checkArgLen(minFeatures, length(useDatasets))
     names(minFeatures) <- useDatasets
     rmFeature <- ifelse(orient %in% c("both", "feature"), TRUE, FALSE)
     rmCell <- ifelse(orient %in% c("both", "cell"), TRUE, FALSE)
@@ -280,17 +280,17 @@ removeMissing <- function(
         } else {
             featureIdx <- seq_len(nrow(ld))
         }
-        if (length(featureIdx) == nrow(ld)) rmFeature <- FALSE
+        rmFeatureDataset <- length(featureIdx) != nrow(ld)
         if (rmCell) {
             cellIdx <- object$dataset == d & object$nGene > minFeatures[d]
             cellIdx <- colnames(object)[cellIdx]
             cellIdx <- which(colnames(ld) %in% cellIdx)
         } else {
             cellIdx <- seq_len(ncol(ld))
         }
-        if (length(cellIdx) == ncol(ld)) rmCell <- FALSE
-        subsetted <- c(subsetted, any(c(rmFeature, rmCell)))
-        if (any(c(rmFeature, rmCell))) {
+        rmCellDataset <- length(cellIdx) != ncol(ld)
+        subsetted <- c(subsetted, any(c(rmFeatureDataset, rmCellDataset)))
+        if (any(c(rmFeatureDataset, rmCellDataset))) {
             if (isTRUE(verbose)) .log("Removing missing in dataset: ", d)
             datasets.new[[d]] <- subsetLigerDataset(
                 ld,