在二进制列 r 中寻找模式

looking for patterns in binary columns r

我需要查找并计算在 3 个或更多个连续零之后出现 1 的 ID。

这是我所拥有的示例:

#  ID   Jan  Feb Mar  Apr May Jun Jul Aug Sept Oct
#   1   0    0   0    1   0   0   1   1    1    0
#   2   0    0   0    0   0   0   1   0    0    0
#   3   0    0   0    0   0   0   0   0    0    1
#   4   1    0   0    1   0   1   0   1    0    1
#   5   0    0   1    0   0   1   1   0    0    1

c1<- c("ID","Jan","Feb", "Mar","Apr", "May","Jun", "Jul", "Aug", "Sept", "Oct")
c2<-  c(1,0,0,0,1,0,0,1,1,1,0)
c3<- c(2,0,0,0,0,0,0,1,0,0,0)
c4<- c(3,0,0,0,0,0,0,0,0,0,1)
c5<- c(4,1,0,0,1,0,1,0,1,0,1)
c6<- c(5,0,0,1,0,0,1,1,0,0,1)
BD<-data.frame(rbind(c2,c3,c4,c5,c6))
colnames(BD)<-c1

我期望的结果是这样的:

#  ID   Jan  Feb Mar  Apr May Jun Jul Aug Sept Oct
#   1   0    0   0    1   0   0   1   1    1    0
#   2   0    0   0    0   0   0   1   0    0    1
#   3   0    0   0    0   0   0   0   0    0    1

有人知道怎么做吗?谢谢!

如果您采用向量 rowid(rleid(x))x,您会得到每个 "run" 每个元素的步数*。您可以检查这是 >= 3 且元素为 0。如果前一个元素(对于移位输出)为真且元素为 1,则 return 为 TRUE。然后检查行中的 any 个元素是否为 TRUE。

library(data.table)

rows <- 
  apply(BD, 1, function(r) any(shift(rowid(rleid(r)) >= 3 & r == 0) & r == 1))

BD[rows,]
#    ID Jan Feb Mar Apr May Jun Jul Aug Sept Oct
# c2  1   0   0   0   1   0   0   1   1    1   0
# c3  2   0   0   0   0   0   0   1   0    0   0
# c4  3   0   0   0   0   0   0   0   0    0   1

* 这是特定行(第一行)的示例

rbind(
  rowid_rleid = rowid(rleid(unlist(BD[1,]))),
  original = unlist(BD[1,]))

#             ID Jan Feb Mar Apr May Jun Jul Aug Sept Oct
# rowid_rleid  1   1   2   3   1   1   2   1   2    3   1
# original     1   0   0   0   1   0   0   1   1    1   0

您可以将行合并为字符串并使用正则表达式来匹配“0001”:

library(tidyverse)
rows = BD %>% 
  purrr::pmap(function(...) paste0(list(...)[-1], collapse='')) %>% 
  stringr::str_detect('0001')
BD[rows,]

这是可以实现的基础 R 解决方案

BDout <- subset(BD,apply(BD[-1], 1, function(x) head(which(x==1),1))>3)

这样

> BDout
  ID Jan Feb Mar Apr May Jun Jul Aug Sept Oct
1  1   0   0   0   1   0   0   1   1    1   0
2  2   0   0   0   0   0   0   1   0    0   0
3  3   0   0   0   0   0   0   0   0    0   1

您可以折叠成字符串并使用 grep() 搜索模式。

k <- 3

grep(sprintf(paste0("%0", k + 1, "d"), 1), apply(d[-1], 1, paste, collapse=""))
# [1] 2 4 5 6 8

如果不需要后面的 1 你可以使用 rle().

d
#     id Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
# c1   1   1   1   0   1   1   0   0   1   1   1   0   0
# c2   2   0   0   0   1   1   1   0   1   1   0   1   0
# c3   3   1   0   0   1   1   0   1   1   1   0   1   0
# c4   4   0   0   0   0   0   1   1   0   0   1   1   0
# c5   5   0   0   0   1   1   1   1   0   0   1   0   1
# c6   6   1   0   0   0   1   0   1   0   0   0   0   1
# c7   7   0   1   0   0   1   0   1   1   1   0   0   1
# c8   8   0   1   1   1   1   1   1   1   0   0   0   1
# c9   9   0   1   0   0   1   1   0   0   1   1   1   0
# c10 10   1   1   0   1   0   1   1   0   0   1   0   1

k <- 3
d$id[sapply(as.data.frame(t(d[-1])), function(x) any(rle(x)$lengths[rle(x)$values == 0] >= k))]
# [1] 2 4 5 6 8

数据:

set.seed(0)
d <- data.frame(id=1:10, 
                  `dimnames<-`(matrix(sample(0:1, 120, r=1), 10), 
                               list(paste0("c", 1:10), month.abb)))

使用 data.table 融合和过滤符合条件的行的选项。

library(data.table)
setDT(BD)[ID %in%
    melt(BD, id.vars="ID")[, 
        mth := .GRP, variable][
            value==1L, ID[mth[1L]>3L | any(diff(mth) > 3L)], ID]$V1
]

对于数据稀疏的大型数据集,它应该更快。