Performance 按名称添加矢量元素的快速函数

我编写了这个

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
}

---

add_vectors使用编译器包编译成字节码会给您带来一些改进。此包装随附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)))

库（编译器）
图书馆（微基准）
添加向量\u cmp我认为你不会得到太多的加速。我在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

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

我不知道如何在
Rcpp
中使用
..
参数（以及如何迭代），因此我将此函数封装在一个简单的
R
函数中

解决方案
请注意，此解决方案使用
STL
libs。
我不知道这是一个写得好的C++解决方案还是一个更有效的解决方案可以写（也许），但肯定是一个好的（和工作的）起点。
使用示例

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

因此，现在的最后一个目标是使用
Rcpp
直接删除
R
包装函数来管理
..
（或类似的，例如
List
）参数

我认为这是可能的，因为
Rcpp
sugar具有与之类似的功能（例如
sapply
函数的移植），但希望得到一些反馈。
我会使用类似的功能：

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

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]])
}

库（data.table）
添加向量5你的向量有多大？这还不够快吗<代码>TAPLY（c（v1，v2），因子（c（名称（v1），名称（v2）），级别=联合（名称（v1），名称（v2）），总和）
或此：
未列出（lapply（拆分（c（v1，v2）），名称（c（v1，v2））），总和）
。尽管我怀疑第一种方法在大向量上比使用
split
@Arun更快，但感谢你的解决方案，我已经在短向量上做了一个基准测试，你的解决方案大约慢2-3倍（可能大向量的结果会相反）。OP函数假设每个向量的名称都是唯一的，你的没有。因此，大向量的结果会有所不同。@Roland:名称必须唯一这一事实并不是主要要求，而是速度要求。；）我知道
编译器
包和相关的，但这不是我要找的。无论如何，谢谢！=）非常感谢Romain Francois提供的更干净（更完整）的解决方案。还感谢您对
..
参数和
CDR
函数的说明。使用
列表（…）
将创建所有输入的副本，这可能是一个沉重的性能代价。一种更复杂的方法（但不需要.External）是传递函数环境和未赋值的参数名。很好。也许值得在属性中支持
.External
接口
add_vectors_2 <- function(...) {
  Reduce(function(x, y) add_vectors_cpp(x, y), list(...))
}

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

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

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

#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(...) )
}

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

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]])
}

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)]))
}