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

Question

您好，我正在使用 slip_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 时，在第二次迭代时，关闭 slip_index() 输出上方的可重现代码将是: [1] 1 2 3 4。但我希望输出仅返回 [1 ] 1 3 4，或者找到一种方法将当前的 x 值读入我将传递给 slip_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

更新

如果有分组数据，那么我们进行group by操作来创建一个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))