Добавление нескольких столбцов в фрейм данных с purrr и mutate

Question

У меня есть набор данных с датами, например,

id <- 1:1000
admission_date <- sample(seq(as.Date('2016/01/01'), as.Date('2018/12/31'), by="day"), 1000)
discharge_date <- admission_date + days(100)

extract <- tibble(id, admission_date, discharge_date)

Мне нужно приписать количество дней соответствующим кварталам.У меня есть некоторый код, который может это сделать;

min_date <- min(extract$admission_date)
max_date <- max(extract$discharge_date)


for (year in year(min_date):year(max_date)) {
  for (quarter in 1:4) {
    min_start_date <- yq(paste(year, quarter)) - days(1)
    max_end_date <- yq(paste(year, quarter)) + months(3) - days(1)

    extract <-
      extract %>% mutate(
        !!paste(year, quarter) := case_when(
          # doa before start of period and dod after end of month (or missing dod) - end of month minus start of month
          (
            admission_date < min_start_date &
              discharge_date > max_end_date
          ) ~ time_length(min_start_date %--% max_end_date, "days"),
          # doa equal or greater to start of period (but within month) and dod after end of month (or missing dod)  - end of month minus doa
          (
            admission_date >= min_start_date &
              admission_date <= max_end_date &
              discharge_date > max_end_date
          ) ~ time_length(admission_date %--% max_end_date, "days"),
          # doa on or before start of period and dod on or before end of month (but within month)  - dod minus start of month
          (
            admission_date <= min_start_date &
              discharge_date <= max_end_date &
              discharge_date > min_start_date
          ) ~ time_length(min_start_date %--% discharge_date, "days"),
          # remainder - doa after start of period and dod on or before end of period  - dod minus doa
          (
            admission_date > min_start_date &
              discharge_date <= max_end_date
          ) ~ time_length(admission_date %--% discharge_date, "days"),
          TRUE ~ 0
        )
      )
  }
}

Однако он довольно медленный (мои реальные данные содержат более 2 миллионов строк), и я чувствую, что это можно улучшить, упаковав в fuction, а затем используя purrr (или, возможно,furrr).

Это то, что я до сих пор, кажется, просто зависает, так что я даже не уверен, в чем проблема ...