R Markdown
## Load Titanic library to get the dataset
library(titanic)
## Load the datasets
data("titanic_train")
data("titanic_test")
## Setting Survived column for test data to NA
titanic_test$Survived <- NA
## Combining Training and Testing dataset
complete_data <- rbind(titanic_train, titanic_test)
## Check data structure
str(complete_data)
## 'data.frame': 1309 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 : chr "Braund, Mr. Owen Harris" "Cumings, Mrs. John Bradley (Florence Briggs Thayer)" "Heikkinen, Miss. Laina" "Futrelle, Mrs. Jacques Heath (Lily May Peel)" ...
## $ Sex : chr "male" "female" "female" "female" ...
## $ Age : num 22 38 26 35 35 NA 54 2 27 14 ...
## $ SibSp : int 1 1 0 1 0 0 0 3 0 1 ...
## $ Parch : int 0 0 0 0 0 0 0 1 2 0 ...
## $ Ticket : chr "A/5 21171" "PC 17599" "STON/O2. 3101282" "113803" ...
## $ Fare : num 7.25 71.28 7.92 53.1 8.05 ...
## $ Cabin : chr "" "C85" "" "C123" ...
## $ Embarked : chr "S" "C" "S" "S" ...
## Let's check for any missing values in the data
colSums(is.na(complete_data))
## PassengerId Survived Pclass Name Sex Age
## 0 418 0 0 0 263
## SibSp Parch Ticket Fare Cabin Embarked
## 0 0 0 1 0 0
## Checking for empty values
colSums(complete_data=='')
## PassengerId Survived Pclass Name Sex Age
## 0 NA 0 0 0 NA
## SibSp Parch Ticket Fare Cabin Embarked
## 0 0 0 NA 1014 2
## Check number of uniques values for each of the column to find out columns which we can convert to factors
sapply(complete_data, function(x) length(unique(x)))
## PassengerId Survived Pclass Name Sex Age
## 1309 3 3 1307 2 99
## SibSp Parch Ticket Fare Cabin Embarked
## 7 8 929 282 187 4
## Missing values imputation
complete_data$Embarked[complete_data$Embarked==""] <- "S"
complete_data$Age[is.na(complete_data$Age)] <- median(complete_data$Age,na.rm=T)
## Removing Cabin as it has very high missing values, passengerId, Ticket and Name are not required
library(dplyr)
titanic_data <- complete_data %>% select(-c(Cabin, PassengerId, Ticket, Name))
## Converting "Survived","Pclass","Sex","Embarked" to factors
for (i in c("Survived","Pclass","Sex","Embarked")){
titanic_data[,i]=as.factor(titanic_data[,i])
}
## Create dummy variables for categorical variables
library(dummies)
titanic_data <- dummy.data.frame(titanic_data, names=c("Pclass","Sex","Embarked"), sep="_")
## Splitting training and test data
train <- titanic_data[1:667,]
test <- titanic_data[668:889,]
## Model Creation
model <- glm(Survived ~.,family=binomial(link='logit'),data=train)
## Model Summary
summary(model)
##
## Call:
## glm(formula = Survived ~ ., family = binomial(link = "logit"),
## data = train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.3804 -0.6562 -0.4300 0.6392 2.3950
##
## Coefficients: (3 not defined because of singularities)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.373105 0.319779 -4.294 1.76e-05 ***
## Pclass_1 2.175104 0.359365 6.053 1.42e-09 ***
## Pclass_2 1.302268 0.271680 4.793 1.64e-06 ***
## Pclass_3 NA NA NA NA
## Sex_female 2.677814 0.226863 11.804 < 2e-16 ***
## Sex_male NA NA NA NA
## Age -0.031671 0.008945 -3.540 0.000399 ***
## SibSp -0.248975 0.123365 -2.018 0.043570 *
## Parch -0.091603 0.141950 -0.645 0.518718
## Fare -0.001397 0.003179 -0.440 0.660254
## Embarked_C 0.431447 0.271693 1.588 0.112288
## Embarked_Q 0.533193 0.369337 1.444 0.148837
## Embarked_S NA NA NA NA
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 891.99 on 666 degrees of freedom
## Residual deviance: 605.78 on 657 degrees of freedom
## AIC: 625.78
##
## Number of Fisher Scoring iterations: 5
## Using anova() to analyze the table of devaiance
anova(model, test="Chisq")
## Analysis of Deviance Table
##
## Model: binomial, link: logit
##
## Response: Survived
##
## Terms added sequentially (first to last)
##
##
## Df Deviance Resid. Df Resid. Dev Pr(>Chi)
## NULL 666 891.99
## Pclass_1 1 39.603 665 852.39 3.112e-10 ***
## Pclass_2 1 26.485 664 825.91 2.655e-07 ***
## Pclass_3 0 0.000 664 825.91
## Sex_female 1 197.978 663 627.93 < 2.2e-16 ***
## Sex_male 0 0.000 663 627.93
## Age 1 8.986 662 618.94 0.002721 **
## SibSp 1 8.114 661 610.83 0.004393 **
## Parch 1 0.998 660 609.83 0.317889
## Fare 1 0.044 659 609.79 0.834588
## Embarked_C 1 1.936 658 607.85 0.164139
## Embarked_Q 1 2.067 657 605.78 0.150485
## Embarked_S 0 0.000 657 605.78
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## Predicting Test Data
result <- predict(model,newdata=test,type='response')
result <- ifelse(result > 0.5,1,0)
## Confusion matrix and statistics
library(caret)
confusionMatrix(data=result, reference=test$Survived)
## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 128 25
## 1 13 56
##
## Accuracy : 0.8288
## 95% CI : (0.7727, 0.8759)
## No Information Rate : 0.6351
## P-Value [Acc > NIR] : 1.817e-10
##
## Kappa : 0.6187
## Mcnemar's Test P-Value : 0.07435
##
## Sensitivity : 0.9078
## Specificity : 0.6914
## Pos Pred Value : 0.8366
## Neg Pred Value : 0.8116
## Prevalence : 0.6351
## Detection Rate : 0.5766
## Detection Prevalence : 0.6892
## Balanced Accuracy : 0.7996
##
## 'Positive' Class : 0
##
## ROC Curve and calculating the area under the curve(AUC)
library(ROCR)
predictions <- predict(model, newdata=test, type="response")
ROCRpred <- prediction(predictions, test$Survived)
ROCRperf <- performance(ROCRpred, measure = "tpr", x.measure = "fpr")
plot(ROCRperf, colorize = TRUE, text.adj = c(-0.2,1.7), print.cutoffs.at = seq(0,1,0.1))
auc <- performance(ROCRpred, measure = "auc")
auc <- auc@y.values[[1]]
auc
## [1] 0.8714211