diff --git a/DESCRIPTION b/DESCRIPTION index 48cc1e08..2b9ec5b3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: SeuratObject Type: Package Title: Data Structures for Single Cell Data -Version: 5.0.99.9002 +Version: 5.0.99.9003 Authors@R: c( person(given = 'Paul', family = 'Hoffman', email = 'hoff0792@alumni.umn.edu', role = 'aut', comment = c(ORCID = '0000-0002-7693-8957')), person(given = 'Rahul', family = 'Satija', email = 'seurat@nygenome.org', role = c('aut', 'cre'), comment = c(ORCID = '0000-0001-9448-8833')), diff --git a/R/logmap.R b/R/logmap.R index 9fdcded8..66be1de8 100644 --- a/R/logmap.R +++ b/R/logmap.R @@ -234,17 +234,18 @@ labels.LogMap <- function( select <- select[1L] select <- match.arg(arg = select) values <- intersect(x = values, y = rownames(x = object)) - p <- progressor(along = values) - obs <- sapply( - X = values, - FUN = function(x) { - vals <- colnames(x = object)[which(x = object[x, , drop = TRUE])] - p() - return(vals) - }, - simplify = FALSE, - USE.NAMES = TRUE - ) + mat <- as.matrix(object) + cols <- colnames(object) + idx <- match(values, rownames(object)) + obs <- vector("list", length(values)) + names(obs) <- values + for (i in seq_along(idx)) { + id <- idx[i] + vals <- cols[mat[id, , drop = FALSE]] + if (length(vals) > 0) { + obs[[i]] <- vals + } + } obs <- Filter(f = length, x = obs) obs <- switch( EXPR = select, @@ -280,6 +281,7 @@ labels.LogMap <- function( return(obs) } + #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Internal #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/tests/testthat/test_logmap.R b/tests/testthat/test_logmap.R new file mode 100644 index 00000000..e9facd0f --- /dev/null +++ b/tests/testthat/test_logmap.R @@ -0,0 +1,67 @@ +# Tests for the LogMap class + +test_that("`labels` generic works as expected for `LogMap` instances", { + # Instantiate and populate a LogMap instance for testing. + map <- LogMap(paste0("value_", 1:6)) + map[["label_a"]] <- c(1, 3) + map[["label_b"]] <- c(2, 4) + map[["label_c"]] <- c(2, 4, 6) + map[["label_d"]] <- c(2, 4, 6) + map[["label_e"]] <- 2 + map[["label_f"]] <- 4 + + # Labels can be fetched for specified values. + values <- c("value_1", "value_3") + result_key <- c(value_1 = "label_a", value_3 = "label_a") + expect_identical(result_key, labels(map, values = values)) + + # For values with multiple labels, the first label is returned by default. + values <- c("value_2", "value_4") + result_key <- c(value_2 = "label_b", value_4 = "label_b") + result <- labels(map, values = values) + expect_identical(result_key, result) + + # The last value for each label can also be fetched. + values <- c("value_1", "value_2", "value_4") + result_key <- c(value_1 = "label_a", value_2 = "label_e", value_4 = "label_f") + result <- labels(map, values = values, select = "last") + expect_identical(result_key, result) + + # It is also possible to fetch the label that is shared by the most values + # in the requested set. If multiple labels are equally common, the first + # is returned. + values <- c("value_2", "value_4", "value_6") + result_key <- c(value_2 = "label_c", value_4 = "label_c", value_6 = "label_c") + result <- labels(map, values = values, select = "common") + expect_identical(result_key, result) + + # Label resolution is based on the column order of the underlying matrix + label_order <- c( + "label_a", + "label_e", + "label_b", + "label_c", + "label_e", + "label_f" + ) + map <- map[, label_order, drop = FALSE] + values <- c("value_2", "value_4") + result_key <- c(value_2 = "label_e", value_4 = "label_b") + result <- labels(map, values = values) + expect_identical(result_key, result) + + # The output order is taken from the `values` parameter. + values <- c("value_3", "value_1") + result_key <- c(value_3 = "label_a", value_1 = "label_a") + result <- labels(map, values = values) + expect_identical(result_key, result) + + # Values without labels are excluded in the return. + values <- c("value_1", "value_5", "value_6") + result_key <- c(value_1 = "label_a", value_6 = "label_c") + result <- labels(map, values = values) + expect_identical(result_key, result) + + # If no labels are found, an error is raised. + expect_error(labels(map, "value_5")) +})