In 1916, the US experienced the first large epidemic of polio. John Salk developed a vaccine with promising results in the lab in the early fifties. In this experiment, children are assigned at random to the control (placebo treatment) or vaccine treatment arm after consent was given by the parents.

As such, we have two treatment arms - Control: vaccination with placebo - Treatment: vaccination with vaccine

Note:

In order to limit confounding, the experiment used double blinding: - The parents did not know if their child was vaccinated or received the placebo - The care-giver/researchers did not know if the child was vaccinated or received placebo

After one year, the polio status of the child was recorded.

1 Goal

The goal of the experiment is to find out if the vaccine reduces the incidence of getting the polio disease.

salk<-data.frame(group=c("cases","control","noConcent"),treatment=c("vaccine","placebo","none"),total=c(200745,
201229, 338778),polio=c(57,142,157))
salk$noPolio<-salk$total-salk$polio
salk$incidencePM<-round(salk$polio/salk$total*1e6,0)
salk
##       group treatment  total polio noPolio incidencePM
## 1     cases   vaccine 200745    57  200688         284
## 2   control   placebo 201229   142  201087         706
## 3 noConcent      none 338778   157  338621         463

2 Logistic regression

2.1 Full comparison

salk
##       group treatment  total polio noPolio incidencePM
## 1     cases   vaccine 200745    57  200688         284
## 2   control   placebo 201229   142  201087         706
## 3 noConcent      none 338778   157  338621         463
levels(salk$treatment) # [1] "none"    "placebo" "vaccine"
## [1] "none"    "placebo" "vaccine"
salk$treatment <- relevel(salk$treatment, "placebo")

levels(salk$treatment)
## [1] "placebo" "none"    "vaccine"
glm_salk <- glm(as.matrix(salk[,4:5]) ~ as.factor(salk[,2]), family = binomial)
summary(glm_salk)
## 
## Call:
## glm(formula = as.matrix(salk[, 4:5]) ~ as.factor(salk[, 2]), 
##     family = binomial)
## 
## Deviance Residuals: 
## [1]  0  0  0
## 
## Coefficients:
##                             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                 -7.25567    0.08395 -86.431  < 2e-16 ***
## as.factor(salk[, 2])none    -0.42073    0.11584  -3.632 0.000281 ***
## as.factor(salk[, 2])vaccine -0.91079    0.15683  -5.807 6.34e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 3.7697e+01  on 2  degrees of freedom
## Residual deviance: 2.0624e-12  on 0  degrees of freedom
## AIC: 25.572
## 
## Number of Fisher Scoring iterations: 3

2.2 Limited comparison

glm_salk <- glm(as.matrix(salk[1:2,4:5]) ~ as.factor(salk[1:2,2]), family = binomial)
summary(glm_salk)
## 
## Call:
## glm(formula = as.matrix(salk[1:2, 4:5]) ~ as.factor(salk[1:2, 
##     2]), family = binomial)
## 
## Deviance Residuals: 
## [1]  0  0
## 
## Coefficients:
##                                Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                    -7.25567    0.08395 -86.431  < 2e-16 ***
## as.factor(salk[1:2, 2])vaccine -0.91079    0.15683  -5.807 6.34e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 3.7313e+01  on 1  degrees of freedom
## Residual deviance: 3.0287e-13  on 0  degrees of freedom
## AIC: 16.678
## 
## Number of Fisher Scoring iterations: 3
LS0tCnRpdGxlOiAiVHV0b3JpYWwgMTAuMjogTG9naXN0aWMgcmVncmVzc2lvbiBvbiB0aGUgc29yZSB0aHJvYXQgZGF0YXNldCIgICAKb3V0cHV0OgogICAgaHRtbF9kb2N1bWVudDoKICAgICAgY29kZV9kb3dubG9hZDogdHJ1ZSAgICAKICAgICAgdGhlbWU6IGNvc21vCiAgICAgIHRvYzogdHJ1ZQogICAgICB0b2NfZmxvYXQ6IHRydWUKICAgICAgaGlnaGxpZ2h0OiB0YW5nbwogICAgICBudW1iZXJfc2VjdGlvbnM6IHRydWUKLS0tCgpJbiAxOTE2LCB0aGUgVVMgZXhwZXJpZW5jZWQgdGhlIGZpcnN0IGxhcmdlIGVwaWRlbWljIG9mIHBvbGlvLgpKb2huIFNhbGsgZGV2ZWxvcGVkIGEgdmFjY2luZSB3aXRoIHByb21pc2luZyByZXN1bHRzIGluIHRoZSBsYWIgaW4gdGhlIGVhcmx5IGZpZnRpZXMuCkluIHRoaXMgZXhwZXJpbWVudCwgY2hpbGRyZW4gYXJlIGFzc2lnbmVkIGF0IHJhbmRvbSB0byB0aGUgY29udHJvbAoocGxhY2VibyB0cmVhdG1lbnQpIG9yIHZhY2NpbmUgdHJlYXRtZW50IGFybSBhZnRlciBjb25zZW50IHdhcyBnaXZlbiBieQp0aGUgcGFyZW50cy4KCkFzIHN1Y2gsIHdlIGhhdmUgdHdvIHRyZWF0bWVudCBhcm1zCi0gQ29udHJvbDogdmFjY2luYXRpb24gd2l0aCBwbGFjZWJvCi0gVHJlYXRtZW50OiB2YWNjaW5hdGlvbiB3aXRoIHZhY2NpbmUKCk5vdGU6CgpJbiBvcmRlciB0byBsaW1pdCBjb25mb3VuZGluZywgdGhlIGV4cGVyaW1lbnQgdXNlZCAgZG91YmxlIGJsaW5kaW5nOgotIFRoZSBwYXJlbnRzIGRpZCBub3Qga25vdyBpZiB0aGVpciBjaGlsZCB3YXMgdmFjY2luYXRlZCBvciByZWNlaXZlZCB0aGUgcGxhY2VibwotIFRoZSBjYXJlLWdpdmVyL3Jlc2VhcmNoZXJzIGRpZCBub3Qga25vdyBpZiB0aGUgY2hpbGQgd2FzIHZhY2NpbmF0ZWQgb3IgcmVjZWl2ZWQgcGxhY2VibwoKQWZ0ZXIgb25lIHllYXIsIHRoZSBwb2xpbyBzdGF0dXMgb2YgdGhlIGNoaWxkIHdhcyByZWNvcmRlZC4KCiMgR29hbAoKVGhlIGdvYWwgb2YgdGhlIGV4cGVyaW1lbnQgaXMgdG8gZmluZCBvdXQgaWYgdGhlIHZhY2NpbmUgcmVkdWNlcyB0aGUKaW5jaWRlbmNlIG9mIGdldHRpbmcgdGhlIHBvbGlvIGRpc2Vhc2UuCgpgYGB7cn0Kc2FsazwtZGF0YS5mcmFtZShncm91cD1jKCJjYXNlcyIsImNvbnRyb2wiLCJub0NvbmNlbnQiKSx0cmVhdG1lbnQ9YygidmFjY2luZSIsInBsYWNlYm8iLCJub25lIiksdG90YWw9YygyMDA3NDUsCjIwMTIyOSwgMzM4Nzc4KSxwb2xpbz1jKDU3LDE0MiwxNTcpKQpzYWxrJG5vUG9saW88LXNhbGskdG90YWwtc2FsayRwb2xpbwpzYWxrJGluY2lkZW5jZVBNPC1yb3VuZChzYWxrJHBvbGlvL3NhbGskdG90YWwqMWU2LDApCnNhbGsKYGBgCgojIExvZ2lzdGljIHJlZ3Jlc3Npb24KCiMjIEZ1bGwgY29tcGFyaXNvbgoKYGBge3J9CnNhbGsKYGBgCgpgYGB7cn0KbGV2ZWxzKHNhbGskdHJlYXRtZW50KSAjIFsxXSAibm9uZSIgICAgInBsYWNlYm8iICJ2YWNjaW5lIgoKc2FsayR0cmVhdG1lbnQgPC0gcmVsZXZlbChzYWxrJHRyZWF0bWVudCwgInBsYWNlYm8iKQoKbGV2ZWxzKHNhbGskdHJlYXRtZW50KQpgYGAKCgoKYGBge3J9CmdsbV9zYWxrIDwtIGdsbShhcy5tYXRyaXgoc2Fsa1ssNDo1XSkgfiBhcy5mYWN0b3Ioc2Fsa1ssMl0pLCBmYW1pbHkgPSBiaW5vbWlhbCkKc3VtbWFyeShnbG1fc2FsaykKYGBgCgojIyBMaW1pdGVkIGNvbXBhcmlzb24KCmBgYHtyfQpnbG1fc2FsayA8LSBnbG0oYXMubWF0cml4KHNhbGtbMToyLDQ6NV0pIH4gYXMuZmFjdG9yKHNhbGtbMToyLDJdKSwgZmFtaWx5ID0gYmlub21pYWwpCnN1bW1hcnkoZ2xtX3NhbGspCmBgYAoKCgoKCgoKCgoKCgoKCgoK