## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(
  collapse  = TRUE,
  comment   = "#>",
  fig.width = 7,
  fig.height = 5,
  warning   = FALSE,
  message   = FALSE
)

## ----rng----------------------------------------------------------------------
library(GammaFrailty)

set.seed(42)

# Arvind (alpha = 0.5)
x_arvind <- r_arvind(200, alpha = 0.5)

# Lindley (lambda = 1.5)
x_lindley <- r_lindley(200, lambda = 1.5)

# LFR (a = 0.5, b = 0.2)
x_lfr <- r_lfr(200, a = 0.5, b = 0.2)

# Power Xgamma (alpha = 1, beta = 0.8)
x_pxg <- r_pxg(100, alpha = 1.0, beta = 0.8)

# Modified Topp-Leone (alpha = 2)
x_mtl <- r_mtl(100, alpha = 2.0)

# Power Failure Rate (a = 0.5, k = 1)
x_pfr <- r_pfr(200, a = 0.5, k = 1.0)

summary(x_arvind)

## ----baseline_plot------------------------------------------------------------
plot_baseline("arvind", par = 0.5, t_range = c(0.01, 3))

## ----simulate-----------------------------------------------------------------
set.seed(1)

# Right-censored data with one covariate
dat_right <- r_gamma_frailty(
  n        = 150,
  baseline = "arvind",
  par      = 0.5,
  x        = matrix(rnorm(150), ncol = 1),
  beta     = 0.5,
  theta    = 0.3,
  cen_type = "right",
  cen_rate = 0.25
)
colnames(dat_right)[4] <- "X1"
cat("Censoring rate:", mean(dat_right$status == 0), "\n")
head(dat_right)

## ----simulate_interval--------------------------------------------------------
set.seed(2)
# Interval-censored, no covariates
dat_int <- r_gamma_frailty(
  n        = 100,
  baseline = "lfr",
  par      = c(0.5, 0.2),
  theta    = 0.4,
  cen_type = "interval",
  int_width = 0.4
)
table(dat_int$status)

## ----fit_no_cov---------------------------------------------------------------
set.seed(3)
dat_complete <- r_gamma_frailty(120, "arvind", par = 0.5, theta = 0.3,
                                 cen_type = "none")

fit0 <- fit_gamma_frailty(dat_complete$time, dat_complete$status,
                           baseline = "arvind")
summary(fit0)

## ----fit_with_cov-------------------------------------------------------------
fit1 <- fit_gamma_frailty(dat_right$time, dat_right$status,
                           x = dat_right[, "X1", drop = FALSE],
                           baseline = "arvind")
summary(fit1)

## ----formula_interface--------------------------------------------------------
library(survival)
fit_formula <- gamma_frailty(
  Surv(time, status) ~ X1,
  data     = dat_right,
  baseline = "arvind"
)
summary(fit_formula)

## ----inference----------------------------------------------------------------
# Coefficients with CI
coef(fit1)
confint(fit1, level = 0.95)

# Log-likelihood and information criteria
logLik(fit1)
AIC(fit1)
cat("BIC:", fit1$BIC, "\n")
cat("Frailty variance (theta):", fit1$theta,
    "  SE:", fit1$theta_se, "\n")

## ----vif----------------------------------------------------------------------
# Generate data with 2 covariates to illustrate VIF
set.seed(4)
dat2 <- r_gamma_frailty(150, "arvind", par = 0.5,
                         x = matrix(rnorm(300), ncol = 2),
                         beta = c(0.4, -0.3), theta = 0.3,
                         cen_type = "right")
fit2 <- fit_gamma_frailty(dat2$time, dat2$status,
                           x = dat2[, 4:5], baseline = "arvind")
cat("VIF:\n"); print(fit2$VIF)
cat("Tolerance:\n"); print(fit2$Tolerance)

## ----residuals----------------------------------------------------------------
res <- residuals_frailty(fit1)
cat("MSE:", round(res$MSE, 4),
    " RMSE:", round(res$RMSE, 4),
    " MAE:", round(res$MAE, 4), "\n")
cat("R-squared:", round(res$R_square, 4),
    " Adj R-sq:", round(res$Adj_R_square, 4), "\n")
cat("KS test p-value:", round(res$KS_pvalue, 4), "\n")

## ----diag_table---------------------------------------------------------------
dt <- diagnostics_table(fit1)
head(dt[, c("time","status","deviance","leverage","cooks_dist","DFFITS")])

## ----plot_core, fig.height=9--------------------------------------------------
oldpar <- par(mfrow = c(2, 2))
plot_residuals_fitted(fit1)
plot_qq_residuals(fit1)
plot_scale_location(fit1)
plot_residuals_leverage(fit1)
par(oldpar)

## ----plot_surv_inf, fig.height=5----------------------------------------------
plot_survival_km(fit1)

## ----plot_forest--------------------------------------------------------------
plot_coef_forest(fit1)

## ----plot_leverage_hist-------------------------------------------------------
plot_leverage(fit1)

## ----plot_dfbetas-------------------------------------------------------------
plot_dfbetas(fit1)

## ----predict_surv-------------------------------------------------------------
# Survival at specific time points
survival_at(fit1, times = c(0.5, 1.0, 2.0)) |> head(6)

## ----predict_median-----------------------------------------------------------
# Median survival times
med <- predict_frailty(fit1, type = "median")
summary(med)

## ----predict_risk-------------------------------------------------------------
# Risk scores (eta = exp(X * beta))
risk <- predict_frailty(fit1, type = "risk")
summary(risk)

## ----predict_marginal---------------------------------------------------------
# Population-averaged (marginal) survival
t_grid <- seq(0.1, 3, by = 0.2)
ms <- predict_frailty(fit1, newtime = t_grid, type = "marginal")
plot(t_grid, ms, type = "l", lwd = 2, col = "steelblue",
     xlab = "Time", ylab = "Marginal S(t)", main = "Marginal Survival")

## ----predict_expected---------------------------------------------------------
# Expected survival drop in [0.5, 1.5]
es <- predict_frailty(fit1, type = "expected", window = c(0.5, 1.5))
summary(es)

## ----forecast-----------------------------------------------------------------
# Forecast beyond training range
fc <- forecast_frailty(fit1, horizon = 6, n_grid = 100)
plot(fc$time, fc$survival[1, ], type = "l", lwd = 2, col = "firebrick",
     xlab = "Time", ylab = "S(t)", main = "Forecast: Subject 1")

## ----compare------------------------------------------------------------------
set.seed(5)
dat_cmp <- r_gamma_frailty(120, "arvind", par = 0.5, theta = 0.3,
                             cen_type = "right", cen_rate = 0.2)

fits <- list(
  Arvind  = fit_gamma_frailty(dat_cmp$time, dat_cmp$status, baseline = "arvind"),
  Lindley = fit_gamma_frailty(dat_cmp$time, dat_cmp$status, baseline = "lindley"),
  LFR     = fit_gamma_frailty(dat_cmp$time, dat_cmp$status, baseline = "lfr"),
  PFR     = fit_gamma_frailty(dat_cmp$time, dat_cmp$status, baseline = "pfr")
)

compare_models(fits)

## ----cv, eval=FALSE-----------------------------------------------------------
# cv_res <- cv_frailty(dat_cmp$time, dat_cmp$status,
#                       baseline = "arvind", k = 5)
# cat("Mean OOS log-lik:", round(cv_res$mean_oos_loglik, 3), "\n")
# cat("Mean OOS RMSE:   ", round(cv_res$mean_oos_rmse,   3), "\n")

## ----left_cen-----------------------------------------------------------------
set.seed(6)
dat_left <- r_gamma_frailty(100, "pfr", par = c(0.5, 1), theta = 0.35,
                             cen_type = "left", left_threshold = 0.3)
table(dat_left$status)
fit_left <- fit_gamma_frailty(dat_left$time, dat_left$status,
                               baseline = "pfr")
summary(fit_left)

## ----int_cen------------------------------------------------------------------
fit_int <- fit_gamma_frailty(dat_int$time, dat_int$status,
                              time2 = dat_int$time2,
                              baseline = "lfr")
summary(fit_int)

## ----type1_cen----------------------------------------------------------------
set.seed(8)
dat_t1 <- r_gamma_frailty(100, "arvind", par = 0.5, theta = 0.3,
                           cen_type = "type1", cen_time = 2.0)
table(dat_t1$status)   # 0 = censored at time 2.0
fit_t1 <- fit_gamma_frailty(dat_t1$time, dat_t1$status, baseline = "arvind")
summary(fit_t1)

## ----type2_cen----------------------------------------------------------------
set.seed(9)
dat_t2 <- r_gamma_frailty(100, "pfr", par = c(0.5, 1), theta = 0.3,
                           cen_type = "type2", r_failures = 70L)
table(dat_t2$status)   # exactly 70 status=1 events
fit_t2 <- fit_gamma_frailty(dat_t2$time, dat_t2$status, baseline = "pfr")
summary(fit_t2)

## ----prog_type1_cen-----------------------------------------------------------
set.seed(10)
dat_pt1 <- r_gamma_frailty(120, "lindley", par = 1.5, theta = 0.4,
                            cen_type = "progressive_type1",
                            prog_times  = c(0.5, 1.0, 1.5),
                            prog_scheme = c(5L, 5L, 5L))
table(dat_pt1$status)   # 0 = withdrawn at tau_j, 1 = exact failure
fit_pt1 <- fit_gamma_frailty(dat_pt1$time, dat_pt1$status,
                              baseline = "lindley")
summary(fit_pt1)

## ----simulation, eval=FALSE---------------------------------------------------
# set.seed(99)
# sim_res <- simulation_study(
#   n_sim    = 200,
#   n_vec    = c(50, 100, 200),
#   baseline = "arvind",
#   par      = 0.5,
#   beta     = 0.4,
#   theta    = 0.3,
#   cen_type = "right",
#   cen_rate = 0.2,
#   verbose  = TRUE
# )

