对具有特定模式的连续数据进行分组

Question

我有一个这样的列的数据框（我没有发布其他列）

Value
1
1
1
0
0
1
0
0
1
1
2
2
0
0
1
0
0
1
1
1
0
0
2
2
1
1
2
0
0
1
0

我正在尝试根据特定条件对其进行分组。当我有 1 和 2 时，必须进行分组。但是像这样的条件是一组：

1 1 0 0 1 1 0 0 

基本上我需要对出现的1 进行分组，但在0s 之间是允许的

预期输出：

Value   Group
    1   1
    1   1 
    1   1
    0   1
    0   1
    1   1
    0   1 
    0   1
    1   1
    1   1
    2   2
    2   2
    0   2
    0   2
    1   3
    0   3
    0   3
    1   3 
    1   3
    1   3
    0   3
    0   3
    2   4 
    2   4
    1   5
    1   5
    2   6
    0   6
    0   6
    1   7
    0   7 
    2   8
    0   8
    2   8
    1   9

Answer 1

这是另一个使用data.table的选项：

DT[, Group := .GRP, .(date, rleid(nafill(replace(Value, Value==0L, NA_integer_), "locf")))]

Answer 2

这是另一种基本方法，它使用ave() 计算1 和2 之间的变化，然后在结果上使用cummax() 来给出最终分组。

dat$Group <- cummax(ave(dat$Value, dat$Value == 0, FUN = function(x) cumsum(c(x[1], diff(x) != 0))))

dat
   Value Group
1      1     1
2      1     1
3      1     1
4      0     1
5      0     1
6      1     1
7      0     1
8      0     1
9      1     1
10     1     1
11     2     2
12     2     2
13     0     2
14     0     2
15     1     3
16     0     3
17     0     3
18     1     3
19     1     3
20     1     3
21     0     3
22     0     3
23     2     4
24     2     4
25     1     5
26     1     5
27     2     6
28     0     6
29     0     6
30     1     7
31     0     7

针对您的评论，如果您希望按日期分组结果，您可以使用嵌套的ave()：

ave(ave(dat$Value, dat$Value == 0, dat$date, FUN = function(x) cumsum(c(x[1], diff(x) != 0))), dat$date, FUN = cummax)

Answer 3

Base-R 中的这个循环可以解决问题

group <- 0
lastgroupvalue <- NA
data$Group <- NA

for(i in 1:nrow(data)){
    if(!data$Value[i] %in% c(lastgroupvalue, 0)){
        group <- group + 1
        lastgroupvalue <- data$Value[i]
    }
    data$Group[i] <- group
}

> data
   Value Group
1      1     1
2      1     1
3      1     1
4      0     1
5      0     1
6      1     1
7      0     1
8      0     1
9      1     1
10     1     1
11     2     2
12     2     2
13     0     2
14     0     2
15     1     3
16     0     3
17     0     3
18     1     3
19     1     3
20     1     3
21     0     3
22     0     3
23     2     4
24     2     4
25     1     5
26     1     5
27     2     6
28     0     6
29     0     6
30     1     7
31     0     7

---

数据：

data <- structure(list(Value = c(1L, 1L, 1L, 0L, 0L, 1L, 0L, 0L, 1L, 
1L, 2L, 2L, 0L, 0L, 1L, 0L, 0L, 1L, 1L, 1L, 0L, 0L, 2L, 2L, 1L, 
1L, 2L, 0L, 0L, 1L, 0L)), class = "data.frame", row.names = c(NA, 
-31L))

Answer 4

另一种避免循环的解决方案，与 Limey 的解决方案类似，但使用 cumsum 创建组。

df$Group <- dplyr::na_if(df$Value, 0)
df <- tidyr::fill(df, Group, .direction = "down")
df$Group <- cumsum(df$Group != dplyr::lag(df$Group, default = -1))

> df

   Value Group
1      1     1
2      1     1
3      1     1
4      0     1
5      0     1
6      1     1
7      0     1
8      0     1
9      1     1
10     1     1
11     2     2
12     2     2
13     0     2
14     0     2
15     1     3
16     0     3
17     0     3
18     1     3
19     1     3
20     1     3
21     0     3
22     0     3
23     2     4
24     2     4
25     1     5
26     1     5
27     2     6
28     0     6
29     0     6
30     1     7
31     0     7

Answer 5

或避免循环的 tidyverse 解决方案：

x <- tibble(Value=c(1,1,1,0,0,1,0,0,1,1,2,2,0,0,1,0,0,1,1,1,
                    0,0,2,2,1,1,2,0,0,1,0,2,0,2,1)) %>% 
       mutate(ModValue=ifelse(Value == 0, NA, Value)) %>%
       fill(ModValue, .direction="down")

runLengths <- rle(x$ModValue)
groupIndex <- unlist(lapply(1:length(runLengths$lengths), 
                            function(x) rep(x, runLengths$lengths[x]))
                    )

x <- x %>% add_column(Group=groupIndex) %>% select(-ModValue)                                      

您的输入数据与预期输出的长度不同。我花了一些时间来解决这个问题... :)

** 编辑 **

还有一个不优雅的解决方案来解释不断变化的日子（或其他超级分组......

x <- tibble(
       RowNumber=1:35,
       Date=lubridate::ymd(c(rep("2020-05-31", 20), rep("2020-06-01", 15))),
       Value=c(1,1,1,0,0,1,0,0,1,1,2,2,0,0,1,0,0,1,1,1,0,0,2,2,1,1,2,0,0,1,0,2,0,2,1))

# Check we have a change of date mid-sequence
x %>% filter(row_number() > 15 & row_number() < 25)   

x <- x %>% 
       mutate(ModValue=ifelse(Value == 0, NA, Value)) %>%
       fill(ModValue, .direction="down")

# Inelegantly compute the groups
make_groups <- function(x) {
  runs <- rle(x)
  return(tibble(GroupWithinDay=unlist(
                                 lapply(1:length(runs$lengths), 
                                        function(x) rep(x, runs$lengths[x])))))
}

y <- x %>% group_by(Date) %>% do(make_groups(.$ModValue))
x <- x %>% add_column(GroupWithinDay=y$GroupWithinDay) %>% select(-ModValue)

# Check the change of date is handled correctly
x %>% filter(row_number() > 15 & row_number() < 25)   

给予

# A tibble: 9 x 4
  RowNumber Date       Value GroupWithinDay
      <int> <date>     <dbl>          <int>
1        16 2020-05-31     0              3
2        17 2020-05-31     0              3
3        18 2020-05-31     1              3
4        19 2020-05-31     1              3
5        20 2020-05-31     1              3
6        21 2020-06-01     0              1
7        22 2020-06-01     0              1
8        23 2020-06-01     2              2
9        24 2020-06-01     2              2