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

我需要根据以下条件过滤行：

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

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

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中是连续的）。

可以在this manual page上找到关于?.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]>

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

2 个答案: