Re-implementing computations from slides 5.2-5.18 of Lecture 6 using Zelig 5 Syntax

Previewing, recoding and cleaning up the data set

library(radiant.data)
data("Titanic")
titanic <- titanic %>%
  mutate(surv = as.integer(survived)) %>% 
  mutate(survival = sjmisc::rec(surv, rec = "2=0; 1=1")) %>% 
  select(pclass, survived, survival, everything())
head(titanic)

Interaction Model (Slide 5.2)

library(Zelig)
z5_tit <- zlogit$new()
z5_tit$zelig(survival ~ age + sex*pclass + fare, data = titanic)
summary(z5_tit)
Model: 

Call:
z5_tit$zelig(formula = survival ~ age + sex * pclass + fare, 
    data = titanic)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-3.0634  -0.6641  -0.4943   0.4336   2.4941  

Coefficients:
                    Estimate Std. Error z value            Pr(>|z|)
(Intercept)        4.8978215  0.6131092   7.988 0.00000000000000137
age               -0.0387245  0.0068044  -5.691 0.00000001262563680
sexmale           -3.8996177  0.5015659  -7.775 0.00000000000000755
pclass2nd         -1.5923247  0.6024844  -2.643             0.00822
pclass3rd         -4.1382715  0.5601819  -7.387 0.00000000000014976
fare              -0.0009058  0.0020509  -0.442             0.65874
sexmale:pclass2nd -0.0600076  0.6372949  -0.094             0.92498
sexmale:pclass3rd  2.5019110  0.5479901   4.566 0.00000498035051247

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 1409.99  on 1042  degrees of freedom
Residual deviance:  931.45  on 1035  degrees of freedom
AIC: 947.45

Number of Fisher Scoring iterations: 5

Next step: Use 'setx' method

Interaction between sex and class along with age and fare to determine the factors that have an effect on survival during the titanic.

Age Effect (Slides 5.3-5.4)

z5_tit$setrange(age=0:80)
z5_tit$sim()
z5_tit$graph()

This plot shows the effect age (independent variable) has on surviving (dependent variable) in the titanic. As we can see elderly people were less likely to survive. As age increases, the probability of surviving the titanic decreases.

Fare Effect (Slides 5.5-5.6)

z5_tit$setrange(fare=0:513)
z5_tit$sim()
z5_tit$graph()

This graph shows the effect fare has on survival. According to this graph, fare does not have much of an affect on survival because as fare increases, the probability of surviving is almost the same for everyone. In other words surviving does not depend on whether the passenger paid a low or high fare during the titanic.

Sex Difference and viewing only the simulated first difference (Slides 5.7-5.9)

z5_tit$setx(sex="male")
z5_tit$setx1(sex="female")
z5_tit$sim()
fd <- z5_tit$get_qi(xvalue="x1", qi="fd")
summary(fd)
       V1         
 Min.   :0.09044  
 1st Qu.:0.22501  
 Median :0.25545  
 Mean   :0.25504  
 3rd Qu.:0.28319  
 Max.   :0.42953  
plot(z5_tit)

This plot shows the simulated first difference between males and females in the titanic. The predicted and expected values for both are shown.

Testing Class Variations in Sex Difference Using Zelig (Slides 5.11-5.14)

First Class

z5t.1 <- zlogit$new()
z5t.1$zelig(survival ~ age +sex*pclass + fare, data=titanic)
z5t.1$setx(sex="male", pclass="1st")
z5t.1$setx1(sex="female", pclass="1st")
z5t.1$sim()
plot(z5t.1)

2nd Class

z5t.2 <- zlogit$new()
z5t.2$zelig(survival ~ age +sex*pclass + fare, data=titanic)
z5t.2$setx(sex="male", pclass="2nd")
z5t.2$setx1(sex="female", pclass="2nd")
z5t.2$sim()
plot(z5t.2)

3rd Class

z5t.3 <- zlogit$new()
z5t.3$zelig(survival ~ age +sex*pclass + fare, data=titanic)
z5t.3$setx(sex="male", pclass="3rd")
z5t.3$setx1(sex="female", pclass="3rd")
z5t.3$sim()
plot(z5t.3)

Putting them into one place (Slides 5.15-5.16)

d1 <- z5t.1$get_qi(xvalue="x1", qi="fd")
d2 <- z5t.2$get_qi(xvalue="x1", qi="fd")
d3 <- z5t.3$get_qi(xvalue="x1", qi="fd")
  
dfd <- as.data.frame(cbind(d1, d2, d3))
head(dfd)
tidd <- dfd %>% 
  gather(class, simv, 1:3)
head(tidd)

Group and plot by class (Slides 5.17-5.18)

tidd %>% 
  group_by(class) %>% 
  summarise(mean = mean(simv), sd = sd(simv))
ggplot(tidd, aes(simv)) + geom_histogram() + facet_grid(~class)

LS0tDQp0aXRsZTogIiMqKlN1cnZpdmluZyB0aGUgVGl0YW5pYyB3aXRoIFplbGlnKioiDQphdXRob3I6ICJTYW5naXRhIFJveSINCmRhdGU6ICJNYXJjaCAxOCwgMjAxOCINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQojIyNSZS1pbXBsZW1lbnRpbmcgY29tcHV0YXRpb25zIGZyb20gc2xpZGVzIDUuMi01LjE4IG9mIExlY3R1cmUgNiB1c2luZyBaZWxpZyA1IFN5bnRheA0KDQojI1ByZXZpZXdpbmcsIHJlY29kaW5nIGFuZCBjbGVhbmluZyB1cCB0aGUgZGF0YSBzZXQNCg0KYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0NCmxpYnJhcnkocmFkaWFudC5kYXRhKQ0KZGF0YSgiVGl0YW5pYyIpDQp0aXRhbmljIDwtIHRpdGFuaWMgJT4lDQogIG11dGF0ZShzdXJ2ID0gYXMuaW50ZWdlcihzdXJ2aXZlZCkpICU+JSANCiAgbXV0YXRlKHN1cnZpdmFsID0gc2ptaXNjOjpyZWMoc3VydiwgcmVjID0gIjI9MDsgMT0xIikpICU+JSANCiAgc2VsZWN0KHBjbGFzcywgc3Vydml2ZWQsIHN1cnZpdmFsLCBldmVyeXRoaW5nKCkpDQpoZWFkKHRpdGFuaWMpDQpgYGANCg0KIyNJbnRlcmFjdGlvbiBNb2RlbCAoU2xpZGUgNS4yKSMjDQoNCmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9DQpsaWJyYXJ5KFplbGlnKQ0KejVfdGl0IDwtIHpsb2dpdCRuZXcoKQ0KejVfdGl0JHplbGlnKHN1cnZpdmFsIH4gYWdlICsgc2V4KnBjbGFzcyArIGZhcmUsIGRhdGEgPSB0aXRhbmljKQ0Kc3VtbWFyeSh6NV90aXQpDQpgYGANCkludGVyYWN0aW9uIGJldHdlZW4gc2V4IGFuZCBjbGFzcyBhbG9uZyB3aXRoIGFnZSBhbmQgZmFyZSB0byBkZXRlcm1pbmUgdGhlIGZhY3RvcnMgdGhhdCBoYXZlIGFuIGVmZmVjdCBvbiBzdXJ2aXZhbCBkdXJpbmcgdGhlIHRpdGFuaWMuDQoNCiMjQWdlIEVmZmVjdCAoU2xpZGVzIDUuMy01LjQpIyMNCg0KYGBge3J9DQp6NV90aXQkc2V0cmFuZ2UoYWdlPTA6ODApDQp6NV90aXQkc2ltKCkNCno1X3RpdCRncmFwaCgpDQpgYGANClRoaXMgcGxvdCBzaG93cyB0aGUgZWZmZWN0IGFnZSAoaW5kZXBlbmRlbnQgdmFyaWFibGUpIGhhcyBvbiBzdXJ2aXZpbmcgKGRlcGVuZGVudCB2YXJpYWJsZSkgaW4gdGhlIHRpdGFuaWMuIEFzIHdlIGNhbiBzZWUgZWxkZXJseSBwZW9wbGUgd2VyZSBsZXNzIGxpa2VseSB0byBzdXJ2aXZlLiBBcyBhZ2UgaW5jcmVhc2VzLCB0aGUgcHJvYmFiaWxpdHkgb2Ygc3Vydml2aW5nIHRoZSB0aXRhbmljIGRlY3JlYXNlcy4NCg0KDQojI0ZhcmUgRWZmZWN0IChTbGlkZXMgNS41LTUuNikjIw0KDQpgYGB7cn0NCno1X3RpdCRzZXRyYW5nZShmYXJlPTA6NTEzKQ0KejVfdGl0JHNpbSgpDQp6NV90aXQkZ3JhcGgoKQ0KYGBgDQpUaGlzIGdyYXBoIHNob3dzIHRoZSBlZmZlY3QgZmFyZSBoYXMgb24gc3Vydml2YWwuIEFjY29yZGluZyB0byB0aGlzIGdyYXBoLCBmYXJlIGRvZXMgbm90IGhhdmUgbXVjaCBvZiBhbiBhZmZlY3Qgb24gc3Vydml2YWwgYmVjYXVzZSBhcyBmYXJlIGluY3JlYXNlcywgdGhlIHByb2JhYmlsaXR5IG9mIHN1cnZpdmluZyBpcyBhbG1vc3QgdGhlIHNhbWUgZm9yIGV2ZXJ5b25lLiBJbiBvdGhlciB3b3JkcyBzdXJ2aXZpbmcgZG9lcyBub3QgZGVwZW5kIG9uIHdoZXRoZXIgdGhlIHBhc3NlbmdlciBwYWlkIGEgbG93IG9yIGhpZ2ggZmFyZSBkdXJpbmcgdGhlIHRpdGFuaWMuDQoNCiMjU2V4IERpZmZlcmVuY2UgYW5kIHZpZXdpbmcgb25seSB0aGUgc2ltdWxhdGVkIGZpcnN0IGRpZmZlcmVuY2UgKFNsaWRlcyA1LjctNS45KSMjDQoNCmBgYHtyfQ0KejVfdGl0JHNldHgoc2V4PSJtYWxlIikNCno1X3RpdCRzZXR4MShzZXg9ImZlbWFsZSIpDQp6NV90aXQkc2ltKCkNCmZkIDwtIHo1X3RpdCRnZXRfcWkoeHZhbHVlPSJ4MSIsIHFpPSJmZCIpDQpzdW1tYXJ5KGZkKQ0KYGBgDQoNCmBgYHtyIGZpZy5oZWlnaHQ9MTAsIGZpZy53aWR0aD0xMH0NCnBsb3QoejVfdGl0KQ0KYGBgDQpUaGlzIHBsb3Qgc2hvd3MgdGhlIHNpbXVsYXRlZCBmaXJzdCBkaWZmZXJlbmNlIGJldHdlZW4gbWFsZXMgYW5kIGZlbWFsZXMgaW4gdGhlIHRpdGFuaWMuIFRoZSBwcmVkaWN0ZWQgYW5kIGV4cGVjdGVkIHZhbHVlcyBmb3IgYm90aCBhcmUgc2hvd24uDQoNCiMjVGVzdGluZyBDbGFzcyBWYXJpYXRpb25zIGluIFNleCBEaWZmZXJlbmNlIFVzaW5nIFplbGlnIChTbGlkZXMgNS4xMS01LjE0KQ0KDQoqKkZpcnN0IENsYXNzKioNCmBgYHtyIGZpZy5oZWlnaHQ9MTAsIGZpZy53aWR0aD0xMH0NCno1dC4xIDwtIHpsb2dpdCRuZXcoKQ0KejV0LjEkemVsaWcoc3Vydml2YWwgfiBhZ2UgK3NleCpwY2xhc3MgKyBmYXJlLCBkYXRhPXRpdGFuaWMpDQp6NXQuMSRzZXR4KHNleD0ibWFsZSIsIHBjbGFzcz0iMXN0IikNCno1dC4xJHNldHgxKHNleD0iZmVtYWxlIiwgcGNsYXNzPSIxc3QiKQ0KejV0LjEkc2ltKCkNCnBsb3QoejV0LjEpDQpgYGANCg0KKioybmQgQ2xhc3MqKg0KYGBge3IgZmlnLmhlaWdodD0xMCwgZmlnLndpZHRoPTEwfQ0KejV0LjIgPC0gemxvZ2l0JG5ldygpDQp6NXQuMiR6ZWxpZyhzdXJ2aXZhbCB+IGFnZSArc2V4KnBjbGFzcyArIGZhcmUsIGRhdGE9dGl0YW5pYykNCno1dC4yJHNldHgoc2V4PSJtYWxlIiwgcGNsYXNzPSIybmQiKQ0KejV0LjIkc2V0eDEoc2V4PSJmZW1hbGUiLCBwY2xhc3M9IjJuZCIpDQp6NXQuMiRzaW0oKQ0KcGxvdCh6NXQuMikNCmBgYA0KDQoqKjNyZCBDbGFzcyoqDQpgYGB7ciBmaWcuaGVpZ2h0PTEwLCBmaWcud2lkdGg9MTB9DQp6NXQuMyA8LSB6bG9naXQkbmV3KCkNCno1dC4zJHplbGlnKHN1cnZpdmFsIH4gYWdlICtzZXgqcGNsYXNzICsgZmFyZSwgZGF0YT10aXRhbmljKQ0KejV0LjMkc2V0eChzZXg9Im1hbGUiLCBwY2xhc3M9IjNyZCIpDQp6NXQuMyRzZXR4MShzZXg9ImZlbWFsZSIsIHBjbGFzcz0iM3JkIikNCno1dC4zJHNpbSgpDQpwbG90KHo1dC4zKQ0KYGBgDQoNCiMjUHV0dGluZyB0aGVtIGludG8gb25lIHBsYWNlIChTbGlkZXMgNS4xNS01LjE2KQ0KDQpgYGB7cn0NCmQxIDwtIHo1dC4xJGdldF9xaSh4dmFsdWU9IngxIiwgcWk9ImZkIikNCmQyIDwtIHo1dC4yJGdldF9xaSh4dmFsdWU9IngxIiwgcWk9ImZkIikNCmQzIDwtIHo1dC4zJGdldF9xaSh4dmFsdWU9IngxIiwgcWk9ImZkIikNCiAgDQpkZmQgPC0gYXMuZGF0YS5mcmFtZShjYmluZChkMSwgZDIsIGQzKSkNCmhlYWQoZGZkKQ0KYGBgDQoNCg0KYGBge3J9DQp0aWRkIDwtIGRmZCAlPiUgDQogIGdhdGhlcihjbGFzcywgc2ltdiwgMTozKQ0KaGVhZCh0aWRkKQ0KYGBgDQoNCiMjR3JvdXAgYW5kIHBsb3QgYnkgY2xhc3MgKFNsaWRlcyA1LjE3LTUuMTgpDQpgYGB7cn0NCnRpZGQgJT4lIA0KICBncm91cF9ieShjbGFzcykgJT4lIA0KICBzdW1tYXJpc2UobWVhbiA9IG1lYW4oc2ltdiksIHNkID0gc2Qoc2ltdikpDQpgYGANCg0KYGBge3J9DQpnZ3Bsb3QodGlkZCwgYWVzKHNpbXYpKSArIGdlb21faGlzdG9ncmFtKCkgKyBmYWNldF9ncmlkKH5jbGFzcykNCmBgYA0KDQo=