delete all additional validation

R/ApotcData.R

@@ -430,18 +430,3 @@ set_labels <- function(apotc_obj, x) {
 	apotc_obj@labels <- x
 	apotc_obj
 }
-
-# functions for testing
-
-does_apotc_listof_clusterlist_equal_expected <- function(
-    apotc_obj, expected, tolerance = 1e-6, verbose = FALSE
-) {	
-    areGeometricallyEqualListsOfClusterLists(
-        a = get_clusterlists(apotc_obj),
-        b = expected,
-        rad_decrease = get_rad_decrease(apotc_obj),
-        clone_scale_factor = get_clone_scale_factor(apotc_obj),
-        tolerance = tolerance,
-        verbose = verbose
-    )
-}

R/clusters.R

@@ -210,189 +210,7 @@ isValidListOfClusterLists <- function(x, legacy = FALSE, verbose = FALSE) {
         if (verbose) {
             message("clusterlist ", i, " is invalid")
         }
-        #print(summary(x[[i]]))
         return(FALSE)
     }
     return(TRUE)
 }
-
-areGeometricallyEqualListsOfClusterLists <- function(
-    a, b, rad_decrease, clone_scale_factor,
-    legacy = TRUE, tolerance = 1e-6, verbose = FALSE
-) {
-
-    if (!isValidListOfClusterLists(a, legacy, verbose)) {
-        if (verbose) message("first list of clusterlists is invalid")
-        return(FALSE)
-    }
-
-    if (!isValidListOfClusterLists(b, legacy, verbose)) {
-        if (verbose) message("second list of clusterlists is invalid")
-        return(FALSE)
-    }
-
-    if (length(a) != length(b)) {
-        if (verbose) message("length of clusterlists unequal")
-        return(FALSE)
-    }
-
-    for (i in seq_along(a)) {
-        if (!areGeometricallyEqualClusterLists(
-            a[[i]], b[[i]], rad_decrease, clone_scale_factor, tolerance, verbose
-        )) {
-            if (verbose) {
-                message("clusterlists at ", i, " is not equal")
-            }
-            return(FALSE)
-        }
-    }
-
-    return(TRUE)
-}
-
-areGeometricallyEqualClusterLists <- function(
-    a, b, rad_decrease, clone_scale_factor,
-    legacy = TRUE, tolerance = 1e-6, verbose = FALSE
-) {
-
-    logIfVerbose <- function(...) if (verbose) message(glue(...))
-    logDiffIfVerbose <- function(...) {
-        logIfVerbose(getDiffAsListInStr(...))
-    }
-
-    if (is_empty(a) && is_empty(b)) return(TRUE)
-
-    if (get_num_clones(a) != get_num_clones(b)) {
-        logIfVerbose(
-            "number of clones unequal: ",
-            "{get_num_clones(a)}, {get_num_clones(b)}"
-        )
-        return(FALSE)
-    }
-
-
-    if (!haveSameElements(get_radii(a), get_radii(b))) {
-        logIfVerbose("radii don't contain the same elements")
-        logDiffIfVerbose(
-            get_radii(a), get_radii(b),
-            deparse(substitute(a)), deparse(substitute(b))
-        )
-        return(FALSE)
-    }
-
-    if (!legacy && !haveSameElements(get_clonotypes(a), get_clonotypes(b))) {
-        logDiffIfVerbose(
-            get_clonotypes(a), get_clonotypes(b),
-            deparse(substitute(a)), deparse(substitute(b))
-        )
-        return(FALSE)
-    }
-
-    list_of_normed_ab <- list(a, b) %>%
-        lapply(function(x)
-            normalizeClusterListRadii(x, rad_decrease, clone_scale_factor)
-        )
-
-    list_of_normed_ab %>%
-        append(list(
-            "legacy" = legacy, "threshold" = tolerance, "verbose" = verbose
-        )) %>%
-        applyListAsArgsTo(areGeometricallyEqualNormalizedClusterLists)
-
-}
-
-normalizeClusterListRadii <- function(
-    clusterlist, rad_decrease, clone_scale_factor
-) {
-    clusterlist %>% set_radii(
-        ((get_radii(clusterlist) + rad_decrease) / clone_scale_factor)^2
-    )
-}
-
-# compare two clusterlists that have their radii transformed back into their
-# original clone counts.
-#
-# this assumes that the number of clones are equal, the radii are setequal,
-# and that the overall clonotypes are setequal.
-#
-# returns TRUE if for all radii groups, the clonotypes are setequal
-# (ignoring x, y) and the (x, y) pairs are setequal. If true, it means
-# that the circle packing cluster made are geometrically identical and
-# represent the same clones.
-areGeometricallyEqualNormalizedClusterLists <- function(
-    a,
-    b,
-    threshold = 1e-6,
-    legacy = TRUE,
-    verbose = FALSE,
-    left_name = "object",
-    right_name = "expected"
-) {
-
-    logIfVerbose <- function(...) if (verbose) message(glue(...))
-
-    list_of_clusterlist_dfs <- list(a, b) %>% lapply(function(clusterlist) {
-        clusterlist %>%
-            convert_to_dataframe("placeholder") %>%
-            dplyr::mutate(r = r / min(r)) %>%
-            dplyr::select(-label)
-    })
-
-    for (radius in sort(unique(get_radii(a)))) {
-
-        logIfVerbose("checking for radius {radius}")
-
-        clusterlist_dfs_filtered_by_curr_rad <- list_of_clusterlist_dfs %>%
-            lapply(function(x) dplyr::filter(x, r == radius))
-
-        are_dim_equal <- clusterlist_dfs_filtered_by_curr_rad %>%
-            applyListAsArgsTo(function(a, b) identical(dim(a), dim(b)))
-
-        if (!are_dim_equal) {
-            logIfVerbose(
-                "dimensions of (clones, slots) unequal: ",
-                "({nrow(a)}, {ncol(a)}), ({nrow(b), ncol(b)})"
-            )
-            return(FALSE)
-        }
-
-        if (!legacy) {
-            clonotypes_list <- lapply(
-                clusterlist_dfs_filtered_by_curr_rad, get_clonotypes
-            )
-
-            are_clonotypes_equal <- clonotypes_list %>%
-                applyListAsArgsTo(haveSameElements)
-
-            if (!are_clonotypes_equal) {
-                logIfVerbose(
-                    "clonotypes don't have the same elements.\n\n",
-                    getDiffAsListInStr(
-                        clonotypes_list[1], clonotypes_list[2],
-                        left_name, right_name
-                    ),
-                )
-                return(FALSE)
-            }
-        }
-
-        xy_are_equal <- clusterlist_dfs_filtered_by_curr_rad %>%
-            lapply(function(a) {
-                a %>%
-                    dplyr::select(x, y, r) %>%
-                    dplyr::arrange(x, y)
-            }) %>%
-            applyListAsArgsTo(function(df1, df2) {
-                if ((nrow(df1) + nrow(df2)) == 0) return(TRUE)
-                sum(df1 - df2) < (ncol(df1) * nrow(df1) * threshold)
-            })
-
-        if (!xy_are_equal) {
-            logIfVerbose("x, y coord pairs don't contain the same elements")
-            return(FALSE)
-        }
-    }
-
-    return(TRUE)
-
-}

tests/testthat/test-ApotcData.R

@@ -185,8 +185,8 @@ test_that("circlepackClones packs right for the default case", {
 		verbose = FALSE
 	)
 
-	expect_apotc_data_clusterlist_equals_expected(
-		test_apotc_data, getdata("combined_pbmc", "expected_clusterlists")
+	expect_equal(
+		test_apotc_data@clusters, getdata("combined_pbmc", "expected_clusterlists")
 	)
 })
 
@@ -253,8 +253,8 @@ test_that("circlepackClones packs right for the subset case", {
 
 	expected_clusterlists <- getdata("combined_pbmc", "expected_clusterlists")
 	expected_clusterlists[[1]] <- list()
-	expect_apotc_data_clusterlist_equals_expected(
-		test_apotc_data, expected_clusterlists
+	expect_equal(
+		test_apotc_data@clusters, expected_clusterlists
 	)
 })
 

tests/testthat/test-clusters.R

@@ -44,17 +44,3 @@ test_that("move_cluster() works", {
     expect_equal(move_cluster(c1, c(4, 5)), c1_shifted_by_4_5, tolerance = 1e-9)
     expect_equal(move_cluster(c1, c(9, 0)), c1_shifted_to_9_0, tolerance = 1e-9)
 })
-
-test_that("the cluster list equality checker works", {
-
-    expect_true(areGeometricallyEqualClusterLists(c1, c1, 0, 1))
-    expect_true(areGeometricallyEqualClusterLists(c2, c2, 0.05, 1))
-    expect_true(areGeometricallyEqualClusterLists(c3, c3, 0.05, 1))
-
-    # TODO cases with shuffled inputs
-
-    expect_false(areGeometricallyEqualClusterLists(c1, c2, 0.05, 1))
-    expect_false(areGeometricallyEqualClusterLists(c1, c1_shifted_by_4_5, 0.05, 1))
-    expect_false(areGeometricallyEqualClusterLists(c1, c1_shifted_to_9_0, 0.05, 1))
-
-})