r - 如何在 R 中最好地结合独特和匹配？

Question

我发现自己经常写这样的代码

#' @param x input vector
#' @param ... passed to [slow_fun()]
fast_fun <- function(x, ...) {
  u <- unique(x)
  i <- match(x, u)
  v <- slow_fun(u, ...)
  v[i]
}

加速一个缓慢的矢量化“纯”函数，其中每个输入条目理论上可以单独计算，并且输入预计包含许多重复项。

现在我想知道这是否是实现这种加速的最佳方式，或者是否有一些函数(最好是在 base R 或 tidyverse 中)执行类似 unique 和 match同时？

---

到目前为止的基准

感谢您提供的答案。我编写了一个小型基准套件来比较这些方法:

method <- list(
  brute = slow_fun,
  unique_match = function(x, ...) {
    u <- unique(x)
    i <- match(x, u)
    v <- slow_fun(u, ...)
    v[i]
  },
  unique_factor = function(x, ...) {
    if (is.character(x)) {
      x <- factor(x)
      i <- as.integer(x)
      u <- levels(x)
    } else {
      u <- unique(x)
      i <- as.integer(factor(x, levels = u))
    }
    v <- slow_fun(u, ...)
    v[i]
  },
  unique_match_df = function(x, ...) {
    u <- unique(x)
    i <- if (is.numeric(x)) {
      match(data.frame(t(round(x, 10))), data.frame(t(round(u, 10))))
    } else {
      match(data.frame(t(x)), data.frame(t(u)))
    }
    v <- slow_fun(u, ...)
    v[i]
  },
  rcpp_uniquify = function(x, ...) {
    iu <- uniquify(x)
    v <- slow_fun(iu[["u"]], ...)
    v[iu[["i"]]]
  }
)

exprs <- lapply(method, function(fun) substitute(fun(x), list(fun = fun)))

settings$bench <- lapply(seq_len(nrow(settings)), function(i) {
  cat("\rBenchmark ", i, " / ", nrow(settings), sep = "")
  x <- switch(
    settings$type[i],
    integer = sample.int(
      n = settings$n_distinct[i],
      size = settings$n_total[i],
      replace = TRUE
    ),
    double = sample(
      x = runif(n = settings$n_distinct[i]),
      size = settings$n_total[i],
      replace = TRUE
    ),
    character = sample(
      x = stringi::stri_rand_strings(
        n = settings$n_distinct[i],
        length = 20L
      ),
      size = settings$n_total[i],
      replace = TRUE
    )
  )
  microbenchmark::microbenchmark(
    list = exprs
  )
})

library(tidyverse)
settings %>%
  mutate(
    bench = map(bench, summary)
  ) %>%
  unnest(bench) %>%
  group_by(n_distinct, n_total, type) %>%
  mutate(score = median / min(median)) %>%
  group_by(expr) %>%
  summarise(mean_score = mean(score)) %>%
  arrange(mean_score)

目前，基于 rcpp 的方法在我的机器上的所有测试设置中是最好的，但勉强超过先唯一后匹配方法。我怀疑 x 越长，性能优势就越大，因为 unique-then-match 需要对数据进行两次传递，而 uniquify() 只需要一次传递。

|expr            | mean_score|
|:---------------|----------:|
|rcpp_uniquify   |   1.018550|
|unique_match    |   1.027154|
|unique_factor   |   5.024102|
|unique_match_df |  36.613970|
|brute           |  45.106015|

Answer 1

也许你可以像下面这样尝试 factor + as.integer

as.integer(factor(x))