Qual a melhor forma de combinar original e combinar em R?

Question

Muitas vezes escrevi códigos como

#' @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]
}

Para acelerar uma função "pura" vetorizada lenta, em que cada entrada de entrada poderia, teoricamente, ser calculada individualmente e onde se espera que a entrada contenha muitas duplicatas.

Agora eu me pergunto se esta é a melhor maneira de conseguir tal aumento de velocidade ou se há alguma função (de preferência na base R ou no tidyverse) que faz algo parecido uniquee matchao mesmo tempo?

---

Benchmarks até agora

Obrigado pelas respostas fornecidas. Escrevi um pequeno pacote de benchmark para comparar as abordagens:

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)

Atualmente, a abordagem baseada em rcpp é a melhor em todas as configurações testadas em minha máquina, mas mal consegue ultrapassar o método único e depois compatível. Suspeito que quanto maior for a vantagem no desempenho, quanto mais longo xse torna, porque o Unique-então-Match precisa de duas passagens sobre os dados enquanto uniquify()só precisa de uma passagem.

|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

Talvez você possa tentar factor+ as.integercomo abaixo

as.integer(factor(x))

Answer 2

Eu encontrei uma resposta legal e rápida recentemente,

match(data.frame(t(x)), data.frame(t(y)))

Como sempre, tome cuidado ao trabalhar com flutuadores. Eu recomendo algo como

match(data.frame(t(round(x,10))), data.frame(t(round(y))))

em tais casos.

Answer 3

Eu finalmente consegui superar unique()e match()usar Rcppa codificação manual do algoritmo em C ++ usando uma std::unordered_mapestrutura de dados de contabilidade central.

Aqui está o código-fonte, que pode ser usado em R escrevendo-o em um arquivo e executando Rcpp::sourceCppnele.

#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;
  }
  }
}