受this post的启发，我尝试使用嵌套的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
这段代码虽然难以阅读，但却以直观的方式工作，因为我能够在几行代码中准确指出我需要的东西。它测试每个公司年份是否存在指定时期内的所有行（==长度（期间）部分）并通过！is.na在先前生成的＆＃39; ValidRow＆＃39;中包含有效值。列。
它完全符合我的要求：
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分钟。
我试图整合data.tables的速度，但我对如何做到这一点相对不确定。我定义了以下函数，以便快速将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秒。它负责加入相关的滞后年份，并以一致的方式命名变量（T-1为_Tm1，T + 1为_Tp1等）：
>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）等。）
我的问题在这里：
感谢您的帮助，Stackoverflow在教我如何在没有任何编程知识的情况下进行这些分析方面非常有帮助。
答案 0 :(得分：4)
这是一个利用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")
要构建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"
我们现在可以在i的{{1}}中使用此表达式，并通过引用创建新列data.table，如下所示：
ValidRow评估DT <- as.data.table(dat)
DT[!eval(expr), ValidRow := "OK"]
表达式，然后否定（i），所有这些条目都得到值!。其他条目默认为OK。
现在，我们将使用NA生成所有领先/延迟的年份（默认情况下会提供矩阵），然后使用embed循环通过。您可能需要花一些时间来理解这一部分。
apply我们确保数据按＆＃34; FirmID＆＃34;排序。然后到＆＃34;年＆＃34;与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)
}
。然后，我们为每个超前/滞后向量调用setkey三次。
ff()这给出了：
setkey(DT, FirmID, Year)
DT[, `:=`(bla1 = ff(Year, ValidRow, AcqPeriod),
bla2 = ff(Year, ValidRow, TargetPeriod),
bla3 = ff(Year, ValidRow, LogitPeriod))
, by=FirmID]
})
这似乎比您当前的解决方案快约16倍。我猜你的大数据，你应该有显着的加速。让我知道这需要多长时间..
我无法找到避免# 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
循环的方法。很高兴知道这个对你的实际数据集有多长。
HTH。