如何在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]
}

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

现在我想知道这是否是实现这种加速的最佳方式，或者是否有一些函数（最好是在基本R或tidyverse中）同时执行诸如唯一和匹配之类的操作？

谢谢你提供的答案。我编写了一个小型基准测试套件来比较这些方法：

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

我终于设法击败独特（）和匹配（）使用Rcpp在C中使用std::unordered_map作为核心簿记数据结构手工编码算法。

以下是源代码，可以通过将其写入文件并在其上运行Rcpp:：sourceCpp在R中使用。

#include <Rcpp.h>
using namespace Rcpp;

template <int T>
List uniquify_impl(Vector<T> x) {
  IntegerVector idxes(x.length());
  typedef typename Rcpp::traits::storage_type<T>::type storage_t;
  std::unordered_map<storage_t, int> unique_map;
  int n_unique = 0;
  // 1. Pass through x once
  for (int i = 0; i < x.length(); i++) {
    storage_t curr = x[i];
    int idx = unique_map[curr];
    if (idx == 0) {
      unique_map[curr] = ++n_unique;
      idx = n_unique;
    }
    idxes[i] = idx;
  }
  // 2. Sort unique_map by its key
  Vector<T> uniques(unique_map.size());
  for (auto &pair : unique_map) {
    uniques[pair.second - 1] = pair.first;
  }
  
  return List::create(
    _["u"] = uniques,
    _["i"] = idxes
  );
}

// [[Rcpp::export]]
List uniquify(RObject x) {
  switch (TYPEOF(x)) {
  case INTSXP: {
    return uniquify_impl(as<IntegerVector>(x));
  }
  case REALSXP: {
    return uniquify_impl(as<NumericVector>(x));
  }
  case STRSXP: {
    return uniquify_impl(as<CharacterVector>(x));
  }
  default: {
    warning(
      "Invalid SEXPTYPE %d (%s).\n",
      TYPEOF(x), type2name(x)
    );
    return R_NilValue;
  }
  }
}

Answer 2

我最近找到了一个冷静、快速的答案，

匹配（数据帧（t（x）），数据。帧（t（y）））

和往常一样，使用浮动时要小心。我推荐这样的东西

匹配（data.frame（t（round（x，10））），数据。框架（t（圆形（y）））

在这种情况下。

Answer 3

也许你可以试着把factor当作。整数如下所示

as.integer(factor(x))