#' Residuals for various time series models
#'
#' Returns time series of residuals from a fitted model.
#'
#' Innovation residuals correspond to the white noise process that drives the
#' evolution of the time series model. Response residuals are the difference
#' between the observations and the fitted values (equivalent to `h`-step
#' forecasts). For functions with no `h` argument, `h = 1`. For
#' homoscedastic models, the innovation residuals and the response residuals
#' for `h = 1` are identical. Regression residuals are available for
#' regression models with ARIMA errors, and are equal to the original data
#' minus the effect of the regression variables. If there are no regression
#' variables, the errors will be identical to the original series (possibly
#' adjusted to have zero mean). `arima.errors` is a deprecated function
#' which is identical to `residuals.Arima(object, type="regression")`.
#' For `nnetar` objects, when `type = "innovations"` and `lambda` is used, a
#' matrix of time-series consisting of the residuals from each of the fitted neural networks is returned.
#'
#' @param object An object containing a time series model of class `ar`,
#' `Arima`, `bats`, `ets`, `arfima`, `nnetar`, `stlm` or `tslm`.
#' If `object` is of class `forecast`, then the function will return
#' `object$residuals` if it exists, otherwise it returns the differences between
#' the observations and their fitted values.
#' @param type Type of residual. The `innovation` residuals are estimates of the innovations in the model; these should look like white noise for a well-fitted model. The `response` residuals are equal to the observation minus its fitted value. For many models, `innovation` and `response` residuals will be identical, but not if there has been a transformation used, or for an ETS model with multiplicative errors. A `regression` residual from a dynamic regression model (`residuals.Arima`) is equal to the response variable minus the linear combination of predictors.
#' @param h If `type = "response"`, then the fitted values are computed for
#' `h`-step forecasts.
#' @param ... Other arguments not used.
#' @return A `ts` object.
#' @author Rob J Hyndman
#' @seealso [fitted.Arima()], [checkresiduals()].
#' @keywords ts
#'
#' @export
residuals.forecast <- function(
  object,
  type = c("innovation", "response"),
  ...
) {
  type <- match.arg(type)
  if (type == "innovation") {
    object$residuals
  } else {
    getResponse(object) - fitted(object)
  }
}

#' @rdname residuals.forecast
#' @export
residuals.ar <- function(object, type = c("innovation", "response"), ...) {
  type <- match.arg(type)
  # innovation and response residuals are the same for AR models
  object$resid
}

#' @rdname residuals.forecast
#'
#' @aliases residuals.forecast_ARIMA
#' @examples
#' fit <- Arima(lynx, order = c(4, 0, 0), lambda = 0.5)
#'
#' plot(residuals(fit))
#' plot(residuals(fit, type = "response"))
#' @export
residuals.Arima <- function(
  object,
  type = c("innovation", "response", "regression"),
  h = 1,
  ...
) {
  type <- match.arg(type)
  if (type == "innovation") {
    object$residuals
  } else if (type == "response") {
    getResponse(object) - fitted(object, h = h)
  } else {
    x <- getResponse(object)
    if (!is.null(object$lambda)) {
      x <- BoxCox(x, object$lambda)
    }
    xreg <- getxreg(object)
    # Remove intercept
    if ("intercept" %in% names(object$coef)) {
      xreg <- cbind(rep(1, length(x)), xreg)
    }
    # Return errors
    if (is.null(xreg)) {
      return(x)
    } else {
      norder <- sum(object$arma[1:4])
      return(ts(
        c(
          x - xreg %*% as.matrix(object$coef[(norder + 1):length(object$coef)])
        ),
        frequency = frequency(x),
        start = start(x)
      ))
    }
  }
}

#' @export
residuals.forecast_ARIMA <- residuals.Arima

#' @rdname residuals.forecast
#' @export
residuals.bats <- function(
  object,
  type = c("innovation", "response"),
  h = 1,
  ...
) {
  type <- match.arg(type)
  if (type == "innovation") {
    object$errors
  } else {
    getResponse(object) - fitted(object, h = h)
  }
}

#' @rdname residuals.forecast
#' @export
residuals.tbats <- function(
  object,
  type = c("innovation", "response"),
  h = 1,
  ...
) {
  type <- match.arg(type)
  if (type == "innovation") {
    object$errors
  } else {
    getResponse(object) - fitted(object, h = h)
  }
}

#' @rdname residuals.forecast
#' @export
residuals.ets <- function(
  object,
  type = c("innovation", "response"),
  h = 1,
  ...
) {
  type <- match.arg(type)
  if (type == "innovation") {
    object$residuals
  } else {
    getResponse(object) - fitted(object, h = h)
  }
}

#' @rdname residuals.forecast
#' @export
residuals.ARFIMA <- function(object, type = c("innovation", "response"), ...) {
  type <- match.arg(type)
  if (type == "innovation") {
    if (!is.null(object$residuals)) {
      # Object produced by arfima()
      return(object$residuals)
    } else {
      # Object produced by fracdiff()
      if ("x" %in% names(object)) {
        x <- object$x
      } else {
        x <- eval.parent(parse(text = as.character(object$call)[2]))
      }
      if (!is.null(object$lambda)) {
        x <- BoxCox(x, object$lambda)
      }
      y <- fracdiff::diffseries(x - mean(x), d = object$d)
      fit <- arima(
        y,
        order = c(length(object$ar), 0, length(object$ma)),
        include.mean = FALSE,
        fixed = c(object$ar, -object$ma)
      )
      return(residuals(fit, type = "innovation"))
    }
  } else {
    getResponse(object) - fitted(object)
  }
}

#' @rdname residuals.forecast
#' @export
residuals.nnetar <- function(
  object,
  type = c("innovation", "response"),
  h = 1,
  ...
) {
  type <- match.arg(type)
  if (type == "innovation" && !is.null(object$lambda)) {
    res <- matrix(
      unlist(lapply(object$model, residuals)),
      ncol = length(object$model)
    )
    if (!is.null(object$scalex$scale)) {
      res <- res * object$scalex$scale
    }
  } else {
    res <- getResponse(object) - fitted(object, h = h)
  }

  tspx <- tsp(getResponse(object))
  res <- ts(res, frequency = tspx[3L], end = tspx[2L])

  res
}

#' @rdname residuals.forecast
#' @export
residuals.stlm <- function(object, type = c("innovation", "response"), ...) {
  type <- match.arg(type)
  if (type == "innovation") {
    object$residuals
  } else {
    getResponse(object) - fitted(object)
  }
}

#' @rdname residuals.forecast
#' @export
residuals.tslm <- function(
  object,
  type = c("innovation", "response", "working", "deviance"),
  ...
) {
  type <- match.arg(type)
  if (type %in% c("innovation", "deviance")) {
    object$residuals
  } else {
    getResponse(object) - fitted(object)
  }
}
