创建事件变量的时间和时间

Question

我正在处理如下所示的面板数据：

d <- data.frame(id = c("a", "a", "a", "a", "a", "b", "b", "b", "b", "b", "c", "c", "c", "c", "c"),
                time = c(1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5),
                iz = c(0,1, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1))
   id time iz
1   a    1  0
2   a    2  1
3   a    3  1
4   a    4  0
5   a    5  0
6   b    1  0
7   b    2  0
8   b    3  0
9   b    4  0
10  b    5  1
11  c    1  0
12  c    2  0
13  c    3  0
14  c    4  1
15  c    5  1

这里 iz 是事件或治疗的指标 (iz = 1)。我需要的是一个变量，它计算事件前后的时间段或事件的距离。这个变量看起来像这样：

  id time iz nvar
1   a    1  0   -1
2   a    2  1    0
3   a    3  1    0
4   a    4  0    1
5   a    5  0    2
6   b    1  0   -4
7   b    2  0   -3
8   b    3  0   -2
9   b    4  0   -1
10  b    5  1    0
11  c    1  0   -1
12  c    2  0   -2
13  c    3  0   -3
14  c    4  1    0
15  c    5  1    0

我尝试使用here 和here 给出的答案，但在我的情况下无法使用。

我非常感谢任何解决此问题的想法。提前感谢您的所有想法和建议。

Answer 1

dplyr 和 purrr 选项可以是：

d %>%
 group_by(id) %>%
 mutate(nvar = map_dbl(.x = seq_along(iz), ~ min(abs(.x - which(iz == 1)))),
        nvar = if_else(cumsum(iz) == 0, -nvar, nvar))

   id     time    iz  nvar
   <fct> <dbl> <dbl> <dbl>
 1 a         1     0    -1
 2 a         2     1     0
 3 a         3     1     0
 4 a         4     0     1
 5 a         5     0     2
 6 b         1     0    -4
 7 b         2     0    -3
 8 b         3     0    -2
 9 b         4     0    -1
10 b         5     1     0
11 c         1     0    -3
12 c         2     0    -2
13 c         3     0    -1
14 c         4     1     0
15 c         5     1     0

Answer 2

1) rleid 此代码将 data.table 中的rleid 应用于每个 id，然后如果产生 1 的运行，则生成负反向序列，否则生成正向序列，即我们假设除了第一次运行之前，应该使用正向序列。对于iz 中的 1，将其归零。一个 id 中可以有任意数量的运行，它还支持只有 0 或只有 1 的 id。它假定时间没有间隔。

library(data.table)

Seq <- function(x, s = seq_along(x)) if (x[1] == 1) -rev(s) else s
nvar <- function(iz, r = rleid(iz)) ave((1-iz) * r, r, FUN = Seq)
transform(d, nvar = (1-iz) * ave(iz, id, FUN = nvar))

给予：

   id time iz nvar
1   a    1  0   -1
2   a    2  1    0
3   a    3  1    0
4   a    4  0    1
5   a    5  0    2
6   b    1  0   -4
7   b    2  0   -3
8   b    3  0   -2
9   b    4  0   -1
10  b    5  1    0
11  c    1  0   -3
12  c    2  0   -2
13  c    3  0   -1
14  c    4  1    0
15  c    5  1    0

2) base 此代码仅使用 base R。它假定每个 id 最多有一次运行。是否有零没有限制。它还支持时间间隔。它将nvar 应用于每个id 的行号。首先，它计算时间的范围rng，然后计算nvar 最后一行的有符号距离。输出与 (1) 中所示的相同。如果我们可以假设每个 id 都恰好有一个 1，则可以省略 if 语句。

nvar <- function(ix) with(d[ix, ], {
  if (all(iz == 0)) return(iz)
  rng <- range(time[iz == 1])
  (time < rng[1]) * (time - rng[1]) + (time > rng[2]) * (time - rng[2])
})
transform(d, nvar = ave(1:nrow(d), id, FUN = nvar))

2a) (2) 的这种变体将 time 和 iz 传递给 nvar，通过将它们编码为复向量的实部和虚部，以避免不得不处理行数字，但在其他方面与 (2) 相同。我们在 (2) 中省略了 if 语句，但如果任何 id 都没有，则可以将其添加回来。

nvar <- function(x, time = Re(x), iz = Im(x), rng = range(time[iz == 1])) 
  (time < rng[1]) * (time - rng[1]) + (time > rng[2]) * (time - rng[2])
transform(d, nvar = Re(ave(time + iz * 1i, id, FUN = nvar)))

Answer 3

这是一个比 G.Grothendieck 的解决方案稍微复杂一点的解决方案。但是将能够处理非连续时间。

library( data.table )
#make d a data.table
setDT(d)

#you can remove the trailing [], they are just for passing the output to the console...
#nvar = 0 where iz = 1
d[ iz == 1, nvar := 0 ][]
#calculate nvar for iz == 0 BEFORE iz == 1, using a forward rolling join
#create subsets for redability
d1 <- d[ iz == 1, ]
d0 <- d[ iz == 0, ]
d[ iz == 0, nvar := time - d1[ d0, x.time, on = .(id, time), roll = -Inf ] ][]
#calculate nvar for iz == 0 AFTER iz == 1, usning a backward rolling join
#create subsets for redability
d1 <- d[ iz == 1, ]
d0 <- d[ iz == 0 & is.na( nvar ), ]
d[ iz == 0 & is.na(nvar) , nvar := time - d1[ d0, x.time, on = .(id, time), roll = Inf ] ][]

#     id time iz nvar
#  1:  a    1  0   -1
#  2:  a    2  1    0
#  3:  a    3  1    0
#  4:  a    4  0    1
#  5:  a    5  0    2
#  6:  b    1  0   -4
#  7:  b    2  0   -3
#  8:  b    3  0   -2
#  9:  b    4  0   -1
# 10:  b    5  1    0
# 11:  c    1  0   -3
# 12:  c    2  0   -2
# 13:  c    3  0   -1
# 14:  c    4  1    0
# 15:  c    5  1    0