滚动中的条件和 window

Conditional sum in rolling window

我是 R 的新手,如果我说错了,请提前致歉:)

我有一个由 395 行和 4973 列组成的数据框,按月排序,许多公司每月出现的次数(范围从 0 到 25)。发生次数是根据按月和年分组的每日数据总结的。 我的数据框 df 看起来像那样(只有几个月和 3 家公司):

Date     FirmA FirmB FirmC
01-2015  20    NA    20
02-2015  21    2     1
03-2015  22    3     2
04-2015  24    7     5
05-2015  10    10    10
06-2015  9     20    2
07-2015  13    22    1
08-2015  20    19    1

我现在的任务是从 t-3 到 t-1(前 3 个月)的三个月滚动 window 来总结每家公司发生的事件。但是,总和应满足以下条件。它应该在三个月 window 期间至少出现 10 次,在 t-1 月至少出现 3 次。 NA在t-3and/ort-2无所谓,只要满足两个条件即可。

应该是这样的。

Date     FirmA FirmB FirmC
01-2015  NA    NA    NA
02-2015  20    NA    20
03-2015  41    NA    NA
04-2015  63    NA    NA
05-2015  67    12    NA
06-2015  56    20    17
07-2015  43    37    NA
08-2015  32    52    NA

我不知道如何解决这个问题,尤其是滚动组合 window/sum(可能有延迟)以及关于使用和不使用哪些数字的条件。

这是一个使用zoo::rollapply的方法:

df <- structure(list(Date = c("01-2015", "02-2015", "03-2015", "04-2015", 
"05-2015", "06-2015", "07-2015", "08-2015"), FirmA = c(20L, 21L, 
22L, 24L, 10L, 9L, 13L, 20L), FirmB = c(NA, 2L, 3L, 7L, 10L, 
20L, 22L, 19L), FirmC = c(20L, 1L, 2L, 5L, 10L, 2L, 1L, 1L)), .Names = c("Date", 
"FirmA", "FirmB", "FirmC"), class = "data.frame", row.names = c(NA, 
-8L))

library(zoo)

mysum <- function(x, minprev = 3) {
  l <- length(x)
  if (l==1 || (! is.na(x[l-1]) && x[l-1] >= minprev)) sum(x[-l], na.rm = TRUE) else NA
}

winsize <- 3
# conditionally-sum
df[-1] <- lapply(df[-1], function(z) rollapply(z, winsize + 1, mysum, partial = TRUE, align = "right"))
# remove those that are insufficient in total
df[-1] <- lapply(df[-1], function(z) ifelse(z <= 10, NA, z))
df
#      Date FirmA FirmB FirmC
# 1 01-2015    NA    NA    NA
# 2 02-2015    20    NA    20
# 3 03-2015    41    NA    NA
# 4 04-2015    63    NA    NA
# 5 05-2015    67    12    NA
# 6 06-2015    56    20    17
# 7 07-2015    43    37    NA
# 8 08-2015    32    52    NA

可能有一种方法不需要 mysum,但有两点让它变得有点棘手:(1) 结果总和进入 next 字段(更多如果 window 的长度始终为 3) 和 (2) 最后一个值的条件,则很容易回避。尝试平滑它当然是可行的,但这已经足够了。

另一种方法,在概念上类似于 r2evans',是通过 cumsum 计算滚动总和(在将 NAs 替换为 0s 之后)并插入 NAs 不满足条件时:

ff = function(x, w = 3, ntot = 10, nlast = 3)
{
    x[is.na(x)] = 0L
    x = c(0L, x[-length(x)])

    cs = cumsum(x)
    wcs = cs - c(numeric(w), cs[1:(length(x) - w)])

    wcs[!((wcs >= ntot) & (x >= nlast))] = NA
    return(wcs)

}

sapply(df[-1], ff)  # 'df' borrowed from r2evans' answer
#     FirmA FirmB FirmC
#[1,]    NA    NA    NA
#[2,]    20    NA    20
#[3,]    41    NA    NA
#[4,]    63    NA    NA
#[5,]    67    12    NA
#[6,]    56    20    17
#[7,]    43    37    NA
#[8,]    32    52    NA