From 8cd2086a1ac08ec20f57ec2f59025ffb1f3de0ab Mon Sep 17 00:00:00 2001
From: mischko <mhem@mailbox.org>
Date: Mon, 27 May 2024 20:56:16 +0200
Subject: [PATCH 1/3] faster logmap labels

---
 R/logmap.R | 24 +++++++++++++-----------
 1 file changed, 13 insertions(+), 11 deletions(-)

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
 #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

From 0a01acee70dcca44d54674c4d383e0dc0e949620 Mon Sep 17 00:00:00 2001
From: mischko <mhem@mailbox.org>
Date: Sat, 7 Dec 2024 18:47:54 +0100
Subject: [PATCH 2/3] add test for logmap

credits to dcollins https://github.com/satijalab/seurat-object/pull/209
---
 tests/testthat/test_logmap.R | 67 ++++++++++++++++++++++++++++++++++++
 1 file changed, 67 insertions(+)
 create mode 100644 tests/testthat/test_logmap.R

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

From e33d806f54ab2277218fea9d3ce8883a587e6f94 Mon Sep 17 00:00:00 2001
From: mischko <mhem@mailbox.org>
Date: Sat, 7 Dec 2024 18:48:55 +0100
Subject: [PATCH 3/3] bump version to 5.0.99.9003

---
 DESCRIPTION | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

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')),