折叠单元格直到满足条件

Question

我正在尝试折叠类别，直到满足某个条件。我模拟了一些数据。在“N”小于 10 的情况下，我想取按 group2 级别和下一个最高级别分组的“wt”之和。在第一行 - “N”等于0，所以我想为第一行和第二行求和“wt”。第 4 行和第 5 行中的“N”之和也小于 10，所以我想对第 3,4 和 5 行求和“wt”。我知道如何在 dplyr 中使用 group by 但不知道该怎么做是有条件的。

a <-expand.grid( group2=c( 1:5  ) , group1=c( "F","M" ) )
a$N <- c( 0 ,12, 15, 2, 5 ,9 , 10 , 11 , 12 , 15)
a$wt =c( 12 ,23 ,45 , 5 , 1 , 11 ,8 , 9 ,12, 27 )
a$row <- 1:10

所以我考虑为每个观察编写一个循环以查看下一行 - 但这似乎很笨重。

如果没有按参数分组，我只会得到“N”大于 10 的所有位置的总和

a %>%
filter( N < 10 ) %>%
mutate(   Wt2 = sum( wt )  )

Answer 1

这是使用dplyr 和data.table 的解决方案。

首先，我们可以设计一个函数，check_fun，看是否有连续两行以上N小于10。TRUE表示需要聚合。

library(dplyr)
library(data.table)

check_fun <- function(df){
  df2 <- df %>%
    mutate(Below10 = rleid(N < 10)) %>%
    filter(N < 10) %>%
    count(group1, Below10)
  return(any(df2$n > 1))
}

check_fun(a)
# [1] TRUE

然后我们可以设计第二个函数aggregate_fun1，它将聚合到下一行。

aggregate_fun1 <- function(df){
  df2 <- df %>%
    mutate(Below10 = rleid(N < 10)) %>%
    group_by(Below10) %>%
    mutate(Index1 = ifelse(N >= 10, row_number(), NA)) %>%
    mutate(Index2 = ifelse(N < 10, row_number(), NA)) %>%
    mutate(Index2 = ifelse(Index2 == 2, 1, Index2)) %>%
    group_by(group1, Below10, Index1, Index2) %>%
    summarize(N = sum(N), wt = sum(wt)) %>%
    ungroup() %>%
    select(-Below10, -Index1, -Index2)
  return(df2)
} 

a2 <- aggregate_fun1(a)
a2
# # A tibble: 9 x 3
#   group1     N    wt
#   <fct>  <dbl> <dbl>
# 1 F       0    12.0 
# 2 F      12.0  23.0 
# 3 F      15.0  45.0 
# 4 F       7.00  6.00
# 5 M       9.00 11.0 
# 6 M      10.0   8.00
# 7 M      11.0   9.00
# 8 M      12.0  12.0 
# 9 M      15.0  27.0 

我们可以迭代地应用aggregate_fun1，直到没有任何两行或多行N 小于10。然后我们需要第三个函数aggregate_fun2，将N 小于10 的单行聚合到下一行或上一行。这里我设计了这个函数，将下一行作为与上一行相比的优先级。

aggregate_fun2 <- function(df){
  df2 <- df %>%
    mutate(Flag1 = ifelse(N < 10, row_number(), NA)) %>%
    mutate(Flag2 = ifelse(is.na(Flag1) & !is.na(lag(Flag1)), lag(Flag1), NA)) %>%
    mutate(Flag3 = ifelse(is.na(Flag1) & !is.na(lead(Flag1)), lead(Flag1), NA)) %>%
    mutate(Flag4 = coalesce(.$Flag1, .$Flag2, .$Flag3)) %>%
    mutate(Flag4 = ifelse(is.na(Flag4), row_number(), Flag4)) %>%
    group_by(group1, Flag4) %>%
    summarize(N = sum(N), wt = sum(wt)) %>%
    ungroup() %>%
    select(-Flag4)
  return(df2)
}

a3 <- aggregate_fun2(a2)
a3
# # A tibble: 6 x 3
#   group1     N    wt
#   <fct>  <dbl> <dbl>
# 1 F       12.0 35.0 
# 2 F       22.0 51.0 
# 3 M       19.0 19.0 
# 4 M       11.0  9.00
# 5 M       12.0 12.0 
# 6 M       15.0 27.0 

在本例中，a3 是最终输出。

我们可以将所有三个函数与check_fun 和aggregate_fun1 上的while 循环结合在一起。如果条件满足，我们就可以使用aggregate_fun2来计算最终的输出。我把这个函数称为aggregate_fun。

aggregate_fun <- function(df){
  while(check_fun(df)){
    df <- df %>% aggregate_fun1()
  }
  df2 <- df %>% aggregate_fun2()
  return(df2)
}

通过将aggregate_fun 应用到a，我们可以得到输出。

aggregate_fun(a)
# # A tibble: 6 x 3
#   group1     N    wt
#   <fct>  <dbl> <dbl>
# 1 F       12.0 35.0 
# 2 F       22.0 51.0 
# 3 M       19.0 19.0 
# 4 M       11.0  9.00
# 5 M       12.0 12.0 
# 6 M       15.0 27.0