Question

给定data.frame带有某种类型的标志或标识符列，我希望能够通过某个时间窗参数n标记周围（前导和滞后）记录。所以给出：

df <- data.frame(
  id = letters[1:26],
  flag = FALSE
)
df$flag[10] <- TRUE
df$flag[17] <- TRUE

我想写一些像：

flag_surrounding <- function(flag, n) {
  # should flag surrounding -n to +n records with condition flag
}

# expected results for n = 2, n = 1...
df
#    id  flag flag_n2 flag_n1
# 1   a FALSE   FALSE   FALSE
# 2   b FALSE   FALSE   FALSE
# 3   c FALSE   FALSE   FALSE
# 4   d FALSE   FALSE   FALSE
# 5   e FALSE   FALSE   FALSE
# 6   f FALSE   FALSE   FALSE
# 7   g FALSE   FALSE   FALSE
# 8   h FALSE    TRUE   FALSE
# 9   i FALSE    TRUE    TRUE
# 10  j  TRUE    TRUE    TRUE
# 11  k FALSE    TRUE    TRUE
# 12  l FALSE    TRUE   FALSE
# 13  m FALSE   FALSE   FALSE
# 14  n FALSE   FALSE   FALSE
# 15  o FALSE    TRUE   FALSE
# 16  p FALSE    TRUE    TRUE
# 17  q  TRUE    TRUE    TRUE
# 18  r FALSE    TRUE    TRUE
# 19  s FALSE    TRUE   FALSE
# 20  t FALSE   FALSE   FALSE
# 21  u FALSE   FALSE   FALSE
# 22  v FALSE   FALSE   FALSE
# 23  w FALSE   FALSE   FALSE
# 24  x FALSE   FALSE   FALSE
# 25  y FALSE   FALSE   FALSE
# 26  z FALSE   FALSE   FALSE

我开始使用dplyr::lead和dplyr::lag以及带有cumsum的变体编写一些内容，但我觉得这已经在某个地方的某个包中，但无法快速找到（并且不确定如何将此作为谷歌搜索的问题） - 也许有人比我更好的回忆:)

以下功能（使用提示from this post），但感觉有点笨拙且容易出错。我很想从包中获得其他方法/技术和/或更强大的东西。

library(dplyr)
flag_surrounding <- function(flag, n) {
  as.logical(cumsum(lead(flag, n, default = FALSE)) - cumsum(lag(flag, n + 1, default = FALSE)))
}

df %>%
  mutate(flag_n2 = flag_surrounding(flag, 2),
         flag_n1 = flag_surrounding(flag, 1))

Answer 1

以下是base中的简单解决方案：

set.seed(4)
df <- data.frame(
  id = letters[1:26],
  flag = as.logical(rbinom(n = 26, size = 1, prob = 0.1))
)

lead_lag_flag = function(x, n) {
    flagged = which(x)
    to_flag = sapply(flagged, function(z) (z - n):(z + n))
    to_flag = pmax(0, to_flag)
    to_flag = pmin(length(x), to_flag)
    to_flag = unique(to_flag)
    new_flag = rep(FALSE, length(x))
    new_flag[to_flag] = TRUE
    return(new_flag)
}

df$flag_n1 = lead_lag_flag(df$flag, 1)
df$flag_n2 = lead_lag_flag(df$flag, 2)
df
#    id  flag flag_n1 flag_n2
# 1   a FALSE   FALSE   FALSE
# 2   b FALSE   FALSE   FALSE
# 3   c FALSE   FALSE   FALSE
# 4   d FALSE   FALSE   FALSE
# 5   e FALSE   FALSE   FALSE
# 6   f FALSE   FALSE    TRUE
# 7   g FALSE    TRUE    TRUE
# 8   h  TRUE    TRUE    TRUE
# 9   i  TRUE    TRUE    TRUE
# 10  j FALSE    TRUE    TRUE
# 11  k FALSE   FALSE    TRUE
# 12  l FALSE   FALSE    TRUE
# 13  m FALSE    TRUE    TRUE
# 14  n  TRUE    TRUE    TRUE
# 15  o FALSE    TRUE    TRUE
# 16  p FALSE    TRUE    TRUE
# 17  q  TRUE    TRUE    TRUE
# 18  r FALSE    TRUE    TRUE
# 19  s  TRUE    TRUE    TRUE
# 20  t FALSE    TRUE    TRUE
# 21  u FALSE    TRUE    TRUE
# 22  v  TRUE    TRUE    TRUE
# 23  w FALSE    TRUE    TRUE
# 24  x FALSE   FALSE    TRUE
# 25  y FALSE   FALSE   FALSE
# 26  z FALSE   FALSE   FALSE

Answer 2

另一个base替代方案：

n <- 1
nm <- paste0("flag", n)
i <- -n:n
df[ , nm] <- FALSE
ix <- rep(which(df$flag), each = length(i)) + i
ix <- ix[ix > 0 & ix <= nrow(d)]
df[ix, nm] <- TRUE

df
#    id  flag flag1
# 1   a FALSE FALSE
# 2   b FALSE FALSE
# 3   c FALSE FALSE
# 4   d FALSE FALSE
# 5   e FALSE FALSE
# 6   f FALSE FALSE
# 7   g FALSE FALSE
# 8   h FALSE FALSE
# 9   i FALSE  TRUE
# 10  j  TRUE  TRUE
# 11  k FALSE  TRUE
# 12  l FALSE FALSE
# 13  m FALSE FALSE
# 14  n FALSE FALSE
# 15  o FALSE FALSE
# 16  p FALSE  TRUE
# 17  q  TRUE  TRUE
# 18  r FALSE  TRUE
# 19  s FALSE FALSE
# 20  t FALSE FALSE
# 21  u FALSE FALSE
# 22  v FALSE FALSE
# 23  w FALSE FALSE
# 24  x FALSE FALSE
# 25  y FALSE FALSE
# 26  z FALSE FALSE

用于通过给定窗口改变，标记或识别条件周围的记录的功能

2 个答案: