R/subset.R

In projections: Project Future Case Incidence

#' Subsetting 'projections' objects
#'
#' Two functions can be used to subset projections objects. The operator "[" can
#' be used as for matrices, using the syntax \code{x[i,j]} where 'i' is a subset
#' of dates, and 'j' is a subset of simulations.
#'
#' @author Thibaut Jombart \email{thibautjombart@@gmail.com}
#'
#'
#' @rdname subset
#'
#' @aliases "subset.projections" "[.projections"
#'
#' @seealso The \code{\link{project}} function to generate the 'projections'
#'   objects.
#'
#' @param x An projections object, generated by the function
#'   \code{\link{project}}.
#'
#' @param from The starting date; data strictly before this date are discarded.
#'
#' @param to The ending date; data strictly after this date are discarded.
#'
#' @param sim (optional) The simulations to retained, indicated as subsets of
#'   the columns of x.
#'
#' @param ... Further arguments passed to other methods (not used).
#'



#' @export
#' @param i a subset of dates to retain
#' @param j a subset of groups to retain

"[.projections" <- function(x, i, j){
  if (missing(i)) {
    i <- TRUE
  }

  if (missing(j)) {
    j <- TRUE
  }

  ## we first subset the incidence matrix and then handle the dates; procedure
  ## is not totally straightforward and needs to work for different types of
  ## dates: numeric, integer, Date, etc.

  out <- as.matrix(x)[i, j, drop = FALSE]

  old_dates <- get_dates(x)
  names(old_dates) <- as.character(old_dates)
  new_dates_chr <- rownames(out)
  new_dates <- old_dates[new_dates_chr]
  new_dates <- unname(new_dates)
  
  cumulative <- attr(x, "cumulative")

  new_projections(out, new_dates, cumulative)
}



#' @export
#' @rdname subset
subset.projections <- function(x, ..., from = NULL, to = NULL,
                               sim = TRUE){

  ## We need to make sure the comparison with dates is going to work. As for the
  ## [ operator, 'from' and 'to' are assumed to be expressed in the same way as
  ## the attr(x, "dates").

  dates <- attr(x, "dates")

  if (is.null(from)) {
    from  <- min(dates, na.rm = TRUE)
  }

  if (is.null(to)) {
    to  <- max(dates, na.rm = TRUE)
  }

  to.keep <- dates >= from & dates <= to

  if (sum(to.keep) < 1) {
    stop("No data retained.")
  }
  x[to.keep, sim]
}