从R中的一组观测值创建频率向量的矢量化方式？

时间：2015-02-19 17:59:22

标签： c++ r

问题

我有一个观察的矢量及其出现年份，我想在更长的时间内创建一个频率矢量，以便进行曲线拟合。我可以使用函数轻松完成此操作，但是有一个更简单的方法或使用固有向量化的方法吗？可能是我忘记了一些简单的事情。

可重复的例子

数据

Events <- data.frame(c(1991, 1991, 1995, 1999, 2007, 2007, 2010, 2010, 2010, 2014), seq(1100, 2000, 100))
names(Events) <- c("Year", "Loss")
Period <- seq(1990, 2014)

功能

FreqV <- function(Period, Observations){
  n <- length(Period)
  F <- double(n)
  for(i in seq_len(n)) {
    F[i] = sum(Observations == Period[i])
  }
  return(F)
}

预期结果

FreqV(Period, Events$Year)
 [1] 0 2 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 2 0 0 3 0 0 0 1

验收后更新

令我困扰的是为什么C ++版本的算法（参见接受的答案中的评论）要慢得多，我终于意识到原因是它是FreqV以上的天真翻译。如果有n个周期和m个事件，则必须进行n * m次计算。即使在C ++中，这也很慢。

Tabulate可能设置为执行一次通过算法，当我在C ++中编写简单的一次通过算法时，它比表格式 5-8 快一倍：

NaïveC++代码

// [[Rcpp::export]]
std::vector<int> FV_C(std::vector<int> P, std::vector<int> O) {
  int n = P.size();
  std::vector<int> F(n);
  for (int i = 0; i < n; ++i){
    F[i] = std::count(O.begin(), O.end(), P[i]);
  }
  return(F);
}

一次通过C ++代码

// [[Rcpp::export]]
std::vector<int> FV_C2(std::vector<int> P, std::vector<int> O) {
  int n = P.size();
  int m = O.size();
  int MinP = *std::min_element(P.begin(), P.end());
  std::vector<int> F(n, 0);
  for (int i = 0; i < m; ++i){
    int offset = O[i] - MinP;
    F[offset] +=  1;
  }
  return(F);
}

速度测试

在i7-2600K上进行的测试超频至4.6Ghz，使用16GB内存，使用Windows 7 64位，R-3.1.2使用OpenBLAS 2.13编译。

set.seed(1)
vals <- sample(sample(10000, 100), 100000, TRUE)
period <- 1:10000

f1a <- function() tabulate(factor(vals, period), nbins = length(period))
f1b <- function() tabulate((vals-period[1])+1, nbins = length(period))
f2 <- function() unname(table(c(period, vals))-1)

library(microbenchmark)

all.equal(f1a(), f1b(), f2(), FV_C(period, vals), FV_C2(period, vals))
[1] TRUE

microbenchmark(f1a(), f1b(), f2(), FV_C(period, vals), FV_C2(period, vals), times = 100L)

Unit: microseconds
                expr        min          lq       mean     median          uq        max neval
               f1a()  26998.194  27812.6250  29515.375  28167.645  28703.4515  55456.079   100
               f1b()    640.049    712.4235   1291.356    800.136   1522.0890  27814.561   100
                f2()  34228.449  35746.6655  39686.660  36210.395  36768.3900  65295.374   100
  FV_C(period, vals) 647577.794 647927.3040 648729.027 648221.417 648848.5090 659463.813   100
 FV_C2(period, vals)    140.877    147.7270    169.085    158.449    170.3625   1095.738   100

3 个答案:

答案 0 :(得分：4)

我建议factor和table或tabulate。

此处tabulate：

tabulate(factor(Events$Year, Period))
#  [1] 0 2 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 2 0 0 3 0 0 0 1

执行以下操作可能会更快：

tabulate((Events$Year-Period[1])+1)

对于这两种情况，您应该指定nbins，（nbins = length(Period)），以防＆＃34; Events $ Year＆＃34;小于＆＃34;期间＆＃34;。

中的最大值

以下是效果比较：

set.seed(1)
vals <- sample(sample(10000, 100), 100000, TRUE)
period <- 1:10000

f1a <- function() tabulate(factor(vals, period), nbins = length(period))
f1b <- function() tabulate((vals-period[1])+1, nbins = length(period))
f2 <- function() unname(table(c(period, vals))-1)

library(microbenchmark)
microbenchmark(f1a(), f1b(), f2())
# Unit: microseconds
#   expr       min        lq      mean    median         uq       max neval
#  f1a() 41784.904 43665.394 46789.753 44278.093  45654.546  95032.59   100
#  f1b()   884.465  1162.254  2261.118  1275.154   2756.922  46641.87   100
#   f2() 54837.666 57615.562 71386.516 58863.272 100893.389 130235.33   100

答案 1 :(得分：2)

你可以尝试

colSums(Vectorize(function(x) x==Events$Year)(Period))
#[1] 0 2 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 2 0 0 3 0 0 0 1

或者

colSums(outer(Events$Year, Period, FUN=function(x,y) x==y))
#[1] 0 2 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 2 0 0 3 0 0 0 1

或使用data.table 

library(data.table)
CJ(Period, Events$Year)[, V3:=V1][, sum(V1==V2), V3]$V1
#[1] 0 2 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 2 0 0 3 0 0 0 1

或者如果订购

 c(0,diff(findInterval(Period,Events$Year)))
 #[1] 0 2 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 2 0 0 3 0 0 0 1

或使用tabulate与fmatch

的组合 
 library(fastmatch)
 tabulate(fmatch(Events$Year, Period), nbins=length(Period))
 #[1] 0 2 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 2 0 0 3 0 0 0 1

答案 2 :(得分：2)

您可以使用table解决此问题：

table(c(Period,Events$Year))-1

# 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 
#    0    2    0    0    0    1    0    0    0    1    0    0    0    0    0    0    0    2    0    0 
# 2010 2011 2012 2013 2014 
#    3    0    0    0    1

要删除名称，请使用：

unname(table(c(Period,Events$Year))-1)
# [1] 0 2 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 2 0 0 3 0 0 0 1
相关问题
最新问题