Question

我正在尝试折叠类别，直到满足条件。我已经模拟了一些数据。在＆＃34; N＆＃34;小于10我想取＆＃34; wt＆＃34;按组2的级别和下一个最高级别分组。在第一行 - ＆＃34; N＆＃34;等于0，所以我想总结＆＃34; wt＆＃34;第一行和第二行。＆＃34; N＆＃34;的总和在第4行和第5行也小于10所以我想总结＆＃34; wt＆＃34;对于3,4行和5行。我知道如何在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

所以我考虑过为每个观察编写一个循环来查看下一行 - 但这看起来很笨拙。

没有分组参数我只得到所有地方的总和，其中＆＃34; N＆＃34;超过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

折叠单元格直到满足条件

1 个答案: