---
title: "Why The Naive Analysis Is Biased"
format:
  html:
    embed-resources: true
  docx: default
execute:
  echo: true
  warning: false
  message: false
---

## Goal

This notebook shows why the naive mortality comparison can be biased.

The key idea is **confounding by indication**: sicker ICU patients are more likely to receive early vasopressors, and sicker ICU patients are also more likely to die.

## Setup

```{r}
suppressPackageStartupMessages({
  library(dplyr)
  library(gt)
  library(gtsummary)
  library(tibble)
})

source("../R/simulate_icu_cohort.R")
source("../R/estimate_naive_vasopressor_mortality_effect.R")
source("../R/estimate_standardized_vasopressor_mortality_effect.R")
```

## Simulate Data And Estimate Effects

```{r}
icu_data <- simulate_icu_cohort(n_patients = 1000, seed = 20260531)

naive_mortality_analysis <- estimate_naive_vasopressor_mortality_effect(icu_data)
standardized_mortality_analysis <- estimate_standardized_vasopressor_mortality_effect(icu_data)

eligible_icu_patients <- naive_mortality_analysis$eligible_icu_patients
```

Both analyses use the same eligible ICU patients.

The naive analysis compares observed treatment groups directly.

The standardized analysis uses an outcome model to compare two treatment strategies in the same eligible cohort.

## Baseline Imbalance

```{r}
eligible_icu_patients |>
  mutate(
    early_vasopressor = factor(
      early_vasopressor,
      levels = c(0, 1),
      labels = c("No early vasopressor", "Early vasopressor")
    )
  ) |>
  select(early_vasopressor, age, sex, sofa_score, lactate, map, death_28d) |>
  tbl_summary(
    by = early_vasopressor,
    statistic = list(
      all_continuous() ~ "{mean} ({sd})",
      all_categorical() ~ "{n} ({p}%)"
    ),
    missing = "no"
  ) |>
  add_overall()
```

The early vasopressor group is generally older and sicker.

That matters because age, SOFA score, lactate, and MAP are also predictors of 28-day mortality.

## Naive Mortality Effect Estimates

```{r}
naive_mortality_analysis$mortality_effect_estimates |>
  gt() |>
  tab_header(title = "Naive Mortality Effect Estimates") |>
  cols_label(
    estimate = "Estimate",
    value = "Value"
  ) |>
  fmt_number(columns = value, decimals = 3)
```

The naive estimate does not compare like with like.

It compares patients who actually received early vasopressors with patients who did not, even though those groups differ in baseline severity.

## Outcome Model Used For Standardization

```{r}
mortality_model_coefficients <- summary(
  standardized_mortality_analysis$mortality_outcome_model
)$coefficients |>
  as.data.frame() |>
  rownames_to_column("model_term") |>
  as_tibble()

names(mortality_model_coefficients) <- c(
  "model_term",
  "log_odds_estimate",
  "standard_error",
  "z_statistic",
  "p_value"
)

mortality_model_coefficients |>
  mutate(odds_ratio = exp(log_odds_estimate)) |>
  select(model_term, log_odds_estimate, odds_ratio, standard_error, p_value) |>
  gt() |>
  tab_header(title = "Mortality Outcome Model") |>
  cols_label(
    model_term = "Model term",
    log_odds_estimate = "Log-odds estimate",
    odds_ratio = "Odds ratio",
    standard_error = "Standard error",
    p_value = "P-value"
  ) |>
  fmt_number(
    columns = c(log_odds_estimate, odds_ratio, standard_error, p_value),
    decimals = 3
  )
```

This logistic regression models 28-day mortality using observed treatment and baseline severity variables.

The model is not the target trial by itself. It is a tool for predicting mortality risk under each treatment strategy while holding the eligible patient population fixed.

## Standardized Mortality Risks

```{r}
standardized_mortality_analysis$standardized_mortality_risks |>
  gt() |>
  tab_header(title = "Standardized 28-Day Mortality Risks") |>
  cols_label(
    treatment_strategy = "Treatment strategy",
    patient_count = "Eligible patients",
    standardized_mortality_risk_28d = "Standardized mortality risk"
  ) |>
  fmt_integer(columns = patient_count) |>
  fmt_number(columns = standardized_mortality_risk_28d, decimals = 3)
```

These risks answer a target-trial-style question:

What would the average mortality risk be if the same eligible patients all followed one strategy versus the other?

## Standardized Mortality Effect Estimates

```{r}
standardized_mortality_analysis$standardized_mortality_effect_estimates |>
  gt() |>
  tab_header(title = "Standardized Mortality Effect Estimates") |>
  cols_label(
    estimate = "Estimate",
    value = "Value"
  ) |>
  fmt_number(columns = value, decimals = 3)
```

The standardized risk difference is less distorted by baseline severity imbalance than the naive risk difference.

This does not make the estimate automatically correct, but it is closer to the target trial question than a direct treated-versus-untreated comparison.

## Naive Versus Standardized Estimates

```{r}
naive_risk_difference <- naive_mortality_analysis$mortality_effect_estimates |>
  filter(estimate == "Naive risk difference") |>
  pull(value)

naive_risk_ratio <- naive_mortality_analysis$mortality_effect_estimates |>
  filter(estimate == "Naive risk ratio") |>
  pull(value)

standardized_risk_difference <- standardized_mortality_analysis$standardized_mortality_effect_estimates |>
  filter(estimate == "Standardized risk difference") |>
  pull(value)

standardized_risk_ratio <- standardized_mortality_analysis$standardized_mortality_effect_estimates |>
  filter(estimate == "Standardized risk ratio") |>
  pull(value)

effect_estimate_comparison <- tibble(
  method = c("Naive observed comparison", "Outcome regression standardization"),
  risk_difference = c(naive_risk_difference, standardized_risk_difference),
  risk_ratio = c(naive_risk_ratio, standardized_risk_ratio)
)

effect_estimate_comparison |>
  gt() |>
  tab_header(title = "Naive Versus Standardized Mortality Effect Estimates") |>
  cols_label(
    method = "Method",
    risk_difference = "Risk difference",
    risk_ratio = "Risk ratio"
  ) |>
  fmt_number(columns = c(risk_difference, risk_ratio), decimals = 3)
```

In the simulated data-generating process, early vasopressors have a modest protective effect.

The naive comparison can still make early vasopressors look harmful because early-treated patients are more severely ill at baseline.

Standardization partially addresses that problem by comparing treatment strategies in the same eligible patient population.

## Next Step

The next tutorial step is to connect this back to target trial emulation mechanics: time zero, eligibility, and treatment assignment windows.

After that, we can introduce inverse probability weighting from first principles.
