Customized floor/ceiling for dates in R

say I have a date range from start to end where start <- as.Date(2009-11-05), end <- as.Date(2009-12-17).

I want a function that essentially acts as a customized floor/ceiling and returns a date interval such that the lower bound is the first date of the form 'yyyy-mm-23' smaller or equal to '2009-11-05' and the upper bound is the first date greater or equal to '2009-12-17' and of the form 'yyyy-mm-22'.

In the above example, the function should return the interval ('2009-10-23, 2009-12-22).

I've tried using seq.Date and using the length function on it but it seems tedious and I wonder if there is a faster solution.

Thanks

Solution

This might be another approach to try. Using lubridate create new start and end dates, substituting the 23rd and 22nd. Then, if the start date precedes the 23rd, subtract a month. Likewise, if the end date exceeds the 22nd, add a month.

start <- as.Date("2009-11-05")
end <- as.Date("2009-12-17")

library(lubridate)

my_fun <- function(start, end) {
  new_start <- start
  day(new_start) <- 23
  new_end <- end
  day(new_end) <- 22
  if (day(start) < 23) new_start = new_start %m-% months(1)
  if (day(end) > 22) new_end = new_end %m+% months(1)
  return(interval(new_start, new_end))
}

my_fun(start, end)

Output

[1] 2009-10-23 UTC--2009-12-22 UTC

Edit: In the comment, the reference day of the month could be greater than 28, which could result in an invalid date. To consider this possibility, one approach is to use the clock package which can handle an invalid date (e.g., Feb. 31), and then resolve to closest day.

start <- as.Date("2009-03-30")
end <- as.Date("2009-12-17")

reference <- 31

library(lubridate)
library(clock)

my_fun <- function(start, end, reference) {
  new_start <- set_day(year_month_day(year(start), month(start)), reference)
  new_end <- set_day(year_month_day(year(end), month(end)), reference)
  if (day(start) < reference) new_start = add_months(new_start, -1) 
  if (day(end) > reference) new_end = add_months(new_end, 1)
  new_start = invalid_resolve(new_start, invalid = "previous") 
  new_end = invalid_resolve(new_end, invalid = "next")
  return(c(new_start, new_end))
}

my_fun(start, end, reference)

Output

[1] "2009-02-28" "2009-12-31"