识别 R 中的运行,允许间隙

Identify runs in R, allowing for gaps

我已经使用此处的帮助板来识别 R 中的运行。例如:

temp.data = rle(c(NA, NA, 1, NA, NA, 1, NA, 1, 1, 1, NA, NA, NA))
output = temp.data$lengths[temp.data$value==1] 

此处,'output' return如下:

NA NA  1 NA NA  1 NA  3 NA NA NA

这行得通,告诉我有 1、1 和 3 的运行。但是,除了我上面所做的之外,我还想确定具有某种级别的运行 "forgiveness" .例如,如果 1 表示事件发生,而 NA 表示事件未发生,我想允许间隙为 1。因此,我希望我的输出为:

NA NA 1 NA NA 5 NA NA NA

或者,它可以简单地 return 有 1 和 5 的运行。我正在尝试跨具有多列和数百行的数据框执行此操作,每个单元格都是 1 的列表和 NA,因此我想自动化这个过程。谢谢!

创建 运行 长度的 NA,用 FALSE 替换 NA 的 运行 长度 1。然后替换由 !inverse.rle(r):

索引的 x 的值
r <- rle(is.na(x))
r$values[r$values][r$lengths[r$values] == 1] <- FALSE
x[!inverse.rle(r)] <- 1
x
# [1] NA NA  1 NA NA  1  1  1  1  1 NA NA NA

如果您不介意使用非 basezoo::na.approx 及其 maxgap 参数是一个方便的包装器:

na.approx(x, maxgap = 1, na.rm = FALSE)
# [1] NA NA  1 NA NA  1  1  1  1  1 NA NA NA

na.approx也可以喂一个数据框:

d <- data.frame(x1 = c(NA, 1, NA, 1, 1, NA),
                x2 = c(1, NA, 1, NA, NA, 1))

na.approx(d, maxgap = 1, na.rm = FALSE)
#      x1 x2
# [1,] NA  1
# [2,]  1  1
# [3,]  1  1
# [4,]  1 NA
# [5,]  1 NA
# [6,] NA  1 

如果您的数据集很大,您可以使用 'long' 格式的 data.table

library(data.table)
setDT(d)

# convert to long format
d2 <- melt(d, measure.var = names(d))

# for each variable and run, add group number and group length
d2[ , `:=`(g = .GRP, n = .N), by = .(variable, rleid(value))]

# for each variable, replace runs of `NA` of length 1 with 1
# leave leading and trailing NA (exclude first and last group)
d2[ , value := replace(value, is.na(value) & n == 1 &
                         g != min(g) & g != max(g), 1),
    by = .(variable)][ 
      , `:=`(g = NULL, n = NULL)] # clean-up
d2
#     variable value
#  1:       x1    NA
#  2:       x1     1
#  3:       x1     1
#  4:       x1     1
#  5:       x1     1
#  6:       x1    NA
#  7:       x2     1
#  8:       x2     1
#  9:       x2     1
# 10:       x2    NA
# 11:       x2    NA
# 12:       x2     1

这是 base R 中的一种方法。基本思想是首先将 NA 替换为 0(以便 rle 的输出提供更多信息),然后对其进行调整输出并重构它,使 isolated 0 被 1 替换。最后,结果的rle()如你所愿:

> x <- c(NA, NA, 1, NA, NA, 1, NA, 1, 1, 1, NA, NA, NA)
> x[is.na(x)] <- 0
> temp.data = rle(x)
> temp.data$values[temp.data$values == 0 & temp.data$lengths == 1] <- 1
> y <- inverse.rle(temp.data)
> rle(y)
Run Length Encoding
  lengths: int [1:5] 2 1 2 5 3
  values : num [1:5] 0 1 0 1 0