CODEWITHSUNDEEP
rlubridate
brno792
brno792

Reputation: 6799

Lubridate get date of certain day in a month

I want to aggregate my dates on the monthly level. I would like to use the last Saturday of a certain month as the date for that month. I can get the date of a Saturday in a week by doing:

as.Date(paste(6, week(mdy(mydate)), year(mdy(mydate)), sep="-"), "%u-%W-%Y")

but months have different numbers of days, so I cant just do:

as.Date(paste(6, month(mdy(mydate)), year(mdy(mydate)), sep="-"), "%U-%m-%Y")

This doesn't even work, even if I was just trying to get the date of the 6th day of a month.

How can I get the date of the last Saturday of a month? So given a date 09-15-2014 I would get 09-27-2014.

Upvotes: 2

Views: 1092

Answers (2)

G. Grothendieck
G. Grothendieck

Reputation: 269441

1) zoo/cut In the zoo Quick Reference vignette this function appears which given a "Date" class variable, x, returns the same date if its Friday or the next Friday if not:

library(zoo)
nextfri <- function(x) 7 * ceiling(as.numeric(x-5+4) / 7) + as.Date(5-4)

Replacing the 5 with 6 will give the next Saturday

nextsat <- function(x) 7 * ceiling(as.numeric(x-6+4) / 7) + as.Date(6-4)

Now if x is the input and is of Date class, get the first of its month using cut, then get the first of the next month using cut again, find the next Saturday using nextsat and then subtract 7 to get the last Saturday of the input date's month.

the.first <- as.Date(cut(x, "month"))
next.month <- as.Date(cut(the.first + 32, "month")
nextsat(next.month) - 7

To test is out:

library(zoo)
x <- as.Date("2014-09-15")
nextsat <- function(x) 7 * ceiling(as.numeric(x-6+4) / 7) + as.Date(6-4)
the.first <- as.Date(cut(x, "month"))
next.month <- as.Date(cut(the.first + 32, "month"))
nextsat(next.month) - 7
## [1] "2014-09-27"

This only uses vectorized functions so if x were a vector of dates it would still work.

1a) zoo/as.yearmon.Date/as.Date.yearmon We can shorten this by using the fact that as.Date(as.yearmon(x), frac = 1) is the date of the last day of the month where as.yearmon.Date and as.Date.yearmon are zoo methods:

library(zoo)
x <- as.Date("2014-09-15")
nextsat <- function(x) 7 * ceiling(as.numeric(x-6+4) / 7) + as.Date(6-4)
nextsat(as.Date(as.yearmon(x), frac = 1) + 1) - 7
## [1] "2014-09-27"

This is also vectorized.

2) zoo/lubridate The above did not use lubridate but we can rework (1) to use lubridate like this:

library(zoo)
library(lubridate)
nextsat <- function(x) 7 * ceiling(as.numeric(x-6+4) / 7) + as.Date(6-4)
x <- as.Date("2014-09-15")
xx <- x
day(xx) <- 1
month(xx) <- month(xx) + 1
nextsat(xx) - 7
## [1] "2014-09-27"

This is also vectorized.

Upvotes: 5

thelatemail
thelatemail

Reputation: 93813

Using standard R date functions:

x <- as.Date(c("09-15-2014","09-15-2014"),format="%m-%d-%Y")

lastsat <- function(x,day) {
 bits <- sapply(x, function(i) {
  res <- seq.Date(as.Date(format(i,"%Y-%m-01")),length=2,by="1 month")[2] - (1:7)
  res[format(res, "%u") == as.character(day)]
 })
 as.Date(bits, origin="1970-01-01")
}

lastsat(x,6)
#[1] "2014-09-27" "2014-09-27"

Upvotes: 4

Related Questions