R/interval.R

In brazil-data-cube/eocubes.R: Web Data Cubes Service client for R

#' @title eocubes functions
#'
#' @description  This functions creates an \code{eo_interval} object
#' that is used in \code{get_cube} verb to filter or slice the
#' time dimension of a cube.
#'
#' @param from   A reference start \code{Date}.
#' @param to     A reference end \code{Date}.
#'
#' @return An \code{eo_interval} object.
#'
#' @export
eo_interval <- function(from = NULL, to = NULL) {

  if (is.null(from) && is.null(to))
    stop("Invalid `from` and `to` parameters.", call. = FALSE)

  if (length(from) > 1)
    stop("Invalid `from` parameter.", call. = FALSE)

  if (length(to) > 1)
    stop("Invalid `to` parameter.", call. = FALSE)

  if (!is.null(from))
    if (is.na(from <- as.Date(from, format = "%Y-%m-%d")))
      stop("Invalid `Date` value.", call. = FALSE)

  if (!is.null(to))
    if (is.na(to <- as.Date(to, format = "%Y-%m-%d")))
      stop("Invalid `Date` value.", call. = FALSE)

  if (!is.null(from) && !is.null(to))
    if (from > to)
      stop("Invalid `from` and `to` parameters.", call. = FALSE)

  res <- structure(list(from = from, to = to), class = "eo_interval")

  return(res)
}

#' @export
as.character.eo_interval <- function(x, ...) {

  if (!inherits(x, "eo_interval"))
    stop("Invalid `interval` value.", call. = TRUE)

  res <- paste(.ifnull(.ifnotnull(x$from, format(x$from, "%Y-%m-%d")), ""),
               .ifnull(.ifnotnull(x$to, format(x$to, "%Y-%m-%d")), ""),
               sep = "/")
  return(res)
}

.interval_intersects <- function(x, dates) {

  if (!inherits(x, "eo_interval"))
    stop("Invalid `interval` value.", call. = TRUE)

  if (!inherits(dates, "Date"))
    stop("Invalid `Date` value.", call. = TRUE)

  res <- rep(TRUE, length(dates))

  res <- .ifnull(.ifnotnull(x$from, x$from <= dates), res) &
    .ifnull(.ifnotnull(x$to, dates <= x$to), res)
  return(res)
}