Lubridate получить дату определенного дня в месяц

Question

Я хочу агрегировать свои даты на ежемесячном уровне. Я хотел бы использовать последнюю субботу определенного месяца в качестве даты этого месяца. я могу получить дату в субботу в неделю, выполнив:

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

но месяца имеют различное количество дней, так что я не могу просто сделать:

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

Это даже не работает, даже если я просто пытался получить дату 6-го числа месяца.

Как я могу получить дату последней субботы месяца? Поэтому дана дата 09-15-2014 Я бы получил 09-27-2014.

Answer 1

1) зоопарк/вырезать В zoo Quick Reference vignette появляется эта функция данной переменной "Date" класса, x, возвращает ту же дату, если его пятницу или в следующую пятницу, если не:

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

Замена 5 с 6 даст следующую субботу

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

Теперь, если x является входным и финиковых класса, получить первый его месяц, используя cut, в n получите первый из следующего месяца, используя cut, найдите следующую субботу, используя nextsat, а затем вычтите 7, чтобы получить последнюю субботу месяца ввода.

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

Для теста из:

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" 

Это использует только векторизованные функции, так что если x были вектор дат он будет работать.

1a) зоопарк/as.yearmon.Date/as.Date.yearmon Мы можем сократить это, используя тот факт, что as.Date(as.yearmon(x), frac = 1) является дата последнего дня месяца, где as.yearmon.Date и as.Date.yearmon методы зоопарка:

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" 

Это также векторная графика.

2) Зоопарк/lubridate выше не использовать lubridate, но мы можем переработать (1) использовать lubridate так:

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" 

Это также векторизации.

Answer 2

Используя стандартные функции даты R:

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"