diff --git a/DESCRIPTION b/DESCRIPTION index e5e0e72..c5ac653 100644 --- a/DESCRIPTION +++ b/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 diff --git a/NAMESPACE b/NAMESPACE index ee5c9c8..bcf528b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -125,7 +125,6 @@ export(optimizeNewK) export(optimizeNewLambda) export(optimizeSubset) export(plotByDatasetAndCluster) -export(plotCellScatter) export(plotCellViolin) export(plotClusterDimRed) export(plotClusterFactorDot) @@ -133,6 +132,7 @@ export(plotClusterGeneDot) export(plotClusterProportions) export(plotDatasetDimRed) export(plotDensityDimRed) +export(plotDimRed) export(plotEnhancedVolcano) export(plotFactorDimRed) export(plotFactorHeatmap) diff --git a/R/GSEA.R b/R/GSEA.R index dc6a089..76baefd 100644 --- a/R/GSEA.R +++ b/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") diff --git a/R/cINMF.R b/R/cINMF.R index 903a77c..e73f970 100644 --- a/R/cINMF.R +++ b/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, diff --git a/R/classConversion.R b/R/classConversion.R index 222461f..9eeaed7 100644 --- a/R/classConversion.R +++ b/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,10 +440,11 @@ 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 @@ -451,6 +452,9 @@ convertOldLiger <- function( # nocov start 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) } diff --git a/R/classes.R b/R/classes.R index ce195d5..3f768d2 100644 --- a/R/classes.R +++ b/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) diff --git a/R/clustering.R b/R/clustering.R index 472e5ff..bdf0f66 100644 --- a/R/clustering.R +++ b/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) } diff --git a/R/embedding.R b/R/embedding.R index 3744496..c668186 100644 --- a/R/embedding.R +++ b/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) } diff --git a/R/factorMarker.R b/R/factorMarker.R index 3130492..060ac3c 100644 --- a/R/factorMarker.R +++ b/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") diff --git a/R/generics.R b/R/generics.R index 029ee60..8692260 100644 --- a/R/generics.R +++ b/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<-") } ) diff --git a/R/ggplotting.R b/R/ggplotting.R index 1cfdb6a..aae9cc3 100644 --- a/R/ggplotting.R +++ b/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. diff --git a/R/import.R b/R/import.R index 251c548..0f97dd6 100644 --- a/R/import.R +++ b/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')}}" diff --git a/R/integration.R b/R/integration.R index 0faec66..f5a688d 100644 --- a/R/integration.R +++ b/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)}. diff --git a/R/liger-methods.R b/R/liger-methods.R index 51d90e5..82dbfab 100644 --- a/R/liger-methods.R +++ b/R/liger-methods.R @@ -84,7 +84,7 @@ is.newLiger <- function(object) { #' c(pbmcPlot, pbmcPlot2) #' #' library(ggplot2) -#' ggplot(pbmcPlot, aes(x = UMAP.1, y = UMAP.2)) + geom_point() +#' ggplot(pbmcPlot, aes(x = UMAP_1, y = UMAP_2)) + geom_point() setMethod( f = "show", signature(object = "liger"), @@ -100,6 +100,8 @@ setMethod( cat(.collapseLongNames(colnames(cellMeta(object))), "\n") cat(paste0("varFeatures(", length(varFeatures(object)), "): ")) cat(.collapseLongNames(varFeatures(object)), "\n") + cat(paste0("dimReds(", length(object@dimReds), "): ")) + cat(.collapseLongNames(names(object@dimReds)), "\n") invisible(x = NULL) } ) @@ -350,12 +352,22 @@ setReplaceMethod("dataset", signature(x = "liger", dataset = "character", x@cellMeta <- cm # x@W is genes x k, no need to worry if (!is.null(x@H.norm)) { - cli::cli_alert_info("Finning in NAs to H.norm matrix") + cli::cli_alert_info("Filling in NAs to {.field H.norm} matrix") H.normNew <- matrix( NA, ncol(value), ncol(x@H.norm), dimnames = list(colnames(value), NULL)) x@H.norm <- rbind(x@H.norm, H.normNew) } + if (length(x@dimReds) != 0) { + cli::cli_alert_info("Filling in NAs to {.field dimReds}") + for (dr in names(x@dimReds)) { + x@dimReds[[dr]] <- rbind( + x@dimReds[[dr]], + matrix(NA, ncol(value), ncol(x@dimReds[[dr]]), + dimnames = list(colnames(value), NULL)) + ) + } + } methods::validObject(x) if (qc) x <- runGeneralQC(x, useDatasets = dataset, verbose = FALSE) @@ -404,6 +416,9 @@ setReplaceMethod( x@cellMeta <- x@cellMeta[!idxToRemove, , drop = FALSE] x@H.norm <- x@H.norm[!idxToRemove, , drop = FALSE] x@cellMeta$dataset <- droplevels(x@cellMeta$dataset) + for (i in seq_along(x@dimReds)) { + x@dimReds[[i]] <- x@dimReds[[i]][!idxToRemove, , drop = FALSE] + } } x } @@ -1114,30 +1129,26 @@ setReplaceMethod( #' @rdname liger-class setMethod( "dimRed", - signature = c(x = "liger", name = "missing", useDatasets = "ANY"), - function(x, name = NULL, useDatasets = NULL, ...) { - # No name given, retrieve default - useDatasets <- .checkUseDatasets(x, useDatasets) + signature = c(x = "liger", name = "missing_OR_NULL"), + function(x, name = NULL, useDatasets = NULL, cellIdx = NULL, ...) { name <- x@uns$defaultDimRed dimred <- NULL if (is.null(name)) { - for (i in seq_along(cellMeta(x))) { - if (!is.null(dim(cellMeta(x)[[i]]))) { - cli::cli_alert_warning( - "No default dimRed recorded. Returning the first matrix alike in {.code cellMeta(object)}.") - dimred <- cellMeta(x)[[i]] - break - } - } - if (is.null(dimred)) { - cli::cli_abort("No possible dimRed can be found in this {.cls liger} object.") + if (length(x@dimReds) > 0) { + cli::cli_alert_warning( + "No default {.field dimRed} recorded. Returning the first available." + ) + dimred <- dimRed(x, name = 1, useDatasets = useDatasets, + cellIdx = cellIdx, ...) + } else { + cli::cli_abort( + "No {.field dimRed} available in this {.cls liger} object." + ) } } else { - dimred <- cellMeta(x, name, x$dataset %in% useDatasets) + dimred <- dimRed(x, name = name, useDatasets = useDatasets, + cellIdx = cellIdx, ...) } - dimred <- as.matrix(dimred) - rownames(dimred) <- colnames(x)[x$dataset %in% useDatasets] - colnames(dimred) <- paste0(name, "_", seq_len(ncol(dimred))) return(dimred) } ) @@ -1146,21 +1157,39 @@ setMethod( #' @rdname liger-class setMethod( "dimRed", - signature = c(x = "liger", name = "character", useDatasets = "ANY"), - function(x, name, useDatasets = NULL, ...) { - # No name given, retrieve default - useDatasets <- .checkUseDatasets(x, useDatasets) - dimred <- cellMeta(x, name, x$dataset %in% useDatasets) - if (is.null(dim(dimred))) { - cli::cli_abort("Retrieved data for {.val {name}} is not a matrix.") + signature = c(x = "liger", name = "index"), + function(x, name, useDatasets = NULL, cellIdx = NULL, ...) { + if (is.null(useDatasets) && is.null(cellIdx)) { + cellIdx <- seq_len(ncol(x)) + } else if (!is.null(cellIdx)) { + cellIdx <- .idxCheck(x, cellIdx, "cell") + } else if (!is.null(useDatasets)) { + useDatasets <- .checkUseDatasets(x, useDatasets) + cellIdx <- which(x$dataset %in% useDatasets) } - dimred <- as.matrix(dimred) - rownames(dimred) <- colnames(x)[x$dataset %in% useDatasets] + + name <- .findDimRedName(x, name, stopOnNull = TRUE) + dimred <- x@dimReds[[name]] + dimred <- dimred[cellIdx, , drop = FALSE] + rownames(dimred) <- colnames(x)[cellIdx] colnames(dimred) <- paste0(name, "_", seq_len(ncol(dimred))) return(dimred) } ) +#' @export +#' @rdname liger-class +setReplaceMethod( + "dimRed", + signature(x = "liger", name = "index", value = "NULL"), + function(x, name = NULL, useDatasets = NULL, cellIdx = NULL, ..., value = NULL) { + name <- .findDimRedName(x, name, stopOnNull = TRUE, returnFirst = FALSE) + x@dimReds[[name]] <- NULL + if (name %in% x@uns$defaultDimRed) x@uns$defaultDimRed <- NULL + return(x) + } +) + #' @export #' @rdname liger-class #' @param asDefault Whether to set the inserted dimension reduction matrix as @@ -1169,17 +1198,61 @@ setMethod( setReplaceMethod( "dimRed", signature(x = "liger", name = "character", value = "matrixLike"), - function(x, name = NULL, useDatasets = NULL, asDefault = NULL, ..., value) { - useDatasets <- .checkUseDatasets(x, useDatasets) - cellIdx <- x$dataset %in% useDatasets + function(x, name = NULL, useDatasets = NULL, cellIdx = NULL, asDefault = NULL, inplace = FALSE, ..., value) { + if (is.null(useDatasets) && is.null(cellIdx)) { + cellIdx <- seq_len(ncol(x)) + } else if (!is.null(cellIdx)) { + cellIdx <- .idxCheck(x, cellIdx, "cell") + } else if (!is.null(useDatasets)) { + useDatasets <- .checkUseDatasets(x, useDatasets) + cellIdx <- which(x$dataset %in% useDatasets) + } + + if (!name %in% names(x@dimReds) || isFALSE(inplace)) { + # Totally new thing or just replace + init <- matrix( + data = NA, + nrow = ncol(x), ncol = ncol(value), + dimnames = list( + colnames(x), + paste0(name, "_", seq_len(ncol(value))) + ) + ) + } else { + # Partial insertion + init <- dimRed(x, name = name) + if (ncol(init) != ncol(value)) { + cli::cli_abort( + "Cannot partially insert {ncol(value)} columns to {ncol(init)} columns inplace, at {.field dimReds}: {.val {name}}" + ) + } + } + value <- as.matrix(value) + if (nrow(value) != length(cellIdx)) { + cli::cli_abort( + "{.code nrow(value)} does not match with the number of cells selected." + ) + } + if (is.null(rownames(value))) { + cli::cli_alert_warning( + "No rownames detected. Assume cells match to the same order as in the object." + ) + } else { + if (!all(endsWith(colnames(x)[cellIdx], rownames(value)))) { + cli::cli_abort( + "Cell identifiers in {.var value} do not match to those in the object" + ) + } + } + rownames(value) <- colnames(x)[cellIdx] + colnames(value) <- paste0(name, "_", seq_len(ncol(value))) + init[rownames(value), ] <- value + x@dimReds[[name]] <- init if (is.null(asDefault)) { if (!is.null(x@uns$defaultDimRed)) asDefault <- FALSE else asDefault <- TRUE } - colnames(value) <- seq_len(ncol(value)) - rownames(value) <- colnames(x)[cellIdx] - cellMeta(x, name, cellIdx) <- value if (isTRUE(asDefault)) defaultDimRed(x) <- name return(x) } @@ -1190,10 +1263,10 @@ setReplaceMethod( setMethod( "defaultDimRed", signature(x = "liger", useDatasets = "ANY"), - function(x, useDatasets = NULL) { + function(x, useDatasets = NULL, cellIdx = cellIdx) { name <- x@uns$defaultDimRed if (is.null(name)) return(NULL) - else dimRed(x, name = name, useDatasets = useDatasets) + else dimRed(x, name = name, useDatasets = useDatasets, cellIdx = cellIdx) } ) @@ -1201,37 +1274,17 @@ setMethod( #' @rdname liger-class setReplaceMethod( "defaultDimRed", - signature(x = "liger", name = "missing", value = "character"), - function(x, name = NULL, useDatasets = NULL, value) { - value <- value[1] - dimred <- cellMeta(x, value) - if (is.null(dim(dimred))) { - cli::cli_abort("Specified variable is not a matrix alike.") - } - if (ncol(dimred) == 0) { - cli::cli_abort("Cannot set unexisting variable as default dimRed.") + signature(x = "liger", value = "character"), + function(x, value) { + if (length(value) != 1) { + cli::cli_abort("Can only set one {.field dimRed} as default.") } + value <- .findDimRedName(x, value, stopOnNull = TRUE) x@uns$defaultDimRed <- value return(x) } ) -#' @export -#' @rdname liger-class -setReplaceMethod( - "defaultDimRed", - signature(x = "liger", name = "character", value = "matrixLike"), - function(x, name, useDatasets = NULL, value) { - useDatasets <- .checkUseDatasets(x, useDatasets) - cellIdx <- x$dataset %in% useDatasets - colnames(value) <- seq_len(ncol(value)) - rownames(value) <- colnames(x)[cellIdx] - cellMeta(x, name, cellIdx) <- value - x@uns$defaultDimRed <- name - return(x) - } -) - #' @export #' @rdname liger-class setMethod("varFeatures", signature(x = "liger"), @@ -1306,6 +1359,8 @@ setReplaceMethod( fortify.liger <- function(model, data, ...) { df <- cellMeta(model, as.data.frame = TRUE) if (!is.null(model@H.norm)) df <- cbind(df, model@H.norm) + drs <- Reduce(cbind, model@dimReds) + if (!is.null(drs)) df <- cbind(df, drs) df } diff --git a/R/subsetObject.R b/R/subsetObject.R index ad09cba..953cbc6 100644 --- a/R/subsetObject.R +++ b/R/subsetObject.R @@ -108,11 +108,16 @@ subsetLiger <- function( W <- object@W varFeature <- varFeatures(object) } + dimRedsSub <- lapply( + object@dimReds, + `[`, i = orderedCellIdx, j = , drop = FALSE + ) return(methods::new( "liger", datasets = datasets.new, cellMeta = cellMeta(object, cellIdx = orderedCellIdx, drop = FALSE), + dimReds = dimRedsSub, varFeatures = varFeature, W = W, H.norm = object@H.norm[orderedCellIdx, , drop = FALSE], @@ -127,8 +132,7 @@ subsetLiger <- function( #' Retrieve a single matrix of cells from a slot #' @description Only retrieve data from specific slot to reduce memory used by #' a whole \linkS4class{liger} object of the subset. Useful for plotting. -#' Internally used by \code{\link{plotCellScatter}} and -#' \code{\link{plotCellViolin}}. +#' Internally used by \code{\link{plotDimRed}} and \code{\link{plotCellViolin}}. #' @param object \linkS4class{liger} object #' @param feature Gene names, factor index or cell metadata variable names. #' Should be available in specified \code{slot}. diff --git a/R/util.R b/R/util.R index d7f54d1..618200d 100644 --- a/R/util.R +++ b/R/util.R @@ -87,6 +87,61 @@ cli_or <- function(x) cli::cli_vec(x, list("vec-last" = " or ")) useDatasets } +.findDimRedName <- function( + object, + name, + returnFirst = FALSE, + stopOnNull = TRUE) { + if (length(names(object@dimReds)) == 0) { + cli::cli_abort("No {.field dimRed} available") + } + if (is.null(name)) { + if (returnFirst) return(names(object@dimReds)[1]) + if (stopOnNull) { + cli::cli_abort("No {.field dimRed} name specified.") + } else { + return(NULL) + } + } + if (length(name) == 0) { + if (stopOnNull) { + cli::cli_abort("No {.field dimRed} name specified.") + } else { + return(NULL) + } + } + if (is.character(name) || is.numeric(name)) { + if (length(name) != 1) { + cli::cli_abort("Only one {.field dimRed} can be retrieved at a time.") + } + if (is.character(name) && !name %in% names(object@dimReds)) { + cli::cli_abort("Specified {.field dimRed} {.val {name}} does not exist in the object.") + } + if (is.numeric(name)) { + if (name > length(object@dimReds)) { + cli::cli_abort("Specified {.field dimRed} index {.val {name}} is out of range.") + } + name <- names(object@dimReds)[name] + } + } else { + if (length(name) != length(object@dimReds)) { + cli::cli_abort( + c("x" = "{.cls logical} {.var name} specification has wrong length.", + "i" = "Should be of length {length(x@dimReds)}") + ) + } + name <- names(object@dimReds)[name] + if (length(name) == 0) { + if (stopOnNull) { + cli::cli_abort("No {.field dimRed} name specified.") + } else { + return(NULL) + } + } + } + return(name) +} + # Check if the selection of cellMeta variable is valid, in terms of existence # and class and return all result .fetchCellMetaVar <- function( @@ -295,10 +350,17 @@ cli_or <- function(x) cli::cli_vec(x, list("vec-last" = " or ")) } } } - if (k != object@uns$factorization$k) - cli::cli_alert_danger( - "Number of factors does not match with recorded parameter." - ) + if (is.null(object@uns$factorization)) { + rlang::warn("No recorded factorization parameter found in object.", + .frequency = "once", .frequency_id = "inmf_param", + use_cli_format = TRUE) + } else { + if (k != object@uns$factorization$k) + cli::cli_alert_danger( + "Number of factors does not match with recorded parameter." + ) + } + if (isFALSE(result)) cli::cli_abort( c(x = "Cannot detect valid existing factorization result. ", @@ -623,19 +685,26 @@ searchH <- function(object, useRaw = NULL) { # use when you have objects created when this package was named by `rliger2` # now we rename the package back to `rliger` and you'll need to have the objects # compatible with "new" package name. -rliger2_to_rliger_namespace <- function(obj) { - if (inherits(obj, "liger")) { - new <- methods::new( - "liger", - datasets = obj@datasets, - cellMeta = obj@cellMeta, - varFeatures = obj@varFeatures, - W = obj@W, - H.norm = obj@H.norm, - uns = obj@uns, - commands = obj@commands, - version = obj@version - ) +rliger2_to_rliger_namespace <- function(obj, dimredName = NULL) { + cm <- obj@cellMeta + drList <- list() + for (i in dimredName) { + drList[[i]] <- cm[[i]] + cm[[i]] <- NULL + } + new <- methods::new( + "liger", + datasets = obj@datasets, + cellMeta = cm, + varFeatures = obj@varFeatures, + W = obj@W, + H.norm = obj@H.norm, + uns = obj@uns, + commands = obj@commands, + version = obj@version + ) + for (i in dimredName) { + dimRed(new, i) <- drList[[i]] } for (i in seq_along(obj)) { ld <- obj@datasets[[i]] diff --git a/R/visualization.R b/R/visualization.R index 87b4937..fa665d7 100644 --- a/R/visualization.R +++ b/R/visualization.R @@ -28,11 +28,9 @@ #' @param colorPalette Name of viridis palette. See #' \code{\link[viridisLite]{viridis}} for options. Default \code{"C"} ("plasma") #' for gene expression and \code{"D"} ("viridis") for factor loading. -#' @param ... Additional graphic setting arguments passed to -#' \code{\link{plotCellScatter}}. #' @return ggplot object when only one feature (e.g. cluster variable, gene, #' factor) is set. List object when multiple of those are specified. -#' @seealso Please refer to \code{\link{plotCellScatter}}, +#' @seealso Please refer to \code{\link{plotDimRed}}, #' \code{\link{.ggScatter}}, \code{\link{.ggplotLigerTheme}} for additional #' graphic setting #' @rdname plotDimRed @@ -48,19 +46,9 @@ plotClusterDimRed <- function( useCluster = NULL, useDimRed = NULL, ...) { - useDimRed <- useDimRed %||% object@uns$defaultDimRed - if (is.null(useDimRed)) { - cli::cli_abort( - c(x = "No {.var useDimRed} given or default dimRed not set.", - i = "Run {.fn runUMAP} or {.fn runTSNE} to create one. Or see {.fn dimRed} and {.fn defaultDimRed}.") - ) - } useCluster <- useCluster %||% object@uns$defaultCluster - xVar <- paste0(useDimRed, ".1") - yVar <- paste0(useDimRed, ".2") - plotCellScatter(object, x = xVar, y = yVar, - colorBy = useCluster, - slot = "cellMeta", dotOrder = "shuffle", ...) + plotDimRed(object, colorBy = useCluster, useDimRed = useDimRed, + slot = "cellMeta", dotOrder = "shuffle", ...) } #' @rdname plotDimRed @@ -69,18 +57,9 @@ plotDatasetDimRed <- function( object, useDimRed = NULL, ...) { - useDimRed <- useDimRed %||% object@uns$defaultDimRed - if (is.null(useDimRed)) { - cli::cli_abort( - c(x = "No {.var useDimRed} given or default dimRed not set.", - i = "Run {.fn runUMAP} or {.fn runTSNE} to create one. Or see {.fn dimRed} and {.fn defaultDimRed}.") - ) - } - xVar <- paste0(useDimRed, ".1") - yVar <- paste0(useDimRed, ".2") - plotCellScatter(object, x = xVar, y = yVar, colorBy = "dataset", - slot = "cellMeta", labelText = FALSE, - dotOrder = "shuffle", ...) + plotDimRed(object, colorBy = "dataset", slot = "cellMeta", + useDimRed = useDimRed, labelText = FALSE, + dotOrder = "shuffle", ...) } #' @rdname plotDimRed @@ -92,12 +71,13 @@ plotByDatasetAndCluster <- function( combinePlots = TRUE, ... ) { - useDimRed <- useDimRed %||% object@uns$defaultDimRed - useCluster <- useCluster %||% object@uns$defaultCluster plot <- list( - dataset = plotDatasetDimRed(object, useDimRed = useDimRed, ...), - cluster = plotClusterDimRed(object, useCluster = useCluster, - useDimRed = useDimRed, ...) + dataset = plotDatasetDimRed( + object, useDimRed = useDimRed, ... + ), + cluster = plotClusterDimRed( + object, useCluster = useCluster, useDimRed = useDimRed, ... + ) ) if (isTRUE(combinePlots)) { plot <- cowplot::plot_grid(plotlist = plot, nrow = 1, @@ -118,18 +98,15 @@ plotGeneDimRed <- function( colorPalette = "C", ... ) { - useDimRed <- useDimRed %||% object@uns$defaultDimRed - xVar <- paste0(useDimRed, ".1") - yVar <- paste0(useDimRed, ".2") scaleFunc <- function(x) { if (!is.null(scaleFactor)) x <- scaleFactor*x if (isTRUE(log)) x <- log2(x + 1) x } - plotCellScatter(object, x = xVar, y = yVar, colorBy = features, - slot = "normData", colorByFunc = scaleFunc, - dotOrder = "ascending", zeroAsNA = zeroAsNA, - colorPalette = colorPalette, ...) + plotDimRed(object, colorBy = features, useDimRed = useDimRed, + slot = "normData", colorByFunc = scaleFunc, + dotOrder = "ascending", zeroAsNA = zeroAsNA, + colorPalette = colorPalette, ...) } #' @rdname plotDimRed @@ -144,18 +121,16 @@ plotPeakDimRed <- function( colorPalette = "C", ... ) { - useDimRed <- useDimRed %||% object@uns$defaultDimRed - xVar <- paste0(useDimRed, ".1") - yVar <- paste0(useDimRed, ".2") scaleFunc <- function(x) { if (!is.null(scaleFactor)) x <- scaleFactor*x if (isTRUE(log)) x <- log2(x + 1) x } - plotCellScatter(object, x = xVar, y = yVar, colorBy = features, - slot = "normPeak", colorByFunc = scaleFunc, - dotOrder = "ascending", zeroAsNA = zeroAsNA, - colorPalette = colorPalette, ...) + plotDimRed( + object, useDimRed = useDimRed, colorBy = features, slot = "normPeak", + colorByFunc = scaleFunc, dotOrder = "ascending", zeroAsNA = zeroAsNA, + colorPalette = colorPalette, ... + ) } #' @rdname plotDimRed @@ -169,13 +144,10 @@ plotFactorDimRed <- function( colorPalette = "D", ... ) { - useDimRed <- useDimRed %||% object@uns$defaultDimRed - xVar <- paste0(useDimRed, ".1") - yVar <- paste0(useDimRed, ".2") - plotCellScatter(object, x = xVar, y = yVar, colorBy = factors, - slot = "H.norm", dotOrder = "ascending", - trimHigh = trimHigh, zeroAsNA = zeroAsNA, - colorPalette = colorPalette, ...) + plotDimRed(object, colorBy = factors, useDimRed = useDimRed, + slot = "H.norm", dotOrder = "ascending", + trimHigh = trimHigh, zeroAsNA = zeroAsNA, + colorPalette = colorPalette, ...) } #' Comprehensive group splited cluster plot on dimension reduction with @@ -211,10 +183,10 @@ plotFactorDimRed <- function( #' @param legendNRow Arrangement of the legend, number of rows. Default #' \code{1}. #' @param ... Additional graphic setting arguments passed to -#' \code{\link{plotCellScatter}}. +#' \code{\link{plotDimRed}}. #' @return ggplot object when only one feature (e.g. cluster variable, gene, #' factor) is set. List object when multiple of those are specified. -#' @seealso Please refer to \code{\link{plotCellScatter}}, +#' @seealso Please refer to \code{\link{plotDimRed}}, #' \code{\link{.ggScatter}}, \code{\link{.ggplotLigerTheme}} for additional #' graphic setting #' @export @@ -234,11 +206,8 @@ plotGroupClusterDimRed <- function( legendNRow = 1, ... ) { - useDimRed <- useDimRed %||% object@uns$defaultDimRed useCluster <- useCluster %||% object@uns$defaultCluster clusterVar <- cellMeta(object, useCluster) - xVar <- paste0(useDimRed, ".1") - yVar <- paste0(useDimRed, ".2") groupVar <- .fetchCellMetaVar(object, useGroup, checkCategorical = TRUE, droplevels = droplevels) plotList <- list() @@ -250,18 +219,19 @@ plotGroupClusterDimRed <- function( clusterVarMasked <- droplevels(clusterVarMasked) tempVarName <- paste0(useCluster, "_", lvl) cellMeta(object, tempVarName) <- clusterVarMasked - plotList[[lvl]] <- plotCellScatter(object, x = xVar, y = yVar, - colorBy = tempVarName, - dotOrder = "shuffle", titles = lvl, - legendColorTitle = "", - legendPosition = "bottom", - legendNRow = legendNRow, - ...) + - ggplot2::theme(line = ggplot2::element_blank(), - axis.text.x = ggplot2::element_blank(), - axis.text.y = ggplot2::element_blank(), - axis.title.x = ggplot2::element_blank(), - axis.title.y = ggplot2::element_blank()) + plotList[[lvl]] <- plotDimRed( + object, colorBy = tempVarName, useDimRed = useDimRed, + slot = "cellMeta", dotOrder = "shuffle", titles = lvl, + legendColorTitle = "", legendPosition = "bottom", + legendNRow = legendNRow, ... + ) + + ggplot2::theme( + line = ggplot2::element_blank(), + axis.text.x = ggplot2::element_blank(), + axis.text.y = ggplot2::element_blank(), + axis.title.x = ggplot2::element_blank(), + axis.title.y = ggplot2::element_blank() + ) proportions <- table(clusterVarMasked) / sum(table(clusterVarMasked)) propDF <- data.frame(group = lvl, proportions) # propDF$clusterVarMasked <- as.character() @@ -803,10 +773,7 @@ plotDensityDimRed <- function( colorDirection = -1, ... ) { - useDimRed <- useDimRed %||% object@uns$defaultDimRed - xVar <- paste0(useDimRed, ".1") - yVar <- paste0(useDimRed, ".2") - dr <- .fetchCellMetaVar(object, c(xVar, yVar)) + dr <- as.data.frame(dimRed(object, useDimRed)) splitVar <- .fetchCellMetaVar(object, splitBy, checkCategorical = TRUE, drop = FALSE) @@ -946,16 +913,14 @@ plotGeneLoadings <- function( object, markerTable, useFactor, - useDimRed = "UMAP", + useDimRed = NULL, nLabel = 15, nPlot = 30, ... ) { - p1 <- plotCellScatter( - object, - x = paste0(useDimRed, ".1"), y = paste0(useDimRed, ".2"), - colorBy = useFactor, slot = "H.norm", zeroAsNA = TRUE, dotOrder = "asc", - splitBy = NULL, shapeBy = NULL, colorByFunc = NULL, ... + p1 <- plotDimRed( + object, colorBy = useFactor, useDimRed = useDimRed, slot = "H.norm", + zeroAsNA = TRUE, dotOrder = "asc", splitBy = NULL, ... ) bottom <- plotGeneLoadingRank(object, markerTable, useFactor, nLabel, nPlot, ...) diff --git a/data/bmmc.rda b/data/bmmc.rda index a35ec2b..8e66429 100644 Binary files a/data/bmmc.rda and b/data/bmmc.rda differ diff --git a/data/pbmc.rda b/data/pbmc.rda index d099ef9..2d6beec 100644 Binary files a/data/pbmc.rda and b/data/pbmc.rda differ diff --git a/data/pbmcPlot.rda b/data/pbmcPlot.rda index 785b560..c4f32ca 100644 Binary files a/data/pbmcPlot.rda and b/data/pbmcPlot.rda differ diff --git a/man/calcAgreement.Rd b/man/calcAgreement.Rd index fa558b1..ce74146 100644 --- a/man/calcAgreement.Rd +++ b/man/calcAgreement.Rd @@ -37,7 +37,9 @@ instead of the average for all datasets. Default \code{FALSE}.} \item{dr.method}{[defunct] We no longer support other methods but just NMF.} -\item{use.aligned, rand.seed, by.dataset}{[Deprecated] Use \code{useRaw} instead.} +\item{k, rand.seed, by.dataset}{[Deprecated] See Usage for replacement.} + +\item{use.aligned}{[defunct] Use \code{useRaw} instead.} } \value{ A numeric vector of agreement metric. A single value if diff --git a/man/calcAlignment.Rd b/man/calcAlignment.Rd index abbe8d1..caa75da 100644 --- a/man/calcAlignment.Rd +++ b/man/calcAlignment.Rd @@ -26,6 +26,10 @@ calcAlignment( \item{object}{A \linkS4class{liger} object, with \code{\link{quantileNorm}} already run.} +\item{clustersUse}{The clusters to consider for calculating the alignment. +Should be a vector of existing levels in \code{clusterVar}. Default +\code{NULL}. See Details.} + \item{clusterVar}{The name of one variable in \code{cellMeta(object)}. Default \code{NULL} uses default clusters.} @@ -46,10 +50,6 @@ On which level should the mean alignment be calculated. Default \code{"all"}.} see Usage for replacement.} \item{by.cell, by.dataset}{[Defunct] Use \code{resultBy} instead.} - -\item{clusterUse}{The clusters to consider for calculating the alignment. -Should be a vector of existing levels in \code{clusterVar}. Default -\code{NULL}. See Details.} } \value{ The alignment metric. diff --git a/man/convertOldLiger.Rd b/man/convertOldLiger.Rd index fa1fc1c..e3eb019 100644 --- a/man/convertOldLiger.Rd +++ b/man/convertOldLiger.Rd @@ -6,7 +6,7 @@ \usage{ convertOldLiger( object, - dimredName = "tsne.coords", + dimredName, clusterName = "clusters", h5FilePath = NULL ) diff --git a/man/dot-ggScatter.Rd b/man/dot-ggScatter.Rd index 8a6aed0..7de33ec 100644 --- a/man/dot-ggScatter.Rd +++ b/man/dot-ggScatter.Rd @@ -28,7 +28,10 @@ \item{plotDF}{Data frame like object (fortifiable) that contains all necessary information to make the plot.} -\item{x, y, colorBy, shapeBy}{See \code{\link{plotCellScatter}}.} +\item{x, y}{Available variable name in \code{cellMeta} slot to look for +the dot coordinates. See details.} + +\item{colorBy, shapeBy}{See \code{\link{plotDimRed}}.} \item{dotOrder}{Controls the order that each dot is added to the plot. Choose from \code{"shuffle"}, \code{"ascending"}, or \code{"descending"}. Default diff --git a/man/liger-class.Rd b/man/liger-class.Rd index 224589a..4aa930b 100644 --- a/man/liger-class.Rd +++ b/man/liger-class.Rd @@ -68,12 +68,12 @@ \alias{defaultCluster<-,liger,ANY,ANY,character-method} \alias{defaultCluster<-,liger,ANY,ANY,factor-method} \alias{defaultCluster<-,liger,ANY,ANY,NULL-method} -\alias{dimRed,liger,missing-method} -\alias{dimRed,liger,character-method} -\alias{dimRed<-,liger,character,ANY,matrixLike-method} +\alias{dimRed,liger,missing_OR_NULL-method} +\alias{dimRed,liger,index-method} +\alias{dimRed<-,liger,index,ANY,ANY,NULL-method} +\alias{dimRed<-,liger,character,ANY,ANY,matrixLike-method} \alias{defaultDimRed,liger-method} -\alias{defaultDimRed<-,liger,missing,ANY,character-method} -\alias{defaultDimRed<-,liger,character,ANY,matrixLike-method} +\alias{defaultDimRed<-,liger,character-method} \alias{varFeatures,liger-method} \alias{varFeatures<-,liger,ANY,character-method} \alias{varUnsharedFeatures,liger,ANY-method} @@ -115,13 +115,13 @@ defaultCluster(x, useDatasets = NULL, ...) defaultCluster(x, name = NULL, useDatasets = NULL, ...) <- value -dimRed(x, name = NULL, useDatasets = NULL, ...) +dimRed(x, name = NULL, useDatasets = NULL, cellIdx = NULL, ...) -dimRed(x, name = NULL, useDatasets = NULL, ...) <- value +dimRed(x, name = NULL, useDatasets = NULL, cellIdx = NULL, ...) <- value -defaultDimRed(x, useDatasets = NULL) +defaultDimRed(x, useDatasets = NULL, cellIdx = NULL) -defaultDimRed(x, name, useDatasets = NULL) <- value +defaultDimRed(x) <- value varFeatures(x) @@ -259,17 +259,25 @@ commands(x, funcName = NULL, arg = NULL) \S4method{defaultCluster}{liger,ANY,ANY,NULL}(x, name = NULL, useDatasets = NULL, ...) <- value -\S4method{dimRed}{liger,missing}(x, name = NULL, useDatasets = NULL, ...) +\S4method{dimRed}{liger,missing_OR_NULL}(x, name = NULL, useDatasets = NULL, cellIdx = NULL, ...) -\S4method{dimRed}{liger,character}(x, name = NULL, useDatasets = NULL, ...) +\S4method{dimRed}{liger,index}(x, name = NULL, useDatasets = NULL, cellIdx = NULL, ...) -\S4method{dimRed}{liger,character,ANY,matrixLike}(x, name = NULL, useDatasets = NULL, asDefault = NULL, ...) <- value +\S4method{dimRed}{liger,index,ANY,ANY,NULL}(x, name = NULL, useDatasets = NULL, cellIdx = NULL, ...) <- value -\S4method{defaultDimRed}{liger}(x, useDatasets = NULL) +\S4method{dimRed}{liger,character,ANY,ANY,matrixLike}( + x, + name = NULL, + useDatasets = NULL, + cellIdx = NULL, + asDefault = NULL, + inplace = FALSE, + ... +) <- value -\S4method{defaultDimRed}{liger,missing,ANY,character}(x, name = NULL, useDatasets = NULL) <- value +\S4method{defaultDimRed}{liger}(x, useDatasets = NULL, cellIdx = cellIdx) -\S4method{defaultDimRed}{liger,character,ANY,matrixLike}(x, name, useDatasets = NULL) <- value +\S4method{defaultDimRed}{liger,character}(x) <- value \S4method{varFeatures}{liger}(x) @@ -483,15 +491,13 @@ utilizes both clustering information and the dataset source information. \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)}. } \section{Variable feature access}{ @@ -595,7 +601,7 @@ names(pbmcPlot2) <- paste0(names(pbmcPlot), 2) c(pbmcPlot, pbmcPlot2) library(ggplot2) -ggplot(pbmcPlot, aes(x = UMAP.1, y = UMAP.2)) + geom_point() +ggplot(pbmcPlot, aes(x = UMAP_1, y = UMAP_2)) + geom_point() cellMeta(pbmc) # Add new variable pbmc[["newVar"]] <- 1 diff --git a/man/plotCellScatter.Rd b/man/plotCellScatter.Rd deleted file mode 100644 index 12d8f0e..0000000 --- a/man/plotCellScatter.Rd +++ /dev/null @@ -1,106 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ggplotting.R -\name{plotCellScatter} -\alias{plotCellScatter} -\title{Generate scatter plot(s) using liger object} -\usage{ -plotCellScatter( - object, - x, - y, - colorBy = NULL, - slot = c("cellMeta", "rawData", "normData", "scaleData", "H.norm", "H", "normPeak", - "rawPeak"), - colorByFunc = NULL, - cellIdx = NULL, - splitBy = NULL, - shapeBy = NULL, - titles = NULL, - ... -) -} -\arguments{ -\item{object}{A \linkS4class{liger} object} - -\item{x, y}{Available variable name in \code{cellMeta} slot to look for -the dot coordinates. See details.} - -\item{colorBy}{Available variable name in specified \code{slot} to look for -color annotation information. See details. Default \code{NULL} generates -all-black dots.} - -\item{slot}{Choose the slot to find the \code{colorBy} variable. See details. -Default \code{"cellMeta"}.} - -\item{colorByFunc}{Default \code{NULL}. A function object that expects a -vector/factor/data.frame retrieved by \code{colorBy} as the only input, and -returns an object of the same size, so that the all color "aes" are replaced -by this output. Useful when, for example, users need to scale the gene -expression shown on plot.} - -\item{cellIdx}{Character, logical or numeric index that can subscribe cells. -Missing or \code{NULL} for all cells.} - -\item{splitBy}{Character vector of categorical variable names in -\code{cellMeta} slot. Split all cells by groupings on this/these variable(s) -to produce a scatter plot containing only the cells in each group. Default -\code{NULL}.} - -\item{shapeBy}{Available variable name in \code{cellMeta} slot to look for -categorical annotation to be reflected by dot shapes. Default \code{NULL}.} - -\item{titles}{Title text. A character scalar or a character vector with as -many elements as multiple plots are supposed to be generated. Default -\code{NULL}.} - -\item{...}{More plot setting arguments. See \code{\link{.ggScatter}} and -\code{\link{.ggplotLigerTheme}}.} -} -\value{ -A ggplot object when a single plot is intended. A list of ggplot -objects, when multiple \code{colorBy} variables and/or \code{splitBy} are -set. When \code{plotly = TRUE}, all ggplot objects become plotly (htmlwidget) -objects. -} -\description{ -This function allows for using available cell metadata to build -the x-/y-axis. Available per-cell data can be used to form the color/shape -annotation, including cell metadata, raw or processed gene expression, and -unnormalized or aligned factor loading. Multiple coloring variable is allowed -from the same specification of \code{slot}, and this returns a list of plots -with different coloring values. Users can further split the plot(s) by -grouping on cells (e.g. datasets). -} -\details{ -Available option for \code{slot} include: \code{"cellMeta"}, -\code{"rawData"}, \code{"normData"}, \code{"scaleData"}, \code{"H.norm"} -and \code{"H"}. When \code{"rawData"}, \code{"normData"} or -\code{"scaleData"}, \code{colorBy} has to be a character vector of feature -names. When \code{"H.norm"} or \code{"H"}, \code{colorBy} can be any valid -index to select one factor of interests. Note that character index follows -\code{"Factor_[k]"} format, with replacing \code{[k]} with an integer. - -When \code{"cellMeta"}, \code{colorBy} has to be an available column name in -the table. Note that, for \code{colorBy} as well as \code{x}, \code{y}, -\code{shapeBy} and \code{splitBy}, since a matrix object is feasible in -\code{cellMeta} table, using a column (e.g. named as \code{"column1"} in a -certain matrix (e.g. named as \code{"matrixVar"}) should follow the syntax of -\code{"matrixVar.column1"}. When the matrix does not have a "colname" -attribute, the subscription goes with \code{"matrixVar.V1"}, -\code{"matrixVar.V2"} and etc. Use \code{"UMAP.1"}, \code{"UMAP.2"}, -\code{"TSNE.1"} or \code{"TSNE.2"} for the 2D embeddings generated with -rliger package. These are based on the nature of \code{as.data.frame} method -on a \code{\link[S4Vectors]{DataFrame}} object. -} -\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") -} diff --git a/man/plotDimRed.Rd b/man/plotDimRed.Rd index 6c13811..1b7b98d 100644 --- a/man/plotDimRed.Rd +++ b/man/plotDimRed.Rd @@ -1,14 +1,29 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/visualization.R -\name{plotClusterDimRed} +% Please edit documentation in R/ggplotting.R, R/visualization.R +\name{plotDimRed} +\alias{plotDimRed} \alias{plotClusterDimRed} \alias{plotDatasetDimRed} \alias{plotByDatasetAndCluster} \alias{plotGeneDimRed} \alias{plotPeakDimRed} \alias{plotFactorDimRed} -\title{Generate Dimensionality Reduction Plot with Coloring} +\title{Generate scatter plot(s) using liger object} \usage{ +plotDimRed( + object, + colorBy = NULL, + useDimRed = NULL, + slot = c("cellMeta", "rawData", "normData", "scaleData", "H.norm", "H", "normPeak", + "rawPeak"), + colorByFunc = NULL, + cellIdx = NULL, + splitBy = NULL, + shapeBy = NULL, + titles = NULL, + ... +) + plotClusterDimRed(object, useCluster = NULL, useDimRed = NULL, ...) plotDatasetDimRed(object, useDimRed = NULL, ...) @@ -56,14 +71,42 @@ plotFactorDimRed( \arguments{ \item{object}{A \linkS4class{liger} object.} -\item{useCluster}{Name of variable in \code{cellMeta(object)}. Default -\code{NULL} uses default cluster.} +\item{colorBy}{Available variable name in specified \code{slot} to look for +color annotation information. See details. Default \code{NULL} generates +all-black dots.} \item{useDimRed}{Name of the variable storing dimensionality reduction result in the \code{cellMeta(object)}. Default \code{NULL} use default dimRed.} -\item{...}{Additional graphic setting arguments passed to -\code{\link{plotCellScatter}}.} +\item{slot}{Choose the slot to find the \code{colorBy} variable. See details. +Default \code{"cellMeta"}.} + +\item{colorByFunc}{Default \code{NULL}. A function object that expects a +vector/factor/data.frame retrieved by \code{colorBy} as the only input, and +returns an object of the same size, so that the all color "aes" are replaced +by this output. Useful when, for example, users need to scale the gene +expression shown on plot.} + +\item{cellIdx}{Character, logical or numeric index that can subscribe cells. +Missing or \code{NULL} for all cells.} + +\item{splitBy}{Character vector of categorical variable names in +\code{cellMeta} slot. Split all cells by groupings on this/these variable(s) +to produce a scatter plot containing only the cells in each group. Default +\code{NULL}.} + +\item{shapeBy}{Available variable name in \code{cellMeta} slot to look for +categorical annotation to be reflected by dot shapes. Default \code{NULL}.} + +\item{titles}{Title text. A character scalar or a character vector with as +many elements as multiple plots are supposed to be generated. Default +\code{NULL}.} + +\item{...}{More plot setting arguments. See \code{\link{.ggScatter}} and +\code{\link{.ggplotLigerTheme}}.} + +\item{useCluster}{Name of variable in \code{cellMeta(object)}. Default +\code{NULL} uses default cluster.} \item{combinePlots}{Logical, whether to utilize \code{\link[cowplot]{plot_grid}} to combine multiple plots into one. Default @@ -92,13 +135,53 @@ loading above this value will all be trimmed to this value. Default \code{0.03}.} } \value{ +A ggplot object when a single plot is intended. A list of ggplot +objects, when multiple \code{colorBy} variables and/or \code{splitBy} are +set. When \code{plotly = TRUE}, all ggplot objects become plotly (htmlwidget) +objects. + ggplot object when only one feature (e.g. cluster variable, gene, factor) is set. List object when multiple of those are specified. } \description{ +This function allows for using available cell metadata to build +the x-/y-axis. Available per-cell data can be used to form the color/shape +annotation, including cell metadata, raw or processed gene expression, and +unnormalized or aligned factor loading. Multiple coloring variable is allowed +from the same specification of \code{slot}, and this returns a list of plots +with different coloring values. Users can further split the plot(s) by +grouping on cells (e.g. datasets). + some text } +\details{ +Available option for \code{slot} include: \code{"cellMeta"}, +\code{"rawData"}, \code{"normData"}, \code{"scaleData"}, \code{"H.norm"} +and \code{"H"}. When \code{"rawData"}, \code{"normData"} or +\code{"scaleData"}, \code{colorBy} has to be a character vector of feature +names. When \code{"H.norm"} or \code{"H"}, \code{colorBy} can be any valid +index to select one factor of interests. Note that character index follows +\code{"Factor_[k]"} format, with replacing \code{[k]} with an integer. + +When \code{"cellMeta"}, \code{colorBy} has to be an available column name in +the table. Note that, for \code{colorBy} as well as \code{x}, \code{y}, +\code{shapeBy} and \code{splitBy}, since a matrix object is feasible in +\code{cellMeta} table, using a column (e.g. named as \code{"column1"} in a +certain matrix (e.g. named as \code{"matrixVar"}) should follow the syntax of +\code{"matrixVar.column1"}. When the matrix does not have a "colname" +attribute, the subscription goes with \code{"matrixVar.V1"}, +\code{"matrixVar.V2"} and etc. Use \code{"UMAP.1"}, \code{"UMAP.2"}, +\code{"TSNE.1"} or \code{"TSNE.2"} for the 2D embeddings generated with +rliger package. These are based on the nature of \code{as.data.frame} method +on a \code{\link[S4Vectors]{DataFrame}} object. +} \examples{ +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") plotClusterDimRed(pbmcPlot) plotDatasetDimRed(pbmcPlot) plotByDatasetAndCluster(pbmcPlot) @@ -106,7 +189,7 @@ plotGeneDimRed(pbmcPlot, varFeatures(pbmcPlot)[1]) plotFactorDimRed(pbmcPlot, 2) } \seealso{ -Please refer to \code{\link{plotCellScatter}}, +Please refer to \code{\link{plotDimRed}}, \code{\link{.ggScatter}}, \code{\link{.ggplotLigerTheme}} for additional graphic setting } diff --git a/man/plotGeneLoadings.Rd b/man/plotGeneLoadings.Rd index 6c98b07..6aad65c 100644 --- a/man/plotGeneLoadings.Rd +++ b/man/plotGeneLoadings.Rd @@ -9,7 +9,7 @@ plotGeneLoadings( object, markerTable, useFactor, - useDimRed = "UMAP", + useDimRed = NULL, nLabel = 15, nPlot = 30, ... diff --git a/man/plotGroupClusterDimRed.Rd b/man/plotGroupClusterDimRed.Rd index a60dcfd..16d6459 100644 --- a/man/plotGroupClusterDimRed.Rd +++ b/man/plotGroupClusterDimRed.Rd @@ -56,7 +56,7 @@ of rows and columns. Default \code{NULL} will be automatically handled by \code{1}.} \item{...}{Additional graphic setting arguments passed to -\code{\link{plotCellScatter}}.} +\code{\link{plotDimRed}}.} } \value{ ggplot object when only one feature (e.g. cluster variable, gene, @@ -73,7 +73,7 @@ subplot of each group. plotGroupClusterDimRed(pbmcPlot) } \seealso{ -Please refer to \code{\link{plotCellScatter}}, +Please refer to \code{\link{plotDimRed}}, \code{\link{.ggScatter}}, \code{\link{.ggplotLigerTheme}} for additional graphic setting } diff --git a/man/retrieveCellFeature.Rd b/man/retrieveCellFeature.Rd index 096d3be..0603979 100644 --- a/man/retrieveCellFeature.Rd +++ b/man/retrieveCellFeature.Rd @@ -36,8 +36,7 @@ features. \description{ Only retrieve data from specific slot to reduce memory used by a whole \linkS4class{liger} object of the subset. Useful for plotting. -Internally used by \code{\link{plotCellScatter}} and -\code{\link{plotCellViolin}}. +Internally used by \code{\link{plotDimRed}} and \code{\link{plotCellViolin}}. } \examples{ S100A8Exp <- retrieveCellFeature(pbmc, "S100A8") diff --git a/man/runCINMF.Rd b/man/runCINMF.Rd index 8142b61..43f634b 100644 --- a/man/runCINMF.Rd +++ b/man/runCINMF.Rd @@ -140,6 +140,7 @@ The consensus iNMF algorithm is developed basing on the consensus NMF (cNMF) method (D. Kotliar et al., 2019). } \examples{ +\donttest{ pbmc <- normalize(pbmc) pbmc <- selectGenes(pbmc) pbmc <- scaleNotCenter(pbmc) @@ -147,6 +148,7 @@ if (requireNamespace("RcppPlanc", quietly = TRUE)) { pbmc <- runCINMF(pbmc) } } +} \references{ Joshua D. Welch and et al., Single-Cell Multi-omic Integration Compares and Contrasts Features of Brain Cell Identity, Cell, 2019 diff --git a/man/runGSEA.Rd b/man/runGSEA.Rd index 520dac7..4f74f24 100644 --- a/man/runGSEA.Rd +++ b/man/runGSEA.Rd @@ -8,11 +8,11 @@ runGSEA( object, genesets = NULL, useW = TRUE, - useDatasets = NULL, + useV = NULL, customGenesets = NULL, gene_sets = genesets, mat_w = useW, - mat_v = useDatasets, + mat_v = useV, custom_gene_sets = customGenesets ) } @@ -25,7 +25,7 @@ tested. Default \code{NULL} uses all the gene sets from the Reactome.} \item{useW}{Logical, whether to use the shared factor loadings (\eqn{W}). Default \code{TRUE}.} -\item{useDatasets}{A character vector of the names, a numeric or logical +\item{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.} diff --git a/tests/testthat/test_downstream.R b/tests/testthat/test_downstream.R index 57fd393..0fca82c 100644 --- a/tests/testthat/test_downstream.R +++ b/tests/testthat/test_downstream.R @@ -117,13 +117,13 @@ test_that("dimensionality reduction", { "Generating UMAP on unnormalized") expect_message(pbmc <- runUMAP(pbmc, useRaw = FALSE), "Generating UMAP on quantile normalized") - expect_equal(dim(pbmc$UMAP), c(ncol(pbmc), 2)) + expect_equal(dim(dimRed(pbmc, "UMAP")), c(ncol(pbmc), 2)) expect_message(runTSNE(pbmc, useRaw = TRUE), "Generating TSNE \\(Rtsne\\) on unnormalized") expect_message(pbmc <- runTSNE(pbmc, useRaw = FALSE), "Generating TSNE \\(Rtsne\\) on quantile normalized") - expect_equal(dim(pbmc$TSNE), c(ncol(pbmc), 2)) + expect_equal(dim(dimRed(pbmc, "TSNE")), c(ncol(pbmc), 2)) expect_error(runTSNE(pbmc, method = "fft"), "Please pass in path to FIt-SNE directory as fitsne.path.") diff --git a/tests/testthat/test_object.R b/tests/testthat/test_object.R index 7c0b885..7bba33b 100644 --- a/tests/testthat/test_object.R +++ b/tests/testthat/test_object.R @@ -163,7 +163,7 @@ test_that("liger S3/S4 methods", { expect_is(cellMeta(pbmc, "dataset"), "factor") expect_message(cellMeta(pbmc, "UMAP.1"), "Specified variables from cellMeta not found") - expect_is(cellMeta(pbmc, "UMAP.1", cellIdx = 1:500, as.data.frame = TRUE), + expect_is(cellMeta(pbmc, "nUMI", cellIdx = 1:500, as.data.frame = TRUE), "numeric") expect_is(pbmc[["nUMI"]], "numeric") expect_is(pbmc$mito, "numeric") @@ -276,17 +276,17 @@ test_that("ligerDataset methods", { # ligerATACDataset related expect_error(rawPeak(pbmc, "stim"), - "Specified dataset is not of ") + "unable to find an inherited") expect_error(rawPeak(pbmc, "stim") <- rawData(ctrl), - "Specified dataset is not of") + "unable to find an inherited") ctrl <- as.ligerDataset(ctrl, modal = "atac") pbmc@datasets$ctrl <- ctrl rawPeak(pbmc, "ctrl") <- rawData(ctrl) expect_error(normPeak(pbmc, "stim"), - "Specified dataset is not of") + "unable to find an inherited") expect_error(normPeak(pbmc, "stim") <- normData(stim), - "Specified dataset is not of") + "unable to find an inherited") normPeak(pbmc, "ctrl") <- normData(ctrl) expect_true(identical(normPeak(pbmc, "ctrl"), normData(ctrl, "ctrl"))) expect_true(validObject(ctrl)) @@ -299,9 +299,9 @@ test_that("ligerDataset methods", { rownames(coords) <- colnames(ctrl) colnames(coords) <- c("x", "y") expect_error(coordinate(pbmc, "stim"), - "Specified dataset is not of") + "unable to find an inherited") expect_error(coordinate(pbmc, "stim") <- coords, - "Specified dataset is not of") + "unable to find an inherited") coordinate(pbmc, "ctrl") <- coords expect_true(identical(coordinate(pbmc, "ctrl"), coords)) expect_true(validObject(ctrl)) diff --git a/tests/testthat/test_visualization.R b/tests/testthat/test_visualization.R index 5f18e7c..a9f0c6f 100644 --- a/tests/testthat/test_visualization.R +++ b/tests/testthat/test_visualization.R @@ -62,27 +62,23 @@ test_that("scatter plots", { # General expect_is( - plotCellScatter(pbmcPlot, "UMAP.1", "UMAP.2", splitBy = "dataset"), + plotDimRed(pbmcPlot, splitBy = "dataset"), "list" ) expect_is( - plotCellScatter(pbmcPlot, "UMAP.1", "UMAP.2", colorBy = "dataset", + plotDimRed(pbmcPlot, colorBy = "dataset", splitBy = "dataset"), "list" ) for (o in c("shuffle", "ascending", "descending")) { - expect_gg(plotCellScatter(pbmcPlot, "UMAP.1", "UMAP.2", - colorBy = "dataset", dotOrder = o)) + expect_gg(plotDimRed(pbmcPlot, colorBy = "dataset", dotOrder = o)) } expect_gg( - plotCellScatter(pbmcPlot, "UMAP.1", "UMAP.2", colorBy = "S100A8", - slot = "normData", trimHigh = 5, trimLow = 0), - plotCellScatter(pbmcPlot, "UMAP.1", "UMAP.2", - colorBy = "leiden_cluster", shapeBy = "dataset"), - plotCellScatter(pbmcPlot, "UMAP.1", "UMAP.2", colorBy = NULL, - shapeBy = "dataset"), - plotCellScatter(pbmcPlot, "UMAP.1", "UMAP.2", - colorBy = "leiden_cluster", raster = TRUE) + plotDimRed(pbmcPlot, colorBy = "S100A8", slot = "normData", + trimHigh = 5, trimLow = 0), + plotDimRed(pbmcPlot, colorBy = "leiden_cluster", shapeBy = "dataset"), + plotDimRed(pbmcPlot, colorBy = NULL, shapeBy = "dataset"), + plotDimRed(pbmcPlot, colorBy = "leiden_cluster", raster = TRUE) ) })