R/formatting_fits_agg_dm.R

In dRiftDM: Estimating (Time-Dependent) Drift Diffusion Models

# FUNCTONS FOR PRINTING/SUMMARIZING ---------------------------------------

#' @rdname estimate_dm
#' @export
print.fits_agg_dm <- function(x, ...) {
  fits_agg <- x
  sum_obj <- summary(fits_agg) # for easier access to infos
  print(sum_obj, just_header = TRUE)
  invisible(x)
}


#' @rdname summary.fits_agg_dm
#' @export
print.summary.fits_agg_dm <- function(
  x,
  ...,
  just_header = FALSE,
  round_digits = drift_dm_default_rounding()
) {
  summary_obj <- x

  # same information as print.fits_agg_dm
  cat("Fit approach: aggregated - classical\n")
  print_classes(
    header = "Fitted model type:",
    class_vector = summary_obj$summary_drift_dm_obj$class
  )
  print_estimate_info(summary_obj$summary_drift_dm_obj$estimate_info)
  cat("N Individuals:", summary_obj$obs_data$N, "\n")
  print_trial_numbers(
    trials_vector = summary_obj$obs_data$avg_trials,
    round_digits = 0,
    header = "Average Trial Numbers:\n"
  )

  if (!just_header) {
    cat("\n")
    cat("Parameters:\n")
    print(round(summary_obj$prms, round_digits))

    cat("\n")
    print_cost_function(
      cost_function_label = summary_obj$summary_drift_dm_obj$cost_function
    )

    cat("\n")
    print_fit_stats(
      fit_stats = summary_obj$summary_drift_dm_obj$fit_stats,
      round_digits = round_digits
    )

    cat("\n-------\n")
    solver <- summary_obj$summary_drift_dm_obj$solver
    prms_solve <- summary_obj$summary_drift_dm_obj$prms_solve
    print_deriving_pdfs(
      solver = solver,
      prms_solve = prms_solve
    )
  }
  invisible(x)
}


#' Summary and Printing for `fits_agg_dm` Objects
#'
#' Methods for summarizing and printing objects of the class `fits_agg_dm`,
#' which contain model fits based on aggregated data across participants.
#'
#' @param object an object of class `fits_agg_dm`, typically generated by a call
#'   to [dRiftDM::estimate_dm].
#' @param x an object of class `summary.fits_agg_dm`.
#' @param round_digits an integer, specifying the number of decimal places for
#'   rounding in the printed summary. Default is 3.
#' @inheritParams summary.fits_ids_dm
#'
#' @details
#' The `summary.fits_agg_dm` function creates a structured summary of a
#' `fits_agg_dm` object, containing:
#'
#' - **summary_drift_dm_obj**: A list with information about the underlying
#'   drift diffusion model (as returned by [dRiftDM::summary.drift_dm()]).
#' - **prms**: Parameter estimates obtained from the model fit.
#'   This is equivalent to a call to [dRiftDM::coef.drift_dm()] on the stored
#'   model object.
#' - **obs_data**: A list providing the number of individual participants and
#'   the average number of trials per condition across participants.
#'
#' The `print.summary.fits_agg_dm` function formats and prints the above summary
#' in a human-readable form.
#'
#' @return
#' `summary.fits_agg_dm()` returns a list of class `summary.fits_agg_dm`
#' (see Details for its structure).
#'
#' `print.summary.fits_agg_dm()` returns the input object invisibly.
#'
#' @examples
#' # Load example fit object
#' fits_agg <- get_example_fits("fits_agg")
#' sum_obj <- summary(fits_agg)
#' print(sum_obj, round_digits = 2)
#'
#' @seealso [dRiftDM::summary.drift_dm], [dRiftDM::coef.drift_dm]
#'
#' @export
summary.fits_agg_dm <- function(object, ..., select_unique = FALSE) {
  fits_agg <- object
  ans <- list()

  # summary of the model itself
  ans$summary_drift_dm_obj <- unclass(summary(fits_agg$drift_dm_obj))
  ans$prms <- coef(fits_agg$drift_dm_obj, select_unique = select_unique)

  # Infos subjects
  n_avg_trials <- get_avg_trials(fits_agg$obs_data_ids)
  ans$obs_data <- n_avg_trials

  class(ans) <- "summary.fits_agg_dm"
  return(ans)
}