## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>")

## ----contributions------------------------------------------------------------
library(likelihood.contr)
library(likelihood.model)

exact <- contr_name("weibull", "exact", ob_col = "t")
right <- contr_name("weibull", "right", ob_col = "t")

## ----model--------------------------------------------------------------------
model <- likelihood_contr(
  obs_type = "status",
  exact = exact,
  right = right
)
model

## ----simulate-----------------------------------------------------------------
set.seed(42)
true_shape <- 2
true_scale <- 5
censor_time <- 4

raw_times <- rweibull(300, shape = true_shape, scale = true_scale)
df <- data.frame(
  t      = pmin(raw_times, censor_time),
  status = ifelse(raw_times <= censor_time, "exact", "right")
)
table(df$status)

## ----fit----------------------------------------------------------------------
result <- suppressWarnings(
  fit(model)(df, par = c(shape = 1.5, scale = 4))
)
summary(result)

## ----inference----------------------------------------------------------------
coef(result)
confint(result)

## ----loglik-------------------------------------------------------------------
ll_fn <- loglik(model)

# Evaluate at two different parameter vectors
ll_fn(df, par = c(shape = 2, scale = 5))
ll_fn(df, par = c(shape = 1, scale = 3))

## ----function-dispatch--------------------------------------------------------
model_fn <- likelihood_contr(
  obs_type = function(df) ifelse(df$delta == 1, "exact", "right"),
  exact = contr_name("exp", "exact", ob_col = "t"),
  right = contr_name("exp", "right", ob_col = "t")
)

df_fn <- data.frame(t = c(0.5, 1.0, 2.0), delta = c(1, 0, 1))
loglik(model_fn)(df_fn, par = c(rate = 1.5))