R/trajeRmodelSelection.R

In trajeR: Group Based Modeling Trajectory

# -----------------------------------
# compute the BIC function to a model
# -----------------------------------
#' @title Bayesian Information Criterion (BIC) for a Trajectory Object
#'
#' @description Calculates the Bayesian Information Criterion (BIC) for a model fitted by `trajeR`.
#'
#' @param sol A trajectory object returned by the `trajeR` function.
#' @return A numeric value representing the BIC.
#' @export
#' @examples
#' data <- read.csv(system.file("extdata", "CNORM2gr.csv", package = "trajeR"))
#' data <- as.matrix(data)
#' sol <- trajeR(Y = data[, 2:6], A = data[, 7:11], degre = c(2, 2), Model = "CNORM", Method = "EM")
#' trajeRBIC(sol)
trajeRBIC <- function(sol) {
  -2 * sol$Likelihood + log(sol$Size) * nrow(sol$tab)
}
# -----------------------------------
# compute the AIC function to a model
# -----------------------------------
#' @title Akaike Information Criterion (AIC) for a Trajectory Object
#'
#' @description Calculates the Akaike Information Criterion (AIC) for a model fitted by `trajeR`.
#'
#' @param sol A trajectory object returned by the `trajeR` function.
#' @return A numeric value representing the AIC.
#' @export
#' @examples
#' data <- read.csv(system.file("extdata", "CNORM2gr.csv", package = "trajeR"))
#' data <- as.matrix(data)
#' sol <- trajeR(Y = data[, 2:6], A = data[, 7:11], degre = c(2, 2), Model = "CNORM", Method = "EM")
#' trajeRAIC(sol)
trajeRAIC <- function(sol) {
  -2 * sol$Likelihood + 2 * nrow(sol$tab)
}
# -----------------------------------
# compute the SH function to a model
# -----------------------------------
#' @title Slope Heuristic for Trajectory Model Selection
#'
#' @description Applies the slope heuristic (from the `capushe` package) to a list of `trajeR` models to select the best one.
#'
#' @param l A list of trajectory objects returned by the `trajeR` function.
#' @return An object of class `DDSE` from the `capushe` package, containing the selected model and related information.
#' @export
#' @examples
#' data <- read.csv(system.file("extdata", "CNORM2gr.csv", package = "trajeR"))
#' degre <- list(
#'  c(2, 2),
#'  c(1, 1),
#'  c(1, 2),
#'  c(2, 1),
#'  c(2, 0),
#'  c(0, 2),
#'  c(3, 2),
#'  c(3, 1),
#'  c(2, 3),
#'  c(1, 3)
#')
#' sol <- list()
#' for (i in 1:length(degre)) {
#'   sol[[i]] <- trajeR(
#'     Y = data[, 2:6], A = data[, 7:11],
#'     degre = degre[[i]], Model = "CNORM", Method = "EM"
#'   )
#' }
#' trajeRSH(sol)
trajeRSH <- function(l) {
  data <- data.frame(
    model = l[[1]]$groups,
    pen = (nrow(l[[1]]$tab) - 1) / l[[1]]$Size,
    complexity = nrow(l[[1]]$tab) - 1,
    contrast = -l[[1]]$Likelihood
  )
  for (i in 2:length(l)) {
    data <- rbind(
      data,
      c(
        l[[i]]$groups,
        (nrow(l[[i]]$tab) - 1) / l[[i]]$Size,
        nrow(l[[i]]$tab) - 1,
        -l[[i]]$Likelihood
      )
    )
  }
  return(capushe::DDSE(data))
}