r - 如何根据开始和结束日期将一条记录拆分为多条记录R

Question

我会尝试通过样本数据来解释我的问题

ID      Region      Start_Date     End_Date
 1       Reg1       27/1/2017      27/1/2017
 2       Reg1       27/2/2017      05/3/2017
 1       Reg1       24/3/2017      25/5/2017

现在我希望结果是这样的:

ID      Region      n_Start_Date   n_End_Date
 1       Reg1       27/1/2017      27/1/2017
 2       Reg2       27/2/2017      28/2/2017
 2       Reg2       01/3/2017      05/3/2017
 1       Reg1       24/3/2017      31/3/2017
 1       Reg1       01/4/2017      30/4/2017
 1       Reg1       01/5/2017      31/5/2017

我正在考虑实现的当前方法:

我创建了一个数据框，其中包含 2017 年和 2018 年每个月的开始日期和结束日期的 14 条记录，例如:

Year    Month   Start of Month  End of Month
2017      1        1/1/2017      31/1/2017
2017      2        1/2/2017      28/2/2017
2017      3        1/3/2017      31/3/2017
2017      4        1/4/2017      30/4/2017
2017      5        1/5/2017      31/5/2017
2017      6        1/6/2017      30/6/2017
2017      7        1/7/2017      31/7/2017
2017      8        1/8/2017      31/8/2017
2017      9        1/9/2017      30/9/2017
2017      10       1/10/2017     31/10/2017
2017      11       1/11/2017     30/11/2017
2017      12       1/12/2017     31/12/2017
2018      1        2/12/2017     31/1/2018
2018      2        3/12/2017     28/2/2018

我为年份和月份创建了一个新列:

1. 如果开始日期年、月与结束日期年、月相同，那么下一个相同的开始和结束日期将被复制到新数据框，如

   ID      Region   Start_Date     End_Date   n_Start_Date   n_End_Date
   1       Reg1      27/1/2017     27/1/2017   27/1/2017      27/1/2017
   

2. 如果开始日期年份、月份不相同则追加

   ID      Region   Start_Date     End_Date   n_Start_Date   n_End_Date
   2       Reg2      27/2/2017    05/3/2017    27/2/2017      28/2/2017
   2       Reg2      27/2/2017    05/3/2017    01/3/2017      05/3/2017
   

我找不到任何类似的问题，我已经完成了这个 link , 但没有用。

如果有任何更好的方法请告诉我。

Answer 1

我想我已经明白你想要什么了，如果你有一个结束日期不在同一年和同一月的日期，你会生成一个新行，直到它出现为止。生成的行应在该月的后一天开始并在该月底结束。

# packages we need
library(tidyverse)
library(lubridate)

---

示例数据

test_data <- tribble(
  ~ID, ~Region, ~Start_Date, ~End_Date,
  1L, "Reg1", "27/1/2017", "27/1/2017",
  2L, "Reg2", "27/2/2017", "05/3/2017",
  1L, "Reg1", "24/3/2017", "25/5/2017"
) %>% mutate_at(vars(Start_Date, End_Date), dmy)

---

创建函数

如果我们让一个函数在给定任何开始和结束的情况下执行您想要的操作，我们就可以在之后轻松应用它。

expand_dates <- function(start, end) {

  # the number of entries we want to add
  to_add <- month(end) - month(start) 

  # Take the start date, roll it forwards until the month is equal to the end month
  start_dates <- start + months(0:to_add)

  # everything but the first start_date is rolled back to first of month
  start_dates <- c(start_dates[1],
                   rollback(start_dates[-1], roll_to_first = T))

  # end dates are just the start_dates rolled forwards to the end of the month
  # apply to all but last, thats the end date
  end_dates <- c(rollback(ceiling_date(start_dates[-length(start_dates)], unit = "months")), end)

  data.frame(start_dates = start_dates,
             end_dates = end_dates)
}

---

使用函数

我们可以只使用 purrr 中的 map2，这使我们能够遍历开始日期和结束日期。我们使用 mutate 添加了一个列表列。列表列中的每个元素都是一个 data.frame，它是我们新函数的输出。我们将使用 unnest 然后将我们的数据扩展到所需的内容。

test_data %>%
  mutate(test = map2(Start_Date, End_Date, expand_dates)) %>%
  unnest()


# A tibble: 6 x 6
     ID Region Start_Date End_Date   start_dates end_dates 
  <int> <chr>  <date>     <date>     <date>      <date>    
1     1 Reg1   2017-01-27 2017-01-27 2017-01-27  2017-01-27
2     2 Reg2   2017-02-27 2017-03-05 2017-02-27  2017-02-28
3     2 Reg2   2017-02-27 2017-03-05 2017-03-01  2017-03-05
4     1 Reg1   2017-03-24 2017-05-25 2017-03-24  2017-03-31
5     1 Reg1   2017-03-24 2017-05-25 2017-04-01  2017-04-30
6     1 Reg1   2017-03-24 2017-05-25 2017-05-01  2017-05-25