1id <- function(.variables, drop = FALSE) {
2  if (length(.variables) == 0) {
3    n <- nrow(.variables) %||% 0L
4    return(structure(seq_len(n), n = n))
5  }
6
7  # Special case for single variable
8  if (length(.variables) == 1) {
9    return(id_var(.variables[[1]], drop = drop))
10  }
11
12  # Calculate individual ids
13  ids <- rev(map(.variables, id_var, drop = drop))
14  p <- length(ids)
15
16  # Calculate dimensions
17  ndistinct <- map_dbl(ids, attr, "n")
18  n <- prod(ndistinct)
19  if (n > 2 ^ 31) {
20    # Too big for integers, have to use strings, which will be much slower :(
21
22    char_id <- do.call("paste", c(ids, sep = "\r"))
23    res <- match(char_id, unique(char_id))
24  } else {
25    combs <- c(1, cumprod(ndistinct[-p]))
26
27    mat <- do.call("cbind", ids)
28    res <- c((mat - 1L) %*% combs + 1L)
29  }
30  attr(res, "n") <- n
31
32
33  if (drop) {
34    id_var(res, drop = TRUE)
35  } else {
36    structure(as.integer(res), n = attr(res, "n"))
37  }
38}
39
40id_var <- function(x, drop = FALSE) {
41  if (!is_null(attr(x, "n", exact = TRUE)) && !drop) return(x)
42
43  if (is.factor(x) && !drop) {
44    x_na <- addNA(x, ifany = TRUE)
45    id <- as.integer(x_na)
46    n <- length(levels(x_na))
47  } else if (length(x) == 0) {
48    id <- integer()
49    n <- 0L
50  } else if (is_list(x)) {
51    # Sorting lists isn't supported
52    levels <- unique(x)
53    id <- match(x, levels)
54    n <- max(id)
55  } else {
56    levels <- sort(unique(x), na.last = TRUE)
57    id <- match(x, levels)
58    n <- max(id)
59  }
60  structure(id, n = n)
61}
62