I have a more elegant way, but I doubt that it is really performant. One way to do it would be to use purrr::map_dfc and loop over the dates vector.
library(tidyverse)
library(lubridate)
dates <- yday(ceiling_date(dmy(sapply(1:11, function(x) paste0("01/", x, "/2009"))), "month") %m-% days(1))
foo <- data.frame(id = 1:1000000) %>%
mutate(
datdeb = round(runif(n(), 1, 365)),
datfin = round(runif(n(), datdeb, 365)),
etp = runif(n()),
group = round(runif(n(), 1, 1000))
)
foo %>%
group_by(group) %>%
mutate(m_size = rowMeans(
map_dfc(set_names(dates, dates),
~ sum(.x >= datdeb & .x <= datfin))
)
) %>%
summarise(m_size = mean(m_size))
#> # A tibble: 1,000 x 2
#> group m_size
#> <dbl> <dbl>
#> 1 1 141.
#> 2 2 258.
#> 3 3 298.
#> 4 4 283.
#> 5 5 286.
#> 6 6 274.
#> 7 7 263.
#> 8 8 273
#> 9 9 272.
#> 10 10 261.
#> # … with 990 more rows
Created on 2021-04-28 by the reprex package (v0.3.0)
If you are interested in the intermediate columns than I have a package on Github called {dplyover} which can loop over vectors to create nicely named columns. It is not very performant, but looking at the benchmarks it seems perform not too bad (see benchmarks below).
library(dplyover) # https://timteafan.github.io/dplyover/
foo %>%
group_by(group) %>%
mutate(over(dates,
~ sum(.x >= datdeb & .x <= datfin),
.names = "size_date{x}"))
#> # A tibble: 1,000,000 x 16
#> # Groups: group [1,000]
#> id datdeb datfin etp group size_date31 size_date59 size_date90
#> <int> <dbl> <dbl> <dbl> <dbl> <int> <int> <int>
#> 1 1 233 234 0.0322 581 82 154 218
#> 2 2 185 305 0.452 956 97 171 221
#> 3 3 237 281 0.0410 735 90 162 232
#> 4 4 255 290 0.290 646 86 159 222
#> 5 5 57 215 0.762 748 78 156 245
#> 6 6 42 218 0.343 243 80 154 215
#> 7 7 52 66 0.329 238 75 145 215
#> 8 8 138 158 0.724 681 81 150 221
#> 9 9 19 135 0.285 542 87 172 235
#> 10 10 300 330 0.0665 61 79 151 212
#> # … with 999,990 more rows, and 8 more variables: size_date120 <int>,
#> # size_date151 <int>, size_date181 <int>, size_date212 <int>,
#> # size_date243 <int>, size_date273 <int>, size_date304 <int>,
#> # size_date334 <int>
Created on 2021-04-28 by the reprex package (v0.3.0)
This would be my data.table approach, but I think, there are better ways to do it, and maybe other users chime in here.
foo_dat <- as.data.table(foo)
foo_dt[, paste0("size_date", 1:11) := lapply(dates,
function(x) {
sum(x >= datdeb & x <= datfin)
}),
by = group
][,
.(m_size = rowMeans(.SD)),
by = group,
.SDcols = paste0("size_date", 1:11)
][,
.(m_size = mean(m_size)),
by = group
]
Benchmarks
Here are some benchmarks for the four approaches mentioned above: the original loop, map, over and data.table. I had some trouble with the loop, therefore I included foo <- foo2 to undo the changes. To be fair, I added a similar line, although not necessary, to the other three approaches. over was surprisingly faster than expected, but still far from being really performant. Admittedly, my data.table approach is not really efficient. There are definitely better ways to do this in data.table which should be much faster.
library(tidyverse)
library(lubridate)
library(dplyover) # https://github.com/TimTeaFan/dplyover
library(data.table)
dates <- yday(ceiling_date(dmy(sapply(1:11, function(x) paste0("01/", x, "/2009"))), "month") %m-% days(1))
foo <- data.frame(id = 1:1000000) %>%
mutate(
datdeb = round(runif(n(), 1, 365)),
datfin = round(runif(n(), datdeb, 365)),
etp = runif(n()),
group = round(runif(n(), 1, 1000))
)
foo_dt <- as.data.table(foo)
foo2 <- foo
test <- bench::mark(iterations = 50L, check = FALSE,
"loop" = {
for(i in 1:11){
foo <- foo %>%
group_by(group) %>%
mutate(
"size_date{i}" := sum((.env$dates[i] >= datdeb & .env$dates[i] <= datfin))
)
}
foo %>%
mutate(
m_size = rowMeans(across(starts_with("size_date")))
) %>%
group_by(group) %>%
summarise(
m_size = mean(m_size)
)
foo <- foo2
},
"map" = {
foo2 %>%
group_by(group) %>%
mutate(m_size = rowMeans(
map_dfc(set_names(dates, dates),
~ sum(.x >= datdeb & .x <= datfin))
)
) %>%
summarise(m_size = mean(m_size))
foo <- foo2
},
"over" = {
foo2 %>%
group_by(group) %>%
mutate(m_size = rowMeans(
over(dates,
~ sum(.x >= datdeb & .x <= datfin),
.names = "size_date{x}")
)
) %>%
summarise(m_size = mean(m_size))
foo <- foo2
},
"datatable" = {
foo_dt[, paste0("size_date", 1:11) := lapply(dates, function(x) sum(x >= datdeb & x <= datfin)),
by = group
][,
.(m_size = rowMeans(.SD)),
by = group,
.SDcols = paste0("size_date", 1:11)
][,
.(m_size = mean(m_size)),
by = group
]
foo <- foo2
})
#> Warning: Some expressions had a GC in every iteration; so filtering is disabled.
test
#> # A tibble: 4 x 6
#> expression min median `itr/sec` mem_alloc `gc/sec`
#> <bch:expr> <bch:tm> <bch:tm> <dbl> <bch:byt> <dbl>
#> 1 loop 1.45s 1.61s 0.627 727MB 3.95
#> 2 map 916.06ms 998.53ms 0.985 186MB 5.24
#> 3 over 649.82ms 701.65ms 1.37 186MB 4.29
#> 4 datatable 856.88ms 921.75ms 1.06 271MB 1.80
Created on 2021-04-28 by the reprex package (v0.3.0)
