# R/increment.R In dint: A Toolkit for Year-Quarter, Year-Month and Year-Isoweek Dates

#### Defines functions increment.date_yincrement.date_ywincrement.date_ymincrement.date_yqincrement

```#' Increment date_xx objects
#'
#' @param x object to increment
#' @param inc Value by which to increment (usually integer)
#'
#' @return
#'   An object of the same type as `x` increment by `inc`
#' @noRd
increment <- function(x, inc = 1){
assert(
is_scalar(inc) ||
is_equal_length(x, inc) ||
is_scalar(x),
"When adding or subtracting from date_xx objects, both elements must ",
"either be of the same length, or one of them must be of length one."
)

UseMethod("increment", x)
}

increment.date_yq <- function(x, inc){
if (is_scalar(x) && length(inc) > 1){
x <- rep(x, length(inc))
}

d <- yqs_matrix_from_numeric(x)
d[, 2] <- d[, 2] + inc

y_add <- d[, 2] %/% 4
q_new <- d[, 2] %% 4

sel <- q_new == 0
q_new[sel] <- 4L

d[, 1] <- d[, 1] + y_add * d[, 3]
d[, 2] <- q_new

date_yq(d[, 1] * d[, 3], d[, 2])
}

increment.date_ym <- function(x, inc){
if (is_scalar(x) && length(inc) > 1){
x <- rep(x, length(inc))
}

d <- yms_matrix_from_numeric(x)
d[, 2] <- d[, 2] + inc

y_add <- d[, 2] %/% 12
q_new <- d[, 2] %% 12

sel <- q_new == 0
q_new[sel] <- 12L

d[, 1] <- d[, 1] + y_add * d[, 3]
d[, 2] <- q_new

date_ym(d[, 1] * d[, 3], d[, 2])
}

increment.date_yw <- function(x, inc){
if (is_scalar(x) && length(inc) > 1){
x <- rep(x, length(inc))
}

x <- first_of_isoweek(x)
as_date_yw(x + 7L * inc)
}

increment.date_y <- function(x, inc){
if (is_scalar(x) && length(inc) > 1){
x <- rep(x, length(inc))
}

date_y(as.integer(x) + inc)
}
```

## Try the dint package in your browser

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

dint documentation built on Oct. 17, 2022, 9:06 a.m.