greek_gods_po <- tibble::tribble( ~greek, ~V, ~Y_a0, ~Y_a1, "Rheia", 1, 0, 1, "Demeter", 1, 0, 0, "Hestia", 1, 0, 0, "Hera", 1, 0, 0, "Artemis", 1, 1, 1, "Leto", 1, 0, 1, "Athena", 1, 1, 1, "Aphrodite", 1, 0, 1, "Persephone", 1, 1, 1, "Hebe", 1, 1, 0, "Kronos", 0, 1, 0, "Hades", 0, 0, 0, "Poseidon", 0, 1, 0, "Zeus", 0, 0, 1, "Apollo", 0, 1, 0, "Ares", 0, 1, 1, "Hephaestus", 0, 0, 1, "Cyclope", 0, 0, 1, "Hermes", 0, 1, 0, "Dionysus", 0, 1, 0)
# had we known counterfactual outcomesgreek_gods_po %>% count(Y_a0)
## # A tibble: 2 x 2## Y_a0 n## <dbl> <int>## 1 0 10## 2 1 10
greek_gods_po %>% count(Y_a1)
## # A tibble: 2 x 2## Y_a1 n## <dbl> <int>## 1 0 10## 2 1 10
Pr[Ya=1=1|V=0] - Pr[Ya=0=1|V=0]
Pr[Ya=1=1|V=1]Pr[Ya=0=1|V=1]
Pr[Ya=1=1|V=0] - Pr[Ya=0=1|V=0]
Pr[Ya=1=1|V=1]Pr[Ya=0=1|V=1]
## # A tibble: 2 x 6## # Groups: V [2]## V label risk_Y_a1 risk_Y_a0 RR RD## <dbl> <chr> <dbl> <dbl> <dbl> <dbl>## 1 0 men 0.4 0.6 0.667 -0.200## 2 1 women 0.6 0.4 1.50 0.200
## # A tibble: 2 x 4## # Groups: L [2]## L A n pr## <dbl> <dbl> <int> <dbl>## 1 0 1 4 0.5 ## 2 1 1 9 0.75
pr_a <- glm(data = romans, formula = A ~ 1, family = binomial(link = "logit"))pr_a_l <- glm(data = romans, formula = A ~ L, family = binomial(link = "logit"))romans %<>% mutate( p_a = predict(object = pr_a, type = "response"), p_a_l = predict(object = pr_a_l, type = "response"), # IPTW sw_iptw = if_else(A==1, p_a/p_a_l, (1-p_a)/(1-p_a_l)) # stabilized weights)
romans %>% distinct(A, L, sw_iptw)
## # A tibble: 4 x 3## L A sw_iptw## <dbl> <dbl> <dbl>## 1 0 0 0.7 ## 2 0 1 1.30 ## 3 1 0 1.40 ## 4 1 1 0.867
romans %>% group_by(A) %>% count(Y) %>% mutate(risk = n/sum(n)) %>% filter(Y == 1)
## # A tibble: 2 x 4## # Groups: A [2]## A Y n risk## <dbl> <dbl> <int> <dbl>## 1 0 1 2 0.286## 2 1 1 8 0.615
romans %>% group_by(A) %>% count(Y, wt = sw_iptw) %>% mutate(risk = n/sum(n)) %>% filter(Y == 1)
## # A tibble: 2 x 4## # Groups: A [2]## A Y n risk## <dbl> <dbl> <dbl> <dbl>## 1 0 1 2.10 0.300## 2 1 1 7.8 0.6
glm(data = romans, formula = Y ~ A, weights = sw_iptw, family = binomial(link = "log")) %>% broom::tidy(., exponentiate = T) %>% filter(term == "A") %>% select(1, 2)
## # A tibble: 1 x 2## term estimate## <chr> <dbl>## 1 A 2.
glm(data = romans, formula = Y ~ A, weights = sw_iptw, family = binomial(link = "identity")) %>% broom::tidy() %>% filter(term == "A") %>% select(1, 2)
## # A tibble: 1 x 2## term estimate## <chr> <dbl>## 1 A 0.3
greeks
## # A tibble: 20 x 5## name L A Y V## <chr> <dbl> <dbl> <dbl> <dbl>## 1 Rheia 0 0 0 1## 2 Kronos 0 0 1 1## 3 Demeter 0 0 0 1## 4 Hades 0 0 0 1## 5 Hestia 0 1 0 1## 6 Poseidon 0 1 0 1## 7 Hera 0 1 0 1## 8 Zeus 0 1 1 1## 9 Artemis 1 0 1 1## 10 Apollo 1 0 1 1## 11 Leto 1 0 0 1## 12 Ares 1 1 1 1## 13 Athena 1 1 1 1## 14 Hephaestus 1 1 1 1## 15 Aphrodite 1 1 1 1## 16 Cyclope 1 1 1 1## 17 Persephone 1 1 1 1## 18 Hermes 1 1 0 1## 19 Hebe 1 1 0 1## 20 Dionysus 1 1 0 1
pr_a_gr <- glm(data = greeks, formula = A~1, family = binomial("logit"))pr_a_l_gr <- glm(data = greeks, formula = A~L, family = binomial("logit"))greeks %<>% mutate( p_a = predict(object = pr_a_gr, type = "response"), p_a_l = predict(object = pr_a_l_gr, type = "response"), # IPTW sw_iptw = if_else(A==1, p_a/p_a_l, (1-p_a)/(1-p_a_l)) # stabilized weights)
glm(data = greeks, formula = Y ~ A, family = binomial("log"), weights = sw_iptw) %>% broom::tidy(exponentiate = T) %>% filter(term == "A") %>% select(term, estimate)
## # A tibble: 1 x 2## term estimate## <chr> <dbl>## 1 A 1.00
glm(data = greeks, formula = Y ~ A, family = binomial("identity"), weights = sw_iptw) %>% broom::tidy(exponentiate = F) %>% filter(term == "A") %>% select(term, estimate)
## # A tibble: 1 x 2## term estimate## <chr> <dbl>## 1 A 2.96e-13
round(2.96e-13, 2)
## [1] 0
# combined greeks and romansgreeks_romans <- bind_rows(greeks, romans)pr_a_greeks_romans <- glm(data = greeks_romans, formula = A~1, family = binomial("logit"))pr_a_l_greeks_romans <- glm(data = greeks_romans, formula = A~L, family = binomial("logit"))greeks_romans %<>% mutate( p_a = predict(object = pr_a_greeks_romans, type = "response"), p_a_l = predict(object = pr_a_l_greeks_romans, type = "response"), # IPTW sw_iptw = if_else(A==1, p_a/p_a_l, (1-p_a)/(1-p_a_l)) # stabilized weights)
glm(data = greeks_romans, formula = Y ~ A, family = binomial("log"), weights = sw_iptw) %>% broom::tidy(exponentiate = T) %>% filter(term == "A") %>% select(term, estimate)
## # A tibble: 1 x 2## term estimate## <chr> <dbl>## 1 A 1.37
glm(data = greeks_romans, formula = Y ~ A, family = binomial("identity"), weights = sw_iptw) %>% broom::tidy(exponentiate = F) %>% filter(term == "A") %>% select(term, estimate)
## # A tibble: 1 x 2## term estimate## <chr> <dbl>## 1 A 0.15
For Pr[Y=1|A=1]≠Pr[Ya=0=1|A=1]
Trying to clear up confusion on effect modification vs. interaction. After diving into the literature, my Qs >> As. Is the difference purely a conceptual one? Do you just focus on stat. vs bio. interaction? Do you only talk about EMM? The lit is all over the place! #epitwitter
— Jess Rohmann is on staycation (@JLRohmann) May 27, 2019
library(MatchIt)# matched on PS herematched_greeks <- matchit(A ~ L, method = "nearest", data = greeks)
# Sample sizes:# Control Treated# All 7 12# Matched 7 7# Unmatched 0 5# Discarded 0 0
table_4.3
## # A tibble: 20 x 4## name L A Z## <chr> <dbl> <dbl> <dbl>## 1 Rheia 0 0 0## 2 Kronos 0 0 1## 3 Demeter 0 0 0## 4 Hades 0 0 0## 5 Hestia 0 1 0## 6 Poseidon 0 1 0## 7 Hera 0 1 1## 8 Zeus 0 1 1## 9 Artemis 1 0 1## 10 Apollo 1 0 1## 11 Leto 1 0 0## 12 Ares 1 1 1## 13 Athena 1 1 1## 14 Hephaestus 1 1 1## 15 Aphrodite 1 1 0## 16 Cyclope 1 1 0## 17 Persephone 1 1 0## 18 Hermes 1 1 0## 19 Hebe 1 1 0## 20 Dionysus 1 1 0
pr_a_table_4.3 <- glm(data = table_4.3, formula = A~1, family = binomial("logit"))pr_a_l_table_4.3 <- glm(data = table_4.3, formula = A~L, family = binomial("logit"))table_4.3 %<>% mutate( p_a = predict(object = pr_a_table_4.3, type = "response"), p_a_l = predict(object = pr_a_l_table_4.3, type = "response"), # IPTW sw_iptw = if_else(A==1, p_a/p_a_l, (1-p_a)/(1-p_a_l)) # stabilized weights)glm(data = table_4.3, formula = Z ~ A, family = binomial("log"), weights = sw_iptw) %>% broom::tidy(exponentiate = T) %>% filter(term == "A") %>% select(term, estimate)
## # A tibble: 1 x 2## term estimate## <chr> <dbl>## 1 A 0.800
table_4.3 %>% group_by(L, A) %>% count(Z) %>% mutate( risk = n / sum(n) ) %>% filter(Z == 1) %>% ungroup() %>% group_by(L) %>% select(-n, -Z) %>% mutate( RR = lead(risk) / risk )
## # A tibble: 4 x 4## # Groups: L [2]## L A risk RR## <dbl> <dbl> <dbl> <dbl>## 1 0 0 0.25 2 ## 2 0 1 0.5 NA ## 3 1 0 0.667 0.5## 4 1 1 0.333 NA
matched_table_4.3 <- matchit(A ~ L, method = "nearest", data = table_4.3)# Sample sizes:# Control Treated# All 7 13# Matched 7 7# Unmatched 0 6# Discarded 0 0matched_table_4.3_data <- match.data(matched_table_4.3)glm(data = matched_table_4.3_data, formula = Z ~ A, family = binomial("log")) %>% broom::tidy(exponentiate = T) %>% filter(term == "A") %>% select(term, estimate)
## # A tibble: 1 x 2## term estimate## <chr> <dbl>## 1 A 1.
## # A tibble: 2 x 3## L n pr## <dbl> <int> <dbl>## 1 0 8 0.4## 2 1 12 0.6
## # A tibble: 4 x 4## # Groups: A [2]## A L n pr## <dbl> <dbl> <int> <dbl>## 1 0 0 4 0.571## 2 0 1 3 0.429## 3 1 0 4 0.308## 4 1 1 9 0.692
table_4.4
## # A tibble: 20 x 5## name V A Y sex ## <chr> <fct> <dbl> <dbl> <chr> ## 1 Rheia 1 0 0 female## 2 Demeter 1 0 0 female## 3 Hestia 1 0 0 female## 4 Hera 1 0 0 female## 5 Artemis 1 0 1 female## 6 Leto 1 1 0 female## 7 Athena 1 1 1 female## 8 Aphrodite 1 1 1 female## 9 Persephone 1 1 0 female## 10 Hebe 1 1 1 female## 11 Kronos 0 0 0 male ## 12 Hades 0 0 0 male ## 13 Poseidon 0 0 1 male ## 14 Zeus 0 0 1 male ## 15 Apollo 0 0 0 male ## 16 Ares 0 1 1 male ## 17 Hephaestus 0 1 1 male ## 18 Cyclope 0 1 1 male ## 19 Hermes 0 1 0 male ## 20 Dionysus 0 1 1 male
glm(Y~A, data = table_4.4, family=binomial(link = "log")) %>% broom::tidy(exponentiate = T) %>% filter(term == "A") %>% select(1, 2)
## # A tibble: 1 x 2## term estimate## <chr> <dbl>## 1 A 2.33
glm(Y~A, data = table_4.4, family=binomial(link = "logit")) %>% broom::tidy(exponentiate = T) %>% filter(term == "A") %>% select(1, 2)
## # A tibble: 1 x 2## term estimate## <chr> <dbl>## 1 A 5.44
## # A tibble: 1 x 3## V term estimate## <chr> <chr> <dbl>## 1 men A 2.00
## # A tibble: 1 x 3## V term estimate## <chr> <chr> <dbl>## 1 women A 3.00
## # A tibble: 1 x 3## V term estimate## <chr> <chr> <dbl>## 1 men A 6.00
## # A tibble: 1 x 3## V term estimate## <chr> <chr> <dbl>## 1 women A 6.00
greek_gods_po <- tibble::tribble( ~greek, ~V, ~Y_a0, ~Y_a1, "Rheia", 1, 0, 1, "Demeter", 1, 0, 0, "Hestia", 1, 0, 0, "Hera", 1, 0, 0, "Artemis", 1, 1, 1, "Leto", 1, 0, 1, "Athena", 1, 1, 1, "Aphrodite", 1, 0, 1, "Persephone", 1, 1, 1, "Hebe", 1, 1, 0, "Kronos", 0, 1, 0, "Hades", 0, 0, 0, "Poseidon", 0, 1, 0, "Zeus", 0, 0, 1, "Apollo", 0, 1, 0, "Ares", 0, 1, 1, "Hephaestus", 0, 0, 1, "Cyclope", 0, 0, 1, "Hermes", 0, 1, 0, "Dionysus", 0, 1, 0)
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 |