Разделить длительности на годовые части - PullRequest
Новая
       3

Разделить длительности на годовые части

2 голосов
/ 24 марта 2020

Проблема: у меня есть фрейм данных, который состоит из длительностей (столбцы: begin и end) для всех случаев (столбец: case). Некоторые продолжительности проходят через два года. Мне нужно разбить эти случаи на годовые периоды: одна часть, которая длится до конца года, а оставшаяся продолжительность - на следующий год.

Текущий подход: мне удалось вычислить эти длительности (см. Текущий подход ниже), но я не могу разбить соответствующие строки на несколько, оставив при этом ежегодные случаи без изменений.

Ниже вы найдете воспроизводимый пример: 

# Packages
library(tidyverse)
library(lubridate)

# Reproducible example
df <- tibble(
  case = c(1, 1, 2, 3),
  begin = ymd("2019-12-20", "2019-08-05", "2012-01-01", "2014-10-10"),
  end = ymd("2020-01-15", "2019-08-20", "2012-01-12", "2015-01-15"),
  reason = c("X", "Y", "X", "Y")) 

head(df)
#> # A tibble: 4 x 4
#>    case begin      end        reason
#>   <dbl> <date>     <date>     <chr> 
#> 1     1 2019-12-20 2020-01-15 X     
#> 2     1 2019-08-05 2019-08-20 Y     
#> 3     2 2012-01-01 2012-01-12 X     
#> 4     3 2014-10-10 2015-01-15 Y

# Goal (split durations and make them "longer")
goal <- tibble(
  case = c(1, 1, 1, 2, 3, 3),
  begin = ymd("2019-12-20", "2020-01-01", "2019-08-05", "2012-01-01", "2014-10-10", "2015-01-01"),
  end = ymd("2019-12-31", "2020-01-15", "2019-08-20", "2012-01-12", "2014-12-31", "2015-01-15"),
  reason = c("X", "X", "Y", "X", "Y", "Y")) 

head(goal)
#> # A tibble: 6 x 4
#>    case begin      end        reason
#>   <dbl> <date>     <date>     <chr> 
#> 1     1 2019-12-20 2019-12-31 X     
#> 2     1 2020-01-01 2020-01-15 X     
#> 3     1 2019-08-05 2019-08-20 Y     
#> 4     2 2012-01-01 2012-01-12 X     
#> 5     3 2014-10-10 2014-12-31 Y     
#> 6     3 2015-01-01 2015-01-15 Y

# Current approach
df %>%
  mutate(end_year = if_else(year(begin) != year(end), 
                            ceiling_date(ymd(begin), "year") - days(1), end),
         begin_year = if_else(year(begin) != year(end), 
                              ceiling_date(ymd(end), "year"), begin))
#> # A tibble: 4 x 6
#>    case begin      end        reason end_year   begin_year
#>   <dbl> <date>     <date>     <chr>  <date>     <date>    
#> 1     1 2019-12-20 2020-01-15 X      2019-12-31 2021-01-01
#> 2     1 2019-08-05 2019-08-20 Y      2019-08-20 2019-08-05
#> 3     2 2012-01-01 2012-01-12 X      2012-01-12 2012-01-01
#> 4     3 2014-10-10 2015-01-15 Y      2014-12-31 2016-01-01

Был бы признателен, если бы вы могли указать мне на решение. Заранее спасибо.

Редактировать на основе ответа Аллан Кэмерон : 

# Final solution
library(tidyverse)
library(lubridate)

# Reproducible example
df <- tibble(
  case = c(1, 1, 2, 3),
  begin = ymd("2019-12-20", "2019-08-05", "2012-01-01", "2014-10-10"),
  end = ymd("2020-01-15", "2019-08-20", "2012-01-12", "2015-01-15"),
  reason = c("X", "Y", "X", "Y")) 

# Find durations that run across a year
df2 <- df %>%
  filter(year(end) != year(begin)) %>%
  mutate(begin = ceiling_date(ymd(begin), "year"), begin)

# 
df <- df %>%
  mutate(end = if_else(year(end) != year(begin), 
                       ceiling_date(ymd(begin), "year") - days(1), end))

# Merge
df <- df %>%
  bind_rows(df2) %>%
  arrange(case, reason)

head(df)
#> # A tibble: 6 x 4
#>    case begin      end        reason
#>   <dbl> <date>     <date>     <chr> 
#> 1     1 2019-12-20 2019-12-31 X     
#> 2     1 2020-01-01 2020-01-15 X     
#> 3     1 2019-08-05 2019-08-20 Y     
#> 4     2 2012-01-01 2012-01-12 X     
#> 5     3 2014-10-10 2014-12-31 Y     
#> 6     3 2015-01-01 2015-01-15 Y

1 Ответ

2 голосов
/ 24 марта 2020

Вы не можете использовать mutate, чтобы сделать ваши данные длиннее.

Вероятно, проще всего показать, как это можно сделать в синтаксисе базового R, продублировав записи, которые соединяют год, а затем используя lubridate. функции для управления месяцем и днем ​​по мере необходимости перед присоединением дубликатов к исходному фрейму данных. 

bridgers                <- which(year(df$end) != year(df$begin))
df2                     <- df[bridgers,]

year(df$end[bridgers])  <- year(df$begin[bridgers])
month(df$end[bridgers]) <- 12
mday(df$end[bridgers])  <- 31

year(df2$begin)         <- year(df2$end)
month(df2$begin)        <- 1
mday(df2$begin)         <- 1

df <- rbind(df, df2)
df[order(df$case), ]
#> # A tibble: 6 x 4
#>    case begin      end        reason
#>   <dbl> <date>     <date>     <chr> 
#> 1     1 2019-12-20 2019-12-31 X     
#> 2     1 2019-08-05 2019-08-20 Y     
#> 3     1 2020-01-01 2020-01-15 X     
#> 4     2 2012-01-01 2012-01-12 X     
#> 5     3 2014-10-10 2014-12-31 Y     
#> 6     3 2015-01-01 2015-01-15 Y

Создано в 2020-03-24 с помощью пакета Представить ( v0.3.0)

...