From 11718ab9cf1d9e527fd8f0f869651a6ec17b3c36 Mon Sep 17 00:00:00 2001
From: Joseph <joseph@larmarange.net>
Date: Sun, 14 Dec 2014 11:34:19 +0200
Subject: [PATCH 1/5] a timespan_length method

---
 R/timespans.r | 57 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 57 insertions(+)

diff --git a/R/timespans.r b/R/timespans.r
index b75207e3..364d0f4c 100644
--- a/R/timespans.r
+++ b/R/timespans.r
@@ -134,3 +134,60 @@ is.timespan <- function(x) is(x, "Timespan")
 #' months(6) + days(1)
 #' # "6m 1d 0H 0M 0S"
 NULL
+
+#' Get the length of a time span in any unit of time
+#' @export timespan_length 
+#' @S3method timespan_length default 
+#' @S3method timespan_length Interveal 
+#' @param x a duration, period, difftime or interval
+#' @param unit a character string that specifies with time units to use
+#' @return the length of the interval in the specified unit. A negative number 
+#' connotes a negative interval or duration
+#' @details
+#' When \code{x} is an \code{\link{Interval-class}} object and \code{unit} are years or months,
+#' \code{timespan_length} takes into account the fact that all months and years don't have the
+#' same number of days. In that case, the decimal value of the result corresponds to the fraction
+#'  of time between last anniversary and end date.
+#' 
+#' When \code{x} is a \code{\link{Duration-class}}, \code{\link{Period-class}} or \code{\link{difftime}}
+#' object, length in months or years is based on their their most common lengths in seconds (see \code{\link{timespan}}).
+#' @seealso \code{\link{timespan}}
+#' @keywords chron math period methods
+#' @examples
+#' int <- new_interval(ymd("1980-01-01"), ymd("2014-09-18"))
+#' timespan_length(int, "week")
+#' 
+#' # Exact age
+#' timespan_length(int, "year")
+#' 
+#' # Age at last anniversary
+#' trunc(timespan_length(int, "year"))
+#' 
+#' # Example of difference between intervals and durations
+#' int <- new_interval(ymd("1900-01-01"), ymd("1999-12-31"))
+#' timespan_length(int, "year")
+#' timespan_length(as.duration(int), "year")
+timespan_length <- function(x, unit = "second")
+  UseMethod("timespan_length")
+
+timespan_length.default <- function(x, unit = "second"){
+  as.duration(x) / duration(num = 1, units = unit)
+}
+
+timespan_length.Interval <- function(x, unit = "second"){
+  unit <- standardise_period_names(unit)
+  if (unit %in% c("year","month")){
+    res <- as.period(x, unit=unit)
+    res <- slot(res, unit)
+    direction <- 1 - 2 * as.integer(res<0) # 1 if positive, -1 if negative
+    previous_anniversary <- int_start(x) %m+% (res * period(1, units = unit))
+    next_anniversary <- int_start(x) %m+% ((res + direction) * period(1, units = unit))
+    time_to_now <- as.duration(int_end(x) - previous_anniversary)
+    time_to_next <- as.duration(next_anniversary - previous_anniversary)
+    res <- res + direction * time_to_now / time_to_next
+    return(res)
+  }
+  else 
+    return(as.duration(x) / duration(num = 1, units = unit))
+}
+

From 62c9baa32affc84178db46f49a5eb72f008318a1 Mon Sep 17 00:00:00 2001
From: Joseph <joseph@larmarange.net>
Date: Sun, 14 Dec 2014 13:00:39 +0200
Subject: [PATCH 2/5] typo

---
 R/timespans.r | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/timespans.r b/R/timespans.r
index 364d0f4c..6d660e48 100644
--- a/R/timespans.r
+++ b/R/timespans.r
@@ -138,7 +138,7 @@ NULL
 #' Get the length of a time span in any unit of time
 #' @export timespan_length 
 #' @S3method timespan_length default 
-#' @S3method timespan_length Interveal 
+#' @S3method timespan_length Interval 
 #' @param x a duration, period, difftime or interval
 #' @param unit a character string that specifies with time units to use
 #' @return the length of the interval in the specified unit. A negative number 

From eee09588360b548533038c2d1886f69f9ab53b9a Mon Sep 17 00:00:00 2001
From: Joseph <joseph@larmarange.net>
Date: Mon, 15 Dec 2014 11:08:11 +0200
Subject: [PATCH 3/5] S4 timespan method

---
 R/timespans.r | 41 +++++++++++++++++++++--------------------
 1 file changed, 21 insertions(+), 20 deletions(-)

diff --git a/R/timespans.r b/R/timespans.r
index 6d660e48..e87f6854 100644
--- a/R/timespans.r
+++ b/R/timespans.r
@@ -136,9 +136,7 @@ is.timespan <- function(x) is(x, "Timespan")
 NULL
 
 #' Get the length of a time span in any unit of time
-#' @export timespan_length 
-#' @S3method timespan_length default 
-#' @S3method timespan_length Interval 
+#' @export time_length 
 #' @param x a duration, period, difftime or interval
 #' @param unit a character string that specifies with time units to use
 #' @return the length of the interval in the specified unit. A negative number 
@@ -149,45 +147,48 @@ NULL
 #' same number of days. In that case, the decimal value of the result corresponds to the fraction
 #'  of time between last anniversary and end date.
 #' 
-#' When \code{x} is a \code{\link{Duration-class}}, \code{\link{Period-class}} or \code{\link{difftime}}
-#' object, length in months or years is based on their their most common lengths in seconds (see \code{\link{timespan}}).
+#' When \code{x} is a \code{\link{Duration-class}}, \code{\link{Period-class}} or 
+#' \code{\link{difftime}} object, length in months or years is based on their their most common 
+#' lengths in seconds (see \code{\link{timespan}}).
 #' @seealso \code{\link{timespan}}
 #' @keywords chron math period methods
 #' @examples
 #' int <- new_interval(ymd("1980-01-01"), ymd("2014-09-18"))
-#' timespan_length(int, "week")
+#' time_length(int, "week")
 #' 
 #' # Exact age
-#' timespan_length(int, "year")
+#' time_length(int, "year")
 #' 
 #' # Age at last anniversary
-#' trunc(timespan_length(int, "year"))
+#' trunc(time_length(int, "year"))
 #' 
 #' # Example of difference between intervals and durations
 #' int <- new_interval(ymd("1900-01-01"), ymd("1999-12-31"))
-#' timespan_length(int, "year")
-#' timespan_length(as.duration(int), "year")
-timespan_length <- function(x, unit = "second")
-  UseMethod("timespan_length")
-
-timespan_length.default <- function(x, unit = "second"){
+#' time_length(int, "year")
+#' time_length(as.duration(int), "year")
+time_length <- function(x, unit = "second") {
   as.duration(x) / duration(num = 1, units = unit)
 }
 
-timespan_length.Interval <- function(x, unit = "second"){
+setGeneric("time_length")
+
+
+#' @export
+setMethod("time_length", signature("Interval"), function(x, unit = "second") {
   unit <- standardise_period_names(unit)
   if (unit %in% c("year","month")){
     res <- as.period(x, unit=unit)
     res <- slot(res, unit)
-    direction <- 1 - 2 * as.integer(res<0) # 1 if positive, -1 if negative
+    direction <- sign(res)
     previous_anniversary <- int_start(x) %m+% (res * period(1, units = unit))
     next_anniversary <- int_start(x) %m+% ((res + direction) * period(1, units = unit))
     time_to_now <- as.duration(int_end(x) - previous_anniversary)
     time_to_next <- as.duration(next_anniversary - previous_anniversary)
     res <- res + direction * time_to_now / time_to_next
-    return(res)
+    res
   }
-  else 
-    return(as.duration(x) / duration(num = 1, units = unit))
-}
+  else {
+    as.duration(x) / duration(num = 1, units = unit)
+  }
+})
 

From c0e55a9971fc83d941e8a957c5e41883bbb2c769 Mon Sep 17 00:00:00 2001
From: Joseph <joseph@larmarange.net>
Date: Mon, 15 Dec 2014 11:52:54 +0200
Subject: [PATCH 4/5] some tests for time_length

---
 inst/tests/test-timespans.R | 43 ++++++++++++++++++++++++++++++++++++-
 1 file changed, 42 insertions(+), 1 deletion(-)

diff --git a/inst/tests/test-timespans.R b/inst/tests/test-timespans.R
index 91991419..2e436ba4 100644
--- a/inst/tests/test-timespans.R
+++ b/inst/tests/test-timespans.R
@@ -16,4 +16,45 @@ test_that("is.timespan works as expected",{
 
 test_that("is.timespan handles vectors",{
   expect_that(is.timespan(minutes(1:3)), is_true())
-})
\ No newline at end of file
+})
+
+test_that("time_length works as expected",{
+  expect_that(time_length(period(1, "day")), # period 
+    equals(86400)) 
+  expect_that(time_length(ymd('2014-12-15')-ymd('2014-11-30'), "day"), # difftime 
+    equals(15)) 
+  expect_that(time_length(ymd('2014-12-15')-ymd('2014-11-30'), "week"), 
+    equals(15/7)) 
+  expect_that(time_length(duration(3, "months"), "month"), # duration
+    equals(3))
+  expect_that(time_length(interval(ymd('2014-11-30'), ymd('2014-12-15')), "weeks"), # interval
+    equals(15/7))
+  expect_that(time_length(interval(ymd('1900-01-01'), ymd('1999-12-31')), "years"), 
+    is_less_than(100))
+  expect_that(time_length(as.duration(interval(ymd('1900-01-01'), ymd('1999-12-31'))), "years"), 
+    is_more_than(100))
+  expect_that(-1*time_length(interval(ymd('1900-01-01'), ymd('2000-01-01')), "days"),
+    equals(time_length(int_flip(interval(ymd('1900-01-01'), ymd('2000-01-01'))), "days")))
+  # time_length should work even if date of birth is a 29 Feb
+  expect_that(time_length(interval(ymd('1992-02-29'), ymd('1999-02-28')), "years"), 
+    is_less_than(7))
+  expect_that(time_length(interval(ymd('1992-02-29'), ymd('1999-03-31')), "years"), 
+    is_more_than(7))
+  # With a leap year, we expect same number of days
+  expect_that(-1*time_length(interval(ymd('1992-02-28'), ymd('2000-01-01')), "days"),
+    equals(time_length(int_flip(interval(ymd('1992-02-28'), ymd('2000-01-01'))), "days")))
+  # But for an age in years (years length different)
+  expect_that(
+    -1*time_length(interval(ymd('1992-02-28'), ymd('2000-01-01')), "years")
+    ==time_length(int_flip(interval(ymd('1992-02-28'), ymd('2000-01-01'))), "years"),
+    is_false())
+})
+
+test_that("time_length handles vectors",{
+  expect_that(time_length(days(1:3), unit="days"),
+    equals(1:3))
+  expect_that(time_length(as.interval(days(1:3), start=today()), unit="days"),
+    equals(1:3))
+  expect_that(time_length(as.interval(days(c(1:3,NA)), start=today()), unit="days"),
+    equals(c(1:3,NA)))
+})

From 5119ddb64ff1ab42aadda3a4316d362bc508aec2 Mon Sep 17 00:00:00 2001
From: Joseph <joseph@larmarange.net>
Date: Mon, 29 Dec 2014 12:23:55 +0100
Subject: [PATCH 5/5] Using %m++% (not exported) for positive intervals

---
 R/timespans.r | 38 ++++++++++++++++++++++++++++++++------
 1 file changed, 32 insertions(+), 6 deletions(-)

diff --git a/R/timespans.r b/R/timespans.r
index e87f6854..a7fb12cf 100644
--- a/R/timespans.r
+++ b/R/timespans.r
@@ -179,12 +179,20 @@ setMethod("time_length", signature("Interval"), function(x, unit = "second") {
   if (unit %in% c("year","month")){
     res <- as.period(x, unit=unit)
     res <- slot(res, unit)
-    direction <- sign(res)
-    previous_anniversary <- int_start(x) %m+% (res * period(1, units = unit))
-    next_anniversary <- int_start(x) %m+% ((res + direction) * period(1, units = unit))
-    time_to_now <- as.duration(int_end(x) - previous_anniversary)
-    time_to_next <- as.duration(next_anniversary - previous_anniversary)
-    res <- res + direction * time_to_now / time_to_next
+    if (sign(res)>0) {
+      previous_anniversary <- int_start(x) %m++% (res * period(1, units = unit))
+      next_anniversary <- int_start(x) %m++% ((res + 1) * period(1, units = unit))
+      time_to_now <- as.duration(int_end(x) - previous_anniversary)
+      time_to_next <- as.duration(next_anniversary - previous_anniversary)
+      res <- res + time_to_now / time_to_next
+    } 
+    else {
+      previous_anniversary <- int_start(x) %m+% (res * period(1, units = unit))
+      next_anniversary <- int_start(x) %m+% ((res - 1) * period(1, units = unit))
+      time_to_now <- as.duration(int_end(x) - previous_anniversary)
+      time_to_next <- as.duration(next_anniversary - previous_anniversary)
+      res <- res - time_to_now / time_to_next
+    }
     res
   }
   else {
@@ -192,3 +200,21 @@ setMethod("time_length", signature("Interval"), function(x, unit = "second") {
   }
 })
 
+"%m++%" <- 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_day_plus_one(new[roll])
+  new
+}
+
+.rollback_day_plus_one <- function(dates) {
+  if (length(dates) == 0) 
+    return(structure(vector(length = 0), class = class(dates)))
+  day(dates) <- 1
+  dates
+}