Определите строки до и после события

Question

Я хочу присвоить номера трем дням до события (от -3 до -1), дню события (0) и трем дням после события (от 1 до 3).

Пример данных:

da1 <- data.frame(day = c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22), event = c(0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0))

da1
   day event
1    1     0
2    2     0
3    3     0
4    4     0
5    5     0
6    6     0
7    7     0
8    8     1
9    9     0
10  10     0
11  11     0
12  12     0
13  13     0
14  14     0
15  15     0
16  16     0
17  17     1
18  18     0
19  19     0
20  20     0
21  21     0
22  22     0

Я хочу создать новый идентификатор переменной, чтобы он выглядел так:

da2 <- data.frame(day = c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22), event = c(0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0), identifier= c(0,0,0,0,-3,-2,-1,0,1,2,3,0,0,-3,-2,-1,0,1,2,3,0,0))

da2
   day event identifier
1    1     0          0
2    2     0          0
3    3     0          0
4    4     0          0
5    5     0         -3
6    6     0         -2
7    7     0         -1
8    8     1          0
9    9     0          1
10  10     0          2
11  11     0          3
12  12     0          0
13  13     0          0
14  14     0         -3
15  15     0         -2
16  16     0         -1
17  17     1          0
18  18     0          1
19  19     0          2
20  20     0          3
21  21     0          0
22  22     0          0

Answer 1

Вот базовое решение R

r <- rep(0,nrow(da1))
da2 <- within(da1,identifier <- replace(r,sapply(which(event==1), `+`, -3:3),-3:3))

# or the line below
# da2 <- within(da1,identifier <- rowSums(sapply(which(event==1),function(x) replace(r,x + (-3:3), -3:3))))

такое, что

> da2
   day event identifier
1    1     0          0
2    2     0          0
3    3     0          0
4    4     0          0
5    5     0         -3
6    6     0         -2
7    7     0         -1
8    8     1          0
9    9     0          1
10  10     0          2
11  11     0          3
12  12     0          0
13  13     0          0
14  14     0         -3
15  15     0         -2
16  16     0         -1
17  17     1          0
18  18     0          1
19  19     0          2
20  20     0          3
21  21     0          0
22  22     0          0

Answer 2

Я думаю, что это будет работать с Tidyverse. Хотя, если есть перекрывающиеся периоды 7 дней:

library('tidyverse')
events = da1 %>% 
  filter(event == 1)

expand_event = function(day){
  tibble(identifier = -3:3,
         day = day + identifier)
}

da1 = events[['day']] %>% 
  lapply(expand_event) %>% 
  bind_rows() %>% 
  right_join(da1) %>% 
  mutate(identifier = replace_na(identifier, 0))

Answer 3

Вот один из способов в базе R:

da1$identifier <- 0
inds <- which(da1$event == 1)
da1$identifier[c(sapply(inds, `+`, -3:3))] <- -3:3

da1
#   day event identifier
#1    1     0          0
#2    2     0          0
#3    3     0          0
#4    4     0          0
#5    5     0         -3
#6    6     0         -2
#7    7     0         -1
#8    8     1          0
#9    9     0          1
#10  10     0          2
#11  11     0          3
#12  12     0          0
#13  13     0          0
#14  14     0         -3
#15  15     0         -2
#16  16     0         -1
#17  17     1          0
#18  18     0          1
#19  19     0          2
#20  20     0          3
#21  21     0          0
#22  22     0          0