A base R solution is
date_df <- data.frame(
Date = seq(from=as.Date('2015-01-01'), to=Sys.Date(), by = "month"))
date_df$count <- sapply(date_df$Date, function(x) sum(x >= begin & x <= end))
date_df <- subset(date_df, count > 0)
head(date_df, 10)
#R> Date count
#R> 7 2015-07-01 3
#R> 8 2015-08-01 19
#R> 9 2015-09-01 19
#R> 10 2015-10-01 18
#R> 11 2015-11-01 16
#R> 12 2015-12-01 16
#R> 13 2016-01-01 16
#R> 14 2016-02-01 15
#R> 15 2016-03-01 15
#R> 16 2016-04-01 15
This is perhaps faster but it uses more peak memory
date_df_2 <- data.frame(
Date = seq(from=as.Date('2015-01-01'), to=Sys.Date(), by = "month"))
date_df_2$count <-
rowSums(outer(date_df_2$Date, begin, `>=`) & outer(date_df_2$Date, end, `<=`))
date_df_2 <- subset(date_df_2, count > 0)
# we got the same
all.equal(date_df_2, date_df)
#R> [1] TRUE
The two solutions can be written a bit more nicely in R 4.1.0 or later as follows
date_df_3 <- data.frame(
Date = seq(as.Date('2015-01-01'), Sys.Date(), by = "month")) |>
transform(count = sapply(Date, \(x) sum(x >= begin & x <= end))) |>
subset(count > 0)
date_df_4 <- data.frame(
Date = seq(as.Date('2015-01-01'), Sys.Date(), by = "month")) |>
transform(
count = rowSums(outer(Date, begin, `>=`) & outer(Date, end, `<=`))) |>
subset(count > 0)
# we got the same
all.equal(date_df_3, date_df)
#R> [1] TRUE
all.equal(date_df_4, date_df)
#R> [1] TRUE
You may want to change one of the >= and <= to a > or <.
Here is a simple benchmark which is created by repeating the data provided by the OP
# repeat the data a number of times to create a larger data set
begin <- rep(begin, 1000)
end <- rep(end, 1000)
smallEmp <- data.frame(begin,end)
small_emp <- data.table(begin = begin, end = end)
# perform the benchmark
bench::mark(
OP = method_currentsolution(),
sapply = data.frame(
Date = seq(as.Date('2015-01-01'), Sys.Date(), by = "month")) |>
transform(count = sapply(Date, \(x) sum(x >= begin & x <= end))) |>
subset(count > 0),
rowSums = data.frame(
Date = seq(as.Date('2015-01-01'), Sys.Date(), by = "month")) |>
transform(
count = rowSums(outer(Date, begin, `>=`) & outer(Date, end, `<=`))) |>
subset(count > 0),
data.table = {
all_dates <- data.table(
date = seq(from = as.Date('2015-01-01'), to = Sys.Date(), by = "month"))
all_dates[small_emp, .N, on = .(date >= begin, date <= end), keyby = .(date)]
},
`data.table (by)` = {
all_dates <- data.table(
date = seq(from = as.Date('2015-01-01'), to = Sys.Date(), by = "month"))
all_dates[small_emp, .N, on = .(date >= begin, date <= end), by = .(date)]
},
fuzzy_inner_join = method_fuzzy(smallEmp), check = FALSE, memory = FALSE)
#R> # A tibble: 6 x 13
#R> expression min median `itr/sec` mem_alloc `gc/sec` n_itr n_gc total_time result memory time gc
#R> <bch:expr> <bch:tm> <bch:tm> <dbl> <bch:byt> <dbl> <int> <dbl> <bch:tm> <list> <list> <list> <list>
#R> 1 OP 2.87s 2.87s 0.349 NA 1.74 1 5 2.87s <NULL> <NULL> <bench_tm [1]> <tibble [1 × 3]>
#R> 2 sapply 8.91ms 9.42ms 55.9 NA 7.71 29 4 518.53ms <NULL> <NULL> <bench_tm [29]> <tibble [29 × 3]>
#R> 3 rowSums 28.26ms 56.98ms 15.9 NA 24.7 9 14 566.25ms <NULL> <NULL> <bench_tm [9]> <tibble [9 × 3]>
#R> 4 data.table 23.34ms 23.89ms 25.8 NA 7.95 13 4 503.36ms <NULL> <NULL> <bench_tm [13]> <tibble [13 × 3]>
#R> 5 data.table (by) 23.22ms 28.4ms 33.9 NA 3.99 17 2 500.82ms <NULL> <NULL> <bench_tm [17]> <tibble [17 × 3]>
#R> 6 fuzzy_inner_join 16.09s 16.09s 0.0622 NA 8.21 1 132 16.09s <NULL> <NULL> <bench_tm [1]> <tibble [1 × 3]>
The sapply solution is the fastest. It is about >2 times faster then the seconds fastest which is the data.table version. Thing may look different for other sized data (say millions of data points instead of 19000).
