causaldef implements Le Cam deficiency theory to provide decision-theoretic diagnostics for causal inference.
Unlike standard sensitivity analysis tools that output abstract bias parameters (like E-values or partial R²), causaldef quantifies the information gap (\(\delta\)) between the data you have throughout your observational study and the data you wish you had (a perfect randomized trial).
causal_spec().estimate_deficiency().nc_diagnostic() or confounding_frontier().policy_regret_bound() with a pre-specified adjustment method.We’ll use a dataset of gene expression outcomes from a CRISPR knockout experiment. This case study illustrates how to detect unobserved confounding using negative controls.
library(causaldef)
library(ggplot2) # Ensure ggplot2 is loaded
# DAG Helper (using ggplot2 only)
plot_dag <- function(coords, edges, title = NULL) {
edges_df <- merge(edges, coords, by.x = "from", by.y = "name")
colnames(edges_df)[c(3,4)] <- c("x_start", "y_start")
edges_df <- merge(edges_df, coords, by.x = "to", by.y = "name")
colnames(edges_df)[c(5,6)] <- c("x_end", "y_end")
ggplot2::ggplot(coords, ggplot2::aes(x = x, y = y)) +
ggplot2::geom_segment(data = edges_df, ggplot2::aes(x = x_start, y = y_start, xend = x_end, yend = y_end),
arrow = ggplot2::arrow(length = ggplot2::unit(0.3, "cm"), type = "closed"),
color = "gray40", size = 1, alpha = 0.8) +
ggplot2::geom_point(size = 14, color = "white", fill = "#8FBC8F", shape = 21, stroke = 1.5) + # DarkSeaGreen
ggplot2::geom_text(ggplot2::aes(label = name), fontface = "bold", size = 2.5, color = "white") +
ggplot2::ggtitle(title) +
ggplot2::theme_void(base_size = 14) +
ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5, face = "bold", margin = ggplot2::margin(b = 10))) +
ggplot2::coord_fixed()
}
data(gene_perturbation)
head(gene_perturbation)
#> sample_id batch library_size knockout_status target_expression
#> 1 S1 3 948877 Knockout 8.643
#> 2 S2 4 984900 Control 11.545
#> 3 S3 4 868332 Control 12.325
#> 4 S4 2 1052105 Control 12.941
#> 5 S5 2 880271 Control 8.289
#> 6 S6 2 1001246 Knockout 9.400
#> housekeeping_gene
#> 1 6.594
#> 2 9.424
#> 3 8.568
#> 4 9.224
#> 5 6.380
#> 6 6.706
# Visualize the Structural Assumption
coords <- data.frame(
name = c("Unobserved", "Knockout", "TargetExpr", "Housekp"),
x = c(0, -1.5, 1.5, 0),
y = c(1, 0, 0, -1)
)
edges <- data.frame(
from = c("Unobserved", "Unobserved", "Unobserved", "Knockout"),
to = c("Knockout", "TargetExpr", "Housekp", "TargetExpr")
)
plot_dag(coords, edges, title = "Gene Perturbation DAG")We are interested in the effect of knockout_status on target_expression, adjusting for technical confounders batch and library_size.
spec <- causal_spec(
data = gene_perturbation,
treatment = "knockout_status",
outcome = "target_expression",
covariates = c("batch", "library_size"),
negative_control = "housekeeping_gene"
)
#> ✔ Created causal specification: n=500, 2 covariate(s)
print(spec)
#>
#> -- Causal Specification --------------------------------------------------
#>
#> * Treatment: knockout_status ( binary )
#> * Outcome: target_expression ( continuous )
#> * Covariates: batch, library_size
#> * Sample size: 500
#> * Estimand: ATE
#> * Negative control: housekeeping_geneHow close can we get to a randomized experiment using these covariates? The following analysis compares the distributional distance (\(\delta\)) of the unadjusted observational data against the reweighted data using Inverse Probability Weighting (IPTW). Compare the deficiency values to determine the information gap.
# Compare unadjusted vs IPTW
results <- estimate_deficiency(
spec,
methods = c("unadjusted", "iptw"),
n_boot = 50 # Low for vignette speed
)
#> ℹ Inferred treatment value: Knockout
#> ℹ Estimating deficiency: unadjusted
#> ℹ Estimating deficiency: iptw
print(results)
#>
#> -- Deficiency Proxy Estimates (PS-TV) ------
#>
#> Method Delta SE CI Quality
#> unadjusted 0.1424 0.0303 [0.1399, 0.2473] Insufficient (Red)
#> iptw 0.0368 0.0112 [0.031, 0.0703] Excellent (Green)
#> Note: delta is a propensity-score TV proxy (overlap/balance diagnostic).
#>
#> Best method: iptw (delta = 0.0368 )
plot(results, type = "bar")Interpreting the PS-TV Deficiency Proxy (\(\delta\)):
The current proxy \(\delta\) quantifies how far the reweighted propensity-score distribution is from the target population:
What to do with these results:
Is the adjustment sufficient? We use the housekeeping gene (which shouldn’t change) to test for residual confounding.
nc_test <- nc_diagnostic(spec, method = "iptw")
#> ℹ Using kappa = 1 (conservative). Consider domain-specific estimation or sensitivity analysis via kappa_range.
#> ✔ No evidence against causal assumptions (p = 0.099502 )
print(nc_test)
#>
#> -- Negative Control Diagnostic ----------------------------------------
#>
#> * screening statistic (weighted corr): 0.0821
#> * delta_NC (association proxy): 0.0821
#> * delta bound (under kappa alignment): 0.0821 (kappa = 1 )
#> * screening p-value: 0.099502
#> * screening method: weighted_permutation_correlation
#>
#> RESULT: NOT REJECTED. This is a screening result, not proof that confounding is absent.
#> NOTE: Your effect estimate must exceed the Noise Floor (delta_bound) to be meaningful.Interpreting Negative Control Results:
The negative control diagnostic tests whether your adjustment removes ALL confounding:
If the test fails:
Suppose we need to decide whether to proceed with this gene target. What is the risk of being wrong due to remaining confounding?
Using policy_regret_bound(), we can compute two decision-theoretic quantities from a pre-specified deficiency proxy:
# Utility scale: 0 to 10 (e.g., normalized expression fold-change value)
bounds <- policy_regret_bound(results, utility_range = c(0, 10), method = "iptw")
#> ℹ Transfer penalty: 0.3676 (delta = 0.0368)
print(bounds)
#>
#> -- Policy Regret Bounds -------------------------------------------------
#>
#> * Deficiency delta: 0.0368
#> * Delta mode: point
#> * Delta method: iptw
#> * Delta selection: pre-specified method
#> * Utility range: [0, 10]
#> * Transfer penalty: 0.3676 (additive regret upper bound)
#> * Minimax floor: 0.1838 (worst-case lower bound)
#>
#> Note: this is a plug-in bound using a deficiency proxy rather than an identified exact deficiency.
#>
#> Interpretation: Transfer penalty is 3.7 % of utility range given deltaInterpreting Policy Regret Bounds:
The bounds answer: “How much regret could confounding add to my decision, and what regret is unavoidable?”
When results comes from estimate_deficiency(), these are plug-in bounds based on the PS-TV proxy rather than an identified exact deficiency.
Decision Rule:
Example: If your gene target could save 5 units of benefit, but the transfer penalty is 0.5 units (and the minimax safety floor is 0.25 units), you have roughly a 10:1 (and 20:1) benefit-to-risk ratio — often acceptable.
Finally, once we are confident in our adjustment strategy (low deficiency, passed diagnostics), we can estimate the causal effect.
# Estimate ATE using the best performing method (IPTW)
effect <- estimate_effect(results, target_method = "iptw")
print(effect)
#>
#> -- Causal Effect Estimate ----------------------
#> Method: iptw
#> Type: ATE
#> Contrast: Knockout vs Control
#> Estimate: -1.7085Interpreting the Effect Estimate:
Reporting Guidelines:
Complete Statement Example:
“Using IPTW adjustment (deficiency \(\delta\) = 0.01), we estimate the knockout reduces target expression by 2.3 units (95% CI: [1.8, 2.8]). The negative control diagnostic passed (p = 0.24). On a 0–10 utility scale (M = 10), the transfer penalty is 0.10 units and the minimax safety floor is 0.05 units, well below our risk tolerance threshold.”