diff --git a/R/clustering.R b/R/clustering.R index 73beabe..52306cf 100644 --- a/R/clustering.R +++ b/R/clustering.R @@ -399,7 +399,7 @@ calcPurity <- function(object, if (length(trueCluster) != length(cellIdx)) { if (is.null(names(trueCluster))) { cli::cli_abort( - "Longer/shorter {.var trueCluster} than cells considered requires {.fn names()} to identify matching." + "Longer/shorter {.var trueCluster} than cells considered requires {.fn names} to identify matching." ) } } else { @@ -502,7 +502,7 @@ calcARI <- function(object, if (length(trueCluster) != length(cellIdx)) { if (is.null(names(trueCluster))) { cli::cli_abort( - "Longer/shorter {.var trueCluster} than cells considered requires {.fn names()} to identify matching." + "Longer/shorter {.var trueCluster} than cells considered requires {.fn names} to identify matching." ) } } else { @@ -625,7 +625,7 @@ calcNMI <- function(object, if (length(trueCluster) != length(cellIdx)) { if (is.null(names(trueCluster))) { cli::cli_abort( - "Longer/shorter {.var trueCluster} than cells considered requires {.fn names()} to identify matching." + "Longer/shorter {.var trueCluster} than cells considered requires {.fn names} to identify matching." ) } } else { diff --git a/R/integration.R b/R/integration.R index 10d3d73..8e108fb 100644 --- a/R/integration.R +++ b/R/integration.R @@ -1863,14 +1863,17 @@ calcAlignment <- function( cellIdx <- .idxCheck(object, cellIdx, "cell") if (!is.null(cellComp)) { cellComp <- .idxCheck(object, cellComp, "cell") - cellIdx <- c(cellIdx, cellComp) datasetVar <- factor(rep.int(c("cellIdx", "cellComp"), c(length(cellIdx), length(cellComp)))) + cellIdx <- c(cellIdx, cellComp) cli::cli_alert_info("Using designated sets {.var cellIdx} and {.var cellComp} as subsets to compare.") } else { datasetVar <- droplevels(object$dataset[cellIdx]) } } else { clusterVar <- clusterVar %||% object@uns$defaultCluster + if (is.null(clusterVar)) { + cli::cli_abort("No {.field clusterVar} specified or default preset by {.fn runCluster}.") + } clusters <- .fetchCellMetaVar(object, clusterVar, checkCategorical = TRUE) notFound <- clustersUse[!clustersUse %in% clusters] if (length(notFound) > 0) { diff --git a/R/liger-methods.R b/R/liger-methods.R index 5700eca..30d1294 100644 --- a/R/liger-methods.R +++ b/R/liger-methods.R @@ -1286,8 +1286,8 @@ setReplaceMethod( #' @rdname liger-class setMethod( "defaultDimRed", - signature(x = "liger", useDatasets = "ANY"), - function(x, useDatasets = NULL, cellIdx = cellIdx) { + signature(x = "liger", useDatasets = "ANY", cellIdx = "ANY"), + function(x, useDatasets = NULL, cellIdx = NULL) { name <- x@uns$defaultDimRed if (is.null(name)) return(NULL) else dimRed(x, name = name, useDatasets = useDatasets, cellIdx = cellIdx) diff --git a/R/visualization.R b/R/visualization.R index 145f42a..9daaded 100644 --- a/R/visualization.R +++ b/R/visualization.R @@ -674,20 +674,7 @@ plotProportionBox <- function( MARGIN = 1, function(row) colnames(conditionTable)[row > 0] ) - conditionVar <- .fetchCellMetaVar( - object = object, variables = conditionBy, checkCategorical = TRUE - ) - # Check that condition variable is strictly a high level variable of dataset - if (!all(rowSums(table(datasetVar, conditionVar) > 0) == 1)) { - cli::cli_abort("Condition variable must be a high level variable of the datasets, i.e. each dataset must belong to only one condition.") - } - conditionTable <- table(datasetVar, conditionVar) - conditionMap <- apply( - conditionTable, - MARGIN = 1, - function(row) colnames(conditionTable)[row > 0] - ) dfLong[[conditionBy]] <- factor( conditionMap[dfLong[[sampleBy]]], levels = levels(conditionVar) diff --git a/man/liger-class.Rd b/man/liger-class.Rd index bb7efc3..4fa20dc 100644 --- a/man/liger-class.Rd +++ b/man/liger-class.Rd @@ -287,7 +287,7 @@ commands(x, funcName = NULL, arg = NULL) ... ) <- value -\S4method{defaultDimRed}{liger}(x, useDatasets = NULL, cellIdx = cellIdx) +\S4method{defaultDimRed}{liger}(x, useDatasets = NULL, cellIdx = NULL) \S4method{defaultDimRed}{liger,character}(x) <- value diff --git a/tests/testthat/test_downstream.R b/tests/testthat/test_downstream.R index b8bf7a9..8240d72 100644 --- a/tests/testthat/test_downstream.R +++ b/tests/testthat/test_downstream.R @@ -80,10 +80,40 @@ test_that("clustering", { pbmc <- quantileNorm(pbmc) expect_message(pbmc <- runCluster(pbmc, nRandomStarts = 1, saveSNN = TRUE), "leiden clustering on quantile normalized") + expect_is(defaultCluster(pbmc, droplevels = TRUE), "factor") expect_is(pbmc@uns$snn, "dgCMatrix") - expect_message(runCluster(pbmc, nRandomStarts = 1, method = "louvain"), + expect_message(pbmc <- runCluster(pbmc, nRandomStarts = 1, method = "louvain"), "louvain clustering on quantile normalized") - + expect_message(defaultCluster(pbmc, name = "louvain_cluster") <- "louvain_cluster", + "Cannot have") + expect_error(defaultCluster(pbmc) <- "notexist", "Selected variable does not exist") + defaultCluster(pbmc) <- pbmc$leiden_cluster + expect_identical(pbmc$leiden_cluster, pbmc$defaultCluster) + expect_error(defaultCluster(pbmc) <- factor(letters), "Length of") + defaultCluster(pbmc) <- NULL + defaultCluster(pbmc, name = "leiden") <- unname(pbmc$leiden_cluster) + expect_identical(pbmc$leiden, pbmc$leiden_cluster) + + fakevar <- pbmc$leiden_cluster + names(fakevar)[1:26] <- letters + expect_error(defaultCluster(pbmc) <- fakevar, "Not all `names") + + + + expect_equal(calcPurity(pbmc, "leiden_cluster", "leiden_cluster"), 1) + expect_error(calcPurity(pbmc, letters, "leiden_cluster"), + "Longer/shorter `trueCluster` than cells considered requires") + expect_message(calcPurity(pbmc, unname(pbmc$leiden_cluster), "leiden_cluster"), "Assuming unnamed") + + expect_equal(calcARI(pbmc, "leiden_cluster", "leiden_cluster"), 1) + expect_error(calcARI(pbmc, letters, "leiden_cluster"), + "Longer/shorter `trueCluster` than cells considered requires") + expect_message(calcARI(pbmc, unname(pbmc$leiden_cluster), "leiden_cluster"), "Assuming unnamed") + + expect_equal(calcNMI(pbmc, "leiden_cluster", "leiden_cluster"), 1) + expect_error(calcNMI(pbmc, letters, "leiden_cluster"), + "Longer/shorter `trueCluster` than cells considered requires") + expect_message(calcNMI(pbmc, unname(pbmc$leiden_cluster), "leiden_cluster"), "Assuming unnamed") # Tests for singleton grouping. Need to find the case where there are singletons # expect_message(runCluster(pbmc, nRandomStarts = 1, # partitionType = "CPMVertexPartition"), @@ -109,7 +139,6 @@ test_that("clustering", { colnames(pbmc))) }) - #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Dimensionality reduction #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -120,9 +149,21 @@ test_that("dimensionality reduction", { pbmc <- process(pbmc) expect_message(runUMAP(pbmc, useRaw = TRUE), "Generating UMAP on unnormalized") + expect_error(dimRed(pbmc), "available in this") expect_message(pbmc <- runUMAP(pbmc, useRaw = FALSE), "Generating UMAP on quantile normalized") - expect_equal(dim(dimRed(pbmc, "UMAP")), c(ncol(pbmc), 2)) + pbmc@uns$defaultDimRed <- NULL + expect_message(dimRed(pbmc), "No default") + defaultDimRed(pbmc) <- "UMAP" + expect_error(defaultDimRed(pbmc) <- letters, "Can only set one") + expect_identical(defaultDimRed(pbmc), dimRed(pbmc, "UMAP")) + expect_equal(dim(dimRed(pbmc)), c(ncol(pbmc), 2)) + expect_no_error(dimRed(pbmc, "UMAP2") <- dimRed(pbmc, "UMAP")) + expect_equal(nrow(dimRed(pbmc, name = 1, cellIdx = 1:10)), 10) + expect_equal(nrow(dimRed(pbmc, name = 1, useDatasets = names(pbmc))), ncol(pbmc)) + expect_equal(nrow(dimRed(pbmc, name = "UMAP", cellIdx = 1:10)), 10) + expect_equal(nrow(dimRed(pbmc, name = "UMAP", useDatasets = names(pbmc))), ncol(pbmc)) + expect_no_error(dimRed(pbmc, 2) <- NULL) expect_message(runTSNE(pbmc, useRaw = TRUE), "Generating TSNE \\(Rtsne\\) on unnormalized") @@ -184,6 +225,12 @@ test_that("wilcoxon", { go2 <- runGOEnrich(res1, group = 0, orderBy = "pval", significant = FALSE) expect_is(go2, "list") expect_is(go2$`0`$result, "data.frame") + go3 <- runGOEnrich(res1, group = c(0, 1), orderBy = "pval", significant = FALSE) + + expect_is(plotGODot(go1, pvalThresh = 1), "ggplot") + expect_error(plotGODot(go1, group = "ctrl"), "Specified group not available") + expect_message(plotGODot(go1, group = '0'), "No enough matching") + expect_is(plotGODot(go3, pvalThresh = 1), "list") } }) diff --git a/tests/testthat/test_factorization.R b/tests/testthat/test_factorization.R index 13e9e2e..de4842a 100644 --- a/tests/testthat/test_factorization.R +++ b/tests/testthat/test_factorization.R @@ -229,6 +229,19 @@ test_that("quantileNorm", { }) +test_that("consensus iNMF", { + skip_if_not_installed("RcppPlanc") + pbmc <- process(pbmc) + expect_error(pbmc <- runCINMF(pbmc, k = 10, nRandomStarts = 1), + "must be greater than 1") + expect_error(pbmc <- runCINMF(pbmc, k = 10, rho = 2), + "must be in the range") + expect_error(pbmc <- runCINMF(pbmc, k = 10, rho = 0.1, nRandomStarts = 2), + "Please use a larger `rho` or/and a larger `nRandomStarts`") + pbmc <- runCINMF(pbmc, k = 10) + expect_no_error(.checkValidFactorResult(pbmc)) +}) + #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Seurat wrapper for everything #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -270,3 +283,50 @@ test_that("Seurat wrapper", { expect_error(quantileNorm(seu, reference = c(TRUE, FALSE, TRUE)), "Should specify one existing dataset as reference") }) + + +context("alignment metrics") +test_that("Alignment metrics", { + skip_if_not_installed("RcppPlanc") + pbmc <- process(pbmc) + pbmc <- runIntegration(pbmc, k = 10, nIteration = 2) + pbmc <- quantileNorm(pbmc) + + # Working cases for agreement + expect_equal(calcAgreement(pbmc), 0.2215288, tol = 1e-6) + expect_equal(calcAgreement(pbmc, useRaw = TRUE), 0.2480121) + expect_true(all.equal(calcAgreement(pbmc, byDataset = TRUE), c(0.2660032, 0.1770543), tol = 1e-6)) + + # failing cases for agreement + hnorm <- pbmc@H.norm + pbmc@H.norm <- NULL + expect_error(calcAgreement(pbmc), "available") + ctrl.H <- pbmc@datasets$ctrl@H + pbmc@datasets$ctrl@H <- NULL + expect_error(calcAgreement(pbmc, useRaw = TRUE), "available for dataset") + pbmc@H.norm <- hnorm + pbmc@datasets$ctrl@H <- ctrl.H + ctrlsd <- scaleData(pbmc, "ctrl") + scaleData(pbmc, "ctrl") <- NULL + expect_error(calcAgreement(pbmc), "available for dataset:") + scaleData(pbmc, "ctrl") <- ctrlsd + + # Working cases for alignment + expect_equal(calcAlignment(pbmc), 0.772) + expect_message(calcAlignment(pbmc, cellIdx = 1:100), "Alignment null for single dataset") + expect_equal(calcAlignment(pbmc, cellIdx = 1:600), 0.772) + expect_equal(calcAlignment(pbmc, cellIdx = 201:400, cellComp = c(1:200, 401:600)), 0.6975) + expect_equal(calcAlignment(pbmc, resultBy = "dataset"), c(ctrl = 0.720, stim = 0.824)) + expect_length(calcAlignment(pbmc, resultBy = "cell"), 600) + + # Failing cases for alignment + pbmc@H.norm <- NULL + expect_error(calcAlignment(pbmc), "Aligned cell factor loading") + pbmc@H.norm <- hnorm + expect_error(calcAlignment(pbmc, clustersUse = 1:3), "specified or default preset by") + pbmc <- runCluster(pbmc) + expect_error(calcAlignment(pbmc, clustersUse = letters), "26 clusters not found in") + expect_error(calcAlignment(pbmc, clustersUse = integer()), "No cell is selected") + expect_error(calcAlignment(pbmc, nNeighbors = 600), "Please select") + +}) diff --git a/tests/testthat/test_visualization.R b/tests/testthat/test_visualization.R index eee80f2..5a7654f 100644 --- a/tests/testthat/test_visualization.R +++ b/tests/testthat/test_visualization.R @@ -87,6 +87,18 @@ test_that("scatter plots", { expect_gg( plotDimRed(pbmcPlot, colorBy = "leiden_cluster", raster = TRUE) ) + + expect_gg(plotGroupClusterDimRed(pbmcPlot)) + do.call(expect_gg, plotGroupClusterDimRed(pbmcPlot, combinePlot = FALSE)) + + do.call(expect_gg, plotBarcodeRank(pbmc)) + # Fake operation to create ATAC datasets + pbmcPlot@datasets$ctrl <- as.ligerDataset(dataset(pbmcPlot, "ctrl"), "atac") + pbmcPlot@datasets$stim <- as.ligerDataset(dataset(pbmcPlot, "stim"), "atac") + normPeak(pbmcPlot, "ctrl") <- normData(pbmcPlot, "ctrl") + normPeak(pbmcPlot, "stim") <- normData(pbmcPlot, "stim") + expect_gg(plotPeakDimRed(pbmcPlot, "ISG15")) + }) #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -188,6 +200,19 @@ test_that("Proportion plots", { "`class1` and `class2` must be") expect_error(plotProportionBar(pbmcPlot, letters), "`class1` and `class2` must be") + + defaultCluster(pbmcPlot) <- NULL + expect_error(plotProportionBox(pbmcPlot), "No cluster specified nor default set") + defaultCluster(pbmcPlot) <- "leiden_cluster" + expect_error(plotProportionBox(pbmcPlot, conditionBy = "leiden_cluster"), + "Condition variable must be a high level variable of the datasets") + expect_gg( + plotProportionBox(pbmcPlot, dot = TRUE), + plotProportionBox(pbmcPlot, conditionBy = "dataset") + ) + do.call(expect_gg, plotProportionBox(pbmcPlot, splitByCluster = TRUE, dot = TRUE)) + do.call(expect_gg, plotProportionBox(pbmcPlot, splitByCluster = TRUE, conditionBy = "dataset")) + })