perf: hash-based vswitch/nswitch and duplicate-table tuning (#107)

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: kit
 Type: Package
 Title: Data Manipulation Functions Implemented in C
-Version: 0.0.23
+Version: 0.0.24
 Authors@R: c(person("Morgan", "Jacob", role = c("aut", "cph"), email = "morgan.emailbox@gmail.com"), 
              person("Sebastian", "Krantz", role = c("ctb", "cre"), email = "sebastian.krantz@graduateinstitute.ch"),
              person("David", "Budzynski", role = c("ctb"), email = "david.budzynsky@gmail.com"))

NEWS.md

@@ -1,3 +1,19 @@
+# kit 0.0.24 <small>(development version)</small>
+
+### Bug Fixes
+
+- Fix `vswitch()`/`nswitch()` with `checkEnc = TRUE` when the first string is already UTF-8 but later elements are latin1 or `NA`: `enc2UTF8()` now checks every element and preserves `NA_STRING`, and value-major `nswitch()` compares each pair against its own converted value instead of the first one.
+
+- Fix `funique()`/`fduplicated()`/`uniqLen()` hashing `-0` and differing `NaN` payloads as distinct doubles. Vector, matrix and data-frame paths now canonicalise doubles the same way `REQUAL` compares them, matching base R.
+
+### Notes
+
+- Speed up `vswitch()` and `nswitch()` when there are many value/output pairs. For more than 8 pairs the implementation builds a value-to-last-pair hash map once and scans `x` in cache-sized blocks instead of comparing `x` against every value. Matching semantics are unchanged: integer/logical `NA` still matches `NA`, doubles/complex canonicalise `-0` and never match `NA`/`NaN`, strings compare `CHARSXP` identity, duplicate values keep the last pair, and threaded results stay deterministic. On 2m elements, 20 values are about 2-2.5x faster and 100 values 4.5-5.7x faster; the value-major path is kept for 8 or fewer pairs.
+
+- Speed up `funique()`/`fduplicated()`/`uniqLen()` on data frames and matrices. Row hashes now use a 64-bit rolling mix instead of mixing every cell and mixing again, and a bounded sample estimates cardinality so high-cardinality inputs allocate the final table once while low-cardinality inputs keep the small grow-on-demand table. On 10m rows, 2-column integer data frames improve about 2.5x and mixed integer/double frames about 2.3-2.5x; 2m frames improve 1.5-1.8x. The scalar vector path was left unchanged: it is already faster than `data.table::uniqueN()` and dedicated hash variants stayed under the 20% threshold.
+
+- Add `tools/benchmark-core.R`, a manual benchmark covering 2m/10m elements, 5/20/100 switch values, integer/string/factor/NA inputs, data frames, and 1/2/4 threads. It is not run in CI.
+
 # kit 0.0.23 <small>(2026-11-02)</small>
 
 ### Bug Fixes

inst/tinytest/test-enc.R

@@ -26,6 +26,20 @@ expect_identical(nswitch(c(enc1, enc2), enc1, 1, default = 0), c(1, 1), info="en
 expect_identical(nswitch(c(enc1, enc2), enc2, 1, default = 0), c(1, 1), info="enc-009")
 expect_identical(nswitch(c(enc1, enc2), enc1, 1, default = 0, checkEnc = TRUE), c(1, 1), info="enc-010")
 
+# --- First element already UTF-8: later latin1 and NA must still convert (#107) ---
+x_enc <- c(enc2, enc1, NA_character_)
+v_enc <- c(enc1, enc2, NA_character_)
+expect_identical(vswitch(x_enc, v_enc, 1:3, checkEnc = TRUE), c(2L, 2L, 3L),
+                 info="enc-047")
+expect_identical(nswitch(x_enc, enc1, 1L, enc2, 2L, NA_character_, 3L,
+                         default = 0L, checkEnc = TRUE), c(2L, 2L, 3L),
+                 info="enc-048")
+# Each pair must compare against its own converted value, not the first one.
+expect_identical(nswitch(c(enc2, "b", NA_character_),
+                         enc1, 1L, "b", 2L, NA_character_, 3L,
+                         default = 0L, checkEnc = TRUE), c(1L, 2L, 3L),
+                 info="enc-049")
+
 # --- checkEnc argument validation ---
 expect_error(vswitch("a", "b", 1, checkEnc = NA), pattern = "Argument 'checkEnc' must be TRUE or FALSE and length 1.", fixed = TRUE, info="enc-011")
 expect_error(vswitch("a", "b", 1, checkEnc = 2), pattern = "Argument 'checkEnc' must be TRUE or FALSE and length 1.", fixed = TRUE, info="enc-012")

inst/tinytest/test-switch-hash.R

@@ -0,0 +1,240 @@
+# Tests for the hash lookup used by vswitch()/nswitch() with many values (#107).
+# The hash path is selected for more than 8 value/output pairs; these cases pin
+# down the matching semantics it must share with the value-major fallback:
+# last pair wins, NA/NaN handling per type, encoding, vector recycling, and
+# thread determinism.
+
+sys.source("helper-kit.R", envir = environment())
+
+# Reference for types where NA matches NA (integer, logical, string, factor).
+ref_na <- function(x, values, outputs, default = NA) {
+  ans <- rep_len(default, length(x))
+  for (i in seq_along(values)) {
+    hit <- if (is.na(values[i])) is.na(x) else !is.na(x) & x == values[i]
+    ans[hit] <- rep_len(outputs[[i]], length(x))[hit]
+  }
+  ans
+}
+
+# Reference for doubles/complex, where NA and NaN never match.
+ref_num <- function(x, values, outputs, default = NA) {
+  ans <- rep_len(default, length(x))
+  for (i in seq_along(values)) {
+    hit <- !is.na(values[i]) & !is.nan(values[i]) &
+      !is.na(x) & !is.nan(x) & x == values[i]
+    ans[hit] <- rep_len(outputs[[i]], length(x))[hit]
+  }
+  ans
+}
+
+# Integer: NA is the same bit pattern, so it matches NA.
+vals_i <- c(9:1, 1L, NA_integer_)
+outs_i <- c(101:109, 110L, 111L)
+x_i <- c(1:9, NA_integer_, NA_integer_, 0L)
+exp_i <- ref_na(x_i, vals_i, as.list(outs_i))
+expect_identical(vswitch(x_i, vals_i, outs_i), exp_i,
+                 info = "hash-vswitch-int")
+expect_identical(vswitch(x_i, vals_i, outs_i, nThread = 2L), exp_i,
+                 info = "hash-vswitch-int-threads")
+
+vals_l <- c(rep(TRUE, 9), FALSE, NA)
+outs_l <- c(1:9, 10L, 11L)
+x_l <- c(NA, TRUE, FALSE, TRUE)
+expect_identical(vswitch(x_l, vals_l, outs_l),
+                 ref_na(x_l, vals_l, as.list(outs_l)),
+                 info = "hash-vswitch-lgl")
+
+# Strings: NA_STRING is a CHARSXP and therefore matches itself.
+vals_s <- c(paste0("v", 1:9), "v1", NA_character_)
+outs_s <- c(1:9, 10L, 11L)
+x_s <- c("v1", "v9", NA_character_, "zz")
+exp_s <- ref_na(x_s, vals_s, as.list(outs_s))
+expect_identical(vswitch(x_s, vals_s, outs_s), exp_s,
+                 info = "hash-vswitch-str")
+expect_identical(vswitch(enc2utf8(x_s), enc2utf8(vals_s), outs_s), exp_s,
+                 info = "hash-vswitch-str-utf8")
+
+enc_lat <- "fa\xE7ile"
+Encoding(enc_lat) <- "latin1"
+enc_utf <- enc2utf8(enc_lat)
+vals_e <- c(paste0("v", 1:8), enc_lat, enc_utf)
+x_e <- c(enc_lat, enc_utf, paste0("v", 1:8))
+expect_identical(vswitch(x_e, vals_e, c(1:8, 9L, 10L)),
+                 c(10L, 10L, 1:8), info = "hash-vswitch-str-enc")
+
+# First element UTF-8: enc2UTF8() must still convert later latin1 and keep NA.
+vals_e10 <- c(paste0("v", 1:7), enc_utf, enc_lat, NA_character_)
+x_e10 <- c(enc_utf, enc_lat, NA_character_, "v1")
+pairs_e10 <- unlist(lapply(seq_along(vals_e10), function(i) list(vals_e10[i], i)),
+                    recursive = FALSE)
+expect_identical(vswitch(x_e10, vals_e10, seq_along(vals_e10)),
+                 c(9L, 9L, 10L, 1L), info = "hash-vswitch-str-enc-first-utf8")
+expect_identical(
+  do.call(nswitch, c(list(x_e10), pairs_e10, list(default = 0L))),
+  c(9L, 9L, 10L, 1L), info = "hash-nswitch-str-enc-first-utf8")
+
+# Doubles: -0 == 0, Inf matches, but NA/NaN never match.
+vals_d <- c(1:8, Inf, 0, NA_real_, NaN)
+outs_d <- c(101:108, 109L, 110L, 111L, 112L)
+x_d <- c(-0, 0, Inf, NA_real_, NaN, 1:8, 99)
+exp_d <- ref_num(x_d, vals_d, as.list(outs_d))
+expect_identical(vswitch(x_d, vals_d, outs_d), exp_d,
+                 info = "hash-vswitch-dbl")
+expect_identical(vswitch(x_d, vals_d, outs_d, nThread = 2L), exp_d,
+                 info = "hash-vswitch-dbl-threads")
+
+# Complex: component-wise ==, so NA/NaN components never match.
+vals_c <- c(as.complex(1:8), 0 + 0i, NA_complex_)
+outs_c <- c(101:108, 110L, 111L)
+x_c <- c(0 + 0i, 1 + 0i, NA_complex_, 1 + 1i)
+expect_identical(vswitch(x_c, vals_c, outs_c),
+                 ref_num(x_c, vals_c, as.list(outs_c)),
+                 info = "hash-vswitch-cplx")
+
+# Factor codes go through the integer path; classes and levels are preserved.
+f_x <- factor(c(letters[1:9], "a", NA), levels = letters[1:9])
+f_v <- factor(c(letters[1:9], "a", NA), levels = letters[1:9])
+f_o <- factor(c(letters[9:1], "a", NA), levels = letters[1:9])
+ans_f <- vswitch(f_x, f_v, f_o, factor(NA, levels = letters[1:9]))
+expect_identical(ans_f,
+                 factor(c("a", letters[8:1], "a", NA), levels = letters[1:9]),
+                 info = "hash-vswitch-factor")
+
+# Date outputs keep their class.
+d_o <- as.Date("2020-01-01") + 0:10
+exp_dt <- as.Date("2020-01-01") + c(9, 7:0, 10, 10, NA)
+expect_identical(vswitch(x_i, vals_i, as.list(d_o), as.Date(NA)), exp_dt,
+                 info = "hash-vswitch-date")
+
+# Element-length outputs are recycled by x position, not by pair.
+out_vec <- lapply(seq_along(vals_i), function(i) seq_along(x_i) + i * 100L)
+exp_vec <- ref_na(x_i, vals_i, out_vec)
+expect_identical(vswitch(x_i, vals_i, out_vec), exp_vec,
+                 info = "hash-vswitch-vector-output")
+
+# Empty input still accepts many values and returns an empty result.
+expect_identical(vswitch(integer(), vals_i, outs_i), integer(),
+                 info = "hash-vswitch-empty")
+
+# nswitch shares the same lookup. Duplicate values keep the last pair.
+pairs <- unlist(lapply(1:9, function(i) list(i, i + 100L)), recursive = FALSE)
+pairs <- c(pairs, list(1L, 999L, NA_integer_, 998L))
+ns <- function(x) do.call(nswitch, c(list(x), pairs, list(default = 0L)))
+expect_identical(ns(c(1:9, NA_integer_, NA_integer_, 0L)),
+                 c(999L, 102:109, 998L, 998L, 0L),
+                 info = "hash-nswitch-int")
+expect_identical(do.call(nswitch, c(list(c(1:9, NA_integer_)), pairs,
+                                    list(default = 0L, nThread = 2L))),
+                 ns(c(1:9, NA_integer_)), info = "hash-nswitch-threads")
+
+pairs_s <- unlist(lapply(1:9, function(i) list(paste0("v", i), i + 100L)),
+                   recursive = FALSE)
+pairs_s <- c(pairs_s, list("v1", 999L, NA_character_, 998L))
+ns_s <- function(x) do.call(nswitch, c(list(x), pairs_s, list(default = 0L)))
+expect_identical(ns_s(c("v1", "v9", NA_character_, "zz")),
+                 c(999L, 109L, 998L, 0L), info = "hash-nswitch-str")
+
+# nswitch vector outputs are recycled by element of x.
+pairs_v <- unlist(lapply(seq_along(vals_i),
+                         function(i) list(vals_i[i], seq_along(x_i) + i * 100L)),
+                  recursive = FALSE)
+ns_v <- function(x) do.call(nswitch, c(list(x), pairs_v,
+                                       list(default = NA_integer_)))
+expect_identical(ns_v(x_i), exp_vec, info = "hash-nswitch-vector-output")
+
+# list inputs stay on the existing deep-equality path.
+xl <- as.list(x_i)
+expect_identical(vswitch(xl, as.list(vals_i), outs_i), exp_i,
+                 info = "hash-vswitch-list-input")
+
+# Every output type goes through its own writer on the hash path.
+exp_lgl <- ref_na(x_i, vals_i, as.list(as.logical(outs_i %% 2)))
+expect_identical(vswitch(x_i, vals_i, as.logical(outs_i %% 2)), exp_lgl,
+                 info = "hash-vswitch-out-lgl")
+exp_dbl <- ref_na(x_i, vals_i, as.list(as.double(outs_i)))
+expect_identical(vswitch(x_i, vals_i, as.double(outs_i)), exp_dbl,
+                 info = "hash-vswitch-out-dbl")
+exp_chr <- ref_na(x_i, vals_i, as.list(as.character(outs_i)))
+expect_identical(vswitch(x_i, vals_i, as.character(outs_i)), exp_chr,
+                 info = "hash-vswitch-out-str")
+expect_identical(vswitch(x_s, vals_s, as.character(outs_s)),
+                 ref_na(x_s, vals_s, as.list(as.character(outs_s))),
+                 info = "hash-vswitch-str-out-str")
+exp_cplx <- ref_num(x_c, vals_c, as.list(as.complex(outs_c)))
+expect_kit_equal(vswitch(x_c, vals_c, as.complex(outs_c)), exp_cplx,
+                 info = "hash-vswitch-out-cplx")
+exp_dbl_d <- ref_num(x_d, vals_d, as.list(as.double(outs_d)))
+expect_identical(vswitch(x_d, vals_d, as.double(outs_d)), exp_dbl_d,
+                 info = "hash-vswitch-dbl-out-dbl")
+out_nested <- lapply(outs_i, function(v) list(v))
+idx_nested <- ref_na(x_i, vals_i, as.list(seq_along(vals_i)), default = NA_integer_)
+exp_nested <- lapply(idx_nested, function(k) if (is.na(k)) NULL else out_nested[[k]][[1]])
+expect_identical(vswitch(x_i, vals_i, out_nested), exp_nested,
+                 info = "hash-vswitch-out-list")
+
+# Unsupported input types keep the value-major error message, even when there
+# are enough pairs to select the hash path.
+expect_error(vswitch(as.raw(rep(0, 9L)), as.raw(rep(0, 9L)), 1:9),
+             pattern = "Type raw is not supported for argument 'x'.",
+             fixed = TRUE, info = "hash-vswitch-raw")
+
+# List outputs use the same writers in list-out mode.
+expect_identical(vswitch(x_i, vals_i, as.list(as.logical(outs_i %% 2))),
+                 ref_na(x_i, vals_i, as.list(as.logical(outs_i %% 2))),
+                 info = "hash-vswitch-list-out-lgl")
+expect_identical(vswitch(x_i, vals_i, as.list(as.character(outs_i))),
+                 ref_na(x_i, vals_i, as.list(as.character(outs_i))),
+                 info = "hash-vswitch-list-out-str")
+expect_kit_equal(vswitch(x_c, vals_c, as.list(as.complex(outs_c))),
+                 ref_num(x_c, vals_c, as.list(as.complex(outs_c))),
+                 info = "hash-vswitch-list-out-cplx")
+
+# nswitch copies each scalar value before hashing; cover every atomic type.
+expect_identical(
+  nswitch(c(TRUE, FALSE, NA), TRUE, 1L, FALSE, 2L, NA, 3L, TRUE, 4L,
+          FALSE, 5L, NA, 6L, TRUE, 7L, FALSE, 8L, NA, 9L, default = 0L),
+  c(7L, 8L, 9L), info = "hash-nswitch-lgl")
+expect_identical(
+  nswitch(c(1, 9, NA, NaN, 0), 1, 1L, 2, 2L, 3, 3L, 4, 4L, 5, 5L,
+          6, 6L, 7, 7L, 8, 8L, 9, 9L, default = 0L),
+  c(1L, 9L, 0L, 0L, 0L), info = "hash-nswitch-dbl")
+expect_identical(
+  nswitch(c(1+0i, 9+0i, NA_complex_, 0+0i),
+          1+0i, 1L, 2+0i, 2L, 3+0i, 3L, 4+0i, 4L, 5+0i, 5L,
+          6+0i, 6L, 7+0i, 7L, 8+0i, 8L, 9+0i, 9L, default = 0L),
+  c(1L, 9L, 0L, 0L), info = "hash-nswitch-cplx")
+
+# Mixed encodings and length(x) defaults on the hash path.
+vals_e9 <- c(paste0("v", 1:7), enc_lat, enc_utf)
+x_e9 <- c(enc_lat, enc_utf, NA_character_, "v1")
+pairs_e9 <- unlist(lapply(seq_along(vals_e9), function(i) list(vals_e9[i], i)),
+                   recursive = FALSE)
+expect_identical(
+  do.call(nswitch, c(list(x_e9), pairs_e9, list(default = 0L))),
+  c(9L, 9L, 0L, 1L), info = "hash-nswitch-enc")
+expect_identical(vswitch(enc2utf8(x_s), enc2utf8(vals_s), outs_s,
+                         checkEnc = FALSE),
+                 exp_s, info = "hash-vswitch-nocheckenc")
+dflt <- seq_along(x_i) * 10L
+expect_identical(vswitch(x_i, vals_i, outs_i, dflt),
+                 ref_na(x_i, vals_i, as.list(outs_i), default = dflt),
+                 info = "hash-vswitch-vector-default")
+expect_identical(
+  do.call(nswitch, c(list(x_i),
+                     unlist(lapply(seq_along(vals_i),
+                                   function(i) list(vals_i[i], outs_i[i])),
+                            recursive = FALSE),
+                     list(default = dflt))),
+  ref_na(x_i, vals_i, as.list(outs_i), default = dflt),
+  info = "hash-nswitch-vector-default")
+
+# Unsupported output types also keep the value-major error at 9+ pairs.
+expect_error(vswitch(1:9, 1:9, as.raw(1:9)),
+             pattern = "Type raw is not supported for argument 'outputs'",
+             fixed = TRUE, info = "hash-vswitch-raw-out")
+expect_error(
+  do.call(nswitch, c(list(1:9),
+                     unlist(lapply(1:9, function(i) list(i, as.raw(i))),
+                            recursive = FALSE))),
+  pattern = "Type raw is not supported for argument 'outputs'",
+  fixed = TRUE, info = "hash-nswitch-raw-out")

inst/tinytest/test-unique.R

@@ -698,3 +698,56 @@ local({
   expect_identical(uniqLen(df), nrow(unique(df)), info = "uniqLen-0074.grow-df")
 })
 
+
+# issue #107: large high-cardinality inputs pre-size the row table while
+# low-cardinality inputs keep the grow-on-demand path. Both must match base R.
+local({
+  n <- 2000L
+  hi <- data.frame(a = seq_len(n), b = seq_len(n) * 31L)
+  lo <- data.frame(a = rep(1:5, length.out = n),
+                   b = rep(1:3, length.out = n))
+  mix <- data.frame(a = seq_len(n), b = as.numeric(seq_len(n)) / 3)
+  for (df in list(hi, lo, mix)) {
+    a <- funique(df); b <- unique(df)
+    rownames(a) <- rownames(b) <- NULL
+    expect_identical(a, b, info = "funique-0107.presize-roundtrip")
+    expect_identical(uniqLen(df), nrow(b), info = "uniqLen-0107.presize")
+    expect_identical(fduplicated(df), duplicated(df),
+                     info = "fduplicated-0107.presize")
+  }
+  m <- as.matrix(hi)
+  expect_identical(uniqLen(m), nrow(unique(m)), info = "uniqLen-0107.presize-mat")
+  a <- funique(m); b <- unique(m)
+  dimnames(a) <- dimnames(b) <- NULL
+  expect_identical(a, b, info = "funique-0107.presize-mat")
+})
+
+# issue #107: -0/0 and differing NaN payloads must hash equal because REQUAL
+# treats them equal. Vector, matrix and data-frame paths all share this rule.
+local({
+  mk_nan <- function(lo) {
+    bits <- as.raw(c(lo, 0, 0, 0, 0, 0, 0xf8, 0x7f))
+    if (.Platform$endian == "big") bits <- rev(bits)
+    readBin(bits, "double", n = 1L, size = 8L)
+  }
+  nans <- vapply(1:64, function(i) mk_nan(as.raw(i)), numeric(1))
+  for (x in list(c(0, -0), nans)) {
+    df <- data.frame(a = x)
+    m <- matrix(x, ncol = 1L)
+    expect_identical(funique(x), unique(x), info = "funique-0107.dbl-equal")
+    expect_identical(fduplicated(x), duplicated(x), info = "fduplicated-0107.dbl-equal")
+    expect_identical(uniqLen(x), 1L, info = "uniqLen-0107.dbl-equal")
+    expect_identical(nrow(funique(df)), nrow(unique(df)),
+                     info = "funique-0107.dbl-equal-df")
+    expect_identical(fduplicated(df), duplicated(df),
+                     info = "fduplicated-0107.dbl-equal-df")
+    expect_identical(uniqLen(df), 1L, info = "uniqLen-0107.dbl-equal-df")
+    expect_identical(nrow(funique(m)), nrow(unique(m)),
+                     info = "funique-0107.dbl-equal-mat")
+    expect_identical(fduplicated(m), as.vector(duplicated(m)),
+                     info = "fduplicated-0107.dbl-equal-mat")
+    expect_identical(uniqLen(m), 1L, info = "uniqLen-0107.dbl-equal-mat")
+  }
+  expect_identical(uniqLen(data.frame(a = c(0, -0), b = c("x", "x"))), 1L,
+                   info = "uniqLen-0107.dbl-equal-mixed-df")
+})