Optimize expand/pivot_wider R to tag all months of a time period

user_5672777 0
Viewed 47

I'm working with a dataset of 1,3M rows and 4 columns, 1 row per policy and for each a starting date and an end date.
My objective is to determine how many active policies I get per month, meaning within each time interval [deb;fin], how many obs for each month of the interval. enter image description here

Using tidyverse, I managed to create the following code, which is efficient on small datasets, but take almost 50 min to run on the input datasets described above.

Any advice to optimize expand > pivot_wider process ? Or maybe I'm not doing it the right way ? Thank you very much for your ideas !

library(tidyverse)
library(lubridate)

n <- 200

df <- data.frame(id = (1:n),
                 deb = sample(seq(as.Date('2020/01/01'), as.Date('2020/04/01'), by="day"), n, replace = T),
                 fin = sample(seq(as.Date('2020/05/01'), as.Date('2020/07/01'), by="day"), n, replace = T)
                 )

system.time((df2 <- df %>% 
              select(id, deb, fin) %>%
              group_by(id, deb, fin) %>% 
              expand(dtmonth = format(seq.Date(floor_date(deb, "month"),
                                               ceiling_date(fin, "month")-1,
                                               by = "month"), "%Y-%m")) %>%
              mutate(nb = 1) %>%
              pivot_wider(names_from = dtmonth, values_from = nb)))
tidyverse r optimization
1 Answers

This should be a bit faster. It uses only base R Date functions and sapply

seqMon <- strftime( seq.Date( from=min(c(df$deb, df$fin)), 
  to=max(c(df$deb, df$fin)), by="month" ), format="%Y-%m" )

df2 <- cbind( df, sapply( seqMon, function(x) 
  strftime( df$deb, format="%Y-%m" ) <= x & strftime( df$fin, format="%Y-%m" ) >= x ) )

head(df2)
  id        deb        fin 2020-01 2020-02 2020-03 2020-04 2020-05 2020-06
1  1 2020-02-19 2020-05-24   FALSE    TRUE    TRUE    TRUE    TRUE   FALSE
2  2 2020-03-09 2020-05-15   FALSE   FALSE    TRUE    TRUE    TRUE   FALSE
3  3 2020-01-12 2020-05-26    TRUE    TRUE    TRUE    TRUE    TRUE   FALSE
4  4 2020-01-08 2020-05-05    TRUE    TRUE    TRUE    TRUE    TRUE   FALSE
5  5 2020-03-16 2020-05-29   FALSE   FALSE    TRUE    TRUE    TRUE   FALSE
6  6 2020-03-11 2020-06-03   FALSE   FALSE    TRUE    TRUE    TRUE    TRUE
  2020-07
1   FALSE
2   FALSE
3   FALSE
4   FALSE
5   FALSE
6   FALSE

To get 1's and NAs

df2[,4:10][df2[,4:10] == FALSE] <- NA
df2[,4:10] <- df2[,4:10] * 1

 head(df2)
  id        deb        fin 2020-01 2020-02 2020-03 2020-04 2020-05 2020-06
1  1 2020-02-19 2020-05-24      NA       1       1       1       1      NA
2  2 2020-03-09 2020-05-15      NA      NA       1       1       1      NA
3  3 2020-01-12 2020-05-26       1       1       1       1       1      NA
4  4 2020-01-08 2020-05-05       1       1       1       1       1      NA
5  5 2020-03-16 2020-05-29      NA      NA       1       1       1      NA
6  6 2020-03-11 2020-06-03      NA      NA       1       1       1       1
  2020-07
1      NA
2      NA
3      NA
4      NA
5      NA
6      NA
user_94620950
Related