Customized floor/ceiling for dates in R

Question

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

Answer 1

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"

Answer 2

I don't know a function that works like that, but I would code something like this:

Code

custom_bound <- function(date, type, ref_day){
  
  obs_day <- lubridate::day(date)

  if(type == "lower"){aux <- -1}
  
  if(type == "upper"){aux <- 1}      
  
  while(obs_day != ref_day ){
    
    date <- date + days(aux)
    
    obs_day <- lubridate::day(date)
    
  }
  
  return(date)
  
}

Output

> custom_bound(date = as.Date("2009-11-05"),type = "lower",ref_day = 23)
[1] "2009-10-23"

> custom_bound(date = as.Date("2009-12-17"),type = "upper",ref_day = 22)
[1] "2009-12-22"