计算在组内经过的时间并在某个累积时间段过去后进行标记

问题描述

考虑以下数据:

df <- structure(list(date = structure(c(10904,10613,10801,10849,10740,10680,10780,10909,10750,10814),class = "Date"),group = c(1L,2L,1L,2L)),class = "data.frame",row.names = c(NA,-10L))

给出:

         date group
1  1999-11-09     1
2  1999-01-22     2
3  1999-07-29     1
4  1999-09-15     2
5  1999-05-29     1
6  1999-03-30     1
7  1999-07-08     1
8  1999-11-14     2
9  1999-06-08     2
10 1999-08-11     2

我现在要计算

  • a) 两个相邻日期之间过去的月份每组(我知道该怎么做)
  • b) 在某个时间段(3 个月)过去后标记行,如果它已经过去,我会重置并再次查看从该日期开始的 3 个月。

所以 a) 我正在这样做:

library(tidyverse)
library(lubridate)
df %>%
  group_by(group) %>%
  arrange(group,date) %>%
  mutate(months_passed = time_length(interval(lag(date),date),"months"))

给出:

# A tibble: 10 x 3
# Groups:   group [2]
   date       group months_passed
   <date>     <int>         <dbl>
 1 1999-03-30     1        NA    
 2 1999-05-29     1         1.97 
 3 1999-07-08     1         1.3  
 4 1999-07-29     1         0.677
 5 1999-11-09     1         3.35 
 6 1999-01-22     2        NA    
 7 1999-06-08     2         4.55 
 8 1999-08-11     2         2.10 
 9 1999-09-15     2         1.13 
10 1999-11-14     2         1.97

但是对于 b) 我迷路了。我想做的是:

  • 分别查看每个组。
  • 计算第 1 行和第 2 行之间的months_passed(此处:第 1 组为 1.97 个月)
  • 如果是
  • 既然差异更大 >= 3 个月,我想标记第 3 行。
  • 现在我重置累积时间差,并再次开始计算与下一行(此处:0.67 个月)的差异,依此类推。

预期结果是:

# A tibble: 10 x 4
# Groups:   group [2]
   date       group months_passed time_flag
   <date>     <int>         <dbl>     <int>
 1 1999-03-30     1        NA             0
 2 1999-05-29     1         1.97          0
 3 1999-07-08     1         1.3           1
 4 1999-07-29     1         0.677         0
 5 1999-11-09     1         3.35          1
 6 1999-01-22     2        NA             0
 7 1999-06-08     2         4.55          1
 8 1999-08-11     2         2.10          0
 9 1999-09-15     2         1.13          1
10 1999-11-14     2         1.97          0

有什么想法吗?

解决方法

你可以写一个辅助函数:

assign_1 <- function(x) {
  y <- numeric(length(x))
  sum <- 0
  for(i in seq_along(x)) {
    sum <- sum + x[i]
    if(sum >= 3) {
      y[i] <- 1
      sum <- 0
    }
  }
  y
}

并在您现有的管道中使用它:

library(dplyr)
library(lubridate)

df %>%
  group_by(group) %>%
  arrange(group,date) %>%
  mutate(months_passed = time_length(interval(lag(date,default = first(date)),date),"months"),time_flag = assign_1(months_passed)) %>%
   ungroup

#    date       group months_passed time_flag
#   <date>     <int>         <dbl>     <dbl>
# 1 1999-03-30     1         0             0
# 2 1999-05-29     1         1.97          0
# 3 1999-07-08     1         1.3           1
# 4 1999-07-29     1         0.677         0
# 5 1999-11-09     1         3.35          1
# 6 1999-01-22     2         0             0
# 7 1999-06-08     2         4.55          1
# 8 1999-08-11     2         2.10          0
# 9 1999-09-15     2         1.13          1
#10 1999-11-14     2         1.97          0
,

顺便说一句,通过一些更好的搜索(现在我知道要搜索哪些术语),我能够在没有附加功能的情况下完全正常工作:

dplyr / R cumulative sum with reset

df %>%
  group_by(group) %>%
  arrange(group,date) %>%
  mutate(months_passed = time_length(interval(lag(date),months_passed = if_else(is.na(months_passed),months_passed),time_flag = if_else(accumulate(months_passed,~if_else(.x >= 3,.y,.x + .y)) >= 3,1,0))

# A tibble: 10 x 4
# Groups:   group [2]
   date       group months_passed time_flag
   <date>     <int>         <dbl>     <dbl>
 1 1999-03-30     1         0             0
 2 1999-05-29     1         1.97          0
 3 1999-07-08     1         1.3           1
 4 1999-07-29     1         0.677         0
 5 1999-11-09     1         3.35          1
 6 1999-01-22     2         0             0
 7 1999-06-08     2         4.55          1
 8 1999-08-11     2         2.10          0
 9 1999-09-15     2         1.13          1
10 1999-11-14     2         1.97          0