【问题标题】:How to compare within a group the first value to each subsequent value until a condition is met如何在组内将第一个值与每个后续值进行比较,直到满足条件
【发布时间】:2021-12-21 15:57:45
【问题描述】:

所以我在下面的一般结构中有一个数据框:

数据框:

rownum group date
1 a 2021-05-01
2 a 2021-05-02
3 a 2021-05-03
4 b 2021-05-15
5 b 2021-05-17
6 b 2021-05-30
7 b 2021-05-31
8 b 2021-05-31
9 c 2021-05-01
10 c 2021-05-05

我想做的是,在 GROUP 内,将第一行与下一行进行比较,直到日期之间的差异达到某个阈值,例如 10 天。然后,一旦该行达到阈值,我想将下一行与后续行进行测试。它看起来像这样:

结果,使用阈值 10:

|rownum|group |date       |date diff|
|------|------|-----------|---|        
|1     | a    |2021-05-01 |NA|
|2     | a    |2021-05-02 |1|
|3     | a    |2021-05-03 |2|
|4     | b    |2021-05-15 |NA|
|5     | b    |2021-05-17 |2|
|6     | b    |2021-05-30 |15 (meets criteria, start from row 7 now)|
|7     | b    |2021-05-31 | NA|
|8     | b    |2021-05-31 | 0|
|9     | c    |2021-05-01 | NA|
|10    | c    |2021-05-05 |  4|

因此,重申一下,它将组的第一行与后续行进行比较,直到达到某个阈值。然后计数从组内的第一个代表开始,直到组内的后续行。差异记录为 datediff。

我已经尝试过了,但我不知道 sapply 是否可行:

dataframe %>% 
    group_by(group) %>%
    mutate(
        datediff = sapply(date, function(x) {
            all(difftime(dataframe$date,dplyr::lag(dataframe, n = 1, default = NA)))
                }
        )
    )

也试过这个,我认为更接近我想要的:

for (m in 1:length(dataframe)) {
    dataframe <- dataframe %>% 
        group_by(group) %>% 
        rowwise() %>% 
        mutate(datediff = difftime(dataframe$date,dplyr::lag(date, n = m, default = NA), units="days"))
    }

到目前为止,我还无法进行正确的逐行比较,甚至无法实现阈值位。

【问题讨论】:

    标签: r if-statement dplyr iteration rowwise


    【解决方案1】:

    另一个tidyverse 解决方案。我们可以使用accumulate 来完成这个任务。 dat 来自 r2evans 的示例。

    library(tidyverse)
    
    dat2 <- dat %>%
      group_by(group) %>%
      mutate(diff_lag = as.integer(date - lag(date))) %>%
      mutate(diff = accumulate(diff_lag, function(x, y){
        if (is.na(x)){
          res <- y
        }  else if (x > 10){
          res <- NA
        } else {
          res <- x + y
        }
        return(res)
      })) %>%
      select(-diff_lag) %>%
      ungroup()
    
    dat2
    # # A tibble: 10 x 4
    #    rownum group date        diff
    # <    int> <chr> <date>     <int>
    #  1      1 a     2021-05-01    NA
    #  2      2 a     2021-05-02     1
    #  3      3 a     2021-05-03     2
    #  4      4 b     2021-05-15    NA
    #  5      5 b     2021-05-17     2
    #  6      6 b     2021-05-30    15
    #  7      7 b     2021-05-31    NA
    #  8      8 b     2021-05-31     0
    #  9      9 c     2021-05-01    NA
    # 10     10 c     2021-05-05     4
    

    【讨论】:

    • 绝对完美,谢谢!
    【解决方案2】:

    基础 R

    func <- function(x, threshold = 10) {
      r <- rle(c(0, diff(x)) > threshold)
      if ((len <- length(r$values)) > 1) {
        r$lengths[len] <- r$lengths[len] - 1L
        r$lengths[1] <- r$lengths[1] + 1L
      }
      cumsum(inverse.rle(r))
    }
    dat$group2 <- ave(as.numeric(dat$date), dat$group, FUN = func)
    dat$datediff <- ave(as.numeric(dat$date), dat[,c("group", "group2")], FUN = function(x) c(NA, (x - x[1])[-1]))
    dat$group2 <- NULL
    dat
    #    rownum group       date datediff
    # 1       1     a 2021-05-01       NA
    # 2       2     a 2021-05-02        1
    # 3       3     a 2021-05-03        2
    # 4       4     b 2021-05-15       NA
    # 5       5     b 2021-05-17        2
    # 6       6     b 2021-05-30       15
    # 7       7     b 2021-05-31       NA
    # 8       8     b 2021-05-31        0
    # 9       9     c 2021-05-01       NA
    # 10     10     c 2021-05-05        4
    

    dplyr

    library(dplyr)
    dat %>%
      group_by(group) %>%
      mutate(group2 = func(date)) %>%
      group_by(group, group2) %>%
      mutate(datediff = c(NA, (date - date[1])[-1])) %>%
      ungroup() %>%
      select(-group2)
    # # A tibble: 10 x 4
    #    rownum group date       datediff
    #     <int> <chr> <date>        <dbl>
    #  1      1 a     2021-05-01       NA
    #  2      2 a     2021-05-02        1
    #  3      3 a     2021-05-03        2
    #  4      4 b     2021-05-15       NA
    #  5      5 b     2021-05-17        2
    #  6      6 b     2021-05-30       15
    #  7      7 b     2021-05-31       NA
    #  8      8 b     2021-05-31        0
    #  9      9 c     2021-05-01       NA
    # 10     10 c     2021-05-05        4
    

    数据

    dat <- structure(list(rownum = 1:10, group = c("a", "a", "a", "b", "b", "b", "b", "b", "c", "c"), date = structure(c(18748, 18749, 18750, 18762, 18764, 18777, 18778, 18778, 18748, 18752), class = "Date")), row.names = c(NA, -10L), class = "data.frame")
    

    (我已经将dat$date 转换为Date-class。)

    【讨论】:

      【解决方案3】:

      这是获取所需内容的一种迂回方式,其中一些 NA 使用此解决方案设置为 0

      library(tidyverse)

      df %>% 
        group_by(group) %>% 
        mutate(date = as.Date(date),
               date_diff = date - first(date),
               flag = date_diff > 10) %>% 
        group_by(group, flag) %>% 
        mutate(temp_group = cur_group_id()) %>% 
        group_by(temp_group) %>% 
        mutate(date_diff = case_when(date_diff == first(date_diff) ~ date_diff,
                                     date_diff != first(date_diff) & date_diff < 10 ~ date - first(date),
                                     date_diff != first(date_diff) & date_diff > 10 ~ date - nth(date, 2))) %>% 
        ungroup() %>% 
        select(group, date, date_diff) 
      
      
      # A tibble: 10 x 3
         group date       date_diff
         <chr> <date>     <drtn>   
       1 a     2021-05-01  0 days  
       2 a     2021-05-02  1 days  
       3 a     2021-05-03  2 days  
       4 b     2021-05-15  0 days  
       5 b     2021-05-17  2 days  
       6 b     2021-05-30 15 days  
       7 b     2021-05-31  0 days  
       8 b     2021-05-31  0 days  
       9 c     2021-05-01  0 days  
      10 c     2021-05-05  4 days 
      

      【讨论】:

        猜你喜欢
        • 2023-03-26
        • 1970-01-01
        • 2020-08-13
        • 1970-01-01
        • 2013-10-23
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 2021-08-24
        相关资源
        最近更新 更多