Update unit tests and minor fixes

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 {

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) {

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)

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)

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")
     }
 })
 

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")
+
+})

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"))
+
 })