快速功能，按名称添加矢量元素

时间：2013-04-02 13:44:18

标签： performance r vector rcpp

我编写了这个R函数，给定任意数量的向量（...），通过根据名称对各个元素值求和来组合它们。

add_vectors <- function(...) {
  a <- list(...)
  nms <- sort(unique(unlist(lapply(a, names))))
  out <- numeric(length(nms))
  names(out) <- nms
  for (v in a) out[names(v)] <- out[names(v)] + v

  out
}

示例：

v1 <- c(a=2,b=3,e=4)
v2 <- c(b=1,c=6,d=0,a=4)
add_vectors(v1, v2)
#
a b c d e 
6 4 6 0 4

我正在尝试编写快得多的等效函数。

不幸的是，目前我不知道如何在R中实现这一点，所以我想到Rcpp。 但是，为了转换Rcpp这个函数，我想念一些概念：

  1. 如何管理...参数。 List中的参数Rcpp？
  2. 如何迭代...参数中的向量。
  3. 如何按名称访问（然后求和）向量的元素（这在R中非常简单，但我无法想象如何在Rcpp中完成）。

    4. 所以我正在寻找可以帮助我提高此功能的性能的人（在R或Rcpp或两者中）。

    感谢任何帮助，谢谢。

5 个答案:

答案 0 :(得分：6)

我会用这样的东西：

#include <Rcpp.h>
using namespace Rcpp; 

// [[Rcpp::export]]
NumericVector add_all(List vectors){
    RCPP_UNORDERED_MAP<std::string,double> out ; 
    int n = vectors.size() ;
    for( int i=0; i<n; i++){
        NumericVector x = vectors[i] ;
        CharacterVector names = x.attr("names") ;
        int m = x.size() ;

        for( int j=0; j<m; j++){
            String name = names[j] ;
            out[ name ] += x[j] ;   
        }
    }
    return wrap(out) ;
}

使用以下包装器：

add_vectors_cpp <- function(...){
    add_all( list(...) )
}

RCPP_UNORDERED_MAP只是unordered_map的typedef，可能在std::或std::tr1::中，具体取决于您的编译器等...

这里的诀窍是使用经典...从list(...)创建常规列表。

如果您真的想直接在C ++中传递...并在内部处理它，则必须使用.External接口。这很少使用，因此Rcpp属性不支持.External接口。

使用.External，它看起来像这样（未经测试）：

SEXP add_vectors(SEXP args){
    RCPP_UNORDERED_MAP<std::string,double> out ; 
    args = CDR(args) ;
    while( args != R_NilValue ){
        NumericVector x = CAR(args) ;

        CharacterVector names = x.attr("names") ;
        int m = x.size() ;

        for( int j=0; j<m; j++){
            String name = names[j] ;
            out[ name ] += x[j] ;   
        }        
        args = CDR(args) ;
    }   
    return wrap(out) ;
}

答案 1 :(得分：3)

使用编译器包编译为字节码可以带来一些改进。该软件包附带R。

library(compiler)
library(microbenchmark)

add_vectors_cmp <- cmpfun(add_vectors)

set.seed(1)
v <- rpois(length(letters), 10)
names(v) <- letters
vs <- replicate(150, v, simplify=FALSE)

not_compiled <- function(l) do.call(add_vectors, l)
compiled <- function(l) do.call(add_vectors_cmp, l)

plot(microbenchmark(not_compiled(vs), compiled(vs)))

enter image description here

答案 2 :(得分：3)

我刚刚在Rcpp中写了这个函数的二进制版本（2输入）。

我不知道如何在...中使用Rcpp参数（以及如何迭代它），所以我将这个函数封装在一个简单的R函数中。 / p>

解

library(Rcpp)
cppFunction(
  code = '
  NumericVector add_vectors_cpp(NumericVector v1, NumericVector v2) {
    // merging names, sorting them and removing duplicates
    std::vector<std::string> nms1 = v1.names();
    std::vector<std::string> nms2 = v2.names();
    std::vector<std::string> nms;
    nms.resize(nms1.size() + nms2.size());
    std::merge(nms1.begin(), nms1.end(), nms2.begin(), nms2.end(), nms.begin());
    std::sort(nms.begin(), nms.end());
    nms.erase(std::unique(nms.begin(), nms.end()), nms.end());
    // summing vector elements by their names and storing them in an associative data structure
    int num_names = nms.size();
    std::tr1::unordered_map<std::string, double> map(num_names);
    for (std::vector<int>::size_type i1 = 0; i1 != nms1.size(); i1++) {
        map[nms1[i1]] += v1[i1];
    }
    for (std::vector<int>::size_type i2 = 0; i2 != nms2.size(); i2++) {
        map[nms2[i2]] += v2[i2];
    }
    // extracting map values (to use as result vector) and keys (to use as result vector names)
    NumericVector vals(map.size());
    for (unsigned r = 0; r < num_names; ++r) {
        vals[r] = map[nms[r]];
    }
    vals.names() = nms;
    return vals;
  }',
  includes = '
  #include <vector>
  #include <tr1/unordered_map>
  #include <algorithm>'
)

然后在R函数中封装：

add_vectors_2 <- function(...) {
  Reduce(function(x, y) add_vectors_cpp(x, y), list(...))
}

请注意，此解决方案使用STL库。 我不知道这是否是一个编写良好的C ++ 解决方案，或者是否可以编写更有效的解决方案（可能），但肯定这是一个很好的（并且正常工作）起点。

使用示例

v1 <- c(b = 1, d = 2, c = 3, a = 4, e = 6, f = 5)
v2 <- c(d = 2, c = 3, a = 4, e = 6, f = 5)
add_vectors(v1, v2, v1, v2)
#  a  b  c  d  e  f 
# 16  2 12  8 24 20
add_vectors_2(v1, v2, v1, v2)
#  a  b  c  d  e  f 
# 16  2 12  8 24 20

注意：此功能也适用于名称不是唯一的矢量。

v1 <- c(b = 1, d = 2, c = 3, a = 4, e = 6, f = 5)
v2 <- c(d = 2, c = 3, a = 4, e = 6, f = 5, f = 10, a = 12)
add_vectors(v1, v2)
#  a  b  c  d  e  f 
# 16  1  6  4 12 15 
add_vectors_2(v1, v2)
#  a  b  c  d  e  f 
# 20  1  6  4 12 20

如上一个例子所示，即使输入向量具有非唯一名称，对具有相同名称的相同向量的元素进行求和，此解决方案仍然有效。

基准

在最简单的情况下（两个向量），我的解决方案比R解决方案快3倍。这是一个很好的改进，但可能有更好的C++解决方案进一步小改进的余地。

Unit: microseconds
                 expr    min     lq median      uq     max neval
  add_vectors(v1, v2) 65.460 68.569 70.913 73.5205 614.274   100
add_vectors_2(v1, v2) 20.743 23.389 25.142 26.9920 337.544   100

enter image description here

将此函数应用于更多向量时，性能会降低一点（仅快2倍）。

Unit: microseconds
                                 expr     min       lq  median       uq     max neval
  add_vectors(v1, v2, v1, v2, v1, v1) 105.994 195.7565 205.174 212.5745 993.756   100
add_vectors_2(v1, v2, v1, v2, v1, v1)  66.168 125.2110 135.060 139.7725 666.975   100

所以现在的最后一个目标是删除R 包装函数，直接用{{1}管理...（或类似的List）参数}}

我认为这是可能的，因为Rcpp糖具有与它类似的功能（例如Rcpp函数的移植），但会感激一些反馈。

答案 3 :(得分：3)

data.table包非常适合执行聚合和其他操作。我不是真正的专家，但是

library(data.table)
add_vectors5 <- function(...)
{
    vals <- do.call(c, list(...))
    dt <- data.table(nm=names(vals), v=vals, key="nm")
    dt <- dt[,sum(v), by=nm]
    setNames(dt[[2]], dt[[1]])
}

似乎比其他纯R实现快约2倍。更加神秘的实现是

add_vectors6 <- function(..., method="radix")
{
    vals <- do.call(c, list(...))
    ## order by name, but use integers for faster order algo
    idx <- match(names(vals), unique(names(vals)))
    o <- sort.list(idx, method=method, na.last=NA)

    ## cummulative sum of ordered values
    csum <- cumsum(vals[o])

    ## subset where ordering factor changes, and then diff
    idxo <- idx[o]
    diff(c(0, csum[idxo != c(idxo[-1], TRUE)]))
}

容易出现数字溢出;如果名称少于100,000，则使用method =“radix”，如?sort.list所示，否则method =“quick”。

答案 4 :(得分：1)

我不认为你会获得更多的加速。我在R代码中采用了另一种方法，将所有输入组合到一个向量中，然后按名称重新分割，并与vapply聚合。或多或少所有函数都称为内部C代码，速度与大型向量的函数相当（在长度为1e5和1e6的向量上测试）。对于3或4个元素的玩具示例，它会慢一些。

add_vectors2 <- function(...) {
  y <- do.call(c, unname(list(...)))
  vapply(split(y, names(y)), sum, numeric(1))
}

#Longer sample vectors
m <- 1e3
n <- 1e6
v1 <- sample(m, n, replace = TRUE)
names(v1) <- sample(n)
v2 <- sample(m, n, replace = TRUE)
names(v2) <- sample(seq_len(n) + n / 2)  

#Timings
k <- 20
system.time(for(i in 1:k) add_vectors(v1, v2))   #5 or 6 seconds
system.time(for(i in 1:k) add_vectors2(v1, v2))  #same
编辑：修改的矢量名称是唯一的，反映了罗兰的评论。我的解决方案现在比OP慢一点。

相关问题
最新问题