Project#3
Syed Abdullah
2024-04-13
R Markdown
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.
When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
summary(cars)## speed dist
## Min. : 4.0 Min. : 2.00
## 1st Qu.:12.0 1st Qu.: 26.00
## Median :15.0 Median : 36.00
## Mean :15.4 Mean : 42.98
## 3rd Qu.:19.0 3rd Qu.: 56.00
## Max. :25.0 Max. :120.00Including Plots
You can also embed plots, for example:
Note that the echo = FALSE parameter was added to the
code chunk to prevent printing of the R code that generated the
plot.
# Load necessary libraries
library(caret)## Warning: package 'caret' was built under R version 4.3.3## Loading required package: ggplot2## Warning: package 'ggplot2' was built under R version 4.3.3## Loading required package: lattice## Warning: package 'lattice' was built under R version 4.3.3library(rattle)## Warning: package 'rattle' was built under R version 4.3.3## Loading required package: tibble## Loading required package: bitops## Rattle: A free graphical interface for data science with R.
## Version 5.5.1 Copyright (c) 2006-2021 Togaware Pty Ltd.
## Type 'rattle()' to shake, rattle, and roll your data.library(rpart)
library(rpart.plot)## Warning: package 'rpart.plot' was built under R version 4.3.3library(RColorBrewer)
# Function to handle missing values
handle_missing <- function(data) {
data$age[is.na(data$age)] <- mean(data$age, na.rm = TRUE)
return(data)
}
# Function for feature engineering
feature_engineering <- function(data) {
data$FamilySize <- data$sibsp + data$parch
return(data)
}
# Load and preprocess the dataset
url <- "https://goo.gl/At238b"
titanic <- read.csv(url)
titanic <- titanic[, c("survived", "embarked", "age", "sex", "sibsp", "parch", "fare")]
titanic <- handle_missing(titanic)
titanic <- na.omit(titanic)
titanic$survived <- factor(titanic$survived)
titanic$embarked <- factor(titanic$embarked)
titanic$sex <- factor(titanic$sex)
titanic <- feature_engineering(titanic)
# Summary of the data
summary(titanic)## survived embarked age sex sibsp parch
## 0:808 C:270 Min. : 0.17 female:464 Min. :0.0 Min. :0.0000
## 1:498 Q:123 1st Qu.:22.00 male :842 1st Qu.:0.0 1st Qu.:0.0000
## S:913 Median :29.88 Median :0.0 Median :0.0000
## Mean :29.83 Mean :0.5 Mean :0.3859
## 3rd Qu.:35.00 3rd Qu.:1.0 3rd Qu.:0.0000
## Max. :80.00 Max. :8.0 Max. :9.0000
## fare FamilySize
## Min. : 0.000 Min. : 0.0000
## 1st Qu.: 7.896 1st Qu.: 0.0000
## Median : 14.454 Median : 0.0000
## Mean : 33.224 Mean : 0.8859
## 3rd Qu.: 31.275 3rd Qu.: 1.0000
## Max. :512.329 Max. :10.0000# Proportion of survived and not survived
prop.table(table(titanic$survived))##
## 0 1
## 0.618683 0.381317# Correlation matrix
library(corrplot)## corrplot 0.92 loadednumeric_titanic <- titanic[, c("sibsp", "age", "parch", "fare")]
correlation_matrix <- cor(numeric_titanic)
print(correlation_matrix)## sibsp age parch fare
## sibsp 1.0000000 -0.1896710 0.3732808 0.1610297
## age -0.1896710 1.0000000 -0.1296365 0.1702670
## parch 0.3732808 -0.1296365 1.0000000 0.2223266
## fare 0.1610297 0.1702670 0.2223266 1.0000000corrplot(correlation_matrix, method="circle")
# 9) Plot survival with other features to see if any correlation exists.
# Bar plot
barplot_table <- table(titanic$survived, titanic$sex)
bp <- barplot(barplot_table, beside = TRUE, legend = TRUE, col = c("red", "blue"),
main = "Survival by Gender", xlab = "Survived", ylab = "Frequency")
text(x = bp, y = barplot_table, label = barplot_table, pos = 3, cex = 0.8, col = "black")
# Box Plot
boxplot(fare ~ survived, data = titanic,
main = "Survival by Fare", xlab = "Survived", ylab = "Fare",
col = c("skyblue", "pink"), names = c("No", "Yes"),
outline = FALSE) # Removes outliers for cleaner visualization
# Density plots
library(ggplot2)
ggplot(titanic, aes(x = fare, fill = survived)) +
geom_density(alpha = 0.5, adjust = 1.5) + # Adjust parameter controls smoothness
labs(title = "Density Plot of Fare by Survival", x = "Fare", y = "Density") +
scale_fill_manual(values = c("skyblue", "pink"), name = "Survived", labels = c("No", "Yes"))
# Histograms
hist(titanic$fare[titanic$survived == "0"], col = "pink",
main = "Histogram of Fare for Non-Survivors", xlab = "Fare", ylab = "Frequency",
xlim = c(0, max(titanic$fare)), ylim = c(0, 200),
breaks = seq(0, max(titanic$fare), by = 10))
abline(v = mean(titanic$fare[titanic$survived == "0"]), col = "blue", lwd = 2)
# Scatter plots
plot(titanic$age, titanic$fare,
col = ifelse(titanic$survived == 1, "skyblue", "pink"),
pch = 16, main = "Scatter Plot of Fare vs Age", xlab = "Age", ylab = "Fare")
legend("topright", legend = c("Survived", "Not Survived"), pch = 16, col = c("skyblue", "pink"))
lines(lowess(titanic$age, titanic$fare), col = "green")
# Split dataset into training and testing
set.seed(1000)
train_index <- sample(1:nrow(titanic), 0.8 * nrow(titanic))
train_data <- titanic[train_index, ]
test_data <- titanic[-train_index, ]
# Train a decision tree model
fit <- rpart(survived ~ sex + age + sibsp + parch + fare + embarked + FamilySize,
data = train_data, method = "class")
# Plot the decision tree
fancyRpartPlot(fit)
png("fancy_decision_tree_plot_train.png", width = 800, height = 600)
fancyRpartPlot(fit)
dev.off()## png
## 2# Make predictions on the test set
predictions <- predict(fit, newdata = test_data, type = "class")
results <- data.frame(PassengerSex = test_data$sex, Survived = as.numeric(predictions))
# Examine the tree
printcp(fit)##
## Classification tree:
## rpart(formula = survived ~ sex + age + sibsp + parch + fare +
## embarked + FamilySize, data = train_data, method = "class")
##
## Variables actually used in tree construction:
## [1] age FamilySize fare sex
##
## Root node error: 390/1044 = 0.37356
##
## n= 1044
##
## CP nsplit rel error xerror xstd
## 1 0.405128 0 1.00000 1.00000 0.040078
## 2 0.021795 1 0.59487 0.59487 0.034443
## 3 0.010256 3 0.55128 0.57179 0.033955
## 4 0.010000 7 0.51026 0.59231 0.034390summary(fit)## Call:
## rpart(formula = survived ~ sex + age + sibsp + parch + fare +
## embarked + FamilySize, data = train_data, method = "class")
## n= 1044
##
## CP nsplit rel error xerror xstd
## 1 0.40512821 0 1.0000000 1.0000000 0.04007803
## 2 0.02179487 1 0.5948718 0.5948718 0.03444349
## 3 0.01025641 3 0.5512821 0.5717949 0.03395542
## 4 0.01000000 7 0.5102564 0.5923077 0.03439034
##
## Variable importance
## sex fare FamilySize age parch sibsp embarked
## 51 14 11 10 8 5 1
##
## Node number 1: 1044 observations, complexity param=0.4051282
## predicted class=0 expected loss=0.3735632 P(node) =1
## class counts: 654 390
## probabilities: 0.626 0.374
## left son=2 (674 obs) right son=3 (370 obs)
## Primary splits:
## sex splits as RL, improve=132.46560, (0 missing)
## fare < 15.1729 to the left, improve= 44.56075, (0 missing)
## FamilySize < 0.5 to the left, improve= 19.85816, (0 missing)
## embarked splits as RLL, improve= 17.31542, (0 missing)
## parch < 0.5 to the left, improve= 15.92044, (0 missing)
## Surrogate splits:
## parch < 0.5 to the left, agree=0.684, adj=0.108, (0 split)
## fare < 77.6229 to the left, agree=0.673, adj=0.078, (0 split)
## FamilySize < 0.5 to the left, agree=0.668, adj=0.062, (0 split)
## age < 18.25 to the right, agree=0.654, adj=0.024, (0 split)
##
## Node number 2: 674 observations, complexity param=0.01025641
## predicted class=0 expected loss=0.1869436 P(node) =0.6455939
## class counts: 548 126
## probabilities: 0.813 0.187
## left son=4 (479 obs) right son=5 (195 obs)
## Primary splits:
## fare < 26.26875 to the left, improve=10.950570, (0 missing)
## age < 9.5 to the right, improve=10.491300, (0 missing)
## parch < 0.5 to the left, improve= 3.753284, (0 missing)
## embarked splits as RLL, improve= 3.202181, (0 missing)
## FamilySize < 0.5 to the left, improve= 2.261516, (0 missing)
## Surrogate splits:
## FamilySize < 2.5 to the left, agree=0.757, adj=0.159, (0 split)
## parch < 0.5 to the left, agree=0.754, adj=0.149, (0 split)
## sibsp < 3.5 to the left, agree=0.743, adj=0.113, (0 split)
## age < 44.5 to the left, agree=0.740, adj=0.103, (0 split)
##
## Node number 3: 370 observations, complexity param=0.02179487
## predicted class=1 expected loss=0.2864865 P(node) =0.3544061
## class counts: 106 264
## probabilities: 0.286 0.714
## left son=6 (266 obs) right son=7 (104 obs)
## Primary splits:
## fare < 48.2021 to the left, improve=13.898900, (0 missing)
## FamilySize < 3.5 to the right, improve=13.398030, (0 missing)
## embarked splits as RLL, improve= 8.493113, (0 missing)
## sibsp < 2.5 to the right, improve= 7.311364, (0 missing)
## parch < 3.5 to the right, improve= 5.420420, (0 missing)
## Surrogate splits:
## age < 46 to the left, agree=0.741, adj=0.077, (0 split)
## embarked splits as RLL, agree=0.732, adj=0.048, (0 split)
## FamilySize < 8.5 to the left, agree=0.730, adj=0.038, (0 split)
## sibsp < 6.5 to the left, agree=0.727, adj=0.029, (0 split)
##
## Node number 4: 479 observations, complexity param=0.01025641
## predicted class=0 expected loss=0.1294363 P(node) =0.4588123
## class counts: 417 62
## probabilities: 0.871 0.129
## left son=8 (463 obs) right son=9 (16 obs)
## Primary splits:
## age < 14.5 to the right, improve=10.3103200, (0 missing)
## parch < 0.5 to the left, improve= 3.5301990, (0 missing)
## embarked splits as RLL, improve= 1.0438490, (0 missing)
## FamilySize < 1.5 to the left, improve= 0.7275991, (0 missing)
## fare < 7.9104 to the left, improve= 0.3909300, (0 missing)
##
## Node number 5: 195 observations, complexity param=0.01025641
## predicted class=0 expected loss=0.3282051 P(node) =0.1867816
## class counts: 131 64
## probabilities: 0.672 0.328
## left son=10 (29 obs) right son=11 (166 obs)
## Primary splits:
## FamilySize < 4.5 to the right, improve=5.877986, (0 missing)
## sibsp < 2.5 to the right, improve=4.494130, (0 missing)
## age < 53.5 to the right, improve=2.260211, (0 missing)
## parch < 2.5 to the right, improve=1.564212, (0 missing)
## fare < 158.2084 to the right, improve=1.533459, (0 missing)
## Surrogate splits:
## sibsp < 2.5 to the right, agree=0.974, adj=0.828, (0 split)
## age < 15.25 to the left, agree=0.892, adj=0.276, (0 split)
## parch < 3.5 to the right, agree=0.877, adj=0.172, (0 split)
## embarked splits as RLR, agree=0.872, adj=0.138, (0 split)
## fare < 262.6875 to the right, agree=0.862, adj=0.069, (0 split)
##
## Node number 6: 266 observations, complexity param=0.02179487
## predicted class=1 expected loss=0.3721805 P(node) =0.2547893
## class counts: 99 167
## probabilities: 0.372 0.628
## left son=12 (27 obs) right son=13 (239 obs)
## Primary splits:
## FamilySize < 3.5 to the right, improve=11.775190, (0 missing)
## sibsp < 2.5 to the right, improve= 4.860271, (0 missing)
## fare < 10.48125 to the left, improve= 4.612900, (0 missing)
## parch < 3.5 to the right, improve= 4.170674, (0 missing)
## embarked splits as RLL, improve= 2.721452, (0 missing)
## Surrogate splits:
## sibsp < 2.5 to the right, agree=0.944, adj=0.444, (0 split)
## parch < 2.5 to the right, agree=0.932, adj=0.333, (0 split)
## fare < 44.2396 to the right, agree=0.910, adj=0.111, (0 split)
##
## Node number 7: 104 observations
## predicted class=1 expected loss=0.06730769 P(node) =0.09961686
## class counts: 7 97
## probabilities: 0.067 0.933
##
## Node number 8: 463 observations
## predicted class=0 expected loss=0.1101512 P(node) =0.4434866
## class counts: 412 51
## probabilities: 0.890 0.110
##
## Node number 9: 16 observations
## predicted class=1 expected loss=0.3125 P(node) =0.01532567
## class counts: 5 11
## probabilities: 0.313 0.688
##
## Node number 10: 29 observations
## predicted class=0 expected loss=0.03448276 P(node) =0.02777778
## class counts: 28 1
## probabilities: 0.966 0.034
##
## Node number 11: 166 observations, complexity param=0.01025641
## predicted class=0 expected loss=0.3795181 P(node) =0.1590038
## class counts: 103 63
## probabilities: 0.620 0.380
## left son=22 (156 obs) right son=23 (10 obs)
## Primary splits:
## age < 14.5 to the right, improve=8.19354300, (0 missing)
## fare < 135.0666 to the right, improve=1.71267800, (0 missing)
## parch < 1.5 to the left, improve=1.65012700, (0 missing)
## FamilySize < 1.5 to the left, improve=0.68587130, (0 missing)
## embarked splits as LLR, improve=0.06862297, (0 missing)
##
## Node number 12: 27 observations
## predicted class=0 expected loss=0.1851852 P(node) =0.02586207
## class counts: 22 5
## probabilities: 0.815 0.185
##
## Node number 13: 239 observations
## predicted class=1 expected loss=0.3221757 P(node) =0.2289272
## class counts: 77 162
## probabilities: 0.322 0.678
##
## Node number 22: 156 observations
## predicted class=0 expected loss=0.3397436 P(node) =0.1494253
## class counts: 103 53
## probabilities: 0.660 0.340
##
## Node number 23: 10 observations
## predicted class=1 expected loss=0 P(node) =0.009578544
## class counts: 0 10
## probabilities: 0.000 1.000split_var <- fit$variable[1]
split_var## sex
## 132.4656# Assess model performance
confusionMatrix(predictions, test_data$survived)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 131 28
## 1 23 80
##
## Accuracy : 0.8053
## 95% CI : (0.7521, 0.8515)
## No Information Rate : 0.5878
## P-Value [Acc > NIR] : 5.431e-14
##
## Kappa : 0.5955
##
## Mcnemar's Test P-Value : 0.5754
##
## Sensitivity : 0.8506
## Specificity : 0.7407
## Pos Pred Value : 0.8239
## Neg Pred Value : 0.7767
## Prevalence : 0.5878
## Detection Rate : 0.5000
## Detection Prevalence : 0.6069
## Balanced Accuracy : 0.7957
##
## 'Positive' Class : 0
## # Optionally, if you need to train and assess with fixed indices:
trainFixedIndex <- titanic[1:1046, ]
testFixedIndex <- titanic[1047:nrow(titanic), ]
fitFixed <- rpart(survived ~ sex + age + sibsp + parch + fare + embarked,
data = trainFixedIndex, method = "class")
fancyRpartPlot(fitFixed)
png("fancy_decision_tree_plot_fixed_index.png", width = 800, height = 600)
fancyRpartPlot(fitFixed)
dev.off()## png
## 2predictionsFixed <- predict(fitFixed, newdata = testFixedIndex, type = "class")
resultsFixed <- data.frame(PassengerSex = testFixedIndex$sex, Survived = as.numeric(predictionsFixed))
printcp(fitFixed)##
## Classification tree:
## rpart(formula = survived ~ sex + age + sibsp + parch + fare +
## embarked, data = trainFixedIndex, method = "class")
##
## Variables actually used in tree construction:
## [1] age sex
##
## Root node error: 444/1046 = 0.42447
##
## n= 1046
##
## CP nsplit rel error xerror xstd
## 1 0.490991 0 1.00000 1.00000 0.036003
## 2 0.033784 1 0.50901 0.50901 0.029979
## 3 0.010000 2 0.47523 0.47973 0.029333summary(fitFixed)## Call:
## rpart(formula = survived ~ sex + age + sibsp + parch + fare +
## embarked, data = trainFixedIndex, method = "class")
## n= 1046
##
## CP nsplit rel error xerror xstd
## 1 0.49099099 0 1.0000000 1.0000000 0.03600318
## 2 0.03378378 1 0.5090090 0.5090090 0.02997867
## 3 0.01000000 2 0.4752252 0.4797297 0.02933347
##
## Variable importance
## sex age parch fare sibsp embarked
## 74 9 8 6 2 1
##
## Node number 1: 1046 observations, complexity param=0.490991
## predicted class=0 expected loss=0.4244742 P(node) =1
## class counts: 602 444
## probabilities: 0.576 0.424
## left son=2 (656 obs) right son=3 (390 obs)
## Primary splits:
## sex splits as RL, improve=156.75120, (0 missing)
## fare < 15.6646 to the left, improve= 46.51541, (0 missing)
## parch < 0.5 to the left, improve= 22.54089, (0 missing)
## age < 8.5 to the right, improve= 16.42941, (0 missing)
## embarked splits as RLL, improve= 15.13880, (0 missing)
## Surrogate splits:
## parch < 0.5 to the left, agree=0.666, adj=0.105, (0 split)
## fare < 77.6229 to the left, agree=0.660, adj=0.087, (0 split)
## sibsp < 2.5 to the left, agree=0.632, adj=0.013, (0 split)
## age < 16.5 to the right, agree=0.630, adj=0.008, (0 split)
## embarked splits as LRL, agree=0.630, adj=0.008, (0 split)
##
## Node number 2: 656 observations, complexity param=0.03378378
## predicted class=0 expected loss=0.2134146 P(node) =0.6271511
## class counts: 516 140
## probabilities: 0.787 0.213
## left son=4 (627 obs) right son=5 (29 obs)
## Primary splits:
## age < 10 to the right, improve=18.037890, (0 missing)
## fare < 26.26875 to the left, improve= 9.603202, (0 missing)
## parch < 0.5 to the left, improve= 6.329854, (0 missing)
## embarked splits as RLL, improve= 4.185190, (0 missing)
## sibsp < 0.5 to the left, improve= 0.946299, (0 missing)
## Surrogate splits:
## sibsp < 3.5 to the left, agree=0.96, adj=0.103, (0 split)
##
## Node number 3: 390 observations
## predicted class=1 expected loss=0.2205128 P(node) =0.3728489
## class counts: 86 304
## probabilities: 0.221 0.779
##
## Node number 4: 627 observations
## predicted class=0 expected loss=0.1881978 P(node) =0.5994264
## class counts: 509 118
## probabilities: 0.812 0.188
##
## Node number 5: 29 observations
## predicted class=1 expected loss=0.2413793 P(node) =0.02772467
## class counts: 7 22
## probabilities: 0.241 0.759split_var_fixed <- fitFixed$variable[1]
split_var_fixed## sex
## 156.7512