我有一个观察的矢量及其出现年份，我想在更长的时间内创建一个频率矢量，以便进行曲线拟合。我可以使用函数轻松完成此操作，但是有一个更简单的方法或使用固有向量化的方法吗？可能是我忘记了一些简单的事情。
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 快一倍：
// [[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);
}
// [[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
答案 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