## ----setup, include = FALSE---------------------------------------------------
eval_surv <- getRversion() >= "4.0.0" && requireNamespace("survival", quietly = TRUE)

knitr::opts_chunk$set(
    collapse = TRUE,
    comment = "#>",
    fig.width = 7,
    fig.height = 5
)

if (!exists("deparse1", envir = baseenv())) {
  deparse1 <- function(expr, collapse = " ", width.cutoff = 500L, ...) {
    paste(deparse(expr, width.cutoff, ...), collapse = collapse)
  }
}

## ----load-data-gene-----------------------------------------------------------
library(causaldef)
library(ggplot2)

data(gene_perturbation)
str(gene_perturbation)

## ----spec-gene----------------------------------------------------------------
spec_gene <- causal_spec(
    data = gene_perturbation,
    treatment = "knockout_status",
    outcome = "target_expression",
    covariates = c("batch", "library_size"),
    negative_control = "housekeeping_gene",
    estimand = "ATE",
    outcome_type = "continuous"
)

print(spec_gene)

## ----estim-gene---------------------------------------------------------------
deficiency_gene <- estimate_deficiency(
    spec_gene,
    methods = c("unadjusted", "iptw", "aipw"),
    n_boot = 100 # Use more for production (e.g., 1000)
)

print(deficiency_gene)

## ----plot-gene, fig.height=4--------------------------------------------------
plot(deficiency_gene, type = "bar")

## ----nc-gene------------------------------------------------------------------
nc_test <- nc_diagnostic(
    spec_gene,
    method = "iptw",
    alpha = 0.05,
    n_boot = 100
)

print(nc_test)

## ----policy-gene--------------------------------------------------------------
bounds_gene <- policy_regret_bound(
    deficiency_gene,
    utility_range = c(0, 10)
)

print(bounds_gene)

## ----effect-gene--------------------------------------------------------------
effect_gene <- estimate_effect(
    deficiency_gene,
    target_method = "iptw"
)

print(effect_gene)

## ----report-gene, results='asis'----------------------------------------------
cat(sprintf(
    "
## Gene Perturbation Analysis Report

**Treatment Effect (IPTW-adjusted):** %.2f log2 expression units
**Deficiency (δ):** %.3f
**Negative Control Test:** %s (p = %.3f)
**Transfer Penalty:** %.3f on [0, 10] scale
**Minimax Safety Floor:** %.3f on [0, 10] scale

**Conclusion:** %s
",
    effect_gene$estimate,
    deficiency_gene$estimates["iptw"],
    ifelse(nc_test$falsified, "FAILED", "PASSED"),
    nc_test$p_value,
    bounds_gene$transfer_penalty,
    bounds_gene$minimax_floor,
    ifelse(nc_test$falsified,
        "Residual confounding detected. Interpret with caution.",
        ifelse(bounds_gene$transfer_penalty < 0.5,
            "Strong evidence supporting treatment effect.",
            "Moderate evidence; consider additional validation."
        )
    )
))

## ----load-data-hct------------------------------------------------------------
data(hct_outcomes)
str(hct_outcomes)

# Summarize key variables
summary(hct_outcomes[, c("age", "kps", "time_to_event")])
table(hct_outcomes$conditioning_intensity, hct_outcomes$event_status)

## ----spec-hct, eval = eval_surv-----------------------------------------------
# # Create binary event indicator
# hct_outcomes$event <- ifelse(hct_outcomes$event_status != "Censored", 1, 0)
# 
# spec_hct <- causal_spec_survival(
#     data = hct_outcomes,
#     treatment = "conditioning_intensity",
#     time = "time_to_event",
#     event = "event",
#     covariates = c("age", "disease_status", "kps", "donor_type"),
#     estimand = "RMST",
#     horizon = 24 # 24-month restricted mean survival time
# )
# 
# print(spec_hct)

## ----estim-hct, eval = eval_surv----------------------------------------------
# deficiency_hct <- estimate_deficiency(
#     spec_hct,
#     methods = c("unadjusted", "iptw"),
#     n_boot = 50 # Use more for production
# )
# 
# print(deficiency_hct)

## ----frontier-hct, fig.height=5, eval = eval_surv-----------------------------
# frontier <- confounding_frontier(
#     spec_hct,
#     alpha_range = c(-2, 2), # Confounding path: U → Treatment
#     gamma_range = c(-2, 2), # Confounding path: U → Outcome
#     grid_size = 30
# )
# 
# print(frontier)
# plot(frontier)

## ----policy-hct, eval = eval_surv---------------------------------------------
# # Utility = months of survival (horizon = 24)
# bounds_hct <- policy_regret_bound(
#     deficiency_hct,
#     utility_range = c(0, 24)
# )
# 
# print(bounds_hct)

## ----effect-hct, eval = eval_surv---------------------------------------------
# # Estimate RMST difference
# effect_hct <- estimate_effect(
#     deficiency_hct,
#     target_method = "iptw",
#     contrast = c("Myeloablative", "Reduced")
# )
# 
# print(effect_hct)

## ----decision-hct, results='asis', eval = eval_surv---------------------------
# delta_iptw <- deficiency_hct$estimates["iptw"]
# transfer_penalty <- bounds_hct$transfer_penalty
# minimax_floor <- bounds_hct$minimax_floor
# rmst_diff <- effect_hct$estimate
# 
# # Decision logic
# if (delta_iptw < 0.05) {
#     evidence_quality <- "HIGH (approximates RCT)"
# } else if (delta_iptw < 0.15) {
#     evidence_quality <- "MODERATE (acceptable with caveats)"
# } else {
#     evidence_quality <- "LOW (substantial bias risk)"
# }
# 
# # Benefit-to-risk ratio
# if (!is.na(rmst_diff) && !is.na(transfer_penalty) && transfer_penalty > 0) {
#     benefit_to_risk <- abs(rmst_diff) / transfer_penalty
#     recommendation <- ifelse(benefit_to_risk > 2,
#         "Recommend treatment with stronger effect",
#         "Evidence inconclusive; consider shared decision-making"
#     )
# } else {
#     benefit_to_risk <- NA
#     recommendation <- "Unable to calculate benefit-to-risk ratio"
# }
# 
# cat(sprintf(
#     "
# ## HCT Treatment Decision Report
# 
# **RMST Difference (IPTW):** %.2f months (%s favored)
# **Deficiency:** %.3f
# **Evidence Quality:** %s
# **Transfer Penalty:** %.2f months
# **Minimax Safety Floor:** %.2f months
# 
# **Benefit-to-Risk Ratio:** %.1f:1
# **Recommendation:** %s
# 
# ### Clinical Translation
# 
# The observational evidence suggests %s conditioning provides approximately
# %.1f additional months of relapse-free survival within the first 2 years.
# 
# However, the transfer penalty is %.1f months and the minimax safety floor is %.1f months
# on the 0--24 month utility scale. Clinicians should weigh this against individual patient factors.
# ",
#     abs(rmst_diff),
#     ifelse(rmst_diff > 0, "Myeloablative", "Reduced"),
#     delta_iptw,
#     evidence_quality,
#     transfer_penalty,
#     minimax_floor,
#     benefit_to_risk,
#     recommendation,
#     ifelse(rmst_diff > 0, "myeloablative", "reduced-intensity"),
#     abs(rmst_diff),
#     transfer_penalty,
#     minimax_floor
# ))