执行（不平衡）时间序列验证（使用 data.table？）

Question

受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

我需要的第一个测试是每一行的数据是否完整。这个 sn-p 测试是否有任何必需的列是 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 和 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.na 在先前生成的“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 分钟。

我尝试结合 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 秒。它负责加入相关的滞后年份并以一致的方式命名变量（_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）等）

我的问题在这里：

1. 在 ValidateT0 sn-p 中：为什么我的变量没有正确命名，导致我添加了重命名行？
2. 我应该如何提高 ddply 选项的速度，还是应该放弃这些嵌套的 ddply 函数？
3. 如何使用 c(-3, -2, -1) 格式的输入来编写一个测试我的验证规则的 sn-p？或者我如何在新创建的具有滞后值的数据表中有效地引用这些列（由我的函数创建）？

感谢您的帮助，Stackoverflow 在教我如何在没有任何编程知识的情况下进行此类分析方面非常有帮助。

编辑：添加了更真实的数据集。

Answer 1

这是一个利用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”排序，然后按“Year”和setkey。然后，我们为您的每个领先/落后向量调用 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。