R/RcppExports.R

In ggdmcLikelihood: Likelihood Computation for 'ggdmc' Package

# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

#' Compute Likelihood for Behavioural Models
#'
#' These functions compute likelihoods for behavioural models, with
#' \code{compute_subject_likelihood} handling a single subject and
#' \code{compute_likelihood} handling multiple subjects.
#'
#' @description Computes the likelihood for multiple subjects by
#' aggregating results from individual subject computations.
#'
#' @param dmis A list of S4 data model instances (one per subject)
#' @param dmi One S4 data model instance (for one subject)
#' @param parameter_r A list (one per subject) of or one numeric vector
#'                    containing model parameters
#' @param debug Logical flag for debug mode (default = FALSE)
#'
#' @return
#' with:
#' \itemize{
#'   \item \code{compute_likelihood} returns a list. Each element is
#'          the likelihood for a subject. The element in the inner list
#'          is the likelihood for a condition.
#'   \item \code{compute_subject_likelihood} returns also a list. Each
#'          element is the likelihood for a condition.
#' }
#'
#' @details These functions provide access to the internal mechanism of 
#' the design-based likelihood computation. They primarily intended to 
#' initialise new 'samples' or to verify that the likelihood evaluations, 
#' when associated with a particular design, are computed accurately.
#'
#' @examples
#' # Example dataset
#' hdat <- data.frame(
#'   RT = round(runif(15, min = 0.4, max = 1.2), 7),
#'   R  = sample(c("r1", "r2", "r3"), size = 15, replace = TRUE),
#'   s  = rep(1:3, each = 5),
#'   S  = rep(c("s1", "s2", "s3"), each = 5),
#'   stringsAsFactors = FALSE
#' )
#' dat <- hdat[hdat$s==1, ]
#'
#' p_vector <- c(A = .75, B = 1.25, mean_v.false = 1.5, mean_v.true = 2.5, t0 = .15)
#' nsubject <- length(unique(hdat$s))
#'
#' if(requireNamespace("ggdmcModel", quietly = TRUE)) {
#'     BuildModel <- getFromNamespace("BuildModel", "ggdmcModel")
#'     BuildDMI   <- getFromNamespace("BuildDMI", "ggdmcModel")
#' 
#'     model <- BuildModel(
#'         p_map = list(A = "1", B = "1", t0 = "1", mean_v = "M", sd_v = "1", st0 = "1"),
#'         match_map = list(M = list(s1 = "r1", s2 = "r2")),
#'         factors = list(S = c("s1", "s2")),
#'         constants = c(st0 = 0, sd_v = 1),
#'         accumulators = c("r1", "r2"),
#'         type = "lba")
#'     pop_dmis <- BuildDMI(hdat, model)
#'     sub_dmis <- BuildDMI(dat, model)
#'
#'     parameters <- list()
#'     for (i in seq_len(nsubject)) {
#'         new_p_vector <- p_vector[model@pnames]
#'         parameters[[i]] <- new_p_vector
#'     }
#'
#'     result1 <- compute_subject_likelihood(sub_dmis[[1]], parameters[[1]], FALSE)
#'     result2 <- compute_likelihood(pop_dmis, parameters, FALSE)
#' }
#'
#' print(result1)
#' print(result2)
#'
#' @export
compute_likelihood <- function(dmis, parameter_r, debug = FALSE) {
    .Call('_ggdmcLikelihood_compute_likelihood', PACKAGE = 'ggdmcLikelihood', dmis, parameter_r, debug)
}

#' @rdname compute_likelihood
#' @export
compute_subject_likelihood <- function(dmi, parameter_r, debug = FALSE) {
    .Call('_ggdmcLikelihood_compute_subject_likelihood', PACKAGE = 'ggdmcLikelihood', dmi, parameter_r, debug)
}