git status! Bump to 1.99.1; DimReds are now in separated slot

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: rliger
-Version: 1.99.0
+Version: 1.99.1
 Date: 2023-11-09
 Type: Package
 Title: Linked Inference of Genomic Experimental Relationships

NAMESPACE

@@ -125,14 +125,14 @@ export(optimizeNewK)
 export(optimizeNewLambda)
 export(optimizeSubset)
 export(plotByDatasetAndCluster)
-export(plotCellScatter)
 export(plotCellViolin)
 export(plotClusterDimRed)
 export(plotClusterFactorDot)
 export(plotClusterGeneDot)
 export(plotClusterProportions)
 export(plotDatasetDimRed)
 export(plotDensityDimRed)
+export(plotDimRed)
 export(plotEnhancedVolcano)
 export(plotFactorDimRed)
 export(plotFactorHeatmap)

R/GSEA.R

@@ -6,7 +6,7 @@
 #' tested. Default \code{NULL} uses all the gene sets from the Reactome.
 #' @param useW Logical, whether to use the shared factor loadings (\eqn{W}).
 #' Default \code{TRUE}.
-#' @param useDatasets A character vector of the names, a numeric or logical
+#' @param useV A character vector of the names, a numeric or logical
 #' vector of the index of the datasets where the \eqn{V} matrices will be
 #' included for analysis. Default \code{NULL} uses all datasets.
 #' @param customGenesets A named list of character vectors of entrez gene ids.
@@ -23,12 +23,12 @@ runGSEA <- function(
         object,
         genesets = NULL,
         useW = TRUE,
-        useDatasets = NULL,
+        useV = NULL,
         customGenesets = NULL,
         # Deprecated coding style
         gene_sets = genesets,
         mat_w = useW,
-        mat_v = useDatasets,
+        mat_v = useV,
         custom_gene_sets = customGenesets
 ) {
     if (!requireNamespace("org.Hs.eg.db", quietly = TRUE)) # nocov start
@@ -51,13 +51,13 @@ runGSEA <- function(
 
     .deprecateArgs(list(gene_sets = "genesets",
                         mat_w = "useW",
-                        mat_v = "useDatasets",
+                        mat_v = "useV",
                         custom_gene_sets = "customGenesets"))
-    useDatasets <- .checkUseDatasets(object, useDatasets = useDatasets)
-    .checkValidFactorResult(object, useDatasets)
+    useV <- .checkUseDatasets(object, useDatasets = useV)
+    .checkValidFactorResult(object, useV)
 
     # list of V matrices: gene x k
-    Vs <- getMatrix(object, "V", dataset = useDatasets, returnList = TRUE)
+    Vs <- getMatrix(object, "V", dataset = useV, returnList = TRUE)
     # Get gene ranks in each factor
     geneLoading <- Reduce("+", Vs)
     if (isTRUE(useW)) geneLoading <- geneLoading + getMatrix(object, "W")

R/cINMF.R

@@ -74,12 +74,14 @@
 #' Dylan Kotliar and et al., Identifying gene expression programs of cell-type
 #' identity and cellular activity with single-cell RNA-Seq, eLife, 2019
 #' @examples
+#' \donttest{
 #' pbmc <- normalize(pbmc)
 #' pbmc <- selectGenes(pbmc)
 #' pbmc <- scaleNotCenter(pbmc)
 #' if (requireNamespace("RcppPlanc", quietly = TRUE)) {
 #'     pbmc <- runCINMF(pbmc)
 #' }
+#' }
 runCINMF <- function(
         object,
         k = 20,

R/classConversion.R

@@ -424,12 +424,12 @@ seuratToLiger <- as.liger.Seurat
 #' }
 convertOldLiger <- function( # nocov start
         object,
-        dimredName = "tsne.coords",
+        dimredName,
         clusterName = "clusters",
         h5FilePath = NULL
 ) {
-    ver120 <- package_version("1.99.0")
-    if (object@version >= ver120) return(object)
+    ver1990 <- package_version("1.99.0")
+    if (object@version >= ver1990) return(object)
     if (inherits(object@raw.data[[1]], "H5File")) {
         ldList <- convertOldLiger.H5(object, h5FilePath = h5FilePath)
     } else {
@@ -440,17 +440,21 @@ convertOldLiger <- function( # nocov start
     cellID <- unlist(lapply(ldList, colnames), use.names = FALSE)
     # 4. Wrap up liger object
     cellMeta <- S4Vectors::DataFrame(cellMeta)
+    oldID <- rownames(cellMeta)
     # TODO: check default prototype of tsne.coords and clusters.
-    dimred <- object@tsne.coords[rownames(cellMeta), , drop = FALSE]
-    colnames(dimred) <- seq_len(ncol(dimred))
-    cellMeta[[dimredName]] <- dimred
+    dimred <- object@tsne.coords[oldID, , drop = FALSE]
+    colnames(dimred) <- paste0(dimredName, "_", seq_len(ncol(dimred)))
+    cellMeta$barcode <- oldID
     cellMeta[[clusterName]] <- object@clusters[rownames(cellMeta)]
     rownames(cellMeta) <- cellID
     hnorm <- object@H.norm
     rownames(hnorm) <- cellID
     newObj <- createLiger(ldList, W = t(object@W), H.norm = hnorm,
                           varFeatures = varFeatures, cellMeta = cellMeta,
                           addPrefix = FALSE, removeMissing = FALSE)
+    dimRed(newObj, dimredName) <- dimred
+    defaultCluster(newObj) <- clusterName
+    defaultDimRed(newObj) <- dimredName
     return(newObj)
 }
 
@@ -536,7 +540,8 @@ convertOldLiger.mem <- function(object) {
         }
         # 3. Construct ligerDataset objects for each dataset
         ldList[[d]] <- do.call(createLigerDataset, dataList)
-        colnames(ldList[[d]]) <- paste0(d, "_", colnames(ldList[[d]]))
+        if (!all(startsWith(colnames(ldList[[d]]), d)))
+            colnames(ldList[[d]]) <- paste0(d, "_", colnames(ldList[[d]]))
     }
     return(ldList)
 }

R/classes.R

@@ -14,6 +14,7 @@ setClassUnion("index",
               members = c("logical", "numeric", "character"))
 setClassUnion("Number_or_NULL", c("integer", "numeric", "NULL"))
 setClassUnion("dataframe", c("data.frame", "DataFrame", "NULL", "missing"))
+setClassUnion("missing_OR_NULL", c("missing", "NULL"))
 
 #' @importClassesFrom Matrix dgCMatrix dgTMatrix dgeMatrix
 NULL
@@ -185,6 +186,7 @@ liger <- setClass(
         varFeatures = "character_OR_NULL",
         W = "matrix_OR_NULL",
         H.norm = "matrix_OR_NULL",
+        dimReds = "list",
         uns = "list",
         commands = "list",
         version = "ANY"
@@ -215,6 +217,21 @@ liger <- setClass(
     return(NULL)
 }
 
+.checkDimReds <- function(x) {
+    barcodes <- rownames(x@cellMeta)
+    for (i in seq_along(x@dimReds)) {
+        dr <- x@dimReds[[i]]
+        drName <- names(x@dimReds[i])
+        if (is.null(drName))
+            return(paste("Unnamed dimReds at index", i))
+        if (!inherits(dr, "matrix"))
+            return(paste("DimReds", drName, "is not of matrix class"))
+        if (!identical(rownames(dr), barcodes))
+            return(paste("DimReds", drName, "does not match barcodes"))
+    }
+    return(NULL)
+}
+
 .checkLigerBarcodes <- function(x) {
     bcFromDatasets <- unlist(lapply(datasets(x), colnames), use.names = FALSE)
     if (!identical(colnames(x), bcFromDatasets)) {
@@ -285,6 +302,8 @@ liger <- setClass(
 .valid.liger <- function(object) {
     res <- .checkAllDatasets(object)
     if (!is.null(res)) return(res)
+    res <- .checkDimReds(object)
+    if (!is.null(res)) return(res)
     res <- .checkDatasetVar(object)
     if (!is.null(res)) return(res)
     res <- .checkLigerBarcodes(object)

R/clustering.R

@@ -125,7 +125,7 @@ runCluster <- function(
         cli::cli_process_done(msg_done = "{method} clustering on {type} cell factor loadings ... Found {nlevels(clusts)} clusters.")
     object@uns$defaultCluster <- object@uns$defaultCluster %||% clusterName
     if (isTRUE(verbose))
-        cli::cli_alert_info("cellMeta variable {.field {clusterName}} is now set as default.")
+        cli::cli_alert_info("{.field cellMeta} variable {.val {clusterName}} is now set as default.")
     return(object)
 }
 

R/embedding.R

@@ -83,7 +83,7 @@ runUMAP <- function(
     if (isTRUE(verbose)) cli::cli_process_done()
     dimRed(object, dimredName) <- umap
     if (isTRUE(verbose))
-        cli::cli_alert_info("cellMeta variable {.field {dimredName}} is now set as default.")
+        cli::cli_alert_info("{.field DimRed} {.val {dimredName}} is now set as default.")
     return(object)
 }
 
@@ -186,7 +186,7 @@ runTSNE <- function(
     dimRed(object, dimredName) <- tsne
     object@uns$TSNE <- list(method = method)
     if (isTRUE(verbose))
-        cli::cli_alert_info("cellMeta variable {.field {dimredName}} is now set as default.")
+        cli::cli_alert_info("{.field DimRed} {.val {dimredName}} is now set as default.")
     return(object)
 }
 

R/factorMarker.R

@@ -250,7 +250,10 @@ calcDatasetSpecificity <- function(
         do.plot = doPlot
 ) {
     .deprecateArgs(list(do.plot = "doPlot"))
-    H1 <- getMatrix(object, slot = "H", dataset = 1)
+    H1 <- getMatrix(object, slot = "H", dataset = dataset1)
+    if (is.null(H1)) {
+        cli::cli_abort("No {.field H} matrix found for dataset {.val {dataset1}}.")
+    }
     # V: List of two g x k matrices
     V <- getMatrix(object, slot = "V", dataset = c(dataset1, dataset2))
     W <- getMatrix(object, slot = "W")

R/generics.R

@@ -269,18 +269,16 @@ setGeneric(
 #' @rdname liger-class
 #' @section Dimension reduction access:
 #' Currently, low-dimensional representaion of cells, presented as dense
-#' matrices, are all stored in \code{cellMeta} slot, and can totally be accessed
-#' with generics \code{cellMeta} and \code{cellMeta<-}. In addition to that,
-#' we provide specific generics \code{dimRed} and \code{dimRed<-} for getting
-#' and setting matrix like cell metadata, respectively. Adding a matrix to the
+#' matrices, are all stored in \code{dimReds} slot, and can totally be accessed
+#' with generics \code{dimRed} and \code{dimRed<-}. Adding a dimRed to the
 #' object looks as simple as \code{dimRed(obj, "name") <- matrixLike}. It can
-#' be retrived back with \code{dimRed(obj, "name")}. Similar to having a default
-#' cluster labeling, we also constructed the feature of default dimRed. It can
-#' be set with \code{defaultDimRed(obj) <- "existingMatLikeVar"} and the matrix
-#' can be retrieved with \code{defaultDimRed(obj)}.
+#' be retrieved back with \code{dimRed(obj, "name")}. Similar to having a
+#' default cluster labeling, we also constructed the feature of default dimRed.
+#' It can be set with \code{defaultDimRed(obj) <- "existingMatLikeVar"} and the
+#' matrix can be retrieved with \code{defaultDimRed(obj)}.
 setGeneric(
     "dimRed",
-    function(x, name = NULL, useDatasets = NULL, ...) {
+    function(x, name = NULL, useDatasets = NULL, cellIdx = NULL, ...) {
         standardGeneric("dimRed")
     }
 )
@@ -289,7 +287,7 @@ setGeneric(
 #' @rdname liger-class
 setGeneric(
     "dimRed<-",
-    function(x, name = NULL, useDatasets = NULL, ..., value) {
+    function(x, name = NULL, useDatasets = NULL, cellIdx = NULL, ..., value) {
         standardGeneric("dimRed<-")
     }
 )
@@ -298,7 +296,7 @@ setGeneric(
 #' @rdname liger-class
 setGeneric(
     "defaultDimRed",
-    function(x, useDatasets = NULL) {
+    function(x, useDatasets = NULL, cellIdx = NULL) {
         standardGeneric("defaultDimRed")
     }
 )
@@ -307,7 +305,7 @@ setGeneric(
 #' @rdname liger-class
 setGeneric(
     "defaultDimRed<-",
-    function(x, name, useDatasets = NULL, value) {
+    function(x, value) {
         standardGeneric("defaultDimRed<-")
     }
 )

R/ggplotting.R

@@ -26,8 +26,6 @@
 #' rliger package. These are based on the nature of \code{as.data.frame} method
 #' on a \code{\link[S4Vectors]{DataFrame}} object.
 #' @param object A \linkS4class{liger} object
-#' @param x,y Available variable name in \code{cellMeta} slot to look for
-#' the dot coordinates. See details.
 #' @param colorBy Available variable name in specified \code{slot} to look for
 #' color annotation information. See details. Default \code{NULL} generates
 #' all-black dots.
@@ -57,21 +55,16 @@
 #' objects.
 #' @export
 #' @examples
-#' plotCellScatter(pbmcPlot, x = "UMAP.1", y = "UMAP.2",
-#'                 colorBy = "dataset", slot = "cellMeta",
-#'                 labelText = FALSE)
-#' plotCellScatter(pbmcPlot, x = "UMAP.1", y = "UMAP.2",
-#'                 colorBy = "S100A8", slot = "normData",
-#'                 dotOrder = "ascending", dotSize = 2)
-#' plotCellScatter(pbmcPlot, x = "UMAP.1", y = "UMAP.2",
-#'                 colorBy = 2, slot = "H.norm",
-#'                 dotOrder = "ascending", dotSize = 2,
-#'                 colorPalette = "viridis")
-plotCellScatter <- function(
+#' plotDimRed(pbmcPlot, colorBy = "dataset", slot = "cellMeta",
+#'            labelText = FALSE)
+#' plotDimRed(pbmcPlot, colorBy = "S100A8", slot = "normData",
+#'            dotOrder = "ascending", dotSize = 2)
+#' plotDimRed(pbmcPlot, colorBy = 2, slot = "H.norm",
+#'            dotOrder = "ascending", dotSize = 2, colorPalette = "viridis")
+plotDimRed <- function(
         object,
-        x,
-        y,
         colorBy = NULL,
+        useDimRed = NULL,
         slot = c("cellMeta", "rawData", "normData",
                  "scaleData", "H.norm", "H",
                  "normPeak", "rawPeak"),
@@ -83,8 +76,12 @@ plotCellScatter <- function(
         ...
 ) {
     slot <- match.arg(slot)
-    plotDF <- cellMeta(object, c(x, y), cellIdx = cellIdx,
-                       as.data.frame = TRUE)
+    # useDimRed <- useDimRed %||% object@uns$defaultDimRed
+    # useDimRed <- .findDimRedName(object, useDimRed, stopOnNull = TRUE, returnFirst = TRUE)
+    plotDF <- as.data.frame(dimRed(object, useDimRed, cellIdx = cellIdx))
+    x <- colnames(plotDF)[1]
+    y <- colnames(plotDF)[2]
+
     ann <- .fetchCellMetaVar(object, variables = c(shapeBy, splitBy),
                              checkCategorical = TRUE, cellIdx = cellIdx,
                              drop = FALSE, droplevels = TRUE)
@@ -95,7 +92,7 @@ plotCellScatter <- function(
     plotDFList <- list()
     colorByParam <- list()
     if (!is.null(colorBy)) {
-        colorDF <- retrieveCellFeature(object, feature =  colorBy,
+        colorDF <- retrieveCellFeature(object, feature = colorBy,
                                        slot = slot, cellIdx = cellIdx,
                                        verbose = FALSE)
         # When retrieving H/H.norm, exact colname might not be what `colorBy` is
@@ -165,7 +162,9 @@ plotCellScatter <- function(
 #' labels on the scatter plot.
 #' @param plotDF Data frame like object (fortifiable) that contains all
 #' necessary information to make the plot.
-#' @param x,y,colorBy,shapeBy See \code{\link{plotCellScatter}}.
+#' @param x,y Available variable name in \code{cellMeta} slot to look for
+#' the dot coordinates. See details.
+#' @param colorBy,shapeBy See \code{\link{plotDimRed}}.
 #' @param dotOrder Controls the order that each dot is added to the plot. Choose
 #' from \code{"shuffle"}, \code{"ascending"}, or \code{"descending"}. Default
 #' \code{"shuffle"}, useful when coloring by categories that overlaps (e.g.

R/import.R

@@ -378,7 +378,8 @@ readLiger <- function(
         if (isH5Liger(obj)) obj <- restoreH5Liger(obj)
         return(obj)
     }
-    cli::cli_alert_info("Older version ({.val {ver}}) of {.cls liger} object detected.")
+    if (ver < package_version("1.99.1"))
+        cli::cli_alert_info("Older version ({.val {ver}}) of {.cls liger} object detected.")
     if (isTRUE(update)) {
         cli::cli_alert_info(
             "Updating the object structure to make it compatible with current version {.val {utils::packageVersion('rliger')}}"

R/integration.R

@@ -1619,7 +1619,8 @@ quantile_norm <- function( # nocov start
 #' @param byDataset Whether to return agreement calculated for each dataset
 #' instead of the average for all datasets. Default \code{FALSE}.
 #' @param seed Random seed to allow reproducible results. Default \code{1}.
-#' @param use.aligned,rand.seed,by.dataset [Deprecated] Use \code{useRaw} instead.
+#' @param k,rand.seed,by.dataset [Deprecated] See Usage for replacement.
+#' @param use.aligned [defunct] Use \code{useRaw} instead.
 #' @param dr.method [defunct] We no longer support other methods but just NMF.
 #' @return A numeric vector of agreement metric. A single value if
 #' \code{byDataset = FALSE} or each dataset a value otherwise.
@@ -1745,7 +1746,7 @@ calcAgreement <- function(
 #' }
 #' @param object A \linkS4class{liger} object, with \code{\link{quantileNorm}}
 #' already run.
-#' @param clusterUse The clusters to consider for calculating the alignment.
+#' @param clustersUse The clusters to consider for calculating the alignment.
 #' Should be a vector of existing levels in \code{clusterVar}. Default
 #' \code{NULL}. See Details.
 #' @param clusterVar The name of one variable in \code{cellMeta(object)}.