R/inars_methods.R

In rdmatheus/inars: INARS(1) Model for Integer-Valued Time Series

#' @name inars-methods
#' @title Methods for 'inars' objects
#'
#' @param x,object an object of class \code{inars}.
#' @param ... optionally more fitted model objects.
#' @param k numeric, the *penalty* per parameter to be used;
#'  the default \code{k = 2} is the classical AIC.
#'
#' @references Medeiros, R. & Bourguignon, M. (2021).
#'
#' @author Rodrigo M. R. Medeiros <\email{rodrigo.matheus@live.com}>
NULL

#' @rdname inars-methods
#' @export
print.inars <- function(x, ...)
{
  p <- length(x$estimates) - 2
  rownames(x$estimates) <- " "

  cat("\n----------------------------\n")
  cat(" Fit of the INARS(1) model:\n")
  cat("----------------------------\n")

  cat("Call:\n")
  print(x$call)
  cat("\nParameter estimates:\n")
  print(x$estimates)
  cat("\nInnovation process:", x$innovation,"\n---\n")
}

#' @rdname inars-methods
#' @export
summary.inars <- function(object, ...)
{
  if (object$method == "MM"){
    stop("\nSummary is not applicable when using moment estimators\n")
  }

  cl <- object$call

  n <- object$nobs
  p <- length(object$estimates) - 2

  # Summary for residuals
  r <- object$residuals
  TAB.residuals <- round(cbind(mean(r),
                               stats::sd(r),
                               mean( ((r - mean(r))/stats::sd(r))^3 ),
                               mean( ((r - mean(r))/stats::sd(r))^4)),
                               6)
  colnames(TAB.residuals) <- c("Mean", "Sd", "Skewness", "Kurtosis")
  rownames(TAB.residuals) <- " "

  # Summary for estimates
  est <- object$estimates
  if(object$method == "CML"){
    se  <- sqrt(diag(object$vcov))
    zval <- est / se
    pval <- 2 * stats::pnorm(abs(zval), lower.tail = FALSE)
  }else{
    se <- zval <- pval <- rep(NA, p + 2)
  }

  TAB.est <- cbind(Estimate = matrix(est, ncol = 1),
                   `Std. Error` = matrix(se, ncol = 1),
                   `z value` = matrix(zval, ncol = 1),
                   `Pr(>|z|)` = matrix(pval, ncol = 1))
  rownames(TAB.est) <- colnames(object$estimates)
  colnames(TAB.est) <- c("Estimate", "Std. Error", "z value", "Pr(>|z|)")

  # Quantities
  logLik <- object$logLik
  AIC <- -2 * object$logLik + 2 * (p + 2); names(AIC) <- " "
  BIC <- -2 * object$logLik + log(object$nobs) * (p + 2); names(BIC) <- " "

  # Out
  out <- list(call = cl,
              est = TAB.est,
              innovation = object$innovation,
              residuals = TAB.residuals,
              logLik = logLik, AIC = AIC, BIC = BIC,
              p = p)

  class(out) <- "summary.inars"
  out
}

#' @rdname inars-methods
#' @export
print.summary.inars <- function(x, ...)
{

  p <- x$p

  cat("\n----------------------------\n")
  cat(" Fit of the INARS(1) model:\n")
  cat("----------------------------\n")

  cat("\nCall:\n")
  print(x$call)

  cat("\nResiduals summary:\n")
  print(x$residuals)

  if (p > 1L){
    cat("\nMean coefficients:\n")
    stats::printCoefmat(x$est[2:(p + 1), ])
    cat("\nEstimates of alpha and disp:\n")
    print(x$est[c(1, p + 2), 1:2])
  }else{
    cat("\nParameter estimates:\n")
    print(x$est[, 1:2])
  }

  cat("\nInnovation process: Zt ~", x$innovation,"(mu, disp)\n")
  cat("\nIn addition, Conditional log-lik value:", x$logLik,
      "\nAIC:", x$AIC, "and BIC:", x$BIC)
  cat("\n---\n")
}

#' @rdname inars-methods
#' @export
vcov.inars <- function(object, ...) {
  vcov <- object$vcov
  rownames(vcov) <- colnames(vcov) <- colnames(object$estimates)
  vcov
}

# Log-likelihood
#' @rdname inars-methods
#' @export
logLik.inars <- function(object, ...) {
  structure(object$logLik,
            df = object$nobs - length(object$estimates),
            class = "logLik")
}

# AIC
#' @rdname inars-methods
#' @export
AIC.inars <- function(object, ..., k = 2) {
  AIC <- - 2 * object$logLik + k * length(object$estimates)
  class(AIC) <- "AIC"
  return(AIC)
}

utils::globalVariables("x")