(R) 如何从 slide_index() 的窗口中排除每个当前行的值？

Question

您好，我正在使用 slide_index() 为数据帧中的每一行捕获时间窗口中的值。但是，对于每一行，我还将比较当前行的值与该行窗口的捕获值。我使用的部分逻辑要求在每行迭代期间从捕获的值中排除当前行的值。

我认为有两种方法可以解决这个问题：1. 我可以将当​​前行的值直接传递到我在 slide_index(.f) 中使用的自定义函数逻辑中，或者 2. 我可以排除当前行的为该行的滑动窗口捕获的值中的值。第一条路线我找不到任何资源，所以我想知道第二条路线是否可行。

library(slider)
x <- c(rep(1:16))
i <- as.Date("2019-08-15") + c(0:15)
slide_index(x, i, ~.x, .before = 2, .after = 2)

例如，当 x = 2 时，在第二次迭代中关闭 slide_index() 输出上方的可重现代码将是：[1] 1 2 3 4。但我希望输出仅返回 [1 ] 1 3 4，或者获取一种将当前 x 值读入我将传递给 slide_index(.f) 的自定义函数的方法

编辑： group_by 的第二个示例

library(slider)
library(tidyverse)
x <- c(10, 12, 12, 14, 11, 22, 25, 25, 33, 31, 34, 36, 23, 24, 29, 13)
y <- c(10, 12, 12, 14, 11, 22, 25, 25, 33, 31, 34, 36, 23, 24, 29, 13)
group <- c(rep(as.character('A'), 5), rep(as.character('B'), 4), rep(as.character('C'), 1), rep(as.character('D'), 6))

df <- data.frame(group, x, y, dates) %>%
  mutate(group = as.factor(group))

df %>% 
  group_by(group) %>%
  do(mutate(., result = slide_index(.x = ., .i = .$dates, ~median(.$y), .before = 2, .after = 2) 
            %>% unlist()
                             ) 
            )

我也试过了，但是没用

df %>% 
  group_by(group) %>%
  do(mutate(., result = max(map2(slide_index(.x = seq_along(.), .i = .$dates, .f = ~.$y, .before = 2, .after = 2), seq_along(.), ~.[setdiff(.x, .y)] )
                             )
            )
     )

Answer 1

如果有重复，则使用值序列进行索引，然后使用map2 删除该索引并获取相应的值

library(purrr)
library(slider)
i1 <- seq_along(x)
map2(slide_index(i1, i, ~.x, .before = 2, .after = 2),
            i1,  ~ x[setdiff(.x, .y)])

-输出

[[1]]
[1] 2 2

[[2]]
[1] 1 2 4

[[3]]
[1] 1 2 4 5

[[4]]
[1] 2 2 5 6

[[5]]
[1] 2 4 6 7

[[6]]
[1] 4 5 7 8

[[7]]
[1] 5 6 8 9

[[8]]
[1]  6  7  9 10

[[9]]
[1]  7  8 10 11

[[10]]
[1]  8  9 11 12

[[11]]
[1]  9 10 12 13

[[12]]
[1] 10 11 13 14

[[13]]
[1] 11 12 14 15

[[14]]
[1] 12 13 15 16

[[15]]
[1] 13 14 16

[[16]]
[1] 14 15

更新

如果有分组数据，那么我们进行分组操作，创建list列

dates <- i
df %>% 
   group_by(group) %>%
   mutate(new = map2(slide_index(row_number(), dates, ~ .x, 
         .before = 2, .after = 2), row_number(), ~ x[setdiff(.x, .y)])) %>%
   ungroup
# A tibble: 16 x 5
#   group     x     y dates      new      
#   <fct> <dbl> <dbl> <date>     <list>   
# 1 A        10    10 2019-08-15 <dbl [2]>
# 2 A        12    12 2019-08-16 <dbl [3]>
# 3 A        12    12 2019-08-17 <dbl [4]>
# 4 A        14    14 2019-08-18 <dbl [3]>
# 5 A        11    11 2019-08-19 <dbl [2]>
# 6 B        22    22 2019-08-20 <dbl [2]>
# 7 B        25    25 2019-08-21 <dbl [3]>
# 8 B        25    25 2019-08-22 <dbl [3]>
# 9 B        33    33 2019-08-23 <dbl [2]>
#10 C        31    31 2019-08-24 <dbl [0]>
#11 D        34    34 2019-08-25 <dbl [2]>
#12 D        36    36 2019-08-26 <dbl [3]>
#13 D        23    23 2019-08-27 <dbl [4]>
#14 D        24    24 2019-08-28 <dbl [4]>
#15 D        29    29 2019-08-29 <dbl [3]>
#16 D        13    13 2019-08-30 <dbl [2]>

数据

x <- c(c(1, 2, 2),rep(4:16)) 
i <- as.Date("2019-08-15") + c(0:15)
df <- structure(list(group = structure(c(1L, 1L, 1L, 1L, 1L, 2L, 2L, 
2L, 2L, 3L, 4L, 4L, 4L, 4L, 4L, 4L), .Label = c("A", "B", "C", 
"D"), class = "factor"), x = c(10, 12, 12, 14, 11, 22, 25, 25, 
33, 31, 34, 36, 23, 24, 29, 13), y = c(10, 12, 12, 14, 11, 22, 
25, 25, 33, 31, 34, 36, 23, 24, 29, 13), dates = structure(c(18123, 
18124, 18125, 18126, 18127, 18128, 18129, 18130, 18131, 18132, 
18133, 18134, 18135, 18136, 18137, 18138), class = "Date")),
class = "data.frame", row.names = c(NA, 
-16L))