受这篇文章的启发，我尝试使用嵌套的ddply语句来验证我的数据集。但是，我遇到了性能问题，代码每次运行(300,000年)都要花费将近一个小时。
这不一定是一个问题(因为我不需要经常重复运行)，但我想知道我如何提高它的性能或做不同的事情来学习它。
我在这里遇到的问题是，我需要根据一些规则来验证一个(不平衡的)时间序列数据集。
示例数据集如下:
dat <- data.frame (
FirmID = c(rep("a",10),rep("b",10),"c",rep("d",10)),
Year = c(rep(c(2000:2004,2006:2010),2),2000,c(2000:2004,2006:2010)),
Random1 = rep("test",31),
Random2 = rep("test2",31),
Assets = rpois(31,3),
Sales = rpois(31,3)
)
dat$Assets[c(1,11)] <- NA
dat$Sales[c(2,11)] <- NA
dat$Assets[21] <- NA
dat$Sales[21] <- NA
我需要的第一个测试是每一行的数据是否完整。下面的代码片段测试所需列中是否有NA，如果所有值都有效，则返回OK:
require(plyr)
RequiredVariables <- c("Assets", "Sales")
ValidateT0 <- ddply(dat, .(FirmID,Year),
function(dat) AnyNA = ifelse(sum(is.na(dat[,names(dat) %in% RequiredVariables]))==0,"OK",NA))
dat <- merge(dat,ValidateT0)
dat <- rename(dat, c("V1"="ValidRow")) # Somehow the variable name was wrong?
dat
返回以下数据集。
FirmID Year Assets Sales ValidRow
1 a 2000 NA 2 <NA>
2 a 2001 1 NA <NA>
3 a 2002 5 3 OK
4 a 2003 5 3 OK
5 a 2004 1 6 OK
6 a 2006 3 4 OK
7 a 2007 3 0 OK
8 a 2008 4 3 OK
9 a 2009 5 3 OK
10 a 2010 3 4 OK
11 b 2000 NA NA <NA>
12 b 2001 4 3 OK
13 b 2002 5 1 OK
14 b 2003 1 4 OK
15 b 2004 4 2 OK
16 b 2006 6 2 OK
17 b 2007 3 3 OK
18 b 2008 2 4 OK
19 b 2009 7 6 OK
20 b 2010 3 5 OK
21 c 2000 NA NA <NA>
22 d 2000 0 2 OK
23 d 2001 4 1 OK
24 d 2002 3 4 OK
25 d 2003 4 0 OK
26 d 2004 3 6 OK
27 d 2006 6 4 OK
28 d 2007 7 0 OK
29 d 2008 6 2 OK
30 d 2009 4 6 OK
31 d 2010 0 1 OK
然后，对于每一年，我指定了三个(相对)时期，我需要这些时期的数据进行单独的分析(我正在研究收购，我需要收购方的T-2、T-1和amp的数据;T+1, T+2等):
AcqPeriod <- c(-2, -1, 1, 2)
TargetPeriod <- c(-3, -2, -1)
LogitPeriod <- c(-2, -1)
现在我想验证，对于每一行，它是否在我的一个分析中可用，这就是嵌套ddply的用途:
ValidatePeriods <- ddply(dat, .(FirmID),
function(datc) adply(datc, 1,
function(x) data.frame(
AsAcquirerOK =
sum(!is.na(subset(datc, Year %in%(x$Year+AcqPeriod))$ValidRow))==length(AcqPeriod),
AsTargetOK =
sum(!is.na(subset(datc, Year %in% (x$Year+TargetPeriod))$ValidRow))==length(TargetPeriod),
AsLogitOK =
sum(!is.na(subset(datc, Year %in% (x$Year+LogitPeriod))$ValidRow))==length(LogitPeriod)
)
)
)
ValidatePeriods
这段代码虽然难以阅读，但却以一种直观的方式工作，因为我能够在几行代码中准确地指定我需要的内容。它对每个公司年份测试指定时间段内的所有行是否存在(==length(period)部分)，并通过!is测试是否包含有效值。
在先前生成的'ValidRow'列上。它返回我所需要的:
FirmID Year Assets Sales ValidRow AsAcquirerOK AsTargetOK AsLogitOK
1 a 2000 NA 6 <NA> FALSE FALSE FALSE
2 a 2001 1 NA <NA> FALSE FALSE FALSE
3 a 2002 3 3 OK FALSE FALSE FALSE
4 a 2003 4 0 OK FALSE FALSE FALSE
5 a 2004 5 3 OK FALSE FALSE TRUE
6 a 2006 1 6 OK FALSE FALSE FALSE
7 a 2007 3 3 OK FALSE FALSE FALSE
8 a 2008 1 2 OK TRUE FALSE TRUE
9 a 2009 1 0 OK FALSE TRUE TRUE
10 a 2010 2 0 OK FALSE TRUE TRUE
11 b 2000 NA NA <NA> FALSE FALSE FALSE
12 b 2001 2 0 OK FALSE FALSE FALSE
13 b 2002 5 2 OK FALSE FALSE FALSE
14 b 2003 4 2 OK FALSE FALSE TRUE
15 b 2004 1 4 OK FALSE TRUE TRUE
16 b 2006 4 3 OK FALSE FALSE FALSE
17 b 2007 3 2 OK FALSE FALSE FALSE
18 b 2008 4 1 OK TRUE FALSE TRUE
19 b 2009 2 2 OK FALSE TRUE TRUE
20 b 2010 3 3 OK FALSE TRUE TRUE
然而，如前所述，该函数在包含300,000年的数据集上花费约52分钟。
我试着合并数据。表的速度，但我相对不确定我应该怎么做。为了快速添加T-1，我定义了以下函数…(_Tm1)或T+1…(_Tp1)列到我的表。:
AddTimeSeriesCols <- function(data=dt, Periods=c(-1), keys=c("FirmID","Year")){
require(data.table)
require(stringr)
dt <- data.table(data)
setkeyv(dt, cols=keys)
dtFinal <- copy(dt) # Duplicate dt to add columns to
for (i in Periods){
StartColumn <- length(names(dt))+1 # First Column to Rename
Tm <- data.table(transform(dt, Year=Year-i)) # Create lagged dataset
setkey(Tm, FirmID,Year) #
dtCurrent<-merge(dt, Tm, by = c("FirmID","Year"), all.x = TRUE) # Join with T-/+x
OldNames <- names(dtCurrent)[StartColumn:length(names(dtCurrent))] # Define old names to change
ifelse(i < 0, middle <- "m",ifelse(i>0,middle <- "p",middle <-"")) # Define middle part in Suffix
Suffix <- paste("_","T",middle,abs(i), sep="") # Define Suffix, Tm1 for T(-1), Tp1 for T(+1)
NewNames <- str_c(str_sub(OldNames,1,-3),Suffix) # Generate new names
setnames(dtCurrent,OldNames, NewNames) # Rename data table
KeepKey <- 1:(length(names(dt))-length(NewNames)) # I only want the lagged values
KeepNew <- StartColumn:length(names(dtCurrent)) # & keys of the original dt when merging
dtCurrent <- dtCurrent[,j=c(KeepKey,KeepNew), with=FALSE] # Data Table with original FirmYear + lagged values
dtFinal <- merge(dtFinal,dtCurrent, by = c("FirmID","Year")) # Append to a separate copy in order to reuse original dataframe.
}
return(dtFinal)
}
它返回一个包含添加的(滞后的)列的数据表，并且在整个(300k行)数据集上运行大约2秒。它负责连接到相关的滞后年份，并以一致的方式命名变量(_Tm1表示T-1， _Tp1表示T+1等):
>AddTimeSeriesCols(data=dat,c(-3, -2, -1))
FirmID Year Assets Sales RowOK Assets_Tm3 Sales_Tm3 RowOK_Tm3 Assets_Tm2 Sales_Tm2 RowOK_Tm2 Assets_Tm1 Sales_Tm1 RowOK_Tm1
1: a 2000 NA 1 NA NA NA NA NA NA NA NA NA NA
2: a 2001 3 NA NA NA NA NA NA NA NA NA 1 NA
3: a 2002 4 3 OK NA NA NA NA 1 NA 3 NA NA
4: a 2003 1 1 OK NA 1 NA 3 NA NA 4 3 OK
5: a 2004 2 0 OK 3 NA NA 4 3 OK 1 1 OK
6: a 2006 5 5 OK 1 1 OK 2 0 OK NA NA NA
7: a 2007 2 4 OK 2 0 OK NA NA NA 5 5 OK
8: a 2008 4 2 OK NA NA NA 5 5 OK 2 4 OK
9: a 2009 2 1 OK 5 5 OK 2 4 OK 4 2 OK
10: a 2010 5 2 OK 2 4 OK 4 2 OK 2 1 OK
11: b 2000 NA NA NA NA NA NA NA NA NA NA NA NA
12: b 2001 3 6 OK NA NA NA NA NA NA NA NA NA
13: b 2002 1 3 OK NA NA NA NA NA NA 3 6 OK
14: b 2003 4 5 OK NA NA NA 3 6 OK 1 3 OK
15: b 2004 0 3 OK 3 6 OK 1 3 OK 4 5 OK
16: b 2006 3 3 OK 4 5 OK 0 3 OK NA NA NA
17: b 2007 2 5 OK 0 3 OK NA NA NA 3 3 OK
18: b 2008 4 3 OK NA NA NA 3 3 OK 2 5 OK
19: b 2009 3 4 OK 3 3 OK 2 5 OK 4 3 OK
20: b 2010 5 1 OK 2 5 OK 4 3 OK 3 4 OK
从技术上讲，这将允许我更快地执行类似的验证，但需要非常不同的验证语法(我必须命名特定的列，而不是放入c(-3， -2， -1)等向量)
我的问题:
- 在ValidateT0代码片段中:为什么我的变量没有正确命名，导致我添加重命名行?
- 我如何提高ddply选项的速度，或者我应该远离这些嵌套的ddply函数?
- 我如何编写一个代码片段来测试我的验证规则，使用c(-3， -2， -1)格式的输入?或者如何在新创建的具有滞后值(由函数创建)的数据表中有效地引用这些列?
谢谢你的帮助，Stackoverflow教我如何在没有任何编程知识的情况下进行这些分析。
编辑:添加了一个更真实的数据集
下面是利用data.table和基函数embed的答案:
数据:
dat <- data.frame (
FirmID = c(rep("a",10),rep("b",10)),
Year = rep(c(2000:2004,2006:2010),2),
Assets = rpois(20,3),
Sales = rpois(20,3)
)
dat$Assets[c(1,11)] <- NA
dat$Sales[c(2,11)] <- NA
RequiredVariables <- c("Assets", "Sales")
步骤1:
要构造ValidRow，我们只需按如下方式构造表达式is.na(Assets) | is.na(Sales):
tmp <- lapply(RequiredVariables,
function(x) as.call(lapply(c("is.na", x), as.name)))
gg <- function(x, y, op=as.name("|")) as.call(list(op,x,y))
expr = tmp[[1L]]
for (i in 2:length(expr))
expr = gg(expr, tmp[[i]])
> expr
# is.na(Assets) | is.na(Sales)
> class(expr)
# [1] "call"
我们现在可以在data.table中使用i中的表达式，并通过引用创建新的列ValidRow，如下所示:
DT <- as.data.table(dat)
DT[!eval(expr), ValidRow := "OK"]
计算i表达式，然后取反(!)，所有这些条目得到值OK。其他条目，默认为NA。
步骤2:
现在，我们将使用embed来生成所有领先/滞后的年份(默认情况下它给出一个矩阵)，然后使用apply来循环。你可能需要花一些时间来理解这部分。
ff <- function(x, p, k) {
min_k = if (min(k) > 0L) 0L else min(k)
max_k = if (max(k) < 0L) 0L else max(k)
len = length(k)
full_range = min_k:max_k
idx = which(!full_range %in% k)
full_years = (min(x)+min_k):(max(x)+max_k)
mat = embed(full_years, length(full_range))
idx = ncol(mat) - idx + 1L
if (length(idx)) mat = mat[mat[, idx] %in% x, , drop=FALSE][, -(idx), drop=FALSE]
apply(mat, 1, function(mm) sum(!is.na(p[x %in% mm])) == len)
}
我们确保数据按"FirmID"排序，然后按setkey的"Year"排序。然后，我们为每个领先/滞后向量调用ff()三次。
setkey(DT, FirmID, Year)
DT[, `:=`(bla1 = ff(Year, ValidRow, AcqPeriod),
bla2 = ff(Year, ValidRow, TargetPeriod),
bla3 = ff(Year, ValidRow, LogitPeriod))
, by=FirmID]
})
这给:
# FirmID Year Assets Sales ValidRow bla1 bla2 bla3
# 1: a 2000 NA 3 NA FALSE FALSE FALSE
# 2: a 2001 0 NA NA FALSE FALSE FALSE
# 3: a 2002 4 1 OK FALSE FALSE FALSE
# 4: a 2003 1 7 OK FALSE FALSE FALSE
# 5: a 2004 2 2 OK FALSE FALSE TRUE
# 6: a 2006 3 3 OK FALSE FALSE FALSE
# 7: a 2007 3 5 OK FALSE FALSE FALSE
# 8: a 2008 1 4 OK TRUE FALSE TRUE
# 9: a 2009 4 6 OK FALSE TRUE TRUE
# 10: a 2010 2 1 OK FALSE TRUE TRUE
# 11: b 2000 NA NA NA FALSE FALSE FALSE
# 12: b 2001 2 3 OK FALSE FALSE FALSE
# 13: b 2002 4 5 OK FALSE FALSE FALSE
# 14: b 2003 2 2 OK FALSE FALSE TRUE
# 15: b 2004 4 6 OK FALSE TRUE TRUE
# 16: b 2006 2 3 OK FALSE FALSE FALSE
# 17: b 2007 3 8 OK FALSE FALSE FALSE
# 18: b 2008 2 3 OK TRUE FALSE TRUE
# 19: b 2009 1 4 OK FALSE TRUE TRUE
# 20: b 2010 2 1 OK FALSE TRUE TRUE
这似乎比你目前的解决方案快16倍。我猜你的大数据，你应该有显著的加速。让我知道这需要多长时间…
我找不到避免apply循环的方法。如果能知道这个在你的实际数据集上花了多长时间就好了。
HTH .