将列的值扩展到数据框中值之前的 n 行和之后的 m 行

Question

我有一个代表不同时间序列的

data.frame

。我在一栏中标记了有趣的时间点（注意：每个Id可以有多个有趣的时间点）：

身份证	时间	价值	有趣
1	0	12	0
1	1	14	0
1	2	11	0
1	3	12	1
1	4	13	0
1	5	14	0
1	6	12	0
1	7	12	0
..	..	..	..
78	128	13

现在，我也想标记之前的

n

时间点和之后的

m

时间点作为一个有趣的块。所以如果

n = 2

和

m = 3

我会期待这个：

身份证	时间	价值	有趣	块
1	0	12	0	0
1	1	14	0	1
1	2	11	0	1
1	3	12	1	1
1	4	13	0	1
1	5	14	0	1
1	6	12	0	1
1	7	12	0	0
..	..	..	..	..
78	128	13	0	0

此刻，我使用一个

gaussianSmooth()

和一个阈值：

df %>% mutate(Block = ifelse(gaussianSmooth(Interesting, sigma = 4) > 0.001, 1, 0))

但这是繁琐的工作，只有在

n = m

的情况下才有效。是否有一个“更简单”的解决方案，我可以轻松地设置应该更改之前和之后的行数。

dplyr

/

tidyverse

.

中更可取的解决方案

Answer 1

我会创建一个自定义函数

before_and_after()

，它创建虚拟变量然后采用

rowSums

.

下面我使用

dplyover::over()

作为虚拟变量（免责声明：我是维护者），但你也可以使用其他包。

library(dplyr)
library(dplyover)

before_and_after <- function(x, bef, aft) {
  tbl <- tibble(x = x)
  tbl <- mutate(tbl,
                over(seq_len(bef),
                     ~ lead(x, n = .x, default = 0),
                     .names = "bef_{x}"
                     ),
                over(seq_len(aft),
                     ~ lag(x, n = .x, default = 0),
                     .names = "aft_{x}"
                )
                )
  rowSums(tbl)
}

dat %>%   
  mutate(Block = before_and_after(Interesting,
                                  bef = 1,
                                  aft = 2),
         .by = Id)

#> # A tibble: 8 x 5
#>      Id  Time Value Interesting Block
#>   <dbl> <dbl> <dbl>       <dbl> <dbl>
#> 1     1     0    12           0     0
#> 2     1     1    14           0     0
#> 3     1     2    11           0     1
#> 4     1     3    12           1     1
#> 5     1     4    13           0     1
#> 6     1     5    14           0     1
#> 7     1     6    12           0     0
#> 8     1     7    12           0     0

来自 OP 的数据

dat <- tribble(~Id, ~ Time, ~Value, ~Interesting, 
   1   , 0    ,12    , 0           ,
   1   , 1    ,14    , 0           ,
   1   , 2    ,11    , 0           ,
   1   , 3    ,12    , 1           ,
   1   , 4    ,13    , 0           ,
   1   , 5    ,14    , 0           ,
   1   , 6    ,12    , 0           ,
   1   , 7    ,12    , 0
   )

^{创建于 2023-03-02 由 reprex 包 (v2.0.1)}

Answer 2

使用

group_modify

（也适用于多个

Interesting

值）。获取你喜欢的索引：这里是

Interesting == 1

时的位置，然后迭代用

1

（

max(0, i - n):min(nrow(.x), i + m)

）替换周围的值。

library(dplyr)
n = 2
m = 3

df %>% 
  group_by(Id) %>% 
  group_modify(~ {
    idx <- which(.x$Interesting == 1)
    for(i in idx){
      .x$Interesting[max(0, i - n):min(nrow(.x), i + m)] <- 1
    }
    .x
  })

# A tibble: 8 × 4
# Groups:   Id [1]
     Id  Time Value Interesting
  <int> <int> <int>       <dbl>
1     1     0    12           0
2     1     1    14           1
3     1     2    11           1
4     1     3    12           1
5     1     4    13           1
6     1     5    14           1
7     1     6    12           1
8     1     7    12           0

Answer 3

我们可以先设置

row_number

，然后

group_by

Id

列。在第二个

mutate

中，我们使用

sapply

迭代来查找感兴趣的行号范围，并在新的

Block

列中将这些行设置为 1。

library(tidyverse)

n = 2
m = 3

df %>% 
  mutate(rn = row_number()) %>% 
  group_by(Id) %>% 
  mutate(rn = row_number(), 
         Block = ifelse(rn %in% 
                          c(sapply(1:length(which(df$Interesting == 1)), \(x) 
                                   (which(df$Interesting == 1) - n)[x]:(which(df$Interesting == 1) + m)[x])), 
                        1, 
                        0)) %>% 
  select(-rn)

# A tibble: 8 × 5
# Groups:   Id [1]
     Id  Time Value Interesting Block
  <int> <int> <int>       <int> <dbl>
1     1     0    12           0     0
2     1     1    14           0     1
3     1     2    11           0     1
4     1     3    12           1     1
5     1     4    13           0     1
6     1     5    14           0     1
7     1     6    12           0     1
8     1     7    12           0     0