R/inference.R

In eFCM: Exponential Factor Copula Model

#' Log-likelihood of a fitted factor copula model
#'
#' Extract the log-likelihood value from a fitted \code{fcm} object.
#'
#' @param object An object of class \code{fcm}, typically returned by [fcm()].
#' @param ... Additional arguments (currently unused).
#'
#' @return A numeric value giving the log-likelihood of the fitted model.
#' @importFrom stats AIC BIC logLik
#' @seealso [AIC.fcm()], [BIC.fcm()], [AICc.fcm()]
#' @method logLik fcm
#' @export
#'
logLik.fcm <- function(object, ...) {
  stopifnot(inherits(object, "fcm"))
  object$value
}
#' Akaike Information Criterion (AIC) for fcm objects
#'
#' Compute the AIC value for a fitted \code{fcm} model using the formula:
#' \deqn{\mathrm{AIC} = -2 \cdot \log L + k \cdot p}
#' where \eqn{L} is the likelihood, \eqn{p} is the number of parameters, and \eqn{k} is a penalty parameter.
#'
#' @param object An object of class \code{fcm}, created by [fcm()].
#' @param ... Currently unused.
#' @param k Penalty per parameter (default is \code{k = 2}).
#'
#' @return A numeric scalar giving the AIC value for the fitted model.
#'
#' @seealso [logLik.fcm()], [BIC.fcm()], [AICc.fcm()]
#' @method AIC fcm
#' @export
AIC.fcm <- function(object, ..., k = 2) {
  if (!inherits(object, "fcm")) stop("object is not of class 'fcm'")
  ll <- logLik(object)
  p <- length(object$par)
  aic <- -2 * ll + k * p
  names(aic) <- "AIC"
  return(aic)
}
#' Bayesian Information Criterion (BIC) for fcm objects
#'
#' Compute the BIC value for a fitted \code{fcm} model using the formula:
#' \deqn{\mathrm{BIC} = -2 \cdot \log L + \log(n) \cdot p}
#' where \eqn{n} is the number of observations and \eqn{p} is the number of parameters.
#'
#' @param object An object of class \code{fcm}, created by [fcm()].
#' @param ... Currently unused.
#'
#' @return A numeric scalar giving the BIC value for the fitted model.
#' @method BIC fcm
#' @export
#'
#'
#' @seealso [AIC.fcm()], [AICc.fcm()]
BIC.fcm <- function(object, ...) {
  if (!inherits(object, "fcm")) stop("object is not of class 'fcm'")
  ll <- logLik(object)
  p <- length(object$par)
  n <- nrow(object$data)
  bic <- -2 * ll + log(n) * p
  names(bic) <- "BIC"
  return(bic)
}
#'

#' Corrected Akaike Information Criterion (AICc) for fcm objects
#'
#' Compute the AICc value for a fitted \code{fcm} model using the formula:
#' \deqn{\mathrm{AICc} = \mathrm{AIC} + \frac{2p(p+1)}{n - p - 1}}
#' where \eqn{n} is the number of observations and \eqn{p} is the number of parameters.
#'
#' @param object An object of class \code{fcm}, created by [fcm()].
#' @param ... Currently unused.
#'
#' @return A numeric scalar giving the AICc value for the fitted model.
#' @export
AICc <- function(object, ...) {
  UseMethod("AICc")
}
#' @rdname AICc
#' @method AICc fcm
#' @export
#'
#' @seealso [AIC.fcm()], [BIC.fcm()]
AICc.fcm <- function(object, ...) {
  if (!inherits(object, "fcm")) stop("object is not of class 'fcm'")
  ll <- logLik(object)
  p <- length(object$par)
  n <- nrow(object$data)
  aic <- -2 * ll + 2 * p
  correction <- 2 * p * (p + 1) / (n - p - 1)
  aicc <- aic + correction
  names(aicc) <- "AICc"
  return(aicc)
}