使用R中的data.table进行顺序过滤

Question

我的数据如下：

PERMNO date DLSTCD
    10 1983     NA 
    10 1985    250 
    10 1986     NA
    10 1986     NA 
    10 1987    240 
    10 1987     NA  
    11 1984     NA  
    11 1984     NA  
    11 1985     NA  
    11 1987     NA 
    12 1984    240 

我需要根据以下标准过滤行：

1. 对于每个PERMNO ，按date对数据进行排序
2. 在公司被除名后解析排序数据并删除行（即DLSTCD！= NA）
3. 如果第一行对应于公司已退市，则不包括该公司的任何行

根据这些标准，以下是我的预期输出：

PERMNO date DLSTCD
    10 1983     NA 
    10 1985    250 
    11 1984     NA  
    11 1984     NA  
    11 1985     NA  
    11 1987     NA 

我在R中使用data.table来处理这些数据。 上面的示例是我的实际数据的过度简化版本，其中包含对应于30k PERMNO的大约3M行。

我实现了三种不同的方法，如下所示：
r-fiddle： http ：//www.r-fiddle.org/#/fiddle？ id = 4GapqSbX＆version = 3

下面我使用50k行的小数据集来比较我的实现。 这是我的结果：

时间比较

system.time(dt <- filterbydelistingcode(dt))   # 39.962 seconds
system.time(dt <- filterbydelistcoderowindices(dt))   # 39.014 seconds
system.time(dt <- filterbydelistcodeinline(dt))   # 114.3 seconds

正如您所看到的，我的所有实现都非常低效。 有人可以帮我实现更快的版本吗？ 谢谢。

编辑 ：以下是我用于时间比较的50k行样本数据集的链接： https ： //ufile.io/q9d8u

此外，这是这个数据的自定义读取功能：

readdata = function(filename){
    data = read.csv(filename,header=TRUE, colClasses = c(date = "Date"))
    PRCABS = abs(data$PRC)
    mcap = PRCABS * data$SHROUT
    hpr = data$RET
    HPR = as.numeric(levels(hpr))[hpr]
    HPR[HPR==""] = NA
    data = cbind(data,PRCABS,mcap, HPR)
    return(data)
}

data <- readdata('fewdata.csv')
dt <- as.data.table(data)

Answer 1

这是data.table的尝试：

dat[
  dat[order(date),
  {
    pos <- match(TRUE, !is.na(DLSTCD));
    (.I <= .I[pos] & pos != 1) | (is.na(pos)) 
  },
  by=PERMNO]
$V1]

#   PERMNO date DLSTCD
#1:     10 1983     NA
#2:     10 1985    250
#3:     11 1984     NA
#4:     11 1984     NA
#5:     11 1985     NA
#6:     11 1987     NA

测试它在250万行，400000与退市日期：

set.seed(1)
dat <- data.frame(PERMNO=sample(1:22000,2.5e6,replace=TRUE), date=1:2.5e6)
dat$DLSTCD <- NA
dat$DLSTCD[sample(1:2.5e6, 400000)] <- 1
setDT(dat)

system.time({
dat[
  dat[order(date),
  {
    pos <- match(TRUE, !is.na(DLSTCD));
    (.I <= .I[pos] & pos != 1) | (is.na(pos)) 
  },
  by=PERMNO]
$V1]
})
#   user  system elapsed 
#   0.74    0.00    0.76 

不到一秒钟 - 不错。

Answer 2

在@ thelatemail的答案的基础上，以下是同一主题的两个变体。

在这两种情况下， setkey()首先使事情更容易理解：

setkey(dat,PERMNO,date)  # sort by PERMNO, then by date within PERMNO

选项1：从每个组中堆叠所需的数据（如果有）

system.time(
  ans1 <- dat[, {
    w = first(which(!is.na(DLSTCD)))
    if (!length(w)) .SD
    else if (w>1) .SD[seq_len(w)]
  }, keyby=PERMNO]
)
   user  system elapsed 
  2.604   0.000   2.605 

这是非常慢的，因为为每个组分配和填充所有小内存的结果，然后再次将其堆叠成一个结果，需要时间和内存。

选项2 :(更接近你所说的问题的方式）找到要删除的行号，然后删除它们。

system.time({
  todelete <- dat[, {
    w = first(which(!is.na(DLSTCD)))
    if (length(w)) .I[seq.int(from=if (w==1) 1 else w+1, to=.N)]
  }, keyby=PERMNO]

  ans2 <- dat[ -todelete$V1 ]
})
   user  system elapsed 
  0.160   0.000   0.159

这样更快，因为它只是堆叠要删除的行号，然后是一个操作来删除一个批量操作中所需的行。 由于它是按密钥的第一列进行分组，因此它使用密钥使分组更快（组在RAM中是连续的）。

有关?.SD和?.I更多信息，请参见本手册页 。

您可以通过添加对browser()的调用并查看如下内容来检查和调试每个组内发生的事情。

> ans1 <- dat[, {
     browser()
     w = first(which(!is.na(DLSTCD)))
     if (!length(w)) .SD
     else if (w>1) .SD[seq_len(w)]
   }, keyby=PERMNO]
Browse[1]> .SD      # type .SD to look at it
        date DLSTCD
  1:   21679     NA
  2:   46408      1
  3:   68378     NA
  4:   75362     NA
  5:   77690     NA
 ---               
111: 2396559      1
112: 2451629     NA
113: 2461958     NA
114: 2484403     NA
115: 2485217     NA
Browse[1]> w   # doesn't exist yet because browser() before that line
Error: object 'w' not found
Browse[1]> w = first(which(!is.na(DLSTCD)))  # copy and paste line
Browse[1]> w
[1] 2
Browse[1]> if (!length(w)) .SD else if (w>1) .SD[seq_len(w)]
    date DLSTCD
1: 21679     NA
2: 46408      1
Browse[1]> # that is what is returned for this group
Browse[1]> n   # or type n to step to next line
debug at #3: w = first(which(!is.na(DLSTCD)))
Browse[2]> help  # for browser commands

假设您发现某个特定PERMNO存在问题或错误。 您可以按如下方式调用浏览器条件。

> ans1 <- dat[, {
     if (PERMNO==42) browser()
     w = first(which(!is.na(DLSTCD)))
     if (!length(w)) .SD
     else if (w>1) .SD[seq_len(w)]
  }, keyby=PERMNO]
Browse[1]> .SD
        date DLSTCD
  1:   31018     NA
  2:   35803      1
  3:   37494     NA
  4:   50012     NA
  5:   52459     NA
 ---               
128: 2405818     NA
129: 2429995     NA
130: 2455519     NA
131: 2478605      1
132: 2497925     NA
Browse[1]>