| Title: | Likelihood Contribution Models for Heterogeneous Observation Types |
|---|---|
| Description: | Constructs likelihood models from heterogeneous observation types by composing named contributions. Each observation type (exact, left-censored, right-censored, interval-censored, or custom) contributes independently to the total log-likelihood, which is summed under an i.i.d. assumption. Provides contr_name() for standard R distributions and contr_fn() for user-defined contributions, composed via likelihood_contr() into objects compatible with the likelihood.model inference framework. |
| Authors: | Alexander Towell [aut, cre] (ORCID: <https://orcid.org/0000-0001-6443-9897>) |
| Maintainer: | Alexander Towell <[email protected]> |
| License: | MIT + file LICENSE |
| Version: | 0.1.1 |
| Built: | 2026-05-24 09:28:49 UTC |
| Source: | https://github.com/queelius/likelihood.contr |
Returns the character vector of model assumptions stored in the
likelihood_contr object. The "iid" assumption is always included.
## S3 method for class 'likelihood_contr' assumptions(model, ...)## S3 method for class 'likelihood_contr' assumptions(model, ...)
model |
A |
... |
Additional arguments (currently unused). |
Character vector of assumptions.
model <- likelihood_contr( obs_type = "status", exact = contr_name("exp", "exact", ob_col = "t"), assumptions = c("exponential distribution", "non-informative censoring") ) assumptions(model)model <- likelihood_contr( obs_type = "status", exact = contr_name("exp", "exact", ob_col = "t"), assumptions = c("exponential distribution", "non-informative censoring") ) assumptions(model)
Wraps user-provided log-likelihood, score, and Hessian functions into
a "contr" S3 object suitable for use in likelihood_contr().
contr_fn(loglik, score = NULL, hess = NULL)contr_fn(loglik, score = NULL, hess = NULL)
loglik |
A function |
score |
Optional function |
hess |
Optional function |
The loglik function must have signature function(df, par, ...) and
return a scalar log-likelihood value. The optional score and hess
functions must have the same signature and return a numeric vector
(score) or matrix (Hessian), respectively.
A "contr" S3 object (a list) with elements $loglik (function),
$score (function or NULL), and $hess (function or NULL). Pass
this object to likelihood_contr() to include it in a composed model.
# Exponential exact-observation contribution my_contr <- contr_fn( loglik = function(df, par, ...) { sum(dexp(df$x, rate = par[1], log = TRUE)) }, score = function(df, par, ...) { n <- nrow(df) c(rate = n / par[1] - sum(df$x)) } )# Exponential exact-observation contribution my_contr <- contr_fn( loglik = function(df, par, ...) { sum(dexp(df$x, rate = par[1], log = TRUE)) }, score = function(df, par, ...) { n <- nrow(df) c(rate = n / par[1] - sum(df$x)) } )
Generates a "contr" object for a standard R distribution using the
d<name> (PDF) and p<name> (CDF) functions. Exact observations use
the PDF, right-censored use the survival function, left-censored use
the CDF, and interval-censored use the CDF difference.
contr_name(dist_name, type, ob_col = "x", ob_col_upper = NULL)contr_name(dist_name, type, ob_col = "x", ob_col_upper = NULL)
dist_name |
The distribution name (e.g., |
type |
One of |
ob_col |
Name of the observation column in the data frame. For interval censoring, this is the lower bound column. |
ob_col_upper |
Name of the upper bound column for interval censoring.
Required when |
The log-likelihood form for each contribution type:
"exact": PDF via d<name>(x, ..., log = TRUE)
"right": Survival function via p<name>(x, ..., lower.tail = FALSE, log.p = TRUE)
"left": CDF via p<name>(x, ..., log.p = TRUE)
"interval": log(F(upper) - F(lower)) via p<name>, computed in
log-space for numerical stability
A "contr" S3 object (a list) with a $loglik function
derived from the named distribution. The $score and $hess elements
are NULL; numerical differentiation is used automatically when the
contribution is part of a likelihood_contr() model.
# Exact Weibull contribution exact <- contr_name("weibull", "exact", ob_col = "t") # Right-censored Weibull contribution right <- contr_name("weibull", "right", ob_col = "t") # Interval-censored normal contribution interval <- contr_name("norm", "interval", ob_col = "lo", ob_col_upper = "hi")# Exact Weibull contribution exact <- contr_name("weibull", "exact", ob_col = "t") # Right-censored Weibull contribution right <- contr_name("weibull", "right", ob_col = "t") # Interval-censored normal contribution interval <- contr_name("norm", "interval", ob_col = "lo", ob_col_upper = "hi")
Returns a closure that splits the data frame by observation type and
sums the per-type Hessian matrices. If a contribution does not provide
an analytical Hessian, numerical differentiation via
numDeriv::hessian() is used.
## S3 method for class 'likelihood_contr' hess_loglik(model, ...)## S3 method for class 'likelihood_contr' hess_loglik(model, ...)
model |
A |
... |
Additional arguments (currently unused). |
A function function(df, par, ...) returning the total Hessian
matrix.
model <- likelihood_contr( obs_type = "status", exact = contr_name("exp", "exact", ob_col = "t") ) df <- data.frame(t = c(0.5, 1.0, 1.5), status = "exact") hess_fn <- hess_loglik(model) hess_fn(df, par = c(rate = 2))model <- likelihood_contr( obs_type = "status", exact = contr_name("exp", "exact", ob_col = "t") ) df <- data.frame(t = c(0.5, 1.0, 1.5), status = "exact") hess_fn <- hess_loglik(model) hess_fn(df, par = c(rate = 2))
Constructs a "likelihood_contr" model by combining named "contr"
objects. The model splits a data frame by observation type, evaluates
each type's contribution, and sums the results (under the i.i.d.
assumption).
likelihood_contr(obs_type, ..., rdata_fn = NULL, assumptions = character(0))likelihood_contr(obs_type, ..., rdata_fn = NULL, assumptions = character(0))
obs_type |
Either a string (column name) or function for determining observation types. See Details. |
... |
Named |
rdata_fn |
Optional function |
assumptions |
Character vector of model assumptions. |
Observation type dispatch is controlled by obs_type:
If a string, it names a column in the data frame whose values are matched against the contribution names.
If a function, it is called as obs_type(df) and must return a
character vector of the same length as nrow(df).
A "likelihood_contr" S3 object (inheriting from
"likelihood_model") containing the contributions, dispatch method,
and assumptions. Use loglik(), score(), hess_loglik() to obtain
inference closures, or generics::fit() from the likelihood.model
package to perform maximum likelihood estimation.
# Weibull model with exact and right-censored observations model <- likelihood_contr( obs_type = "status", exact = contr_name("weibull", "exact", ob_col = "t"), right = contr_name("weibull", "right", ob_col = "t"), assumptions = c("Weibull distribution", "non-informative censoring") )# Weibull model with exact and right-censored observations model <- likelihood_contr( obs_type = "status", exact = contr_name("weibull", "exact", ob_col = "t"), right = contr_name("weibull", "right", ob_col = "t"), assumptions = c("Weibull distribution", "non-informative censoring") )
These generics are re-exported so that users can call them directly
after loading likelihood.contr, without loading
likelihood.model separately.
model |
A likelihood model object (e.g., a |
... |
Additional arguments passed to methods. |
loglik(model, ...)Returns a closure
function(df, par, ...) that evaluates the total log-likelihood
(a scalar).
score(model, ...)Returns a closure
function(df, par, ...) that evaluates the score vector
(gradient of the log-likelihood).
hess_loglik(model, ...)Returns a closure
function(df, par, ...) that evaluates the Hessian matrix of the
log-likelihood.
assumptions(model, ...)Returns a character vector of model assumptions.
rdata(model, ...)Returns a closure
function(theta, n, ...) that generates a random data frame from
the model.
See loglik for full documentation.
The return type depends on the generic; see Details.
loglik, score, hess_loglik, and rdata each
return a closure (function). assumptions returns a
character vector.
Returns a closure that splits the data frame by observation type,
evaluates each contribution's log-likelihood, and sums them.
The data-frame split is cached so repeated calls with the same df
(e.g., during optimization) skip the split step.
## S3 method for class 'likelihood_contr' loglik(model, ...)## S3 method for class 'likelihood_contr' loglik(model, ...)
model |
A |
... |
Additional arguments (currently unused). |
A function function(df, par, ...) returning the total
log-likelihood (scalar).
model <- likelihood_contr( obs_type = "status", exact = contr_name("exp", "exact", ob_col = "t"), right = contr_name("exp", "right", ob_col = "t") ) df <- data.frame(t = c(1, 2, 3, 4), status = c("exact", "exact", "right", "right")) ll_fn <- loglik(model) ll_fn(df, par = c(rate = 0.5))model <- likelihood_contr( obs_type = "status", exact = contr_name("exp", "exact", ob_col = "t"), right = contr_name("exp", "right", ob_col = "t") ) df <- data.frame(t = c(1, 2, 3, 4), status = c("exact", "exact", "right", "right")) ll_fn <- loglik(model) ll_fn(df, par = c(rate = 0.5))
Prints a summary of the model's observation types, dispatch method (column name or function), and assumptions.
## S3 method for class 'likelihood_contr' print(x, ...)## S3 method for class 'likelihood_contr' print(x, ...)
x |
A |
... |
Additional arguments (ignored). |
The model object, invisibly.
model <- likelihood_contr( obs_type = "status", exact = contr_name("weibull", "exact", ob_col = "t"), right = contr_name("weibull", "right", ob_col = "t"), assumptions = c("Weibull distribution") ) print(model)model <- likelihood_contr( obs_type = "status", exact = contr_name("weibull", "exact", ob_col = "t"), right = contr_name("weibull", "right", ob_col = "t"), assumptions = c("Weibull distribution") ) print(model)
Returns the user-supplied rdata_fn or errors if none was provided.
## S3 method for class 'likelihood_contr' rdata(model, ...)## S3 method for class 'likelihood_contr' rdata(model, ...)
model |
A |
... |
Additional arguments (currently unused). |
A function function(theta, n, ...) returning a data frame.
rdata_fn <- function(theta, n, ...) { data.frame(t = rexp(n, rate = theta[1]), status = "exact") } model <- likelihood_contr( obs_type = "status", exact = contr_name("exp", "exact", ob_col = "t"), rdata_fn = rdata_fn ) gen <- rdata(model) gen(theta = c(rate = 2), n = 5)rdata_fn <- function(theta, n, ...) { data.frame(t = rexp(n, rate = theta[1]), status = "exact") } model <- likelihood_contr( obs_type = "status", exact = contr_name("exp", "exact", ob_col = "t"), rdata_fn = rdata_fn ) gen <- rdata(model) gen(theta = c(rate = 2), n = 5)
Returns a closure that splits the data frame by observation type and
sums the per-type score vectors. If a contribution does not provide
an analytical score, numerical differentiation via numDeriv::grad()
is used.
## S3 method for class 'likelihood_contr' score(model, ...)## S3 method for class 'likelihood_contr' score(model, ...)
model |
A |
... |
Additional arguments (currently unused). |
A function function(df, par, ...) returning the total score
vector.
model <- likelihood_contr( obs_type = "status", exact = contr_name("exp", "exact", ob_col = "t") ) df <- data.frame(t = c(0.5, 1.0, 1.5), status = "exact") score_fn <- score(model) score_fn(df, par = c(rate = 2))model <- likelihood_contr( obs_type = "status", exact = contr_name("exp", "exact", ob_col = "t") ) df <- data.frame(t = c(0.5, 1.0, 1.5), status = "exact") score_fn <- score(model) score_fn(df, par = c(rate = 2))