r data.table构建自定义的滚动求和函数



我目前正在处理R中的一个数据集,该数据集看起来有点像以下(除了数百万个pid和观测值(:

id  agedays  diar
1    1        1
1    2        0
1    3        1
1    4        1
1    5        0
1    6        0
1    7        NA
1    8        1
1    9        1
1    10       1
3    2        0
3    5        0
3    6        0
3    8        1
3    9        1
4    1        0
4    4        NA
4    5        0
4    6        1
4    7        0

我需要在日记中创建一个基于年龄日值增量的滚动和。我想创建一个变量,为每行数据保留5天的diar总和。该变量将被称为diar_prev5。数据集应如下所示:

id  agedays  diar  diar_prev5
1    1        1      NA
1    2        0      NA
1    3        1      NA
1    4        1      NA
1    5        0      3
1    6        0      2
1    7        NA     2
1    8        1      2
1    9        1      2
1    10       1      3
3    2        0      NA
3    5        0      0
3    6        0      0
3    8        1      1
3    9        1      2
4    1        0      NA
4    4       NA      NA
4    5        0      0
4    6        1      1
4    7        0      1

如上所示,滚动和应包括当前agedays值,如果当前行和4天后之间的某些值包含NA值,则滚动和应忽略这些值,并仍然计算其间的obs.(如果有(。我尝试了roll_sum和rollsum函数来实现这个请求,但发现如果agedays列包含间隙,该函数就不起作用。当出现间隙时,滚动和将只包含NA值,而不是计算间隙之间的值。这些函数似乎也没有在滚动和计算中包含agedays的现值,所以我以前不得不返回并手动添加它。

我之前使用的与roll_sum相关的代码不起作用,如下所示:

DT[, diar_prev5 := roll_sum(lag(diar, 1L), n=4L, fill=NA, align = "right"), by=id]

我现在的问题是,我如何创建一个自定义函数来实现上述目标,该函数将在计算中包含diar的当前值,并且不会出现agedays值的差距问题?

我尝试了以下操作,但变量的结果只有0,而且似乎无法正常工作:

f = function(id_input, ageday_input) { 
  startday = ageday_input
  endday = ageday_input- 13
  sum((MPC_anthro %>% filter(id == id_input & agedays <= startday & startday <= endday))$diar) }
f = Vectorize(f)
MPC_anthro_1<-MPC_anthro %>% mutate(diar_prev5 = f(id, agedays))

使用重叠间隔而不是填充缺失值的data.table解决方案:

DT[  ,.(id,start=agedays-4L,stop=agedays,agedays,diar)][
   DT,on=.(id=id,stop >= agedays,start <= agedays),.(id,agedays,diar),allow.cartesian=T][
     ,.(diar_prev5 = sum(diar,na.rm=T)),by = .(id,agedays)][
     ,.(id,agedays, diar_prev5 = ifelse(agedays>=5,diar_prev5,NA))]
   id agedays diar_prev5
 1:  1       1         NA
 2:  1       2         NA
 3:  1       3         NA
 4:  1       4         NA
 5:  1       5          3
 6:  1       6          2
 7:  1       7          2
 8:  1       8          2
 9:  1       9          2
10:  1      10          3
11:  3       2         NA
12:  3       5          0
13:  3       6          0
14:  3       8          1
15:  3       9          2
16:  4       1         NA
17:  4       4         NA
18:  4       5          0
19:  4       6          1
20:  4       7          1

逻辑可以通过分别运行前两个步骤来更好地解释:

DT[  ,.(id,start=agedays-4L,stop=agedays,agedays,diar)][
  DT,on=.(id=id,stop >= agedays,start <= agedays),.(id,x.start,x.stop,x.agedays,i.agedays,diar),allow.cartesian=T][order(id,x.start,i.agedays)]
    id x.start x.stop x.agedays agedays i.agedays diar
 1:  1      -3      1         1       1         1    1
 2:  1      -2      2         2       2         1    0
 3:  1      -2      2         2       2         2    0
 4:  1      -1      3         3       3         1    1
 5:  1      -1      3         3       3         2    1
 6:  1      -1      3         3       3         3    1
 7:  1       0      4         4       4         1    1
 8:  1       0      4         4       4         2    1
 9:  1       0      4         4       4         3    1
10:  1       0      4         4       4         4    1
11:  1       1      5         5       5         1    0
12:  1       1      5         5       5         2    0
13:  1       1      5         5       5         3    0
14:  1       1      5         5       5         4    0
15:  1       1      5         5       5         5    0
  1. 我们创建了一个观察窗口[start = agedays-4,stop = agedays]
  2. 我们将表连接到观察窗口,以便对于每个ageday,我们在观察窗口中获得所有i.agedaysdiar
    data.table连接中,如果右侧存在相同的名称,则来自连接左侧的术语将以x.为前缀。右侧的术语以.i为前缀
  3. 接下来的步骤只是将每个ageday的观察窗口中的所有行相加

我怀疑data.table应该能够快速填充缺失的agedays,即使对于大型数据集也是如此。因此,我构建了一个有一百万行的,并尝试了"按组填充缺失日期"中所示的方法。

在@Henrik给出的链接中,你会发现他也给出了这个链接。

library(data.table)
set.seed(2345)
DT <- data.table(
 id=rep(1:100000,each=10),
 agedays=unlist(lapply(1:100000,function(x) sort(sample(1:13,10,replace=FALSE)))),
 diar=sample(c(0,1,NA),1e6,replace=TRUE)
 )
 
 DT1 <- DT[,.(agedays=1:max(agedays)),by=.(id)]
 DT1[,diar:=NA_integer_][DT,diar:=i.diar,on=c("id","agedays")]
 
 DT1[,diar_prev5 := frollsum(diar,5,na.rm=TRUE),by=id]
 DT2 <- DT1[DT,.(id,agedays,diar,diar_prev5),on=c("id","agedays")]
  
 head(DT2,25)

给出

        id agedays diar diar_prev5
 1:  1       1    0         NA
 2:  1       2   NA         NA
 3:  1       3    0         NA
 4:  1       4    1         NA
 5:  1       7    1          2
 6:  1       8    1          3
 7:  1      10   NA          2
 8:  1      11    1          3
 9:  1      12   NA          2
10:  1      13    1          2
11:  2       1    1         NA
12:  2       3   NA         NA
13:  2       4    0         NA
14:  2       5    0          1
15:  2       6   NA          0
16:  2       7    1          1
17:  2       8    1          2
18:  2       9   NA          2
19:  2      10    1          3
20:  2      12    1          3
21:  3       2    1         NA
22:  3       3   NA         NA
23:  3       4   NA         NA
24:  3       6    1          2
25:  3       7    0          1
    id agedays diar diar_prev5

跑步没花太长时间。这就是你要找的吗?

这里有另一个使用滚动连接的选项:

n <- 5L
DT[, c("ndaysago", "val") := .(agedays - n + 1L, fcoalesce(diar, 0L))]
DT[, cs := cumsum(val), id]
DT[, diar_prev := DT[DT, on=.(id, agedays=ndaysago), roll=-n, i.cs - x.cs + x.val]]
DT[agedays - n < 0L, diar_prev := NA_integer_]

输出:

    id agedays diar diar_prev5 ndaysago val cs diar_prev
 1:  1       1    1         NA       -3   1  1        NA
 2:  1       2    0         NA       -2   0  1        NA
 3:  1       3    1         NA       -1   1  2        NA
 4:  1       4    1         NA        0   1  3        NA
 5:  1       5    0          3        1   0  3         3
 6:  1       6    0          2        2   0  3         2
 7:  1       7   NA          2        3   0  3         2
 8:  1       8    1          2        4   1  4         2
 9:  1       9    1          2        5   1  5         2
10:  1      10    1          3        6   1  6         3
11:  3       2    0         NA       -2   0  0        NA
12:  3       5    0          0        1   0  0         0
13:  3       6    0          0        2   0  0         0
14:  3       8    1          1        4   1  1         1
15:  3       9    1          2        5   1  2         2
16:  4       1    0         NA       -3   0  0        NA
17:  4       4   NA         NA        0   0  0        NA
18:  4       5    0          0        1   0  0         0
19:  4       6    1          1        2   1  1         1
20:  4       7    0          1        3   0  1         1
21:  5       1    1         NA       -3   1  1        NA
22:  5       6    2          2        2   2  3         2
23:  5      10    3          5        6   3  6         5
24:  5      15    4          4       11   4 10         4
    id agedays diar diar_prev5 ndaysago val cs diar_prev

多了一个id的数据:

DT <- fread("id  agedays  diar  diar_prev5
1    1        1      NA
1    2        0      NA
1    3        1      NA
1    4        1      NA
1    5        0      3
1    6        0      2
1    7        NA     2
1    8        1      2
1    9        1      2
1    10       1      3
3    2        0      NA
3    5        0      0
3    6        0      0
3    8        1      1
3    9        1      2
4    1        0      NA
4    4       NA      NA
4    5        0      0
4    6        1      1
4    7        0      1
5 1 1 NA
5 6 2 2
5 10 3 5
5 15 4 4")

有兴趣了解实际数据集的运行时。

最新更新