Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Wrote %m+% and %m-% for doing arithmetic with months withour rollover…

… at the end of months. Fixes #133.
  • Loading branch information...
commit 9c0c45174f00850092c73e87cff514074782d990 1 parent dbecd30
@garrettgman garrettgman authored
View
1  DESCRIPTION
@@ -66,3 +66,4 @@ Collate:
'data.r'
'guess.r'
'stamp.r'
+ 'ops-%m+%.r'
View
5 NAMESPACE
@@ -46,6 +46,8 @@ S3method(xtfrm,Period)
S3method(yday,default)
S3method(year,default)
export("%--%")
+export("%m+%")
+export("%m-%")
export("%within%")
export("day<-")
export("hour<-")
@@ -163,6 +165,7 @@ export(pretty.year)
export(pretty_dates)
export(reclass_date)
export(reclass_timespan)
+export(rollback)
export(round_date)
export(second)
export(seconds)
@@ -196,6 +199,8 @@ exportMethods("$")
exportMethods("$<-")
exportMethods("%%")
exportMethods("%/%")
+exportMethods("%m+%")
+exportMethods("%m-%")
exportMethods("%within%")
exportMethods("*")
exportMethods("+")
View
1  R/intervals.r
@@ -521,6 +521,7 @@ setMethod("setdiff", signature(x = "Interval", y = "Interval"), function(x,y){
#' @param a An interval or date-time object
#' @param b An interval
#' @return A logical
+#' @examples
#' int <- new_interval(ymd("2001-01-01"), ymd("2002-01-01"))
#' # 2001-01-01 UTC--2002-01-01 UTC
#' int2 <- new_interval(ymd("2001-06-01"), ymd("2002-01-01"))
View
132 R/ops-%m+%.r
@@ -0,0 +1,132 @@
+#' @include timespans.r
+#' @include durations.r
+#' @include intervals.r
+#' @include periods.r
+#' @include Dates.r
+#' @include difftimes.r
+#' @include numeric.r
+#' @include POSIXt.r
+#' @include ops-addition.r
+NULL
+
+#' Add and subtract months to a date without exceeding the last day of the new month
+#'
+#' Adding months frustrates basic arithmetic because consecutive months have different lengths.
+#' With other elements, it is helpful for arithmetic to perform automatic roll over. For
+#' example, 12:00:00 + 61 seconds becomes 12:01:01. However, people often prefer that this behavior
+#' NOT occur with months. For example, we sometimes want January 31 + 1 month = February 28 and not
+#' March 3. %m+% performs this type of arithmetic. Date %m+% months(n) always returns a date in the
+#' nth month after Date. If the new date would usually spill over into the n + 1th month, %m+% will
+#' return the last day of the nth month. Date %m-% months(n) always returns a date in the
+#' nth month before Date.
+#'
+#' %m+% and %m-% do not handle periods less than a month. These must be added separately with traditional
+#' arithmetic. %m+% and %m-% should be used with caution as they are not a one-to-one operations and
+#' results for either will be sensitive to the order of operations.
+#'
+#'
+#' @export
+#' @rdname mplus
+#' @usage e1 \%m+\% e2
+#' @aliases m+ %m+% m- %m-%
+#' @aliases %m+%,Period,ANY-method
+#' @aliases %m+%,ANY,Period-method
+#' @aliases %m-%,Period,ANY-method
+#' @aliases %m-%,ANY,Period-method
+#' @param e1 A period or a date-time object of class \code{\link{POSIXlt}}, \code{\link{POSIXct}
+#' or \code{\link{Date}}.
+#' @param e2 A period or a date-time object of class \code{\link{POSIXlt}}, \code{\link{POSIXct}
+#' or \code{\link{Date}}. Note that one of e1 and e2 must be a period and the other a
+#' date-time object.
+#' @return A date-time object of class POSIXlt, POSIXct or Date
+#' @examples
+#' jan <- ymd_hms("2010-01-31 03:04:05")
+#' # "2010-01-31 03:04:05 UTC"
+#' jan + months(1:3) # Feb 31 and April 31 prompt "rollover"
+#' # "2010-03-03 03:04:05 UTC" "2010-03-31 03:04:05 UTC" "2010-05-01 03:04:05 UTC"
+#' jan %m+% months(1:3) # No rollover
+#' # "2010-02-28 03:04:05 UTC" "2010-03-31 03:04:05 UTC" "2010-04-30 03:04:05 UTC"
+#'
+#' leap <- ymd("2012-02-29")
+#' "2012-02-29 UTC"
+#' leap %m+% years(1)
+#' # "2013-02-28 UTC"
+#' leap %m+% years(-1)
+#' leap %m-% years(1)
+#' # "2011-02-28 UTC"
+"%m+%" <- function(e1,e2) standardGeneric("%m+%")
+
+#' @export
+setGeneric("%m+%")
+
+#' @export
+setMethod("%m+%", signature(e2 = "Period"),
+ function(e1, e2) .month_plus(e1, e2))
+
+#' @export
+setMethod("%m+%", signature(e1 = "Period"),
+ function(e1, e2) .month_plus(e2, e1))
+
+
+#' @export
+"%m-%" <- function(e1,e2) standardGeneric("%m-%")
+
+#' @export
+setGeneric("%m-%")
+
+#' @export
+setMethod("%m-%", signature(e2 = "Period"),
+ function(e1, e2) .month_plus(e1, -e2))
+
+#' @export
+setMethod("%m-%", signature(e1 = "Period"),
+ function(e1, e2) .month_plus(e2, -e1))
+
+
+.month_plus <- function(e1, e2) {
+ if (any(c(e2@.Data, e2@minute, e2@hour, e2@day) != 0))
+ stop("%m+% only handles month and years. Add other periods separately with '+'")
+
+ if (any(e2@year != 0)) e2 <- months(12 * e2@year + e2@month)
+
+ new <- .quick_month_add(e1, e2@month)
+ roll <- day(new) < day(e1)
+ new[roll] <- rollback(new[roll])
+ new
+}
+
+
+.quick_month_add <- function(object, mval) {
+ tzs <- tz(object)
+ utc <- as.POSIXlt(force_tz(object, tzone = "UTC"))
+ utc$mon <- utc$mon + mval
+ utc <- as.POSIXct(utc)
+ new <- force_tz(utc, tzone = tzs)
+ reclass_date(new, object)
+}
+
+#' Roll back date to last day of previous month
+#'
+#' rollback changes a date to the last day of the previous month. The new date retains the same hour,
+#' minute, and second information.
+#'
+#'
+#' @export
+#' @param dates A POSIXct, POSIXlt or Date class object.
+#' @return A date-time object of class POSIXlt, POSIXct or Date, whose day has been adjusted to the
+#' last day of the previous month.
+#' date <- ymd("2010-03-03")
+#' # "2010-03-03 UTC"
+#' rollback(date)
+#' # "2010-02-28 UTC"
+#'
+#' dates <- date + months(0:2)
+#' "2010-03-03 UTC" "2010-04-03 UTC" "2010-05-03 UTC"
+#' rollback(dates)
+#' "2010-02-28 UTC" "2010-03-31 UTC" "2010-04-30 UTC"
+rollback <- function(dates) {
+ if (length(dates) == 0)
+ return(structure(vector(length = 0), class = class(dates)))
+ day(dates) <- 1
+ dates - days(1)
+}
View
1  R/ops-addition.r
@@ -248,3 +248,4 @@ setMethod("+", signature(e1 = "POSIXlt", e2 = "Interval"), function(e1, e2) {
#' @export
setMethod("+", signature(e1 = "POSIXlt", e2 = "Period"),
function(e1, e2) add_period_to_date(e2, e1))
+
View
35 inst/tests/test-ops-addition.R
@@ -252,4 +252,39 @@ test_that("adding vectors works as expected for intervals",{
expect_error(int + eyears(1))
expect_error(int + int2)
+})
+
+
+test_that("%m+% correctly adds months without rollover",{
+ jan <- ymd_hms("2010-01-31 03:04:05")
+ ends <- ymd_hms(c("2010-02-28 03:04:05", "2010-03-31 03:04:05", "2010-04-30 03:04:05"))
+
+ expect_equal(jan %m+% months(1:3), ends)
+})
+
+test_that("%m+% correctly adds years without rollover",{
+ leap <- ymd("2012-02-29")
+ next1 <- ymd("2013-02-28")
+ next2 <- ymd("2013-03-29")
+
+ expect_equal(leap %m+% years(1), next1)
+ expect_equal(leap %m+% new_period(years = 1, months = 1), next2)
+})
+
+test_that("%m+% correctly adds negative months without rollover",{
+ may <- ymd_hms("2010-05-31 03:04:05")
+ ends <- ymd_hms(c("2010-04-30 03:04:05", "2010-03-31 03:04:05", "2010-02-28 03:04:05"))
+
+ expect_equal(may %m+% -months(1:3), ends)
+})
+
+test_that("%m+% correctly adds negative years without rollover",{
+ leap <- ymd("2012-02-29")
+ next1 <- ymd("2011-02-28")
+ next2 <- ymd("2011-01-29")
+ next3 <- ymd("2011-03-29")
+
+ expect_equal(leap %m+% years(-1), next1)
+ expect_equal(leap %m+% new_period(years = -1, months = -1), next2)
+ expect_equal(leap %m+% new_period(years = -1, months = 1), next3)
})
View
37 inst/tests/test-ops-subtraction.R
@@ -99,5 +99,42 @@ test_that("subtraction works as expected for intervals",{
expect_error(int - eminutes(3))
expect_error(int - int2)
+})
+
+
+test_that("%m-% correctly subtracts months without rollover",{
+ may <- ymd_hms("2010-05-31 03:04:05")
+ ends <- ymd_hms(c("2010-04-30 03:04:05", "2010-03-31 03:04:05", "2010-02-28 03:04:05"))
+
+ expect_equal(may %m-% months(1:3), ends)
+})
+
+test_that("%m-% correctly subtracts years without rollover",{
+ leap <- ymd("2012-02-29")
+ next1 <- ymd("2011-02-28")
+ next2 <- ymd("2011-01-29")
+ next3 <- ymd("2011-03-29")
+
+ expect_equal(leap %m-% years(1), next1)
+ expect_equal(leap %m-% new_period(years = 1, months = 1), next2)
+ expect_equal(leap %m-% new_period(years = 1, months = -1), next3)
+})
+test_that("%m-% correctly subtract negative months without rollover",{
+ jan <- ymd_hms("2010-01-31 03:04:05")
+ ends <- ymd_hms(c("2010-02-28 03:04:05", "2010-03-31 03:04:05", "2010-04-30 03:04:05"))
+
+ expect_equal(jan %m-% -months(1:3), ends)
})
+
+test_that("%m-% correctly subtracts negative years without rollover",{
+ leap <- ymd("2012-02-29")
+ next1 <- ymd("2013-02-28")
+ next2 <- ymd("2013-03-29")
+ next3 <- ymd("2013-01-29")
+
+ expect_equal(leap %m-% years(-1), next1)
+ expect_equal(leap %m-% new_period(years = -1, months = -1), next2)
+ expect_equal(leap %m-% new_period(years = -1, months = 1), next3)
+
+})
View
65 man/mplus.Rd
@@ -0,0 +1,65 @@
+\name{\%m+\%}
+\alias{\%m+\%}
+\alias{\%m+\%,ANY,Period-method}
+\alias{\%m+\%,Period,ANY-method}
+\alias{\%m-\%}
+\alias{\%m-\%,ANY,Period-method}
+\alias{\%m-\%,Period,ANY-method}
+\alias{m+}
+\alias{m-}
+\title{Add and subtract months to a date without exceeding the last day of the new month}
+\usage{
+ e1 \%m+\% e2
+}
+\arguments{
+ \item{e1}{A period or a date-time object of class
+ \code{\link{POSIXlt}}, \code{\link{POSIXct} or
+ \code{\link{Date}}.}
+
+ \item{e2}{A period or a date-time object of class
+ \code{\link{POSIXlt}}, \code{\link{POSIXct} or
+ \code{\link{Date}}. Note that one of e1 and e2 must be a
+ period and the other a date-time object.}
+}
+\value{
+ A date-time object of class POSIXlt, POSIXct or Date
+}
+\description{
+ Adding months frustrates basic arithmetic because
+ consecutive months have different lengths. With other
+ elements, it is helpful for arithmetic to perform
+ automatic roll over. For example, 12:00:00 + 61 seconds
+ becomes 12:01:01. However, people often prefer that this
+ behavior NOT occur with months. For example, we sometimes
+ want January 31 + 1 month = February 28 and not March 3.
+ %m+% performs this type of arithmetic. Date %m+%
+ months(n) always returns a date in the nth month after
+ Date. If the new date would usually spill over into the n
+ + 1th month, %m+% will return the last day of the nth
+ month. Date %m-% months(n) always returns a date in the
+ nth month before Date.
+}
+\details{
+ %m+% and %m-% do not handle periods less than a month.
+ These must be added separately with traditional
+ arithmetic. %m+% and %m-% should be used with caution as
+ they are not a one-to-one operations and results for
+ either will be sensitive to the order of operations.
+}
+\examples{
+jan <- ymd_hms("2010-01-31 03:04:05")
+# "2010-01-31 03:04:05 UTC"
+jan + months(1:3) # Feb 31 and April 31 prompt "rollover"
+# "2010-03-03 03:04:05 UTC" "2010-03-31 03:04:05 UTC" "2010-05-01 03:04:05 UTC"
+jan \%m+\% months(1:3) # No rollover
+# "2010-02-28 03:04:05 UTC" "2010-03-31 03:04:05 UTC" "2010-04-30 03:04:05 UTC"
+
+leap <- ymd("2012-02-29")
+"2012-02-29 UTC"
+leap \%m+\% years(1)
+# "2013-02-28 UTC"
+leap \%m+\% years(-1)
+leap \%m-\% years(1)
+# "2011-02-28 UTC"
+}
+
View
25 man/rollback.Rd
@@ -0,0 +1,25 @@
+\name{rollback}
+\alias{rollback}
+\title{Roll back date to last day of previous month}
+\usage{
+ rollback(dates)
+}
+\arguments{
+ \item{dates}{A POSIXct, POSIXlt or Date class object.}
+}
+\value{
+ A date-time object of class POSIXlt, POSIXct or Date,
+ whose day has been adjusted to the last day of the
+ previous month. date <- ymd("2010-03-03") # "2010-03-03
+ UTC" rollback(date) # "2010-02-28 UTC"
+
+ dates <- date + months(0:2) "2010-03-03 UTC" "2010-04-03
+ UTC" "2010-05-03 UTC" rollback(dates) "2010-02-28 UTC"
+ "2010-03-31 UTC" "2010-04-30 UTC"
+}
+\description{
+ rollback changes a date to the last day of the previous
+ month. The new date retains the same hour, minute, and
+ second information.
+}
+
View
18 man/within-interval.Rd
@@ -12,17 +12,21 @@
\item{b}{An interval}
}
\value{
- A logical int <- new_interval(ymd("2001-01-01"),
- ymd("2002-01-01")) # 2001-01-01 UTC--2002-01-01 UTC int2
- <- new_interval(ymd("2001-06-01"), ymd("2002-01-01")) #
- 2001-06-01 UTC--2002-01-01 UTC
-
- ymd("2001-05-03") %within% int # TRUE int2 %within% int #
- TRUE ymd("1999-01-01") %within% int # FALSE
+ A logical
}
\description{
%within% returns TRUE if a falls within interval b, FALSE
otherwise. If a is an interval, both its start and end
dates must fall within b to return TRUE.
}
+\examples{
+int <- new_interval(ymd("2001-01-01"), ymd("2002-01-01"))
+# 2001-01-01 UTC--2002-01-01 UTC
+int2 <- new_interval(ymd("2001-06-01"), ymd("2002-01-01"))
+# 2001-06-01 UTC--2002-01-01 UTC
+
+ymd("2001-05-03") \%within\% int # TRUE
+int2 \%within\% int # TRUE
+ymd("1999-01-01") \%within\% int # FALSE
+}
Please sign in to comment.
Something went wrong with that request. Please try again.