1#' @include timespans.r 2#' @include durations.r 3#' @include intervals.r 4#' @include periods.r 5#' @include Dates.r 6#' @include difftimes.r 7#' @include numeric.r 8#' @include POSIXt.r 9#' @include ops-addition.r 10NULL 11 12#' Add and subtract months to a date without exceeding the last day of the new month 13#' 14#' Adding months frustrates basic arithmetic because consecutive months have 15#' different lengths. With other elements, it is helpful for arithmetic to 16#' perform automatic roll over. For example, 12:00:00 + 61 seconds becomes 17#' 12:01:01. However, people often prefer that this behavior NOT occur with 18#' months. For example, we sometimes want January 31 + 1 month = February 28 and 19#' not March 3. \code{\%m+\%} performs this type of arithmetic. Date \code{\%m+\%} months(n) 20#' always returns a date in the nth month after Date. If the new date would 21#' usually spill over into the n + 1th month, \code{\%m+\%} will return the last day of 22#' the nth month ([rollback()]). Date \code{\%m-\%} months(n) always returns a 23#' date in the nth month before Date. 24#' 25#' \code{\%m+\%} and \code{\%m-\%} handle periods with components less than a month by first 26#' adding/subtracting months and then performing usual arithmetics with smaller 27#' units. 28#' 29#' \code{\%m+\%} and \code{\%m-\%} should be used with caution as they are not one-to-one 30#' operations and results for either will be sensitive to the order of 31#' operations. 32#' 33#' @rdname mplus 34#' @usage e1 \%m+\% e2 35#' @aliases m+ %m+% m- %m-% %m+%,ANY,ANY-method %m-%,ANY,ANY-method %m+%,Period,ANY-method %m+%,ANY,Period-method %m-%,Period,ANY-method %m-%,ANY,Period-method %m+%,Duration,ANY-method %m+%,ANY,Duration-method %m-%,Duration,ANY-method %m-%,ANY,Duration-method %m+%,Interval,ANY-method %m+%,ANY,Interval-method %m-%,Interval,ANY-method %m-%,ANY,Interval-method 36#' @param e1 A period or a date-time object of class [POSIXlt], [POSIXct] 37#' or [Date]. 38#' @param e2 A period or a date-time object of class [POSIXlt], [POSIXct] 39#' or [Date]. Note that one of e1 and e2 must be a period and the other a 40#' date-time object. 41#' @return A date-time object of class POSIXlt, POSIXct or Date 42#' @examples 43#' jan <- ymd_hms("2010-01-31 03:04:05") 44#' jan + months(1:3) # Feb 31 and April 31 returned as NA 45#' # NA "2010-03-31 03:04:05 UTC" NA 46#' jan %m+% months(1:3) # No rollover 47#' 48#' leap <- ymd("2012-02-29") 49#' "2012-02-29 UTC" 50#' leap %m+% years(1) 51#' leap %m+% years(-1) 52#' leap %m-% years(1) 53#' @export 54"%m+%" <- function(e1, e2) standardGeneric("%m+%") 55 56#' @export 57setGeneric("%m+%") 58 59#' @export 60setMethod("%m+%", signature(e2 = "Period"), 61 function(e1, e2) add_with_rollback(e1, e2)) 62 63#' @export 64setMethod("%m+%", signature(e1 = "Period"), 65 function(e1, e2) add_with_rollback(e2, e1)) 66 67#' @export 68setMethod("%m+%", signature(e2 = "ANY"), 69 function(e1, e2) 70 stop("%m+% handles only Period objects as second argument")) 71 72#' @export 73"%m-%" <- function(e1, e2) standardGeneric("%m-%") 74 75#' @export 76setGeneric("%m-%") 77 78#' @export 79setMethod("%m-%", signature(e2 = "Period"), 80 function(e1, e2) add_with_rollback(e1, -e2)) 81 82#' @export 83setMethod("%m-%", signature(e1 = "Period"), 84 function(e1, e2) add_with_rollback(e2, -e1)) 85 86#' @export 87setMethod("%m-%", signature(e2 = "ANY"), 88 function(e1, e2) 89 stop("%m-% handles only Period objects as second argument")) 90 91#' `add_with_rollback()` is like \code{\%m+\%} and \code{\%m-\%} with more 92#' control over the rollback process. It allows the rollback to first day of the 93#' month instead of the last day of the previous month and controls whether HMS 94#' component of the end date is preserved or not. Please note that the rollback 95#' kicks in only when the resulting date lands on the non-existing date. 96#' @rdname mplus 97#' @param roll_to_first rollback to the first day of the month instead of the 98#' last day of the previous month (passed to [rollback()]) 99#' @param preserve_hms retains the same hour, minute, and second information? If 100#' FALSE, the new date will be at 00:00:00 (passed to [rollback()]) 101#' @examples 102#' 103#' x <- ymd_hms("2019-01-29 01:02:03") 104#' add_with_rollback(x, months(1)) 105#' add_with_rollback(x, months(1), preserve_hms = FALSE) 106#' add_with_rollback(x, months(1), roll_to_first = TRUE) 107#' add_with_rollback(x, months(1), roll_to_first = TRUE, preserve_hms = FALSE) 108#' @export 109add_with_rollback <- function(e1, e2, roll_to_first = FALSE, preserve_hms = TRUE) { 110 111 any_HMS <- any(e2@.Data != 0) || any(e2@minute != 0) || any(e2@hour != 0) || any(e2@day != 0) 112 any_year <- any(e2@year != 0) 113 if (!is.na(any_year) && any_year) { 114 e2$month <- 12 * e2@year + e2@month 115 e2$year <- 0L 116 } 117 118 new <- .quick_month_add(e1, e2@month) 119 roll <- day(new) < day(e1) 120 roll <- !is.na(roll) & roll 121 new[roll] <- rollback(new[roll], roll_to_first = roll_to_first, preserve_hms = preserve_hms) 122 123 if (!is.na(any_HMS) && any_HMS) { 124 e2$month <- 0L 125 new + e2 126 } else { 127 new 128 } 129} 130 131.quick_month_add <- function(object, mval) { 132 tzs <- tz(object) 133 utc <- as.POSIXlt(force_tz(object, tzone = "UTC")) 134 utc$mon <- utc$mon + mval 135 utc <- as.POSIXct(utc) 136 new <- force_tz(utc, tzone = tzs, roll = TRUE) 137 reclass_date(new, object) 138} 139 140#' Roll backward or forward a date the previous, current or next month 141#' 142#' `rollbackward()` changes a date to the last day of the previous month or to 143#' the first day of the month. `rollforward()` rolls to the last day of the 144#' current month or to the first day of the next month. Optionally, the new date 145#' can retain the same hour, minute, and second information. `rollback()` is a 146#' synonym for `rollbackward()`. 147#' 148#' @export 149#' @param dates A POSIXct, POSIXlt or Date class object. 150#' @param roll_to_first Rollback to the first day of the month instead of the 151#' last day of the month 152#' @param preserve_hms Retains the same hour, minute, and second information? If 153#' FALSE, the new date will be at 00:00:00. 154#' @return A date-time object of class POSIXlt, POSIXct or Date, whose day has 155#' been adjusted to the last day of the previous month, or to the first day of 156#' the month. 157#' @examples 158#' date <- ymd("2010-03-03") 159#' rollbackward(date) 160#' 161#' dates <- date + months(0:2) 162#' rollbackward(dates) 163#' 164#' date <- ymd_hms("2010-03-03 12:44:22") 165#' rollbackward(date) 166#' rollbackward(date, roll_to_first = TRUE) 167#' rollbackward(date, preserve_hms = FALSE) 168#' rollbackward(date, roll_to_first = TRUE, preserve_hms = FALSE) 169rollbackward <- function(dates, roll_to_first = FALSE, preserve_hms = TRUE) { 170 .roll(dates, roll_to_first, preserve_hms) 171} 172 173#' @rdname rollbackward 174#' @export 175rollback <- rollbackward 176 177#' @rdname rollbackward 178#' @export 179rollforward <- function(dates, roll_to_first = FALSE, preserve_hms = TRUE) { 180 .roll(dates, roll_to_first, preserve_hms, forward = TRUE) 181} 182 183.roll <- function(dates, roll_to_first, preserve_hms, forward = FALSE) { 184 if (length(dates) == 0) 185 return(dates) 186 day(dates) <- 1 187 if (!preserve_hms) { 188 hour(dates) <- 0 189 minute(dates) <- 0 190 second(dates) <- 0 191 } 192 if (forward) { 193 dates <- dates + months(1) 194 } 195 if (roll_to_first) { 196 dates 197 } else { 198 dates - days(1) 199 } 200} 201