# R/addition.R In timechange: Efficient Changing of Date-Times

```##' Arithmetics with periods
##'
##' @description Add periods to date-time objects. Periods track the change in
##'   the "clock time" between two civil times. They are measured in common
##'   civil time units: years, months, days, hours, minutes, and seconds.
##'
##' @description Arithmetic operations with multiple period units (years, months
##'   etc) are applied in decreasing size order, from year to second. Thus
##'   `time_add(x, months = 1, days = 3)` first adds 1 to `x` and then 3
##'   days.
##'
##' Generally period arithmetic is undefined due to the irregular nature of
##' civil time and complexities with DST transitions. \pkg{`timechange`} allows
##' for a refined control of what happens when an addition of irregular periods
##' (years, months, days) results in "unclear" date.
##'
##' "2000-01-31 01:02:03"? \pkg{`timechange`} operates by applying larger
##' periods first. First months are added`1 + 1 = February` which results in
##' non-existent time of `2000-02-31 01:02:03`. Here the `roll_month`
##'
##' * `skip` - no adjustment is done to the simple arithmetic operations (the
##' gap is skipped as if it's not there. Thus, `2000-01-31 01:02:03 + 1 month +
##' 3 days` is equivalent to `2000-01-01 01:02:03 + 1 month + 31 days + 3 days`
##' resulting in `2000-03-05 01:02:03`.
##'
##' * `NA` - if any of the intermediate additions result in non-existent dates
##' `NA` is produced. This is how arithmetic in `lubridate` operates.
##'
##' * `boundary` - if an intermediate computation falls in a gap, the date is
##' adjusted to the next valid time. Thus, `2000-01-31 01:02:03 + month =
##' 2000-03-01 00:00:00`.
##'
##' * `next` - is like `boundary` but preserves the smaller units. Thus,
##' `2000-01-31 01:02:03 + 1 month = 2000-03-01 01:02:03`.
##'
##' * `prev` - is like `next` but instead of rolling forward to the first day of
##' the month, it rolls back to the last valid day of the previous month. Thus,
##' `2000-01-31 01:02:03 + 1 month = 2000-02-28 01:02:03`. This is the default.
##'
##' @param time date-time object
##' @param periods string of units to add/subtract (not yet implemented) or a
##'   named list of the form `list(years = 1, months = 2, ...)`.
##' @param years,months,weeks,days,hours,minutes,seconds Units to be added to
##'   `time`. Each unit except for seconds must be expressed as integer values.
##' @param roll_month controls how addition of months and years behaves when
##'   standard arithmetic rules exceed limits of the resulting date's month. See
##'   "Details" for the description of possible values.
##' @param roll_dst controls how to adjust the updated time if it falls within a
##'   DST transition intervals. See the "Details".
##' @examples
##'
##'
##' ## Month gap
##' x <- as.POSIXct("2000-01-31 01:02:03", tz = "America/Chicago")
##' time_add(x, months = 1, roll_month = "first")
##' time_add(x, months = 1, roll_month = "last")
##' time_add(x, months = 1, roll_month = "boundary")
##' time_add(x, months = 1, roll_month = "skip")
##' time_add(x, months = 1, roll_month = "NA")
##' time_add(x, months = 1, days = 3,  roll_month = "first")
##' time_add(x, months = 1, days = 3,  roll_month = "last")
##' time_add(x, months = 1, days = 3,  roll_month = "boundary")
##' time_add(x, months = 1, days = 3,  roll_month = "skip")
##' time_add(x, months = 1, days = 3,  roll_month = "NA")
##'
##' ## DST gap
##' x <- as.POSIXlt("2010-03-14 01:02:03", tz = "America/Chicago")
##' time_add(x, hours = 1, minutes = 50, roll_dst = "first")
##' time_add(x, hours = 1, minutes = 50, roll_dst = "last")
##' time_add(x, hours = 1, minutes = 50, roll_dst = "boundary")
##' time_add(x, hours = 1, minutes = 50, roll_dst = "skip")
##' time_add(x, hours = 1, minutes = 50, roll_dst = "NA")
##'
##' # SUBTRACTION
##'
##' ## Month gap
##' x <- as.POSIXct("2000-03-31 01:02:03", tz = "America/Chicago")
##' time_subtract(x, months = 1, roll_month = "first")
##' time_subtract(x, months = 1, roll_month = "last")
##' time_subtract(x, months = 1, roll_month = "boundary")
##' time_subtract(x, months = 1, roll_month = "skip")
##' time_subtract(x, months = 1, roll_month = "NA")
##' time_subtract(x, months = 1, days = 3,  roll_month = "first")
##' time_subtract(x, months = 1, days = 3,  roll_month = "last")
##' time_subtract(x, months = 1, days = 3,  roll_month = "boundary")
##' time_subtract(x, months = 1, days = 3,  roll_month = "skip")
##' time_subtract(x, months = 1, days = 3,  roll_month = "NA")
##'
##' ## DST gap
##' y <- as.POSIXlt("2010-03-15 01:02:03", tz = "America/Chicago")
##' time_subtract(y, hours = 22, minutes = 50, roll_dst = "first")
##' time_subtract(y, hours = 22, minutes = 50, roll_dst = "last")
##' time_subtract(y, hours = 22, minutes = 50, roll_dst = "boundary")
##' time_subtract(y, hours = 22, minutes = 50, roll_dst = "skip")
##' time_subtract(y, hours = 22, minutes = 50, roll_dst = "NA")
##' @export
time_add <- function(time, periods = NULL,
years = NULL, months = NULL, weeks = NULL, days = NULL,
hours = NULL, minutes = NULL, seconds = NULL,
roll_month = "last",
roll_dst = "first") {

if (length(time) == 0L)
return(time)

roll_month <- match.arg(roll_month[], .roll_types)
roll_dst <- match.arg(roll_dst[], .roll_types)

if (is.null(periods)) {
periods <- list()
} else {
if (!is.list(periods))
stop("character periods are not implemented yet")
}

argperiods <- list(years = years, months = months, weeks = weeks, days = days,
hours = hours, minutes = minutes, seconds = seconds)
for (nm in names(argperiods)) {
if (!is.null(argperiods[[nm]]))
if (is.null(periods[[nm]]))
periods[[nm]] <- argperiods[[nm]]
else
periods[[nm]] <- periods[[nm]] + argperiods[[nm]]
}
periods <- normalize_units_length(periods)

if (is.POSIXct(time)) {
} else if (is.Date(time)) {
out <- date2posixct(time)
attr(out, "tzone") <- "UTC"
out <- C_time_add(out, periods, roll_month, roll_dst)
if (is.null(hours) && is.null(minutes) && is.null(seconds)) {
out <- as.Date(out, tz = "UTC")
}
out
} else if (is.POSIXlt(time)) {
} else {
unsupported_date_time(time)
}
}

##' @export
time_subtract <- function(time, periods = NULL,
years = NULL, months = NULL, weeks = NULL, days = NULL,
hours = NULL, minutes = NULL, seconds = NULL,
roll_month = "last",
roll_dst = "last") {
if (length(time) == 0L)
return(time)

roll_month <- match.arg(roll_month, .roll_types)
roll_dst <- match.arg(roll_dst, .roll_types)

## fixme: no longer needed?
if (roll_dst == "skip")
roll_dst <- "last"

if (is.null(periods)) {
periods <- list()
} else {
if (!is.list(periods))
stop("character periods are not implemented yet")
}
for (nm in names(periods))
periods[[nm]] <- -periods[[nm]]

argperiods <- list(years = years, months = months, weeks = weeks, days = days,
hours = hours, minutes = minutes, seconds = seconds)
for (nm in names(argperiods)) {
if (!is.null(argperiods[[nm]]))
if (is.null(periods[[nm]]))
periods[[nm]] <- -argperiods[[nm]]
else
periods[[nm]] <- periods[[nm]] - argperiods[[nm]]
}
periods <- normalize_units_length(periods)

time_add(time, periods, roll_month = roll_month, roll_dst = roll_dst)

}
```

## Try the timechange package in your browser

Any scripts or data that you put into this service are public.

timechange documentation built on Jan. 13, 2021, 5:19 p.m.