Required packages

rr library(tidyr) library(readr) library(stringr) library(dplyr) library(Hmisc) library(outliers) library(InformationValue)

Executive Summary

The survival of passengers on Titanic

Data

The Titanic data from Kaggle.com was used for this particular project. This dataset has information about 889 passengers on the Titanic contained in 12 variables.

rr #read data titanic_train <- read.csv(/Users/Vidya/Downloads/train.csv, header = T, na.strings = c(\)) training.data.raw <- read.csv(‘/Users/Vidya/Downloads/train.csv’,header=T,na.strings=c(\))

rr #dimension of the dataframe str(titanic_train)

'data.frame':   891 obs. of  12 variables:
 $ PassengerId: int  1 2 3 4 5 6 7 8 9 10 ...
 $ Survived   : int  0 1 1 1 0 0 0 0 1 1 ...
 $ Pclass     : int  3 1 3 1 3 3 1 3 3 2 ...
 $ Name       : Factor w/ 891 levels \Abbing

rr View(titanic_train)

rr # find sum of NA values in the data sum(is.na(titanic_train))

[1] 866

rr sum(is.na(titanic_train$Cabin))

[1] 687

rr sapply(titanic_train, function(x) sum(is.na(x)))

PassengerId    Survived      Pclass        Name         Sex         Age       SibSp       Parch 
          0           0           0           0           0         177           0           0 
     Ticket        Fare       Cabin    Embarked 
          0           0         687           2 

rr sapply(titanic_train, function(x) length(unique(x)))

PassengerId    Survived      Pclass        Name         Sex         Age       SibSp       Parch 
        891           2           3         891           2          89           7           7 
     Ticket        Fare       Cabin    Embarked 
        681         248         148           4 

There are 687 missing values in the cabin variable. This can be removed from the training dataset. The passenger ID column also does n ot contribute any meaningful information to the data as it only records a unique id of the passenger. The new training data is subset fom the original dataset.

rr titanic_subset <- subset(titanic_train, select= c(2:10, 12)) View(titanic_subset)

The age variable has 177 missing values. This can be dealt with by imputing the age value.

rr titanic_subset\(Age[is.na(titanic_subset\)Age)] <- mean(titanic_subset\(Age, na.rm =T) titanic_subset <- titanic_subset[!is.na(titanic_subset\)Embarked),] rownames(titanic_subset) <- NULL str(titanic_subset)

'data.frame':   889 obs. of  10 variables:
 $ Survived: int  0 1 1 1 0 0 0 0 1 1 ...
 $ Pclass  : int  3 1 3 1 3 3 1 3 3 2 ...
 $ Name    : Factor w/ 891 levels \Abbing

rr table(titanic_subset$Survived)


  0   1 
549 340 

rr #train <- titanic_subset[1:800,] #test <- titanic_subset[801:889,] train <- titanic_subset[1:800,] test <- titanic_subset[801:889,] model <- glm(Survived ~ Sex + Pclass ,family=binomial(link=‘logit’),data=train) #model <- glm(Survived ~., family = binomial(link =‘logit’), data = train)

rr summary(model)


Call:
glm(formula = Survived ~ Sex + Pclass, family = binomial(link = \logit\), 
    data = train)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-2.2060  -0.6949  -0.4491   0.6652   2.1653  

Coefficients:
            Estimate Std. Error z value Pr(>|z|)    
(Intercept)   3.2870     0.3158  10.409   <2e-16 ***
Sexmale      -2.6937     0.1951 -13.809   <2e-16 ***
Pclass       -0.9456     0.1123  -8.418   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 1065.39  on 799  degrees of freedom
Residual deviance:  741.77  on 797  degrees of freedom
AIC: 747.77

Number of Fisher Scoring iterations: 4

rr predicted <- plogis(predict(model, test)) # predicted scores

rr optCutOff <- optimalCutoff(test$Survived, predicted)[1]

rr misClassError(test$Survived, predicted, threshold = optCutOff)

[1] 0.2022

rr plotROC(test$Survived, predicted)

rr confusionMatrix(test$Survived, predicted, threshold = optCutOff)

   0  1
0 55 17
1  1 16



LS0tCm91dHB1dDoKICBodG1sX25vdGVib29rOiBkZWZhdWx0CiAgaHRtbF9kb2N1bWVudDogZGVmYXVsdAotLS0KCgoKCgoKIyMgUmVxdWlyZWQgcGFja2FnZXMgCgoKYGBge3J9CmxpYnJhcnkodGlkeXIpCmxpYnJhcnkocmVhZHIpCmxpYnJhcnkoc3RyaW5ncikKbGlicmFyeShkcGx5cikKbGlicmFyeShIbWlzYykKbGlicmFyeShvdXRsaWVycykKbGlicmFyeShJbmZvcm1hdGlvblZhbHVlKQoKYGBgCgojIyBFeGVjdXRpdmUgU3VtbWFyeSAKClRoZSBzdXJ2aXZhbCBvZiBwYXNzZW5nZXJzIG9uIFRpdGFuaWMgCgojIyBEYXRhIAoKVGhlIFRpdGFuaWMgZGF0YSBmcm9tIEthZ2dsZS5jb20gd2FzIHVzZWQgZm9yIHRoaXMgcGFydGljdWxhciBwcm9qZWN0LiBUaGlzIGRhdGFzZXQgaGFzIGluZm9ybWF0aW9uIGFib3V0IDg4OSBwYXNzZW5nZXJzIG9uIHRoZSBUaXRhbmljIGNvbnRhaW5lZCBpbiAxMiB2YXJpYWJsZXMuIAoKYGBge3J9CiNyZWFkIGRhdGEKdGl0YW5pY190cmFpbiA8LSByZWFkLmNzdigiL1VzZXJzL1ZpZHlhL0Rvd25sb2Fkcy90cmFpbi5jc3YiLCBoZWFkZXIgPSBULCBuYS5zdHJpbmdzID0gYygiIikpCnRyYWluaW5nLmRhdGEucmF3IDwtIHJlYWQuY3N2KCcvVXNlcnMvVmlkeWEvRG93bmxvYWRzL3RyYWluLmNzdicsaGVhZGVyPVQsbmEuc3RyaW5ncz1jKCIiKSkKCgpgYGAKCgpgYGB7cn0KI2RpbWVuc2lvbiBvZiB0aGUgZGF0YWZyYW1lCnN0cih0aXRhbmljX3RyYWluKQpWaWV3KHRpdGFuaWNfdHJhaW4pCmBgYAoKCmBgYHtyfQoKIyBmaW5kIHN1bSBvZiBOQSB2YWx1ZXMgaW4gdGhlIGRhdGEKc3VtKGlzLm5hKHRpdGFuaWNfdHJhaW4pKQoKc3VtKGlzLm5hKHRpdGFuaWNfdHJhaW4kQ2FiaW4pKQpzYXBwbHkodGl0YW5pY190cmFpbiwgZnVuY3Rpb24oeCkgc3VtKGlzLm5hKHgpKSkKc2FwcGx5KHRpdGFuaWNfdHJhaW4sIGZ1bmN0aW9uKHgpIGxlbmd0aCh1bmlxdWUoeCkpKQoKYGBgClRoZXJlIGFyZSA2ODcgbWlzc2luZyB2YWx1ZXMgaW4gdGhlIGNhYmluIHZhcmlhYmxlLiBUaGlzIGNhbiBiZSByZW1vdmVkIGZyb20gdGhlIHRyYWluaW5nIGRhdGFzZXQuIFRoZSBwYXNzZW5nZXIgSUQgY29sdW1uIGFsc28gZG9lcyBuIG90IGNvbnRyaWJ1dGUgYW55IG1lYW5pbmdmdWwgaW5mb3JtYXRpb24gdG8gdGhlIGRhdGEgYXMgaXQgb25seSByZWNvcmRzIGEgdW5pcXVlIGlkIG9mIHRoZSBwYXNzZW5nZXIuIFRoZSBuZXcgdHJhaW5pbmcgZGF0YSBpcyBzdWJzZXQgZm9tIHRoZSBvcmlnaW5hbCBkYXRhc2V0LiAKCmBgYHtyfQp0aXRhbmljX3N1YnNldCA8LSBzdWJzZXQodGl0YW5pY190cmFpbiwgc2VsZWN0PSBjKDI6MTAsIDEyKSkKVmlldyh0aXRhbmljX3N1YnNldCkKYGBgClRoZSBhZ2UgdmFyaWFibGUgaGFzIDE3NyBtaXNzaW5nIHZhbHVlcy4gVGhpcyBjYW4gYmUgZGVhbHQgd2l0aCBieSBpbXB1dGluZyB0aGUgYWdlIHZhbHVlLgoKCgpgYGB7cn0KCnRpdGFuaWNfc3Vic2V0JEFnZVtpcy5uYSh0aXRhbmljX3N1YnNldCRBZ2UpXSA8LSBtZWFuKHRpdGFuaWNfc3Vic2V0JEFnZSwgbmEucm0gPVQpCnRpdGFuaWNfc3Vic2V0IDwtIHRpdGFuaWNfc3Vic2V0WyFpcy5uYSh0aXRhbmljX3N1YnNldCRFbWJhcmtlZCksXQpyb3duYW1lcyh0aXRhbmljX3N1YnNldCkgPC0gTlVMTApzdHIodGl0YW5pY19zdWJzZXQpCgpgYGAKCgpgYGB7cn0KdGFibGUodGl0YW5pY19zdWJzZXQkU3Vydml2ZWQpCgpgYGAKIAoKYGBge3J9CiN0cmFpbiA8LSB0aXRhbmljX3N1YnNldFsxOjgwMCxdCgojdGVzdCA8LSB0aXRhbmljX3N1YnNldFs4MDE6ODg5LF0KCnRyYWluIDwtIHRpdGFuaWNfc3Vic2V0WzE6ODAwLF0KdGVzdCA8LSB0aXRhbmljX3N1YnNldFs4MDE6ODg5LF0KCm1vZGVsIDwtIGdsbShTdXJ2aXZlZCB+IFNleCArIFBjbGFzcyAsZmFtaWx5PWJpbm9taWFsKGxpbms9J2xvZ2l0JyksZGF0YT10cmFpbikKCiNtb2RlbCA8LSBnbG0oU3Vydml2ZWQgfi4sIGZhbWlseSA9IGJpbm9taWFsKGxpbmsgPSdsb2dpdCcpLCBkYXRhID0gdHJhaW4pCmBgYAoKCgoKCmBgYHtyfQpzdW1tYXJ5KG1vZGVsKQoKcHJlZGljdGVkIDwtIHBsb2dpcyhwcmVkaWN0KG1vZGVsLCB0ZXN0KSkgICMgcHJlZGljdGVkIHNjb3JlcwoKYGBgCgoKYGBge3J9CgpvcHRDdXRPZmYgPC0gb3B0aW1hbEN1dG9mZih0ZXN0JFN1cnZpdmVkLCBwcmVkaWN0ZWQpWzFdIApgYGAKCgoKCgoKYGBge3J9Cm1pc0NsYXNzRXJyb3IodGVzdCRTdXJ2aXZlZCwgcHJlZGljdGVkLCB0aHJlc2hvbGQgPSBvcHRDdXRPZmYpCgpgYGAKCgoKCgoKYGBge3J9CnBsb3RST0ModGVzdCRTdXJ2aXZlZCwgcHJlZGljdGVkKQoKYGBgCgoKYGBge3J9CmNvbmZ1c2lvbk1hdHJpeCh0ZXN0JFN1cnZpdmVkLCBwcmVkaWN0ZWQsIHRocmVzaG9sZCA9IG9wdEN1dE9mZikKCmBgYAoKCmBgYHtyfQoKYGBgCgo8YnI+Cjxicj4K