I'm currently re-arranging a health service data. My data frame includes the start and end dates of service use for each individuals
id <- c("A", "A", "B")
start <- c("2018-04-01", "2019-04-02", "2018-09-01")
end <- c("2019-04-01", "2019-04-05", "2018-09-02")
df <- data.frame(id, start, end)
id start end
A 2018-04-01 2019-04-01
A 2019-04-02 2019-04-05
B 2018-09-01 2018-09-02
I want to do the following things: (1) calculate the number of dates in each month for each service use; (2) calculate dates of service use for each individual; (3) construct new columns for all possible months; and (4) generate a new data frame. The ultimate goal is to construct the following data frame:
id 2018_Jan 2018_Feb 2018_Mar 2018_Apr 2018_May 2018_Jun ... 2018_Sep ... 2019_Sep
A 0 0 0 30 31 31 ... 30 ... 1
B 0 0 0 0 0 0 ... 1 ... 0
The lubridate package and function command should be helpful in this. My question is similar to this post Count the number of days in each month of a date range, where it counted the number of days in each month. However, I'm not sure how to apply it to formulate the data frame that I want.
I will be really grateful for your help on this.
CodePudding user response：
Here's one way. First I make all combinations of id, and year-months from jan 2018 to dec 2019. Then, I summarize the data by id and year-month. Finally, join the two datasets together (to make sure you capture the months where nothing happened) and then pivot wider.
library(dplyr)
#>
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#>
#> filter, lag
#> The following objects are masked from 'package:base':
#>
#> intersect, setdiff, setequal, union
library(tidyr)
library(lubridate)
#>
#> Attaching package: 'lubridate'
#> The following objects are masked from 'package:base':
#>
#> date, intersect, setdiff, union
id <- c("A", "A", "B")
start <- c("2018/04/01", "2019-04-02", "2018-09-01")
end <- c("2019-04-01", "2019-04-05", "2018-09-02")
df <- data.frame(id, start, end)
all_dates <- expand.grid(id = unique(df$id),
month = c("Jan", "Feb", "Mar", "Apr", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"),
year = 2018:2019) %>%
mutate(yrmo = paste(year, month, sep="_")) %>%
select(id, yrmo)
df <- df %>%
mutate(start = ymd(start),
end = ymd(end)) %>%
rowwise() %>%
summarise(id = id, obs = 1, dates = seq(start, end, by=1)) %>%
mutate(yrmo = paste(year(dates), month(dates, label=TRUE, abbr=TRUE), sep="_")) %>%
group_by(id, yrmo) %>%
summarise(obs = n()) %>%
full_join(., all_dates) %>%
mutate(yrmo = factor(yrmo, levels = all_dates$yrmo[which(all_dates$id == "A")])) %>%
arrange(id, yrmo) %>%
pivot_wider(names_from="yrmo", values_from="obs") %>%
mutate(across(everything(), ~ifelse(is.na(.x), 0, .x)))
#> `summarise()` has grouped output by 'id'. You can override using the `.groups`
#> argument.
#> Joining, by = c("id", "yrmo")
df
#> # A tibble: 2 × 24
#> # Groups: id [2]
#> id `2018_Jan` `2018_Feb` `2018_Mar` `2018_Apr` `2018_Jun` `2018_Jul`
#> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 A 0 0 0 30 30 31
#> 2 B 0 0 0 0 0 0
#> # … with 17 more variables: `2018_Aug` <dbl>, `2018_Sep` <int>,
#> # `2018_Oct` <dbl>, `2018_Nov` <dbl>, `2018_Dec` <dbl>, `2019_Jan` <dbl>,
#> # `2019_Feb` <dbl>, `2019_Mar` <dbl>, `2019_Apr` <dbl>, `2019_Jun` <dbl>,
#> # `2019_Jul` <dbl>, `2019_Aug` <dbl>, `2019_Sep` <dbl>, `2019_Oct` <dbl>,
#> # `2019_Nov` <dbl>, `2019_Dec` <dbl>, `NA` <dbl>
Created on 2022-03-04 by the reprex package (v2.0.1)
CodePudding user response：
Here's a {tidyverse} solution. This uses dplyr::summarize() to generate the full range of dates for each row and lubridate::floor_date(unit = "month") to convert these to months. Then I count() up month-days for each id and pivot_wider().
library(tidyverse)
library(lubridate)
month_counts <- df %>%
mutate(across(start:end, ymd)) %>%
group_by(id, obs = row_number()) %>%
summarize(
month = floor_date(seq(start, end, by = 1), unit = "month"),
.groups = "drop"
) %>%
count(month, id) %>%
mutate(month = strftime(month, "%Y_%B")) %>%
pivot_wider(
names_from = month,
values_from = n,
values_fill = 0
)
month_counts
# # A tibble: 2 x 14
# id `2018_April` `2018_May` `2018_June` `2018_July` `2018_August`
# <chr> <int> <int> <int> <int> <int>
# 1 A 30 31 30 31 31
# 2 B 0 0 0 0 0
# # ... with 8 more variables: `2018_September` <int>, `2018_October` <int>,
# # `2018_November` <int>, `2018_December` <int>, `2019_January` <int>,
# # `2019_February` <int>, `2019_March` <int>, `2019_April` <int>
I wasn't sure if you actually want empty columns for months with no observations, as in your example. If so, the following wraps tidyr::complete() in a function that imputes all months in all years in the data:
complete_months <- function(.data, month, ..., fill = list()) {
month <- pull(.data, {{ month }})
firstday <- floor_date(min(month, na.rm = TRUE), unit = "year")
lastday <- ceiling_date(max(month, na.rm = TRUE), unit = "year") - 1
allmonths <- seq(firstday, lastday, by = "month")
complete(.data, month = allmonths, ..., fill = fill)
}
month_counts <- df %>%
mutate(across(start:end, ymd)) %>%
group_by(id, obs = row_number()) %>%
summarize(
month = floor_date(seq(start, end, by = 1), unit = "month"),
.groups = "drop"
) %>%
count(month, id) %>%
complete_months(month, id, fill = list(n = 0)) %>%
mutate(month = strftime(month, "%Y_%B")) %>%
pivot_wider(
names_from = month,
values_from = n
)
month_counts
# # A tibble: 2 x 25
# id `2018_January` `2018_February` `2018_March` `2018_April` `2018_May`
# <chr> <int> <int> <int> <int> <int>
# 1 A 0 0 0 30 31
# 2 B 0 0 0 0 0
# # ... with 19 more variables: `2018_June` <int>, `2018_July` <int>,
# # `2018_August` <int>, `2018_September` <int>, `2018_October` <int>,
# # `2018_November` <int>, `2018_December` <int>, `2019_January` <int>,
# # `2019_February` <int>, `2019_March` <int>, `2019_April` <int>,
# # `2019_May` <int>, `2019_June` <int>, `2019_July` <int>, `2019_August` <int>,
# # `2019_September` <int>, `2019_October` <int>, `2019_November` <int>,
# # `2019_December` <int>