+ - 0:00:00
Notes for current slide
Notes for next slide

Fitting the outcome model

Lucy D’Agostino McGowan

Wake Forest University

2020-07-29 (updated: 2020-07-29)

1 / 12

Outcome Model

library(broom)
lm(outcome ~ exposure, data = df, weights = wts) %>% 
  tidy()
2 / 12

Outcome Model

library(broom)
lm(outcome ~ exposure, data = df, weights = wts) %>% 
  tidy()

✅ This will get us the point estimate

2 / 12

Outcome Model

library(broom)
lm(outcome ~ exposure, data = df, weights = wts) %>% 
  tidy()

✅ This will get us the point estimate
❌ This will get NOT us the correct confidence intervals

2 / 12

Outcome Model

library(broom)
lm(outcome ~ exposure, data = df, weights = wts) %>% 
  tidy()

✅ This will get us the point estimate
❌ This will get NOT us the correct confidence intervals
📦 {rsample}

2 / 12

1

        Create a function to run your analysis once on a sample of your data

fit_ipw <- function(split, ...) {
  .df <- analysis(split)
  # fit propensity score model
  propensity_model <- glm(
    exposure ~ confounder_1 + confounder_2 + ...
    family = binomial(), 
    data = .df
  )
  # calculate inverse probability weights
  .df <- propensity_model %>% 
    augment(type.predict = "response", data = .df) %>% 
    mutate(wts = 1 / ifelse(exposure == 0, 1 - .fitted, .fitted))
  # fit correctly bootsrapped ipw model
  lm(outcome ~ exposure, data = .df, weights = wts) %>% 
    tidy()
}
3 / 12

1

        Create a function to run your analysis once on a sample of your data

fit_ipw <- function(split, ...) {
  .df <- analysis(split)
  # fit propensity score model
  propensity_model <- glm(
    exposure ~ confounder_1 + confounder_2 + ...
    family = binomial(), 
    data = .df
  )
  # calculate inverse probability weights
  .df <- propensity_model %>% 
    augment(type.predict = "response", data = .df) %>% 
    mutate(wts = 1 / ifelse(exposure == 0, 1 - .fitted, .fitted))
  # fit correctly bootsrapped ipw model
  lm(outcome ~ exposure, data = .df, weights = wts) %>% 
    tidy()
}
4 / 12

1

        Create a function to run your analysis once on a sample of your data

fit_ipw <- function(split, ...) {
  .df <- analysis(split)
  # fit propensity score model
  propensity_model <- glm(
    exposure ~ confounder_1 + confounder_2 + ...
    family = binomial(),
    data = .df
  )
  # calculate inverse probability weights
  .df <- propensity_model %>% 
    augment(type.predict = "response", data = .df) %>% 
    mutate(wts = 1 / ifelse(exposure == 0, 1 - .fitted, .fitted))
  # fit correctly bootsrapped ipw model
  lm(outcome ~ exposure, data = .df, weights = wts) %>% 
    tidy()
}
5 / 12

1

        Create a function to run your analysis once on a sample of your data

fit_ipw <- function(split, ...) { 
  .df <- analysis(split) 
  # fit propensity score model
  propensity_model <- glm(
    exposure ~ confounder_1 + confounder_2 + ...
    family = binomial(), 
    data = .df
  )
  # calculate inverse probability weights
  .df <- propensity_model %>%
    augment(type.predict = "response", data = .df) %>%
    mutate(wts = 1 / ifelse(exposure == 0, 1 - .fitted, .fitted))
  # fit correctly bootsrapped ipw model
  lm(outcome ~ exposure, data = .df, weights = wts) %>% 
    tidy() 
}
6 / 12

1

        Create a function to run your analysis once on a sample of your data

fit_ipw <- function(split, ...) { 
  .df <- analysis(split) 
  # fit propensity score model
  propensity_model <- glm(
    exposure ~ confounder_1 + confounder_2 + ...
    family = binomial(), 
    data = .df
  )
  # calculate inverse probability weights
  .df <- propensity_model %>% 
    augment(type.predict = "response", data = .df) %>% 
    mutate(wts = 1 / ifelse(exposure == 0, 1 - .fitted, .fitted))
  # fit correctly bootsrapped ipw model
  lm(outcome ~ exposure, data = .df, weights = wts) %>%
    tidy()
}
7 / 12

2

        Use {rsample} to bootstrap our causal effect

library(rsample)
# fit ipw model to bootstrapped samples
ipw_results <- bootstraps(df, 1000, apparent = TRUE) %>% 
  mutate(results = map(splits, fit_ipw))
8 / 12

2

        Use {rsample} to bootstrap our causal effect

library(rsample)
# fit ipw model to bootstrapped samples
ipw_results <- bootstraps(df, 1000, apparent = TRUE) %>%
  mutate(results = map(splits, fit_ipw))
9 / 12

2

        Use {rsample} to bootstrap our causal effect

library(rsample)
# fit ipw model to bootstrapped samples
ipw_results <- bootstraps(df, 1000, apparent = TRUE) %>% 
  mutate(results = map(splits, fit_ipw))
10 / 12

3

        Pull out the causal effect

# get t-statistic-based CIs
boot_estimate <- int_t(ipw_results, results) %>%
  filter(term == "exposure")
11 / 12

Your Turn

07:00

  1. Create a function called ipw_fit that fits the propensity score model and the weighted outcome model for the effect between qsmk and wt82_71

  2. Using the bootstraps() and int_t() functions to estimate the final effect.

12 / 12

Outcome Model

library(broom)
lm(outcome ~ exposure, data = df, weights = wts) %>% 
  tidy()
2 / 12
Paused

Help

Keyboard shortcuts

↑, ←, Pg Up, k Go to previous slide
↓, →, Pg Dn, Space, j Go to next slide
Home Go to first slide
End Go to last slide
Number + Return Go to specific slide
b / m / f Toggle blackout / mirrored / fullscreen mode
c Clone slideshow
p Toggle presenter mode
t Restart the presentation timer
?, h Toggle this help
Esc Back to slideshow