我有一個大約 330 000 行的資料集。每個觀察代表一個人獲得稱為“護理津貼”的福利福利的時期。當受助人因嚴重疾病而不得不全職照顧孩子或陪他們去專科醫療機構時，該福利旨在替代收入。
2017 年有關福利的立法發生了變化，我的研究問題之一涉及受助人口規模和構成的變化。我的資料集包含有關從 2016 年 1 月 1 日到 2021 年 12 月 31 日的每個福利接收案例的資訊。
我想描繪隨著時間的推移由護理津貼計劃補償的作業日數量的發展。在許多情況下，接受護理津貼的期限可以跨越數年。我想計算從 2016 年到 2021 年每年的接收期的開始日期和結束日期的間隔內的作業日數（例如星期一到星期五）。
我只能計算每年的平日數。我將非常感謝有關如何修改我的代碼以便df$bdays == df$days計算vars(days16:days21)作業日數的建議。
更新
@Marcus 的建議在小型資料集上運行良好，但在我的較大資料集上執行需要花費大量時間（超過一個半小時）。我想出了一個解決方案purrr::map2_dbl()
原始代碼：
library(bizdays)
library(lubridate)
library(dplyr)
id <- sort(sample(1:100, 1000, replace = T))
start_date <- sample(seq(ymd("2016-01-01"), ymd("2021-12-30"), by="day"), 1000)
end_date <- sample(seq(ymd("2016-01-01"), ymd("2021-12-31"), by="day"), 1000)
df <- data.frame(id, start_date, end_date) %>%
filter(end_date > start_date) %>%
mutate(interval = interval(start = start_date, end = end_date))
df <- df %>%
mutate(days16 = as.period(intersect(interval, interval(ymd("2016-01-01"), ymd("2016-12-31"))))%/%days(1),
days17 = as.period(intersect(interval, interval(ymd("2017-01-01"), ymd("2017-12-31"))))%/%days(1),
days18 = as.period(intersect(interval, interval(ymd("2018-01-01"), ymd("2018-12-31"))))%/%days(1),
days19 = as.period(intersect(interval, interval(ymd("2019-01-01"), ymd("2019-12-31"))))%/%days(1),
days20 = as.period(intersect(interval, interval(ymd("2020-01-01"), ymd("2020-12-31"))))%/%days(1),
days21 = as.period(intersect(interval, interval(ymd("2021-01-01"), ymd("2021-12-31"))))%/%days(1))
df[is.na(df)] <- 0
cal <- create.calendar(name = "mycal", weekdays=c("saturday", "sunday"))
df <- df %>%
mutate(days = days16 days17 days18 days19 days20 days21) %>%
mutate(bdays = bizdays(start_date, end_date, cal)) %>%
arrange(id, start_date)
head(df, n = 10)
#> id start_date end_date interval days16 days17 days18
#> 1 1 2016-03-15 2017-04-20 2016-03-15 UTC--2017-04-20 UTC 289 110 0
#> 2 1 2016-07-10 2018-12-14 2016-07-10 UTC--2018-12-14 UTC 173 364 347
#> 3 1 2018-03-06 2021-01-11 2018-03-06 UTC--2021-01-11 UTC 0 0 298
#> 4 1 2018-09-01 2019-04-21 2018-09-01 UTC--2019-04-21 UTC 0 0 121
#> 5 2 2016-04-27 2019-04-28 2016-04-27 UTC--2019-04-28 UTC 247 364 364
#> 6 2 2016-08-13 2019-09-10 2016-08-13 UTC--2019-09-10 UTC 139 364 364
#> 7 2 2016-10-03 2017-10-05 2016-10-03 UTC--2017-10-05 UTC 88 277 0
#> 8 2 2018-05-12 2018-07-17 2018-05-12 UTC--2018-07-17 UTC 0 0 65
#> 9 2 2019-08-29 2021-10-11 2019-08-29 UTC--2021-10-11 UTC 0 0 0
#> 10 2 2019-10-08 2020-08-05 2019-10-08 UTC--2020-08-05 UTC 0 0 0
#> days19 days20 days21 days bdays
#> 1 0 0 0 399 287
#> 2 0 0 0 884 634
#> 3 364 364 10 1036 744
#> 4 111 0 0 232 164
#> 5 118 0 0 1093 782
#> 6 252 0 0 1119 801
#> 7 0 0 0 365 263
#> 8 0 0 0 65 46
#> 9 123 364 283 770 552
#> 10 83 217 0 300 216
由reprex 包于 2022-09-30 創建(v2.0.1)
uj5u.com熱心網友回復：
我會將該bizdays函式rowwise應用于每個條目（警告這可能需要一段時間才能運行）。這允許您使用開始/結束日期或一年的開始/結束日期來定義bizdays. 還將日歷的定義上移，將其設定為financial = FALSE. 否則，如果一年中的最后一天是作業日（計算年份時），則不會計算在內。
cal <- create.calendar(name = "mycal", weekdays=c("saturday", "sunday"), financial = FALSE)
df <- df %>%
rowwise() |>
mutate(
days16 = bizdays(max(start_date, ymd("2016-01-01")), min(end_date, ymd("2016-12-31")), cal),
days17 = bizdays(max(start_date, ymd("2017-01-01")), min(end_date, ymd("2017-12-31")), cal),
days18 = bizdays(max(start_date, ymd("2018-01-01")), min(end_date, ymd("2018-12-31")), cal),
days19 = bizdays(max(start_date, ymd("2019-01-01")), min(end_date, ymd("2019-12-31")), cal),
days20 = bizdays(max(start_date, ymd("2020-01-01")), min(end_date, ymd("2020-12-31")), cal),
days21 = bizdays(max(start_date, ymd("2021-01-01")), min(end_date, ymd("2021-12-31")), cal)
)
df[is.na(df) | df < 0] <- 0
df <- df %>%
mutate(days = days16 days17 days18 days19 days20 days21) %>%
mutate(bdays = bizdays(start_date, end_date, cal)) %>%
arrange(id, start_date)
df |>
as.data.frame() |>
head(n = 10)
#> id start_date end_date interval days16 days17 days18
#> 1 1 2017-02-06 2017-04-03 2017-02-06 UTC--2017-04-03 UTC 0 41 0
#> 2 1 2017-07-18 2018-05-27 2017-07-18 UTC--2018-05-27 UTC 0 119 105
#> 3 1 2019-02-06 2019-12-26 2019-02-06 UTC--2019-12-26 UTC 0 0 0
#> 4 1 2019-04-29 2020-02-15 2019-04-29 UTC--2020-02-15 UTC 0 0 0
#> 5 2 2016-01-07 2018-08-05 2016-01-07 UTC--2018-08-05 UTC 257 260 155
#> 6 2 2016-02-22 2016-11-17 2016-02-22 UTC--2016-11-17 UTC 194 0 0
#> 7 2 2016-12-04 2021-05-19 2016-12-04 UTC--2021-05-19 UTC 20 260 261
#> 8 2 2018-08-28 2020-09-26 2018-08-28 UTC--2020-09-26 UTC 0 0 90
#> 9 3 2016-10-21 2017-10-24 2016-10-21 UTC--2017-10-24 UTC 51 212 0
#> 10 3 2017-02-08 2021-07-04 2017-02-08 UTC--2021-07-04 UTC 0 233 261
#> days19 days20 days21 days bdays
#> 1 0 0 0 41 41
#> 2 0 0 0 224 224
#> 3 232 0 0 232 232
#> 4 177 33 0 210 210
#> 5 0 0 0 672 672
#> 6 0 0 0 194 194
#> 7 261 262 99 1163 1163
#> 8 261 193 0 544 544
#> 9 0 0 0 263 263
#> 10 261 262 131 1148 1148
all(df3$days == df3$bdays)
#> [1] TRUE
uj5u.com熱心網友回復：
我設法使用purrr::map2_dbl(). 該函式允許一個人指定預期的輸出，處理時間可以減少到不到一分鐘：
library(bizdays)
library(lubridate)
library(dplyr)
library(purrr)
id <- sort(sample(1:100, 1000, replace = T))
start_date <- sample(seq(ymd("2016-01-01"), ymd("2021-12-30"), by="day"), 1000)
end_date <- sample(seq(ymd("2016-01-01"), ymd("2021-12-31"), by="day"), 1000)
cal <- create.calendar(name = "mycal", weekdays=c("saturday", "sunday"), financial = FALSE)
df <- data.frame(id, start_date, end_date) %>%
filter(end_date > start_date) %>%
mutate(interval = interval(start = start_date, end = end_date))
df <- df %>%
mutate(days16 = bizdays(as_date(map2_dbl(df$start_date, rep(ymd("2016-01-01"), nrow(df)), max)),
as_date(map2_dbl(df$end_date, rep(ymd("2016-12-31"), nrow(df)), min)), cal),
days17 = bizdays(as_date(map2_dbl(df$start_date, rep(ymd("2017-01-01"), nrow(df)), max)),
as_date(map2_dbl(df$end_date, rep(ymd("2017-12-31"), nrow(df)), min)), cal),
days18 = bizdays(as_date(map2_dbl(df$start_date, rep(ymd("2018-01-01"), nrow(df)), max)),
as_date(map2_dbl(df$end_date, rep(ymd("2018-12-31"), nrow(df)), min)), cal),
days19 = bizdays(as_date(map2_dbl(df$start_date, rep(ymd("2019-01-01"), nrow(df)), max)),
as_date(map2_dbl(df$end_date, rep(ymd("2019-12-31"), nrow(df)), min)), cal),
days20 = bizdays(as_date(map2_dbl(df$start_date, rep(ymd("2020-01-01"), nrow(df)), max)),
as_date(map2_dbl(df$end_date, rep(ymd("2020-12-31"), nrow(df)), min)), cal),
days21 = bizdays(as_date(map2_dbl(df$start_date, rep(ymd("2021-01-01"), nrow(df)), max)),
as_date(map2_dbl(df$end_date, rep(ymd("2021-12-31"), nrow(df)), min)), cal))
df[is.na(df) | df < 0] <- 0
df <- df %>%
mutate(days = days16 days17 days18 days19 days20 days21) %>%
mutate(bdays = bizdays(start_date, end_date, cal)) %>%
arrange(id, start_date)
head(df, 10)
#> id start_date end_date interval days16 days17 days18
#> 1 1 2016-02-26 2016-04-12 2016-02-26 UTC--2016-04-12 UTC 33 0 0
#> 2 1 2016-03-12 2017-04-12 2016-03-12 UTC--2017-04-12 UTC 210 73 0
#> 3 1 2016-10-11 2018-08-12 2016-10-11 UTC--2018-08-12 UTC 59 260 160
#> 4 1 2017-03-23 2021-08-14 2017-03-23 UTC--2021-08-14 UTC 0 202 261
#> 5 1 2017-04-21 2021-08-05 2017-04-21 UTC--2021-08-05 UTC 0 181 261
#> 6 1 2017-05-21 2018-07-17 2017-05-21 UTC--2018-07-17 UTC 0 160 142
#> 7 1 2017-08-07 2019-10-03 2017-08-07 UTC--2019-10-03 UTC 0 105 261
#> 8 1 2018-02-28 2019-07-30 2018-02-28 UTC--2019-07-30 UTC 0 0 219
#> 9 1 2019-02-02 2019-09-17 2019-02-02 UTC--2019-09-17 UTC 0 0 0
#> 10 1 2020-02-16 2021-12-03 2020-02-16 UTC--2021-12-03 UTC 0 0 0
#> days19 days20 days21 days bdays
#> 1 0 0 0 33 33
#> 2 0 0 0 283 283
#> 3 0 0 0 479 479
#> 4 261 262 161 1147 1147
#> 5 261 262 155 1120 1120
#> 6 0 0 0 302 302
#> 7 198 0 0 564 564
#> 8 151 0 0 370 370
#> 9 162 0 0 162 162
#> 10 0 229 241 470 470
all(df$days == df$bdays)
#> [1] TRUE
由reprex 包于 2022-10-05 創建(v2.0.1)
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/513123.html
標籤：r日期润滑天商务日