R/other.R

In twolodzko/boots: Nonparametric Bootstrap/Resampling-Based Time-Series Forecasting

#' @importFrom forecast BoxCox InvBoxCox ma
NULL


#' Loess for a single variable
#' 
#' @param x     numeric or ts vector.
#' @param \dots other arguments passed to \code{\link[stats]{loess}}.
#' 
#' @importFrom stats loess
#' @export

loe <- function(x, ...) {
  res <- loess(x ~ seq_along(x), ...)$fitted
  cloneAttributes(x, res)
}


#' Calculate block-wise means
#' 
#' @param x       numeric or ts vector.
#' @param na.rm a logical value indicating whether NA values should be stripped
#'                before the computation proceeds.
#' 
#' @export

blockMeans <- function(x, groups = floor(time(x)), na.rm = TRUE) {
  bmeans <- tapply(x, groups, mean, na.rm = na.rm)
  res <- rep(bmeans, rle(as.numeric(groups))$lengths)
  cloneAttributes(x, res)
}


# clone attributes from one object to another - use with caution!

cloneAttributes <-function(from, to) {
  attributes(to) <- attributes(from)
  return(to)
}


# test for being THE vector

is.simple.vector <- function(x) {
  is.atomic(x) && !is.recursive(x) && !is.array(x)
}