diff --git a/DESCRIPTION b/DESCRIPTION index 512d567..0e4ac5e 100644 --- a/DESCRIPTION +++ b/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")) diff --git a/NEWS.md b/NEWS.md index a043d2b..309e05a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,19 @@ +# kit 0.0.24 (development version) + +### 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 (2026-11-02) ### Bug Fixes diff --git a/inst/tinytest/test-enc.R b/inst/tinytest/test-enc.R index ece2d7a..330c9b1 100644 --- a/inst/tinytest/test-enc.R +++ b/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") diff --git a/inst/tinytest/test-switch-hash.R b/inst/tinytest/test-switch-hash.R new file mode 100644 index 0000000..3afe705 --- /dev/null +++ b/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") diff --git a/inst/tinytest/test-unique.R b/inst/tinytest/test-unique.R index fa2aa0b..8278de0 100644 --- a/inst/tinytest/test-unique.R +++ b/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") +}) diff --git a/src/dup.c b/src/dup.c index 818cc28..cb353ac 100644 --- a/src/dup.c +++ b/src/dup.c @@ -85,6 +85,7 @@ SEXP dupDataFrameR(SEXP x, SEXP uniq, SEXP fromLast) { // move to matrix if poss Mbase *= 2; Kbase++; } + kit_rows_presize(mlv, len_i, len_x, &M, &K, Mbase, Kbase); R_xlen_t count = 0; int *restrict h = (int*) R_Calloc(M, int); const int *restrict v = INTEGER(mlv); @@ -95,11 +96,7 @@ SEXP dupDataFrameR(SEXP x, SEXP uniq, SEXP fromLast) { // move to matrix if poss if (buniq) { if (pfromLast) { for (R_xlen_t i = len_i-1; i > -1; --i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - key ^= HASH(v[i+j*len_i],K)*97*(j+1); - } - id = HASH(key, K); + id = kit_hash_rows_int_raw(v, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (v[h[id]-1+j*len_i] != v[i+j*len_i]) { @@ -118,11 +115,7 @@ SEXP dupDataFrameR(SEXP x, SEXP uniq, SEXP fromLast) { // move to matrix if poss } } else { for (R_xlen_t i = 0; i < len_i; ++i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - key ^= HASH(v[i+j*len_i],K)*97*(j+1); - } - id = HASH(key, K); + id = kit_hash_rows_int_raw(v, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (v[h[id]-1+j*len_i] != v[i+j*len_i]) { @@ -157,11 +150,7 @@ SEXP dupDataFrameR(SEXP x, SEXP uniq, SEXP fromLast) { // move to matrix if poss } if (pfromLast) { for (R_xlen_t i = len_i-1; i > -1; --i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - key ^= HASH(v[i+j*len_i],K)*97*(j+1); - } - id = HASH(key, K); + id = kit_hash_rows_int_raw(v, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (v[h[id]-1+j*len_i] != v[i+j*len_i]) { @@ -181,11 +170,7 @@ SEXP dupDataFrameR(SEXP x, SEXP uniq, SEXP fromLast) { // move to matrix if poss } } else { for (R_xlen_t i = 0; i < len_i; ++i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - key ^= HASH(v[i+j*len_i],K)*97*(j+1); - } - id = HASH(key, K); + id = kit_hash_rows_int_raw(v, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (v[h[id]-1+j*len_i] != v[i+j*len_i]) { @@ -231,6 +216,7 @@ SEXP dupMatrixR(SEXP x, SEXP uniq, bool idx, SEXP fromLast) { Mbase *= 2; Kbase++; } + kit_rows_presize(x, len_i, len_x, &M, &K, Mbase, Kbase); R_xlen_t count = 0; int *restrict h = (int*) R_Calloc(M, int); int *restrict pans = buniq ? (int*) R_Calloc(len_i, int) : LOGICAL(ans); @@ -245,11 +231,7 @@ SEXP dupMatrixR(SEXP x, SEXP uniq, bool idx, SEXP fromLast) { if (buniq) { if (pfromLast) { for (R_xlen_t i = len_i-1; i > -1; --i) { - id = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - id ^= ((unsigned)(j+1) * ((px[i+j*len_i] == NA_LOGICAL) ? 2U : (size_t) px[i+j*len_i]))*97*(j+1); - } - id = HASH(id, K); + id = kit_hash_rows_lgl(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (px[h[id]-1+j*len_i] != px[i+j*len_i]) { @@ -268,11 +250,7 @@ SEXP dupMatrixR(SEXP x, SEXP uniq, bool idx, SEXP fromLast) { } } else { for (R_xlen_t i = 0; i < len_i; ++i) { - id = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - id ^= ((unsigned)(j+1) * ((px[i+j*len_i] == NA_LOGICAL) ? 2U : (size_t) px[i+j*len_i]))*97*(j+1); - } - id = HASH(id, K); + id = kit_hash_rows_lgl(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (px[h[id]-1+j*len_i] != px[i+j*len_i]) { @@ -293,11 +271,7 @@ SEXP dupMatrixR(SEXP x, SEXP uniq, bool idx, SEXP fromLast) { } else { if (pfromLast) { for (R_xlen_t i = len_i-1; i >-1; --i) { - id = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - id ^= ((unsigned)(j+1) * ((px[i+j*len_i] == NA_LOGICAL) ? 2U : (size_t) px[i+j*len_i]))*97*(j+1); - } - id = HASH(id, K); + id = kit_hash_rows_lgl(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (px[h[id]-1+j*len_i] != px[i+j*len_i]) { @@ -317,11 +291,7 @@ SEXP dupMatrixR(SEXP x, SEXP uniq, bool idx, SEXP fromLast) { } } else { for (R_xlen_t i = 0; i < len_i; ++i) { - id = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - id ^= ((unsigned)(j+1) * ((px[i+j*len_i] == NA_LOGICAL) ? 2U : (size_t) px[i+j*len_i]))*97*(j+1); - } - id = HASH(id, K); + id = kit_hash_rows_lgl(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (px[h[id]-1+j*len_i] != px[i+j*len_i]) { @@ -349,11 +319,7 @@ SEXP dupMatrixR(SEXP x, SEXP uniq, bool idx, SEXP fromLast) { if (buniq) { if (pfromLast) { for (R_xlen_t i = len_i-1; i > -1; --i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - key ^= HASH(((px[i+j*len_i] == NA_INTEGER) ? 0 : px[i+j*len_i]),K)*97*(j+1); - } - id = HASH(key, K); + id = kit_hash_rows_int(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (px[h[id]-1+j*len_i] != px[i+j*len_i]) { @@ -372,11 +338,7 @@ SEXP dupMatrixR(SEXP x, SEXP uniq, bool idx, SEXP fromLast) { } } else { for (R_xlen_t i = 0; i < len_i; ++i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - key ^= HASH(((px[i+j*len_i] == NA_INTEGER) ? 0 : px[i+j*len_i]),K)*97*(j+1); - } - id = HASH(key, K); + id = kit_hash_rows_int(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (px[h[id]-1+j*len_i] != px[i+j*len_i]) { @@ -397,11 +359,7 @@ SEXP dupMatrixR(SEXP x, SEXP uniq, bool idx, SEXP fromLast) { } else { if (pfromLast) { for (R_xlen_t i = len_i-1; i > -1; --i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - key ^= HASH(((px[i+j*len_i] == NA_INTEGER) ? 0 : px[i+j*len_i]),K)*97*(j+1); - } - id = HASH(key, K); + id = kit_hash_rows_int(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (px[h[id]-1+j*len_i] != px[i+j*len_i]) { @@ -421,11 +379,7 @@ SEXP dupMatrixR(SEXP x, SEXP uniq, bool idx, SEXP fromLast) { } } else { for (R_xlen_t i = 0; i < len_i; ++i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - key ^= HASH(((px[i+j*len_i] == NA_INTEGER) ? 0 : px[i+j*len_i]),K)*97*(j+1); - } - id = HASH(key, K); + id = kit_hash_rows_int(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (px[h[id]-1+j*len_i] != px[i+j*len_i]) { @@ -450,17 +404,10 @@ SEXP dupMatrixR(SEXP x, SEXP uniq, bool idx, SEXP fromLast) { const double *restrict px = REAL(x); rowctx.px = px; grow = kit_grow_rows_real; - union uno tpv; if (buniq) { if (pfromLast) { for (R_xlen_t i = len_i-1; i > -1; --i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - tpv.d = px[i+j*len_i]; - key ^= HASH(tpv.u[0] + tpv.u[1],K)*97*(j+1); - } - tpv.d = key; - id = HASH(tpv.u[0] + tpv.u[1], K); + id = kit_hash_rows_real(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (!REQUAL(px[h[id]-1+j*len_i], px[i+j*len_i])) { @@ -479,13 +426,7 @@ SEXP dupMatrixR(SEXP x, SEXP uniq, bool idx, SEXP fromLast) { } } else { for (R_xlen_t i = 0; i < len_i; ++i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - tpv.d = px[i+j*len_i]; - key ^= HASH(tpv.u[0] + tpv.u[1],K)*97*(j+1); - } - tpv.d = key; - id = HASH(tpv.u[0] + tpv.u[1], K); + id = kit_hash_rows_real(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (!REQUAL(px[h[id]-1+j*len_i], px[i+j*len_i])) { @@ -506,13 +447,7 @@ SEXP dupMatrixR(SEXP x, SEXP uniq, bool idx, SEXP fromLast) { } else { if (pfromLast) { for (R_xlen_t i = len_i-1; i > -1; --i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - tpv.d = px[i+j*len_i]; - key ^= HASH(tpv.u[0] + tpv.u[1],K)*97*(j+1); - } - tpv.d = key; - id = HASH(tpv.u[0] + tpv.u[1], K); + id = kit_hash_rows_real(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (!REQUAL(px[h[id]-1+j*len_i], px[i+j*len_i])) { @@ -532,13 +467,7 @@ SEXP dupMatrixR(SEXP x, SEXP uniq, bool idx, SEXP fromLast) { } } else { for (R_xlen_t i = 0; i < len_i; ++i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - tpv.d = px[i+j*len_i]; - key ^= HASH(tpv.u[0] + tpv.u[1],K)*97*(j+1); - } - tpv.d = key; - id = HASH(tpv.u[0] + tpv.u[1], K); + id = kit_hash_rows_real(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (!REQUAL(px[h[id]-1+j*len_i], px[i+j*len_i])) { @@ -563,28 +492,10 @@ SEXP dupMatrixR(SEXP x, SEXP uniq, bool idx, SEXP fromLast) { const Rcomplex *restrict px = COMPLEX(x); rowctx.px = px; grow = kit_grow_rows_cplx; - unsigned int u; - union uno tpv; - Rcomplex tmp; if (buniq) { if (pfromLast) { for (R_xlen_t i = len_i-1; i > -1; --i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - tmp.r = (px[i+j*len_i].r == 0.0) ? 0.0 : px[i+j*len_i].r; - tmp.i = (px[i+j*len_i].i == 0.0) ? 0.0 : px[i+j*len_i].i; - if (C_IsNA(tmp)) { - tmp.r = tmp.i = NA_REAL; - } else if (C_IsNaN(tmp)) { - tmp.r = tmp.i = R_NaN; - } - tpv.d = tmp.r; - u = tpv.u[0] ^ tpv.u[1]; - tpv.d = tmp.i; - u ^= tpv.u[0] ^ tpv.u[1]; - key ^= HASH(u, K)*97*(j+1); - } - id = HASH(key, K); + id = kit_hash_rows_cplx(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (!CEQUAL(px[h[id]-1+j*len_i], px[i+j*len_i])) { @@ -603,22 +514,7 @@ SEXP dupMatrixR(SEXP x, SEXP uniq, bool idx, SEXP fromLast) { } } else { for (R_xlen_t i = 0; i < len_i; ++i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - tmp.r = (px[i+j*len_i].r == 0.0) ? 0.0 : px[i+j*len_i].r; - tmp.i = (px[i+j*len_i].i == 0.0) ? 0.0 : px[i+j*len_i].i; - if (C_IsNA(tmp)) { - tmp.r = tmp.i = NA_REAL; - } else if (C_IsNaN(tmp)) { - tmp.r = tmp.i = R_NaN; - } - tpv.d = tmp.r; - u = tpv.u[0] ^ tpv.u[1]; - tpv.d = tmp.i; - u ^= tpv.u[0] ^ tpv.u[1]; - key ^= HASH(u, K)*97*(j+1); - } - id = HASH(key, K); + id = kit_hash_rows_cplx(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (!CEQUAL(px[h[id]-1+j*len_i], px[i+j*len_i])) { @@ -639,22 +535,7 @@ SEXP dupMatrixR(SEXP x, SEXP uniq, bool idx, SEXP fromLast) { } else { if (pfromLast) { for (R_xlen_t i = len_i-1; i > -1; --i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - tmp.r = (px[i+j*len_i].r == 0.0) ? 0.0 : px[i+j*len_i].r; - tmp.i = (px[i+j*len_i].i == 0.0) ? 0.0 : px[i+j*len_i].i; - if (C_IsNA(tmp)) { - tmp.r = tmp.i = NA_REAL; - } else if (C_IsNaN(tmp)) { - tmp.r = tmp.i = R_NaN; - } - tpv.d = tmp.r; - u = tpv.u[0] ^ tpv.u[1]; - tpv.d = tmp.i; - u ^= tpv.u[0] ^ tpv.u[1]; - key ^= HASH(u, K)*97*(j+1); - } - id = HASH(key, K); + id = kit_hash_rows_cplx(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (!CEQUAL(px[h[id]-1+j*len_i], px[i+j*len_i])) { @@ -674,22 +555,7 @@ SEXP dupMatrixR(SEXP x, SEXP uniq, bool idx, SEXP fromLast) { } } else { for (R_xlen_t i = 0; i < len_i; ++i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - tmp.r = (px[i+j*len_i].r == 0.0) ? 0.0 : px[i+j*len_i].r; - tmp.i = (px[i+j*len_i].i == 0.0) ? 0.0 : px[i+j*len_i].i; - if (C_IsNA(tmp)) { - tmp.r = tmp.i = NA_REAL; - } else if (C_IsNaN(tmp)) { - tmp.r = tmp.i = R_NaN; - } - tpv.d = tmp.r; - u = tpv.u[0] ^ tpv.u[1]; - tpv.d = tmp.i; - u ^= tpv.u[0] ^ tpv.u[1]; - key ^= HASH(u, K)*97*(j+1); - } - id = HASH(key, K); + id = kit_hash_rows_cplx(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (!CEQUAL(px[h[id]-1+j*len_i], px[i+j*len_i])) { @@ -717,11 +583,7 @@ SEXP dupMatrixR(SEXP x, SEXP uniq, bool idx, SEXP fromLast) { if (buniq) { if (pfromLast) { for (R_xlen_t i = len_i-1; i > -1; --i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - key ^= HASH(((intptr_t) px[i+j*len_i] & 0xffffffff),K)*97*(j+1); - } - id = HASH(key, K); + id = kit_hash_rows_str(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (px[h[id]-1+j*len_i] != px[i+j*len_i]) { @@ -740,11 +602,7 @@ SEXP dupMatrixR(SEXP x, SEXP uniq, bool idx, SEXP fromLast) { } } else { for (R_xlen_t i = 0; i < len_i; ++i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - key ^= HASH(((intptr_t) px[i+j*len_i] & 0xffffffff),K)*97*(j+1); - } - id = HASH(key, K); + id = kit_hash_rows_str(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (px[h[id]-1+j*len_i] != px[i+j*len_i]) { @@ -765,11 +623,7 @@ SEXP dupMatrixR(SEXP x, SEXP uniq, bool idx, SEXP fromLast) { } else { if (pfromLast) { for (R_xlen_t i = len_i-1; i > -1; --i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - key ^= HASH(((intptr_t) px[i+j*len_i] & 0xffffffff),K)*97*(j+1); - } - id = HASH(key, K); + id = kit_hash_rows_str(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (px[h[id]-1+j*len_i] != px[i+j*len_i]) { @@ -789,11 +643,7 @@ SEXP dupMatrixR(SEXP x, SEXP uniq, bool idx, SEXP fromLast) { } } else { for (R_xlen_t i = 0; i < len_i; ++i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - key ^= HASH(((intptr_t) px[i+j*len_i] & 0xffffffff),K)*97*(j+1); - } - id = HASH(key, K); + id = kit_hash_rows_str(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (px[h[id]-1+j*len_i] != px[i+j*len_i]) { @@ -1107,7 +957,7 @@ SEXP dupVecR(SEXP x, SEXP uniq, SEXP fromLast) { if (buniq) { if (pfromLast) { for (int i = n-1; i > -1; --i) { - tpv.d = R_IsNA(px[i]) ? NA_REAL : (R_IsNaN(px[i]) ? R_NaN :px[i]); + tpv.u64 = kit_real_bits(px[i]); id = HASH(tpv.u[0] + tpv.u[1], K); while (h[id]) { if (REQUAL(px[h[id]-1], px[i])) { @@ -1123,7 +973,7 @@ SEXP dupVecR(SEXP x, SEXP uniq, SEXP fromLast) { } } else { for (int i = 0; i < n; ++i) { - tpv.d = R_IsNA(px[i]) ? NA_REAL : (R_IsNaN(px[i]) ? R_NaN :px[i]); + tpv.u64 = kit_real_bits(px[i]); id = HASH(tpv.u[0] + tpv.u[1], K); while (h[id]) { if (REQUAL(px[h[id]-1], px[i])) { @@ -1154,7 +1004,7 @@ SEXP dupVecR(SEXP x, SEXP uniq, SEXP fromLast) { } else { if (pfromLast) { for (int i = n-1; i > -1; --i) { - tpv.d = R_IsNA(px[i]) ? NA_REAL : (R_IsNaN(px[i]) ? R_NaN :px[i]); + tpv.u64 = kit_real_bits(px[i]); id = HASH(tpv.u[0] + tpv.u[1], K); while (h[id]) { if (REQUAL(px[h[id]-1], px[i])) { @@ -1171,7 +1021,7 @@ SEXP dupVecR(SEXP x, SEXP uniq, SEXP fromLast) { } } else { for (int i = 0; i < n; ++i) { - tpv.d = R_IsNA(px[i]) ? NA_REAL : (R_IsNaN(px[i]) ? R_NaN :px[i]); + tpv.u64 = kit_real_bits(px[i]); id = HASH(tpv.u[0] + tpv.u[1], K); while (h[id]) { if (REQUAL(px[h[id]-1], px[i])) { @@ -1442,6 +1292,7 @@ SEXP dupVecIndexOnlyR(SEXP x) { } else { error("Type %s is not supported.", type2char(tx)); // # nocov } + kit_rows_presize(x, n, 1, &M, &K, Mbase, Kbase); size_t count = 0; int *restrict h = (int*)R_Calloc(M, int); SEXP ans_i = PROTECT(allocVector(INTSXP, n)); @@ -1488,7 +1339,7 @@ SEXP dupVecIndexOnlyR(SEXP x) { size_t id = 0; union uno tpv; for (int i = 0; i < n; ++i) { - tpv.d = R_IsNA(px[i]) ? NA_REAL : (R_IsNaN(px[i]) ? R_NaN :px[i]); + tpv.u64 = kit_real_bits(px[i]); id = HASH(tpv.u[0] + tpv.u[1], K); while (h[id]) { if (REQUAL(px[h[id]-1], px[i])) { diff --git a/src/dupLen.c b/src/dupLen.c index c64ef26..26949a6 100644 --- a/src/dupLen.c +++ b/src/dupLen.c @@ -79,6 +79,7 @@ SEXP dupLenDataFrameR(SEXP x) { Mbase *= 2; Kbase++; } + kit_rows_presize(mlv, len_i, len_x, &M, &K, Mbase, Kbase); R_xlen_t count = 0; int *restrict h = (int*) R_Calloc(M, int); const int *restrict v = INTEGER(mlv); @@ -86,11 +87,7 @@ SEXP dupLenDataFrameR(SEXP x) { kit_row_ctx rowctx = {v, len_i, len_x}; size_t id = 0; for (R_xlen_t i = 0; i < len_i; ++i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - key ^= HASH(v[i+j*len_i],K)*97*(j+1); - } - id = HASH(key, K); + id = kit_hash_rows_int_raw(v, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (v[h[id]-1+j*len_i] != v[i+j*len_i]) { @@ -127,6 +124,7 @@ SEXP dupLenMatrixR(SEXP x) { Mbase *= 2; Kbase++; } + kit_rows_presize(x, len_i, len_x, &M, &K, Mbase, Kbase); R_xlen_t count = 0; int *restrict h = (int*) R_Calloc(M, int); size_t id = 0; @@ -138,11 +136,7 @@ SEXP dupLenMatrixR(SEXP x) { rowctx.px = px; grow = kit_grow_rows_lgl; for (R_xlen_t i = 0; i < len_i; ++i) { - id = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - id ^= ((unsigned)(j+1) * ((px[i+j*len_i] == NA_LOGICAL) ? 2U : (size_t) px[i+j*len_i]))*97*(j+1); - } - id = HASH(id, K); + id = kit_hash_rows_lgl(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (px[h[id]-1+j*len_i] != px[i+j*len_i]) { @@ -164,11 +158,7 @@ SEXP dupLenMatrixR(SEXP x) { rowctx.px = px; grow = kit_grow_rows_int; for (R_xlen_t i = 0; i < len_i; ++i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - key ^= HASH(((px[i+j*len_i] == NA_INTEGER) ? 0 : px[i+j*len_i]),K)*97*(j+1); - } - id = HASH(key, K); + id = kit_hash_rows_int(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (px[h[id]-1+j*len_i] != px[i+j*len_i]) { @@ -189,15 +179,8 @@ SEXP dupLenMatrixR(SEXP x) { const double *restrict px = REAL(x); rowctx.px = px; grow = kit_grow_rows_real; - union uno tpv; for (R_xlen_t i = 0; i < len_i; ++i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - tpv.d = px[i+j*len_i]; - key ^= HASH(tpv.u[0] + tpv.u[1],K)*97*(j+1); - } - tpv.d = key; - id = HASH(tpv.u[0] + tpv.u[1], K); + id = kit_hash_rows_real(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (!REQUAL(px[h[id]-1+j*len_i], px[i+j*len_i])) { @@ -218,26 +201,8 @@ SEXP dupLenMatrixR(SEXP x) { const Rcomplex *restrict px = COMPLEX(x); rowctx.px = px; grow = kit_grow_rows_cplx; - unsigned int u; - union uno tpv; - Rcomplex tmp; for (R_xlen_t i = 0; i < len_i; ++i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - tmp.r = (px[i+j*len_i].r == 0.0) ? 0.0 : px[i+j*len_i].r; - tmp.i = (px[i+j*len_i].i == 0.0) ? 0.0 : px[i+j*len_i].i; - if (C_IsNA(tmp)) { - tmp.r = tmp.i = NA_REAL; - } else if (C_IsNaN(tmp)) { - tmp.r = tmp.i = R_NaN; - } - tpv.d = tmp.r; - u = tpv.u[0] ^ tpv.u[1]; - tpv.d = tmp.i; - u ^= tpv.u[0] ^ tpv.u[1]; - key ^= HASH(u, K)*97*(j+1); - } - id = HASH(key, K); + id = kit_hash_rows_cplx(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (!CEQUAL(px[h[id]-1+j*len_i], px[i+j*len_i])) { @@ -259,11 +224,7 @@ SEXP dupLenMatrixR(SEXP x) { rowctx.px = px; grow = kit_grow_rows_str; for (R_xlen_t i = 0; i < len_i; ++i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - key ^= HASH(((intptr_t) px[i+j*len_i] & 0xffffffff),K)*97*(j+1); - } - id = HASH(key, K); + id = kit_hash_rows_str(px, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (px[h[id]-1+j*len_i] != px[i+j*len_i]) { @@ -373,7 +334,7 @@ SEXP dupLenVecR(SEXP x) { size_t id = 0; union uno tpv; for (int i = 0; i < n; ++i) { - tpv.d = R_IsNA(px[i]) ? NA_REAL : (R_IsNaN(px[i]) ? R_NaN :px[i]); + tpv.u64 = kit_real_bits(px[i]); id = HASH(tpv.u[0] + tpv.u[1], K); while (h[id]) { if (REQUAL(px[h[id]-1], px[i])) { diff --git a/src/kit.h b/src/kit.h index d8f64ce..d626dff 100644 --- a/src/kit.h +++ b/src/kit.h @@ -48,6 +48,9 @@ #define UTYPEOF(x) ((unsigned)TYPEOF(x)) #define IS_BOOL(x) (XLENGTH(x)==1 && TYPEOF(x)==LGLSXP && LOGICAL(x)[0]!=NA_LOGICAL) #define IS_VALID_TYPE(x) ((x) == LGLSXP || (x)==INTSXP || (x)==REALSXP || (x)==CPLXSXP || (x)==STRSXP || (x)==VECSXP) +#define IS_SWITCH_HASH_TYPE(x) ((x) == LGLSXP || (x)==INTSXP || (x)==REALSXP || (x)==CPLXSXP || (x)==STRSXP) +/* Keep the per-pair map memory bounded; absurd pair counts stay value-major. */ +#define KIT_SWITCH_HASH_MAX_PAIRS 1048576 #define PTR_ETL(x, y) (((const SEXP *)DATAPTR_RO(x))[y]) #define SEXPPTR_RO(x) ((const SEXP *)DATAPTR_RO(x)) #define ISNA_COMPLEX(x) (ISNA(x.r) || ISNA(x.i)) @@ -62,6 +65,14 @@ static inline size_t kit_hash_key(uint32_t key, int K) { key *= 0x9E3779B1U; return (size_t)(key >> (32 - K)); } +static inline size_t kit_hash_u64(uint64_t key, int K) { + // finaliser for the 64-bit rolling row hashes + key ^= key >> 33; + key *= 0xff51afd7ed558ccdULL; + key ^= key >> 29; + return (size_t)(key >> (64 - K)); +} +#define KIT_MIX64 0x9E3779B97F4A7C15ULL #define HASH(key, K) kit_hash_key((uint32_t)(key), (K)) #define N_ISNAN(x, y) (!ISNAN(x) && !ISNAN(y)) #define B_IsNA(x, y) (R_IsNA(x) && R_IsNA(y)) @@ -73,7 +84,19 @@ static inline size_t kit_hash_key(uint32_t key, int K) { #define REQUAL(x, y) (N_ISNAN(x, y) ? (x == y) : (B_IsNA(x, y) || B_IsNaN(x, y))) #define CEQUAL(x, y) ((N_ISNAN(x.r, x.i) && N_ISNAN(y.r, y.i)) ? (x.r == y.r && x.i == y.i) : (C_IsNA(x) ? C_IsNA(y) : (C_IsNA(y) ? 0 : (C_ISNAN(x.r, y.r) && C_ISNAN(x.i, y.i))))) -union uno { double d; unsigned int u[2]; }; +union uno { double d; unsigned int u[2]; uint64_t u64; }; + +/* Canonical bits for hashing a double the way REQUAL/CEQUAL compare it. */ +static inline uint64_t kit_real_bits(double x) { + union uno v; + v.d = x; + if (ISNAN(x)) { + v.d = R_IsNA(x) ? NA_REAL : R_NaN; + } else if (x == 0.0) { + v.u64 = 0; // -0 == 0 + } + return v.u64; +} /* * Growable duplicate tables. Each table stores 1-based input indices in an @@ -92,51 +115,49 @@ typedef int *(*kit_row_grow_fn)(const kit_row_ctx *ctx, int *h, size_t M, size_t static inline size_t kit_hash_rows_lgl(const int *px, const R_xlen_t i, const R_xlen_t len_i, const R_xlen_t len_x, const int K) { - size_t id = 0; + uint64_t key = 0; for (R_xlen_t j = 0; j < len_x; ++j) { - id ^= ((unsigned)(j+1) * ((px[i+j*len_i] == NA_LOGICAL) ? 2U : (size_t) px[i+j*len_i]))*97*(j+1); + key = key * KIT_MIX64 + + (uint64_t)((px[i+j*len_i] == NA_LOGICAL) ? 2U : (unsigned) px[i+j*len_i]); } - return HASH(id, K); + return kit_hash_u64(key, K); } static inline size_t kit_hash_rows_int(const int *px, const R_xlen_t i, const R_xlen_t len_i, const R_xlen_t len_x, const int K) { - R_xlen_t key = 0; + uint64_t key = 0; for (R_xlen_t j = 0; j < len_x; ++j) { - key ^= HASH(((px[i+j*len_i] == NA_INTEGER) ? 0 : px[i+j*len_i]), K)*97*(j+1); + key = key * KIT_MIX64 + + (uint64_t)(uint32_t)((px[i+j*len_i] == NA_INTEGER) ? 0 : px[i+j*len_i]); } - return HASH(key, K); + return kit_hash_u64(key, K); } static inline size_t kit_hash_rows_int_raw(const int *px, const R_xlen_t i, const R_xlen_t len_i, const R_xlen_t len_x, const int K) { - R_xlen_t key = 0; + uint64_t key = 0; for (R_xlen_t j = 0; j < len_x; ++j) { - key ^= HASH(px[i+j*len_i], K)*97*(j+1); + key = key * KIT_MIX64 + (uint64_t)(uint32_t) px[i+j*len_i]; } - return HASH(key, K); + return kit_hash_u64(key, K); } static inline size_t kit_hash_rows_real(const double *px, const R_xlen_t i, const R_xlen_t len_i, const R_xlen_t len_x, const int K) { - R_xlen_t key = 0; - union uno tpv; + uint64_t key = 0; for (R_xlen_t j = 0; j < len_x; ++j) { - tpv.d = px[i+j*len_i]; - key ^= HASH(tpv.u[0] + tpv.u[1], K)*97*(j+1); + key = key * KIT_MIX64 + kit_real_bits(px[i+j*len_i]); } - tpv.d = key; - return HASH(tpv.u[0] + tpv.u[1], K); + return kit_hash_u64(key, K); } static inline size_t kit_hash_rows_cplx(const Rcomplex *px, const R_xlen_t i, const R_xlen_t len_i, const R_xlen_t len_x, const int K) { - R_xlen_t key = 0; - unsigned int u; + uint64_t key = 0; union uno tpv; Rcomplex tmp; for (R_xlen_t j = 0; j < len_x; ++j) { @@ -148,22 +169,21 @@ static inline size_t kit_hash_rows_cplx(const Rcomplex *px, const R_xlen_t i, tmp.r = tmp.i = R_NaN; } tpv.d = tmp.r; - u = tpv.u[0] ^ tpv.u[1]; + key = key * KIT_MIX64 + tpv.u64; tpv.d = tmp.i; - u ^= tpv.u[0] ^ tpv.u[1]; - key ^= HASH(u, K)*97*(j+1); + key = key * KIT_MIX64 + tpv.u64; } - return HASH(key, K); + return kit_hash_u64(key, K); } static inline size_t kit_hash_rows_str(const SEXP *px, const R_xlen_t i, const R_xlen_t len_i, const R_xlen_t len_x, const int K) { - R_xlen_t key = 0; + uint64_t key = 0; for (R_xlen_t j = 0; j < len_x; ++j) { - key ^= HASH(((intptr_t) px[i+j*len_i] & 0xffffffff), K)*97*(j+1); + key = key * KIT_MIX64 + (uint64_t)(uintptr_t) px[i+j*len_i]; } - return HASH(key, K); + return kit_hash_u64(key, K); } #define KIT_DEFINE_ROW_GROW(name, type, hashfn) \ @@ -192,6 +212,75 @@ KIT_DEFINE_ROW_GROW(real, double, kit_hash_rows_real) KIT_DEFINE_ROW_GROW(cplx, Rcomplex, kit_hash_rows_cplx) KIT_DEFINE_ROW_GROW(str, SEXP, kit_hash_rows_str) +/* + * Estimate whether an input is high-cardinality from a bounded row sample. + * High-cardinality inputs pre-size the duplicate table to its final capacity, + * avoiding several full rehashes while low-cardinality inputs keep the small + * grow-on-demand table (#74). + */ +#define KIT_DEFINE_ROW_SAMPLE(name, type, hashfn) \ +static inline bool kit_likely_high_card_##name(const type *px, \ + const R_xlen_t len_i, \ + const R_xlen_t len_x) { \ + if (len_i < 262144) return false; /* growth is cheap below this size */ \ + R_xlen_t sample = len_x > 16 ? 65536 / len_x : 65536; \ + if (sample < 4096) sample = 4096; \ + if (sample > len_i) sample = len_i; \ + size_t cap = 256; \ + while (cap < (size_t) sample * 2) cap <<= 1; \ + uint32_t *keys = (uint32_t*) R_Calloc(cap, uint32_t); \ + size_t distinct = 0; \ + uint64_t state = 0x9E3779B97F4A7C15ULL ^ (uint64_t) len_i; \ + for (R_xlen_t s = 0; s < sample; ++s) { \ + state = state * 6364136223846793005ULL + 1442695040888963407ULL; \ + const R_xlen_t i = (R_xlen_t)(state % (uint64_t) len_i); \ + uint32_t key = (uint32_t) hashfn(px, i, len_i, len_x, 32); \ + if (!key) key = 1; \ + size_t id = (size_t) key & (cap - 1); \ + while (keys[id] && keys[id] != key) id = (id + 1) & (cap - 1); \ + if (!keys[id]) { keys[id] = key; distinct++; } \ + } \ + R_Free(keys); \ + if (distinct < 64) return false; \ + const size_t dup = (size_t) sample - distinct; \ + if (!dup) return true; /* no repeat in a random sample means U >> n/2 */ \ + const double uhat = (double) sample * (double) (sample - 1) / \ + (2.0 * (double) dup); \ + return uhat > (double) len_i * 0.5; \ +} + +KIT_DEFINE_ROW_SAMPLE(lgl, int, kit_hash_rows_lgl) +KIT_DEFINE_ROW_SAMPLE(int, int, kit_hash_rows_int) +KIT_DEFINE_ROW_SAMPLE(real, double, kit_hash_rows_real) +KIT_DEFINE_ROW_SAMPLE(cplx, Rcomplex, kit_hash_rows_cplx) +KIT_DEFINE_ROW_SAMPLE(str, SEXP, kit_hash_rows_str) + +static inline void kit_rows_presize(SEXP x, const R_xlen_t len_i, + const R_xlen_t len_x, size_t *M, int *K, + const size_t Mbase, const int Kbase) { + bool high = false; + switch (UTYPEOF(x)) { + case LGLSXP: + high = kit_likely_high_card_lgl(LOGICAL(x), len_i, len_x); + break; + case INTSXP: + high = kit_likely_high_card_int(INTEGER(x), len_i, len_x); + break; + case REALSXP: + high = kit_likely_high_card_real(REAL(x), len_i, len_x); + break; + case CPLXSXP: + high = kit_likely_high_card_cplx(COMPLEX(x), len_i, len_x); + break; + case STRSXP: + high = kit_likely_high_card_str(STRING_PTR_RO(x), len_i, len_x); + break; + default: + return; + } + if (high) { *M = Mbase; *K = Kbase; } +} + #define KIT_GROW_ROWS() do { if ((size_t) count > M - (M >> 2)) { \ size_t Mnew = M << 2; int Knew = K + 2; \ if (Mnew > Mbase) { Mnew = Mbase; Knew = Kbase; } \ @@ -223,7 +312,7 @@ static inline int *kit_rehash_real(const double *restrict px, int *restrict h, const int e = h[s]; if (e) { const int i = e - 1; - tpv.d = R_IsNA(px[i]) ? NA_REAL : (R_IsNaN(px[i]) ? R_NaN : px[i]); + tpv.u64 = kit_real_bits(px[i]); size_t id = HASH(tpv.u[0] + tpv.u[1], K2); while (h2[id]) { id++; id %= M2; } h2[id] = e; @@ -355,3 +444,7 @@ extern SEXP clearMappingObjectR(SEXP ext, SEXP verboseArg); bool isMixEnc(SEXP x); SEXP enc2UTF8(SEXP x); +void kit_switch_hash(SEXP ans, SEXP x, SEXP values, SEXP outputs, SEXP na, + SEXPTYPE type_x, SEXPTYPE type_o, R_xlen_t len_x, + R_xlen_t len_values, R_xlen_t len_na, int nth, bool nonna, + bool utfcon, SEXP xans, SEXP vans); diff --git a/src/nswitch.c b/src/nswitch.c index c336780..59657b4 100644 --- a/src/nswitch.c +++ b/src/nswitch.c @@ -133,6 +133,42 @@ SEXP nswitchR(SEXP x, SEXP na, SEXP nthreads, SEXP chkenc, SEXP args) { } SEXP ans = PROTECT(allocVector(type0, len_x)); copyMostAttrib(PTR_ETL(args, 1), ans); + if (n > 8 && n <= KIT_SWITCH_HASH_MAX_PAIRS && len_x <= INT_MAX && IS_SWITCH_HASH_TYPE(type_x) && IS_VALID_TYPE(type0)) { + SEXP values = PROTECT(allocVector(type_x, n)); + SEXP outputs = PROTECT(allocVector(VECSXP, n)); + switch (type_x) { + case LGLSXP: { + int *restrict pv = LOGICAL(values); + for (int i = 0; i < n; ++i) pv[i] = LOGICAL(PTR_ETL(args, 2*i))[0]; + } break; + case INTSXP: { + int *restrict pv = INTEGER(values); + for (int i = 0; i < n; ++i) pv[i] = INTEGER(PTR_ETL(args, 2*i))[0]; + } break; + case REALSXP: { + double *restrict pv = REAL(values); + for (int i = 0; i < n; ++i) pv[i] = REAL(PTR_ETL(args, 2*i))[0]; + } break; + case CPLXSXP: { + Rcomplex *restrict pv = COMPLEX(values); + for (int i = 0; i < n; ++i) pv[i] = COMPLEX(PTR_ETL(args, 2*i))[0]; + } break; + case STRSXP: { + for (int i = 0; i < n; ++i) { + SET_STRING_ELT(values, i, + STRING_PTR_RO(utfcon ? vans : PTR_ETL(args, 2*i))[0]); + } + } break; + } + for (int i = 0; i < n; ++i) { + SET_VECTOR_ELT(outputs, i, PTR_ETL(args, 2*i+1)); + } + kit_switch_hash(ans, x, values, outputs, na, type_x, VECSXP, len_x, n, + len_na, nth, nonna, utfcon, xans, vans); + UNPROTECT(2); + UNPROTECT(nprotect + 3); + return ans; + } switch(type0) { /* * This part is for LOGICAL @@ -202,7 +238,7 @@ SEXP nswitchR(SEXP x, SEXP na, SEXP nthreads, SEXP chkenc, SEXP args) { const SEXP *restrict px = STRING_PTR_RO(utfcon ? xans : x); for (ssize_t i = 0; i < n; ++i) { const int *restrict pto = LOGICAL(PTR_ETL(args, 2*i+1)); - const SEXP *restrict pvalues = STRING_PTR_RO(utfcon ? vans : PTR_ETL(args, 2*i)); + const SEXP *restrict pvalues = utfcon ? STRING_PTR_RO(vans) + i : STRING_PTR_RO(PTR_ETL(args, 2*i)); OMP_PARALLEL_FOR(nth) for (ssize_t j = 0; j < len_x; ++j) { if (px[j] == pvalues[0]) { @@ -295,7 +331,7 @@ SEXP nswitchR(SEXP x, SEXP na, SEXP nthreads, SEXP chkenc, SEXP args) { const SEXP *restrict px = STRING_PTR_RO(utfcon ? xans : x); for (ssize_t i = 0; i < n; ++i) { const int *restrict pto = INTEGER(PTR_ETL(args, 2*i+1)); - const SEXP *restrict pvalues = STRING_PTR_RO(utfcon ? vans : PTR_ETL(args, 2*i)); + const SEXP *restrict pvalues = utfcon ? STRING_PTR_RO(vans) + i : STRING_PTR_RO(PTR_ETL(args, 2*i)); OMP_PARALLEL_FOR(nth) for (ssize_t j = 0; j < len_x; ++j) { if (px[j] == pvalues[0]) { @@ -388,7 +424,7 @@ SEXP nswitchR(SEXP x, SEXP na, SEXP nthreads, SEXP chkenc, SEXP args) { const SEXP *restrict px = STRING_PTR_RO(utfcon ? xans : x); for (ssize_t i = 0; i < n; ++i) { const double *restrict pto = REAL(PTR_ETL(args, 2*i+1)); - const SEXP *restrict pvalues = STRING_PTR_RO(utfcon ? vans : PTR_ETL(args, 2*i)); + const SEXP *restrict pvalues = utfcon ? STRING_PTR_RO(vans) + i : STRING_PTR_RO(PTR_ETL(args, 2*i)); OMP_PARALLEL_FOR(nth) for (ssize_t j = 0; j < len_x; ++j) { if (px[j] == pvalues[0]) { @@ -482,7 +518,7 @@ SEXP nswitchR(SEXP x, SEXP na, SEXP nthreads, SEXP chkenc, SEXP args) { const SEXP *restrict px = STRING_PTR_RO(utfcon ? xans : x); for (ssize_t i = 0; i < n; ++i) { const Rcomplex *restrict pto = COMPLEX(PTR_ETL(args, 2*i+1)); - const SEXP *restrict pvalues = STRING_PTR_RO(utfcon ? vans : PTR_ETL(args, 2*i)); + const SEXP *restrict pvalues = utfcon ? STRING_PTR_RO(vans) + i : STRING_PTR_RO(PTR_ETL(args, 2*i)); OMP_PARALLEL_FOR(nth) for (ssize_t j = 0; j < len_x; ++j) { if (px[j] == pvalues[0]) { @@ -569,7 +605,7 @@ SEXP nswitchR(SEXP x, SEXP na, SEXP nthreads, SEXP chkenc, SEXP args) { const SEXP *restrict px = STRING_PTR_RO(utfcon ? xans : x); for (ssize_t i = 0; i < n; ++i) { const SEXP *restrict pto = STRING_PTR_RO(PTR_ETL(args, 2*i+1)); - const SEXP *restrict pvalues = STRING_PTR_RO(utfcon ? vans : PTR_ETL(args, 2*i)); + const SEXP *restrict pvalues = utfcon ? STRING_PTR_RO(vans) + i : STRING_PTR_RO(PTR_ETL(args, 2*i)); for (ssize_t j = 0; j < len_x; ++j) { if (px[j] == pvalues[0]) { SET_STRING_ELT(ans, j, pto[j & amask[i]]); @@ -657,7 +693,7 @@ SEXP nswitchR(SEXP x, SEXP na, SEXP nthreads, SEXP chkenc, SEXP args) { const SEXP *restrict px = STRING_PTR_RO(utfcon ? xans : x); for (ssize_t i = 0; i < n; ++i) { const SEXP *restrict pto = SEXPPTR_RO(PTR_ETL(args, 2*i+1)); - const SEXP *restrict pvalues = STRING_PTR_RO(utfcon ? vans : PTR_ETL(args, 2*i)); + const SEXP *restrict pvalues = utfcon ? STRING_PTR_RO(vans) + i : STRING_PTR_RO(PTR_ETL(args, 2*i)); for (ssize_t j = 0; j < len_x; ++j) { if (px[j] == pvalues[0]) { SET_VECTOR_ELT(ans, j, pto[j & amask[i]]); diff --git a/src/switch_hash.c b/src/switch_hash.c new file mode 100644 index 0000000..9dd1ab6 --- /dev/null +++ b/src/switch_hash.c @@ -0,0 +1,424 @@ +/* + * kit : Useful R Functions Implemented in C + * Copyright (C) 2020-2025 Morgan Jacob + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + */ + +#include "kit.h" +#include + +/* + * Value -> last pair index map for vswitch()/nswitch() when there are many + * values. The value-major fallback compares x against every value; this map + * finds the pair in one probe and then scans x once. + * + * Matching follows the fallback exactly: integer/logical use bit equality (so + * NA matches NA), doubles and complex canonicalise -0 and never match NA/NaN, + * and strings compare CHARSXP identity (so NA_STRING matches itself). + * + * x is processed in blocks so the temporary match indices stay in cache and a + * long input does not need a second full-length allocation. + */ + +#define KIT_SW_BLOCK 4096 + +static inline uint32_t kit_sw_mix32(uint32_t x) { + x ^= x >> 16; + x *= 0x9E3779B1U; + x ^= x >> 13; + return x; +} + +static inline uint32_t kit_sw_mix64(uint64_t x) { + x ^= x >> 33; + x *= 0xff51afd7ed558ccdULL; + x ^= x >> 33; + return (uint32_t)x; +} + +static inline uint64_t kit_sw_bits_dbl(double x) { + union { double d; uint64_t u; } v; + v.d = (x == 0.0) ? 0.0 : x; // -0 == 0 + return v.u; +} + +static inline uint32_t kit_sw_hash_int(int x) { + return kit_sw_mix32((uint32_t)x); +} + +static inline uint32_t kit_sw_hash_dbl(double x) { + return kit_sw_mix64(kit_sw_bits_dbl(x)); +} + +static inline uint32_t kit_sw_hash_cplx(Rcomplex x) { + return kit_sw_mix64(kit_sw_bits_dbl(x.r) ^ + (kit_sw_bits_dbl(x.i) * 0x9E3779B97F4A7C15ULL)); +} + +static inline uint32_t kit_sw_hash_str(SEXP x) { + const uintptr_t p = (uintptr_t)x; + return kit_sw_mix64((uint64_t)p ^ ((uint64_t)p >> 17)); +} + +static inline bool kit_sw_eq_int(int a, int b) { return a == b; } +static inline bool kit_sw_eq_dbl(double a, double b) { + return kit_sw_bits_dbl(a) == kit_sw_bits_dbl(b); +} +static inline bool kit_sw_eq_cplx(Rcomplex a, Rcomplex b) { + return kit_sw_bits_dbl(a.r) == kit_sw_bits_dbl(b.r) && + kit_sw_bits_dbl(a.i) == kit_sw_bits_dbl(b.i); +} +static inline bool kit_sw_eq_str(SEXP a, SEXP b) { return a == b; } + +static inline bool kit_sw_skip_none_int(int x) { (void)x; return false; } +static inline bool kit_sw_skip_none_str(SEXP x) { (void)x; return false; } +static inline bool kit_sw_skip_dbl(double x) { return ISNAN(x); } +static inline bool kit_sw_skip_cplx(Rcomplex x) { return ISNAN(x.r) || ISNAN(x.i); } + +#define KIT_SW_MAP_DEF(TAG, TYPE, HASHFN, EQFN, SKIPFN) \ +static inline void kit_sw_build_##TAG(const TYPE *v, const R_xlen_t m, \ + int *h, const size_t mask) { \ + for (R_xlen_t i = 0; i < m; ++i) { \ + if (SKIPFN(v[i])) continue; \ + size_t id = (size_t)HASHFN(v[i]) & mask; \ + while (h[id] && !EQFN(v[h[id]-1], v[i])) id = (id + 1) & mask; \ + h[id] = (int)i + 1; /* later pairs overwrite earlier ones */ \ + } \ +} \ +static inline int kit_sw_get_##TAG(const TYPE *v, const int *h, \ + const size_t mask, const TYPE x) { \ + if (SKIPFN(x)) return -1; \ + size_t id = (size_t)HASHFN(x) & mask; \ + while (h[id]) { \ + if (EQFN(v[h[id]-1], x)) return h[id]-1; \ + id = (id + 1) & mask; \ + } \ + return -1; \ +} + +KIT_SW_MAP_DEF(lgl, int, kit_sw_hash_int, kit_sw_eq_int, kit_sw_skip_none_int) +KIT_SW_MAP_DEF(int, int, kit_sw_hash_int, kit_sw_eq_int, kit_sw_skip_none_int) +KIT_SW_MAP_DEF(dbl, double, kit_sw_hash_dbl, kit_sw_eq_dbl, kit_sw_skip_dbl) +KIT_SW_MAP_DEF(cplx, Rcomplex, kit_sw_hash_cplx, kit_sw_eq_cplx, kit_sw_skip_cplx) +KIT_SW_MAP_DEF(str, SEXP, kit_sw_hash_str, kit_sw_eq_str, kit_sw_skip_none_str) + +#define KIT_SW_MATCH_DEF(TAG, TYPE) \ +static inline void kit_sw_match_##TAG(const TYPE *px, const TYPE *pv, \ + const int *h, const size_t mask, \ + int *match, const R_xlen_t off, \ + const R_xlen_t len) { \ + for (ssize_t j = 0; j < len; ++j) \ + match[j] = kit_sw_get_##TAG(pv, h, mask, px[off + j]); \ +} + +KIT_SW_MATCH_DEF(lgl, int) +KIT_SW_MATCH_DEF(int, int) +KIT_SW_MATCH_DEF(dbl, double) +KIT_SW_MATCH_DEF(cplx, Rcomplex) +KIT_SW_MATCH_DEF(str, SEXP) + +static inline void kit_sw_write_lgl(int *restrict pans, const int *match, + const R_xlen_t off, const R_xlen_t len, + const int *pna, const ssize_t namask, + int *const *ppo, const ssize_t *amask) { + for (ssize_t j = 0; j < len; ++j) { + const int k = match[j]; + pans[off + j] = k < 0 ? (pna ? pna[(off + j) & namask] : NA_LOGICAL) + : ppo[k][(off + j) & amask[k]]; + } +} + +static inline void kit_sw_write_int(int *restrict pans, const int *match, + const R_xlen_t off, const R_xlen_t len, + const int *pna, const ssize_t namask, + int *const *ppo, const ssize_t *amask) { + for (ssize_t j = 0; j < len; ++j) { + const int k = match[j]; + pans[off + j] = k < 0 ? (pna ? pna[(off + j) & namask] : NA_INTEGER) + : ppo[k][(off + j) & amask[k]]; + } +} + +static inline void kit_sw_write_dbl(double *restrict pans, const int *match, + const R_xlen_t off, const R_xlen_t len, + const double *pna, const ssize_t namask, + double *const *ppo, const ssize_t *amask) { + for (ssize_t j = 0; j < len; ++j) { + const int k = match[j]; + pans[off + j] = k < 0 ? (pna ? pna[(off + j) & namask] : NA_REAL) + : ppo[k][(off + j) & amask[k]]; + } +} + +static inline void kit_sw_write_cplx(Rcomplex *restrict pans, const int *match, + const R_xlen_t off, const R_xlen_t len, + const Rcomplex *pna, const ssize_t namask, + Rcomplex *const *ppo, + const ssize_t *amask) { + Rcomplex na_cplx; + na_cplx.r = NA_REAL; + na_cplx.i = NA_REAL; + for (ssize_t j = 0; j < len; ++j) { + const int k = match[j]; + pans[off + j] = k < 0 ? (pna ? pna[(off + j) & namask] : na_cplx) + : ppo[k][(off + j) & amask[k]]; + } +} + +static inline void kit_sw_write_str(SEXP ans, const int *match, + const R_xlen_t off, const R_xlen_t len, + const SEXP *pna, const ssize_t namask, + const SEXP *const *ppo, + const ssize_t *amask) { + for (ssize_t j = 0; j < len; ++j) { + const int k = match[j]; + SET_STRING_ELT(ans, off + j, + k < 0 ? (pna ? pna[(off + j) & namask] : NA_STRING) + : ppo[k][(off + j) & amask[k]]); + } +} + +static inline void kit_sw_write_vec(SEXP ans, const int *match, + const R_xlen_t off, const R_xlen_t len, + const SEXP *pna, const ssize_t namask, + const SEXP *const *ppo, + const ssize_t *amask) { + for (ssize_t j = 0; j < len; ++j) { + const int k = match[j]; + if (k < 0) { + if (pna) SET_VECTOR_ELT(ans, off + j, pna[(off + j) & namask]); + } else { + SET_VECTOR_ELT(ans, off + j, ppo[k][(off + j) & amask[k]]); + } + } +} + +void kit_switch_hash(SEXP ans, SEXP x, SEXP values, SEXP outputs, SEXP na, + const SEXPTYPE type_x, const SEXPTYPE type_o, + const R_xlen_t len_x, const R_xlen_t len_values, + const R_xlen_t len_na, const int nth, const bool nonna, + const bool utfcon, SEXP xans, SEXP vans) { + const bool list_out = type_o == VECSXP; + const SEXP *po = list_out ? SEXPPTR_RO(outputs) : NULL; + const SEXPTYPE type_ot = list_out ? UTYPEOF(po[0]) : type_o; + const ssize_t namask = len_na > 1 ? SSIZE_MAX : 0; + const SEXP sx = utfcon ? xans : x; + const SEXP sv = utfcon ? vans : values; + const int nth_hash = nth < 1 ? 1 : nth; + const bool serial_out = type_ot == STRSXP || type_ot == VECSXP; + + /* Keep small tables sparse (they still fit in cache) so a miss usually + stops after one probe; large tables stay at a 2x load factor. */ + size_t cap = 256; + const size_t target = (size_t)len_values * (len_values <= 4096 ? 4 : 2); + while (cap < target) cap <<= 1; + const size_t mask = cap - 1; + int *slots = (int*) R_alloc(cap, sizeof(int)); + memset(slots, 0, cap * sizeof(int)); + int *match = (int*) R_alloc((size_t) nth_hash * KIT_SW_BLOCK, sizeof(int)); + + /* Materialise every user data pointer on the main thread before any OpenMP + loop: ALTREP accessors (LOGICAL/INTEGER/.../STRING_PTR_RO) are not + thread-safe and can allocate from R's heap. */ + const int *px_lgl = NULL, *pv_lgl = NULL; + const int *px_int = NULL, *pv_int = NULL; + const double *px_dbl = NULL, *pv_dbl = NULL; + const Rcomplex *px_cplx = NULL, *pv_cplx = NULL; + const SEXP *px_str = NULL, *pv_str = NULL; + switch (type_x) { + case LGLSXP: + px_lgl = LOGICAL(sx); + pv_lgl = LOGICAL(sv); + kit_sw_build_lgl(pv_lgl, len_values, slots, mask); + break; + case INTSXP: + px_int = INTEGER(sx); + pv_int = INTEGER(sv); + kit_sw_build_int(pv_int, len_values, slots, mask); + break; + case REALSXP: + px_dbl = REAL(sx); + pv_dbl = REAL(sv); + kit_sw_build_dbl(pv_dbl, len_values, slots, mask); + break; + case CPLXSXP: + px_cplx = COMPLEX(sx); + pv_cplx = COMPLEX(sv); + kit_sw_build_cplx(pv_cplx, len_values, slots, mask); + break; + case STRSXP: + px_str = STRING_PTR_RO(sx); + pv_str = STRING_PTR_RO(sv); + kit_sw_build_str(pv_str, len_values, slots, mask); + break; + default: // # nocov + error("Type %s is not supported for hashed switch.", type2char(type_x)); // # nocov + } + + /* Output pointers: a list of per-pair outputs, or a vector of pair results. */ + void *ppo_store = NULL; + ssize_t *amask = (ssize_t*) R_alloc((size_t) len_values, sizeof(ssize_t)); + int *pans_lgl = NULL, *pans_int = NULL; + double *pans_dbl = NULL; + Rcomplex *pans_cplx = NULL; + const int *pna_lgl = NULL, *pna_int = NULL; + const double *pna_dbl = NULL; + const Rcomplex *pna_cplx = NULL; + const SEXP *pna_str = NULL, *pna_vec = NULL; + const int *ppo_int = NULL; + const double *ppo_dbl = NULL; + const Rcomplex *ppo_cplx = NULL; + const SEXP *ppo_str = NULL; + switch (type_ot) { + case LGLSXP: + pans_lgl = LOGICAL(ans); + pna_lgl = nonna ? LOGICAL(na) : NULL; + ppo_store = R_alloc((size_t) len_values, sizeof(int*)); + if (list_out) { + for (ssize_t i = 0; i < len_values; ++i) { + ((int**) ppo_store)[i] = LOGICAL(po[i]); + amask[i] = xlength(po[i]) > 1 ? SSIZE_MAX : 0; + } + } else { + ppo_int = LOGICAL(outputs); + for (ssize_t i = 0; i < len_values; ++i) { + ((int**) ppo_store)[i] = (int*) ppo_int + i; + amask[i] = 0; + } + } + break; + case INTSXP: + pans_int = INTEGER(ans); + pna_int = nonna ? INTEGER(na) : NULL; + ppo_store = R_alloc((size_t) len_values, sizeof(int*)); + if (list_out) { + for (ssize_t i = 0; i < len_values; ++i) { + ((int**) ppo_store)[i] = INTEGER(po[i]); + amask[i] = xlength(po[i]) > 1 ? SSIZE_MAX : 0; + } + } else { + ppo_int = INTEGER(outputs); + for (ssize_t i = 0; i < len_values; ++i) { + ((int**) ppo_store)[i] = (int*) ppo_int + i; + amask[i] = 0; + } + } + break; + case REALSXP: + pans_dbl = REAL(ans); + pna_dbl = nonna ? REAL(na) : NULL; + ppo_store = R_alloc((size_t) len_values, sizeof(double*)); + if (list_out) { + for (ssize_t i = 0; i < len_values; ++i) { + ((double**) ppo_store)[i] = REAL(po[i]); + amask[i] = xlength(po[i]) > 1 ? SSIZE_MAX : 0; + } + } else { + ppo_dbl = REAL(outputs); + for (ssize_t i = 0; i < len_values; ++i) { + ((double**) ppo_store)[i] = (double*) ppo_dbl + i; + amask[i] = 0; + } + } + break; + case CPLXSXP: + pans_cplx = COMPLEX(ans); + pna_cplx = nonna ? COMPLEX(na) : NULL; + ppo_store = R_alloc((size_t) len_values, sizeof(Rcomplex*)); + if (list_out) { + for (ssize_t i = 0; i < len_values; ++i) { + ((Rcomplex**) ppo_store)[i] = COMPLEX(po[i]); + amask[i] = xlength(po[i]) > 1 ? SSIZE_MAX : 0; + } + } else { + ppo_cplx = COMPLEX(outputs); + for (ssize_t i = 0; i < len_values; ++i) { + ((Rcomplex**) ppo_store)[i] = (Rcomplex*) ppo_cplx + i; + amask[i] = 0; + } + } + break; + case STRSXP: + pna_str = nonna ? STRING_PTR_RO(na) : NULL; + ppo_store = R_alloc((size_t) len_values, sizeof(SEXP*)); + if (list_out) { + for (ssize_t i = 0; i < len_values; ++i) { + ((const SEXP**) ppo_store)[i] = STRING_PTR_RO(po[i]); + amask[i] = xlength(po[i]) > 1 ? SSIZE_MAX : 0; + } + } else { + ppo_str = STRING_PTR_RO(outputs); + for (ssize_t i = 0; i < len_values; ++i) { + ((const SEXP**) ppo_store)[i] = (const SEXP*) ppo_str + i; + amask[i] = 0; + } + } + break; + case VECSXP: + pna_vec = nonna ? SEXPPTR_RO(na) : NULL; + ppo_store = R_alloc((size_t) len_values, sizeof(SEXP*)); + for (ssize_t i = 0; i < len_values; ++i) { + ((const SEXP**) ppo_store)[i] = SEXPPTR_RO(po[i]); + amask[i] = xlength(po[i]) > 1 ? SSIZE_MAX : 0; + } + break; + default: // # nocov + error("Type %s is not supported for hashed switch output.", // # nocov + type2char(type_ot)); // # nocov + } + + const R_xlen_t nblocks = (len_x + KIT_SW_BLOCK - 1) / KIT_SW_BLOCK; + #define KIT_SW_MATCH_BLOCK() do { \ + switch (type_x) { \ + case LGLSXP: kit_sw_match_lgl(px_lgl, pv_lgl, slots, mask, mb, off, blen); break; \ + case INTSXP: kit_sw_match_int(px_int, pv_int, slots, mask, mb, off, blen); break; \ + case REALSXP: kit_sw_match_dbl(px_dbl, pv_dbl, slots, mask, mb, off, blen); break; \ + case CPLXSXP: kit_sw_match_cplx(px_cplx, pv_cplx, slots, mask, mb, off, blen); break; \ + case STRSXP: kit_sw_match_str(px_str, pv_str, slots, mask, mb, off, blen); break; \ + } \ + } while (0) + + #define KIT_SW_WRITE_BLOCK() do { \ + switch (type_ot) { \ + case LGLSXP: kit_sw_write_lgl(pans_lgl, mb, off, blen, pna_lgl, namask, (int*const*) ppo_store, amask); break; \ + case INTSXP: kit_sw_write_int(pans_int, mb, off, blen, pna_int, namask, (int*const*) ppo_store, amask); break; \ + case REALSXP: kit_sw_write_dbl(pans_dbl, mb, off, blen, pna_dbl, namask, (double*const*) ppo_store, amask); break; \ + case CPLXSXP: kit_sw_write_cplx(pans_cplx, mb, off, blen, pna_cplx, namask, (Rcomplex*const*) ppo_store, amask); break; \ + case STRSXP: kit_sw_write_str(ans, mb, off, blen, pna_str, namask, (const SEXP*const*) ppo_store, amask); break; \ + case VECSXP: kit_sw_write_vec(ans, mb, off, blen, pna_vec, namask, (const SEXP*const*) ppo_store, amask); break; \ + } \ + } while (0) + + if (serial_out) { + for (R_xlen_t b = 0; b < nblocks; ++b) { + const R_xlen_t off = b * KIT_SW_BLOCK; + const R_xlen_t blen = (len_x - off < KIT_SW_BLOCK) ? len_x - off : KIT_SW_BLOCK; + int *mb = match; + KIT_SW_MATCH_BLOCK(); + KIT_SW_WRITE_BLOCK(); + } + } else { + OMP_PARALLEL_FOR(nth_hash) + for (R_xlen_t b = 0; b < nblocks; ++b) { + const R_xlen_t off = b * KIT_SW_BLOCK; + const R_xlen_t blen = (len_x - off < KIT_SW_BLOCK) ? len_x - off : KIT_SW_BLOCK; + int *mb = match + (size_t) omp_get_thread_num() * KIT_SW_BLOCK; + KIT_SW_MATCH_BLOCK(); + KIT_SW_WRITE_BLOCK(); + } + } + #undef KIT_SW_MATCH_BLOCK + #undef KIT_SW_WRITE_BLOCK +} diff --git a/src/utils.c b/src/utils.c index 1bb3c50..9ab838d 100644 --- a/src/utils.c +++ b/src/utils.c @@ -563,7 +563,7 @@ SEXP countOccurR(SEXP x) { // can be improved for factors size_t id = 0; union uno tpv; for (int i = 0; i < n; ++i) { - tpv.d = R_IsNA(px[i]) ? NA_REAL : (R_IsNaN(px[i]) ? R_NaN :px[i]); + tpv.u64 = kit_real_bits(px[i]); id = HASH(tpv.u[0] + tpv.u[1], K); while (h[id]) { if (REQUAL(px[h[id] - 1], px[i])) { @@ -708,11 +708,7 @@ SEXP countOccurDataFrameR(SEXP x) { // move to matrix if possible (change hash a const int *restrict v = INTEGER(mlv); size_t id = 0; for (R_xlen_t i = 0; i < len_i; ++i) { - R_xlen_t key = 0; - for (R_xlen_t j = 0; j < len_x; ++j) { - key ^= HASH(v[i+j*len_i],K)*97*(j+1); - } - id = HASH(key, K); + id = kit_hash_rows_int_raw(v, i, len_i, len_x, K); while (h[id]) { for (R_xlen_t j = 0; j < len_x; ++j) { if (v[h[id]-1+j*len_i] != v[i+j*len_i]) { @@ -828,13 +824,19 @@ SEXP enc2UTF8(SEXP x) { const R_xlen_t len = xlength(x); if (len == 0) return x; // avoid px[0] OOB on empty input const SEXP *px = STRING_PTR_RO(x); - if (getCharCE(px[0]) != CE_UTF8) { - SEXP ans = PROTECT(allocVector(STRSXP, len)); - for (R_xlen_t i = 0; i < len; ++i) { - SET_STRING_ELT(ans, i, mkCharCE(translateCharUTF8(px[i]), CE_UTF8)); + bool all_utf8 = true; + for (R_xlen_t i = 0; i < len; ++i) { + if (px[i] != NA_STRING && getCharCE(px[i]) != CE_UTF8) { + all_utf8 = false; + break; } - UNPROTECT(1); - return ans; } - return x; + if (all_utf8) return x; + SEXP ans = PROTECT(allocVector(STRSXP, len)); + for (R_xlen_t i = 0; i < len; ++i) { + SET_STRING_ELT(ans, i, px[i] == NA_STRING ? NA_STRING : + mkCharCE(translateCharUTF8(px[i]), CE_UTF8)); + } + UNPROTECT(1); + return ans; } diff --git a/src/vswitch.c b/src/vswitch.c index 304adeb..abff7d6 100644 --- a/src/vswitch.c +++ b/src/vswitch.c @@ -182,6 +182,12 @@ SEXP vswitchR(SEXP x, SEXP values, SEXP outputs, SEXP na, SEXP nthreads, SEXP ch } ans = PROTECT(allocVector(type_outputs, len_x)); nprotect++; copyMostAttrib(po[0], ans); + if (len_values > 8 && len_values <= KIT_SWITCH_HASH_MAX_PAIRS && len_x <= INT_MAX && IS_SWITCH_HASH_TYPE(type_x) && IS_VALID_TYPE(type_outputs)) { + kit_switch_hash(ans, x, values, outputs, na, type_x, type_o, len_x, + len_values, len_na, nth, nonna, utfcon, xans, vans); + UNPROTECT(nprotect); + return ans; + } switch(type_outputs) { /* * This part is for LOGICAL @@ -347,6 +353,12 @@ SEXP vswitchR(SEXP x, SEXP values, SEXP outputs, SEXP na, SEXP nthreads, SEXP ch } ans = PROTECT(allocVector(type_o, len_x)); nprotect++; copyMostAttrib(outputs, ans); + if (len_values > 8 && len_values <= KIT_SWITCH_HASH_MAX_PAIRS && len_x <= INT_MAX && IS_SWITCH_HASH_TYPE(type_x) && IS_SWITCH_HASH_TYPE(type_o)) { + kit_switch_hash(ans, x, values, outputs, na, type_x, type_o, len_x, + len_values, len_na, nth, nonna, utfcon, xans, vans); + UNPROTECT(nprotect); + return ans; + } switch(type_o) { /* * This part is for LOGICAL diff --git a/tools/benchmark-core.R b/tools/benchmark-core.R new file mode 100644 index 0000000..d612bdc --- /dev/null +++ b/tools/benchmark-core.R @@ -0,0 +1,128 @@ +# Manual benchmark for the issue #107 hot paths. Not part of the test suite. +# +# Usage: Rscript tools/benchmark-core.R [library] [label] [reps] +# library optional library path to load kit from (e.g. a baseline install) +# label free-form label printed in every row (default "current") +# reps timed repetitions per case (default 5) +# +# Covers 2m/10m elements, 5/20/100 switch values, integer/string/factor/NA +# inputs, data-frame funique/uniqLen, and 1/2/4 threads on the 100-value cases. +# data.table is optional; its reference cases are skipped when unavailable. + +args <- commandArgs(trailingOnly = TRUE) +if (length(args) > 3L) stop("Usage: Rscript tools/benchmark-core.R [library] [label] [reps]") +if (length(args) >= 1L && nzchar(args[[1]])) .libPaths(c(args[[1]], .libPaths())) +label <- if (length(args) >= 2L) args[[2]] else "current" +reps <- if (length(args) >= 3L) as.integer(args[[3]]) else 5L +library(kit) +options(kit.nThread = 1L) +has_dt <- requireNamespace("data.table", quietly = TRUE) + +bench <- function(f) { + invisible(f()) + times <- numeric(reps) + for (i in seq_len(reps)) { + invisible(gc(FALSE)) + times[[i]] <- system.time(f())[["elapsed"]] + } + median(times) +} + +row <- function(case, n, m = NA_integer_, threads = 1L, f) { + cat(sprintf("%s\t%s\t%s\t%d\t%d\t%d\t%.6f\n", + label, case, R.version$platform, n, m, threads, bench(f))) +} + +set.seed(107) +n10 <- 10000000L +base_int <- sample.int(1000L, n10, TRUE) +base_str <- paste0("v", base_int) +base_na <- base_str +base_na[sample.int(n10, n10 %/% 20L)] <- NA_character_ +base_fac <- factor(base_str, levels = paste0("v", 1:1000)) +vals_int <- sample.int(1000L, 100L) +vals_str <- paste0("v", vals_int) +vals_na <- vals_str; vals_na[100L] <- NA_character_ +vals_fac <- factor(vals_str, levels = levels(base_fac)) + +cat(sprintf("# R\t%s\tplatform\t%s\tpackage\t%s\tlabel\t%s\treps\t%d\n", + R.version.string, R.version$platform, + as.character(packageVersion("kit")), label, reps)) + +for (n in c(2000000L, n10)) { + xi <- base_int[seq_len(n)] + xs <- base_str[seq_len(n)] + xn <- base_na[seq_len(n)] + xf <- base_fac[seq_len(n)] + for (m in c(5L, 20L, 100L)) { + out <- seq_len(m) + vi <- vals_int[seq_len(m)] + vs <- vals_str[seq_len(m)] + vn <- vals_na[seq_len(m)] + vf <- vals_fac[seq_len(m)] + stopifnot(length(vswitch(xi, vi, out)) == n, + length(vswitch(xs, vs, out)) == n, + length(vswitch(xn, vn, out)) == n, + length(vswitch(xf, vf, out)) == n) + row("vswitch_int", n, m, f = function() vswitch(xi, vi, out)) + row("vswitch_str", n, m, f = function() vswitch(xs, vs, out)) + row("vswitch_na", n, m, f = function() vswitch(xn, vn, out)) + row("vswitch_factor", n, m, f = function() vswitch(xf, vf, out)) + pairs_i <- unlist(lapply(seq_len(m), function(i) list(vi[i], i)), recursive = FALSE) + pairs_s <- unlist(lapply(seq_len(m), function(i) list(vs[i], i)), recursive = FALSE) + row("nswitch_int", n, m, f = function() { + do.call(nswitch, c(list(xi), pairs_i, list(default = 0L))) + }) + row("nswitch_str", n, m, f = function() { + do.call(nswitch, c(list(xs), pairs_s, list(default = 0L))) + }) + if (has_dt) { + row("ref_chmatch_str", n, m, f = function() data.table::chmatch(xs, vs)) + } + } +} + +for (n in c(2000000L, n10)) { + set.seed(107) + xi <- sample.int(100000L, n, TRUE) + xs <- sprintf("id%06d", sample.int(100000L, n, TRUE)) + xseq <- rep(seq_len(100000L), length.out = n) + df_int <- data.frame(a = xi, b = sample.int(1000L, n, TRUE)) + df_mix <- data.frame(a = xi, b = rnorm(n)) + row("funique_int", n, f = function() funique(xi)) + row("funique_seq_cycle", n, f = function() funique(xseq)) + row("funique_str", n, f = function() funique(xs)) + row("uniqLen_int", n, f = function() uniqLen(xi)) + row("uniqLen_df_int", n, f = function() uniqLen(df_int)) + row("funique_df_int", n, f = function() funique(df_int)) + row("uniqLen_df_mixed", n, f = function() uniqLen(df_mix)) + row("funique_df_mixed", n, f = function() funique(df_mix)) + row("ref_unique_int", n, f = function() length(unique(xi))) + row("ref_unique_df_int", n, f = function() nrow(unique(df_int))) + row("ref_unique_df_mixed", n, f = function() nrow(unique(df_mix))) + if (has_dt) { + row("ref_uniqueN_int", n, f = function() data.table::uniqueN(xi)) + row("ref_uniqueN_df_int", n, f = function() data.table::uniqueN(df_int)) + row("ref_uniqueN_df_mixed", n, f = function() data.table::uniqueN(df_mix)) + } +} + +# Thread scaling on the 100-value cases. +for (n in c(2000000L, n10)) { + xi <- base_int[seq_len(n)] + xs <- base_str[seq_len(n)] + pairs_i <- unlist(lapply(1:100, function(i) list(vals_int[i], i)), recursive = FALSE) + pairs_s <- unlist(lapply(1:100, function(i) list(vals_str[i], i)), recursive = FALSE) + for (th in c(1L, 2L, 4L)) { + row("vswitch_int_100t", n, 100L, th, + function() vswitch(xi, vals_int, 1:100, nThread = th)) + row("vswitch_str_100t", n, 100L, th, + function() vswitch(xs, vals_str, 1:100, nThread = th)) + row("nswitch_int_100t", n, 100L, th, function() { + do.call(nswitch, c(list(xi), pairs_i, list(default = 0L, nThread = th))) + }) + row("nswitch_str_100t", n, 100L, th, function() { + do.call(nswitch, c(list(xs), pairs_s, list(default = 0L, nThread = th))) + }) + } +}