In Lecture 2, we used inverse probability weighting. IPW modeled the treatment:
Who was likely to be a smoker, based on baseline covariates?
In Lecture 3, we use a different method: outcome regression modelling. Outcome regression models the outcome:
Who was likely to have CVD, based on smoking and baseline covariates?
We keep the same causal question:
Is CVD risk different under smoking versus no smoking after adjusting for baseline covariates?
Our treatment, outcome, and covariates are:
| Symbol | Meaning in this lecture |
|---|---|
T |
Smoking status: 1 = smoker, 0 = non-smoker |
Y |
CVD status: 1 = had CVD, 0 = did not have CVD |
X |
Age, gender, race, education, income-to-poverty ratio, and BMI |
As before, this teaching analysis does not use survey weights.
There are two ideas to keep separate:
The model learns patterns like:
People with different ages, BMI values, education levels, and smoking status may have different CVD risks.
The right side also previews the causal use of the model: keep the
same covariates X, predict once with T = 0,
predict again with T = 1, and compare the two average
predicted risks.
The key idea is simple:
This process is often called standardization or g-computation.
This picture is important. Outcome regression does not simply compare the actual smokers with the actual non-smokers. Instead, it asks the fitted model to predict both treatment worlds for the same covariate distribution.
data_path <- file.path("..", "Data", "NHANES_data.csv")
if (!file.exists(data_path)) {
data_path <- file.path("Data", "NHANES_data.csv")
}
nhanes <- read.csv(data_path, stringsAsFactors = FALSE)
baseline_vars <- c(
"age_yr",
"gender",
"race",
"educ_lvl",
"inc_to_pov_ratio",
"bmi"
)
analysis_vars <- c("smoker_indicator", "cvd_indicator", baseline_vars)
regression_data <- nhanes[complete.cases(nhanes[, analysis_vars]), analysis_vars]
regression_data$smoker_indicator <- as.integer(regression_data$smoker_indicator)
regression_data$cvd_indicator <- as.integer(regression_data$cvd_indicator)
regression_data$smoking_group <- ifelse(
regression_data$smoker_indicator == 1,
"Smoker",
"Non-smoker"
)
regression_data$smoking_group <- factor(
regression_data$smoking_group,
levels = c("Non-smoker", "Smoker")
)
regression_data$gender_label <- factor(
regression_data$gender,
levels = c("F", "M"),
labels = c("Female", "Male")
)
regression_data$race_label <- factor(
regression_data$race,
levels = c(
"mex_american",
"other_hispanic",
"nh_white",
"nh_black",
"nh_asian"
),
labels = c(
"Mexican American",
"Other Hispanic",
"Non-Hispanic White",
"Non-Hispanic Black",
"Non-Hispanic Asian"
)
)
regression_data$educ_label <- factor(
regression_data$educ_lvl,
levels = c(
"lt_9th_grade",
"9_to_12th_grade_no_diploma",
"hs_grad_or_ged",
"start_college_to_aa",
"college_grad_or_above"
),
labels = c(
"Less than 9th grade",
"9th-12th, no diploma",
"High school or GED",
"Some college or AA",
"College graduate or above"
)
)
nrow(regression_data)
## [1] 6299
We use the same complete-case sample as Lecture 2 so that IPW and outcome regression are easy to compare.
sample_summary <- data.frame(
Quantity = c(
"Number of people",
"Number of smokers",
"Number of non-smokers",
"Number with CVD"
),
Value = c(
nrow(regression_data),
sum(regression_data$smoker_indicator == 1),
sum(regression_data$smoker_indicator == 0),
sum(regression_data$cvd_indicator == 1)
)
)
knitr::kable(sample_summary)
| Quantity | Value |
|---|---|
| Number of people | 6299 |
| Number of smokers | 2559 |
| Number of non-smokers | 3740 |
| Number with CVD | 646 |
smoker_rows <- regression_data$smoking_group == "Smoker"
non_smoker_rows <- regression_data$smoking_group == "Non-smoker"
observed_risk_smoker <- mean(regression_data$cvd_indicator[smoker_rows])
observed_risk_non_smoker <- mean(regression_data$cvd_indicator[non_smoker_rows])
observed_difference <- observed_risk_smoker - observed_risk_non_smoker
observed_ratio <- observed_risk_smoker / observed_risk_non_smoker
observed_result <- data.frame(
Method = "Simple observed comparison",
Risk_non_smokers_percent = round(100 * observed_risk_non_smoker, 1),
Risk_smokers_percent = round(100 * observed_risk_smoker, 1),
Difference_percentage_points = round(100 * observed_difference, 1),
Risk_ratio = round(observed_ratio, 2)
)
knitr::kable(
observed_result,
col.names = c(
"Method",
"Non-smoker risk (%)",
"Smoker risk (%)",
"Difference (percentage points)",
"Risk ratio"
)
)
| Method | Non-smoker risk (%) | Smoker risk (%) | Difference (percentage points) | Risk ratio |
|---|---|---|---|---|
| Simple observed comparison | 6.9 | 15.1 | 8.2 | 2.18 |
This is the unadjusted comparison. It does not yet use outcome regression.
Because CVD is a yes/no outcome, we use logistic regression. Logistic regression is useful here because it predicts a probability between 0 and 1.
The model is:
CVD risk = function(smoking, age, gender, race, education, income, BMI)
outcome_model <- glm(
cvd_indicator ~ smoker_indicator + age_yr + gender_label +
race_label + educ_label + inc_to_pov_ratio + bmi,
data = regression_data,
family = binomial()
)
regression_data$predicted_risk_observed <- predict(
outcome_model,
type = "response"
)
smoking_odds_ratio <- exp(coef(outcome_model)["smoker_indicator"])
model_takeaway_table <- data.frame(
Model_piece = c(
"Smoking indicator",
"Age, one year older",
"BMI, one unit higher",
"Income-to-poverty ratio, one unit higher"
),
Odds_ratio = round(
exp(coef(outcome_model)[
c("smoker_indicator", "age_yr", "bmi", "inc_to_pov_ratio")
]),
2
)
)
knitr::kable(
model_takeaway_table,
col.names = c("Model piece", "Odds ratio from the fitted model")
)
| Model piece | Odds ratio from the fitted model | |
|---|---|---|
| smoker_indicator | Smoking indicator | 1.54 |
| age_yr | Age, one year older | 1.07 |
| bmi | BMI, one unit higher | 1.03 |
| inc_to_pov_ratio | Income-to-poverty ratio, one unit higher | 0.83 |
The smoking odds ratio from the model is 1.54. This means that, in the fitted model, smokers have higher odds of CVD than non-smokers after including the baseline covariates.
Be careful: an odds ratio is not the same as a risk ratio. For our main causal comparison, we will use predicted risks instead of stopping at the odds ratio.
The outcome model is a logistic regression model. One way to see the fit is to draw the fitted CVD-risk curve separately for each exposure group:
| Panel | Meaning |
|---|---|
T = 0 |
Predicted CVD risk curve if smoking is set to non-smoker |
T = 1 |
Predicted CVD risk curve if smoking is set to smoker |
The points below show observed CVD risk in age groups. The smooth lines show fitted logistic-regression predictions for a reference person. This is a visualization of the model, not the final standardized estimate.
The points are not expected to fall perfectly on the lines. Real data are noisy. The purpose of the logistic model is to draw a smooth risk curve that uses smoking and baseline covariates together.
The boxplot shows the model’s predicted CVD risks for people in their observed smoking groups. Some people have higher predicted risks than others because their covariates are different.
This plot shows a model-based picture for a reference person. We hold gender, race, education, income, and BMI fixed, then let age change. The smoker line is higher than the non-smoker line in this fitted model.
Now we make two copies of the full analysis dataset.
data_if_non_smoker <- regression_data
data_if_smoker <- regression_data
data_if_non_smoker$smoker_indicator <- 0
data_if_smoker$smoker_indicator <- 1
predicted_risk_if_non_smoker <- predict(
outcome_model,
newdata = data_if_non_smoker,
type = "response"
)
predicted_risk_if_smoker <- predict(
outcome_model,
newdata = data_if_smoker,
type = "response"
)
or_risk_non_smoker <- mean(predicted_risk_if_non_smoker)
or_risk_smoker <- mean(predicted_risk_if_smoker)
or_difference <- or_risk_smoker - or_risk_non_smoker
or_ratio <- or_risk_smoker / or_risk_non_smoker
outcome_regression_result <- data.frame(
Method = "Outcome regression standardization",
Risk_non_smokers_percent = round(100 * or_risk_non_smoker, 1),
Risk_smokers_percent = round(100 * or_risk_smoker, 1),
Difference_percentage_points = round(100 * or_difference, 1),
Risk_ratio = round(or_ratio, 2)
)
knitr::kable(
outcome_regression_result,
col.names = c(
"Method",
"Risk if everyone non-smoker (%)",
"Risk if everyone smoker (%)",
"Difference (percentage points)",
"Risk ratio"
)
)
| Method | Risk if everyone non-smoker (%) | Risk if everyone smoker (%) | Difference (percentage points) | Risk ratio |
|---|---|---|---|---|
| Outcome regression standardization | 8.5 | 12 | 3.5 | 1.4 |
Outcome regression estimates two average predicted risks:
| Quantity | Meaning |
|---|---|
| 8.5% | Average predicted CVD risk if everyone were set to non-smoker |
| 12% | Average predicted CVD risk if everyone were set to smoker |
The standardized outcome-regression difference is 3.5 percentage points.
The blue bars are the simple observed comparison. The green bars are the standardized outcome-regression comparison.
In the observed data, CVD risk is 6.9% for non-smokers and 15.1% for smokers, a difference of 8.2 percentage points.
After outcome-regression adjustment, the estimated risk is 8.5% if everyone were set to non-smoker and 12% if everyone were set to smoker, a difference of 3.5 percentage points.
The teaching point is similar to Lecture 2: the adjusted gap is smaller than the raw gap. This suggests that part of the raw smoker versus non-smoker difference was related to baseline covariate differences between the groups.
Lecture 1 used a simple observed comparison. Lecture 2 used IPW. Lecture 3 uses outcome regression standardization.
propensity_model <- glm(
smoker_indicator ~ age_yr + gender_label + race_label +
educ_label + inc_to_pov_ratio + bmi,
data = regression_data,
family = binomial()
)
regression_data$propensity_score <- predict(propensity_model, type = "response")
regression_data$ipw_weight <- ifelse(
regression_data$smoker_indicator == 1,
1 / regression_data$propensity_score,
1 / (1 - regression_data$propensity_score)
)
weighted_risk <- function(outcome, weights) {
sum(weights * outcome) / sum(weights)
}
ipw_risk_smoker <- weighted_risk(
regression_data$cvd_indicator[smoker_rows],
regression_data$ipw_weight[smoker_rows]
)
ipw_risk_non_smoker <- weighted_risk(
regression_data$cvd_indicator[non_smoker_rows],
regression_data$ipw_weight[non_smoker_rows]
)
ipw_difference <- ipw_risk_smoker - ipw_risk_non_smoker
ipw_ratio <- ipw_risk_smoker / ipw_risk_non_smoker
comparison_table <- data.frame(
Method = c(
"Observed comparison",
"IPW",
"Outcome regression"
),
Non_smoker_risk_percent = round(
100 * c(
observed_risk_non_smoker,
ipw_risk_non_smoker,
or_risk_non_smoker
),
1
),
Smoker_risk_percent = round(
100 * c(
observed_risk_smoker,
ipw_risk_smoker,
or_risk_smoker
),
1
),
Difference_percentage_points = round(
100 * c(observed_difference, ipw_difference, or_difference),
1
),
Risk_ratio = round(c(observed_ratio, ipw_ratio, or_ratio), 2)
)
knitr::kable(
comparison_table,
col.names = c(
"Method",
"Non-smoker risk (%)",
"Smoker risk (%)",
"Difference (percentage points)",
"Risk ratio"
)
)
| Method | Non-smoker risk (%) | Smoker risk (%) | Difference (percentage points) | Risk ratio |
|---|---|---|---|---|
| Observed comparison | 6.9 | 15.1 | 8.2 | 2.18 |
| IPW | 8.7 | 11.7 | 3.0 | 1.34 |
| Outcome regression | 8.5 | 12.0 | 3.5 | 1.40 |
The IPW and outcome-regression estimates are close in this example. That is reassuring, but not guaranteed. Different methods rely on different models and assumptions.
In this teaching analysis:
We should still be careful. Outcome regression adjusts only for covariates included in the model. It also depends on the model being reasonable. If the model is badly wrong, the adjusted estimate can be misleading.
This appendix gives the mathematical notation for the outcome regression method used in this lecture.
For each person \(i = 1, \ldots, n\), define:
\[ \begin{aligned} T_i &= \text{smoking indicator}, \\ Y_i &= \text{CVD indicator}, \\ X_i &= \text{baseline covariates}. \end{aligned} \]
Here \(T_i = 1\) means smoker, \(T_i = 0\) means non-smoker, and \(Y_i = 1\) means the person has CVD.
The causal targets are two adjusted risks:
\[ \begin{aligned} \psi_1 &= \text{CVD risk if everyone smoked}, \\ \psi_0 &= \text{CVD risk if everyone did not smoke}. \end{aligned} \]
Then the adjusted risk difference and adjusted risk ratio are:
\[ \begin{aligned} RD &= \psi_1 - \psi_0, \\ RR &= \frac{\psi_1}{\psi_0}. \end{aligned} \]
Outcome regression begins by modeling the outcome:
\[ m(t, X_i) = P(Y_i = 1 \mid T_i = t, X_i). \]
Because CVD is a yes/no variable, this lecture uses logistic regression:
\[ \text{logit}\{m(T_i, X_i)\} = \beta_0 + \beta_1T_i + \beta^\top X_i. \]
Here \(X_i\) includes age, gender, race, education, income-to-poverty ratio, and BMI.
After fitting the model, we get:
\[ \hat m(t, X_i). \]
This is the fitted probability of CVD for a person with covariates \(X_i\) if treatment is set to \(t\).
For each person, we make two model-based predictions.
First, predict CVD risk if that person were set to non-smoker:
\[ \hat m_0(X_i) = \hat m(0, X_i). \]
Second, predict CVD risk if that person were set to smoker:
\[ \hat m_1(X_i) = \hat m(1, X_i). \]
The key idea is that \(X_i\) stays the same. Only \(T_i\) changes.
This is why outcome regression standardization compares:
\[ \hat m(1, X_i) \quad \text{versus} \quad \hat m(0, X_i) \]
for the same covariate distribution.
The standardized risk if everyone were set to smoker is:
\[ \hat\psi_1^{OR} = \frac{1}{n} \sum_{i=1}^{n} \hat m_1(X_i). \]
The standardized risk if everyone were set to non-smoker is:
\[ \hat\psi_0^{OR} = \frac{1}{n} \sum_{i=1}^{n} \hat m_0(X_i). \]
These formulas match the R code in the lecture:
\[ \begin{aligned} \hat\psi_1^{OR} &= \text{average predicted risk if everyone is set to smoker}, \\ \hat\psi_0^{OR} &= \text{average predicted risk if everyone is set to non-smoker}. \end{aligned} \]
The outcome-regression risk difference is:
\[ \widehat{RD}^{OR} = \hat\psi_1^{OR} - \hat\psi_0^{OR}. \]
The outcome-regression risk ratio is:
\[ \widehat{RR}^{OR} = \frac{\hat\psi_1^{OR}} {\hat\psi_0^{OR}}. \]
In the lecture, the risk difference is reported in percentage points:
\[ 100 \times \widehat{RD}^{OR}. \]
The model uses \(X_i\) when predicting CVD risk:
\[ \hat m(t, X_i). \]
Then we average predictions over the observed covariate distribution:
\[ \frac{1}{n} \sum_{i=1}^{n} \hat m(t, X_i). \]
This means we compare smoker and non-smoker risk using the same set of covariates \(X_1, \ldots, X_n\).
In plain language:
We ask what CVD risk would look like if the same classroom dataset were placed into two worlds: everyone non-smoker and everyone smoker.
Outcome regression standardization needs causal assumptions.
The main assumptions are:
If the outcome model is badly wrong, the standardized outcome-regression estimate can be biased.
Hernan, M. A., & Robins, J. M. (2020). Causal Inference: What If. Chapman & Hall/CRC.
Robins, J. M. (1986). A new approach to causal inference in mortality studies with a sustained exposure period: Application to control of the healthy worker survivor effect. Mathematical Modelling, 7(9-12), 1393-1512.
Snowden, J. M., Rose, S., & Mortimer, K. M. (2011). Implementation of G-computation on a simulated data set: Demonstration of a causal inference technique. American Journal of Epidemiology, 173(7), 731-738.