Myriam Aicha Mbongo 10/16/2023
134141 - Aicha Mbongo | |
| Course Code | Course Name | Program | Semester Duration |
|---|---|---|---|
| BBT4206 | Business Intelligence II | Bachelor of Business Information Technology | 21st August 2023 to 28th November 2023 |
# STEP 1. Install and Load the Required Packages ----
# The following packages should be installed and loaded before proceeding to the
# subsequent steps.
## readr ----
if (require("readr")) {
require("readr")
} else {
install.packages("readr", dependencies = TRUE,
repos = "https://cloud.r-project.org")
}## Loading required package: readr
## caret ----
if (require("caret")) {
require("caret")
} else {
install.packages("caret", dependencies = TRUE,
repos = "https://cloud.r-project.org")
}## Loading required package: caret
## Loading required package: ggplot2
## Loading required package: lattice
## e1071 ----
if (require("e1071")) {
require("e1071")
} else {
install.packages("e1071", dependencies = TRUE,
repos = "https://cloud.r-project.org")
}## Loading required package: e1071
## factoextra ----
if (require("factoextra")) {
require("factoextra")
} else {
install.packages("factoextra", dependencies = TRUE,
repos = "https://cloud.r-project.org")
}## Loading required package: factoextra
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
## FactoMineR ----
if (require("FactoMineR")) {
require("FactoMineR")
} else {
install.packages("FactoMineR", dependencies = TRUE,
repos = "https://cloud.r-project.org")
}## Loading required package: FactoMineR
if (!is.element("NHANES", installed.packages()[, 1])) {
install.packages("NHANES", dependencies = TRUE,
repos = "https://cloud.r-project.org")
}
require("NHANES")## Loading required package: NHANES
## dplyr ----
if (!is.element("dplyr", installed.packages()[, 1])) {
install.packages("dplyr", dependencies = TRUE,
repos = "https://cloud.r-project.org")
}
require("dplyr")## Loading required package: dplyr
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
## naniar ----
# Documentation:
# https://cran.r-project.org/package=naniar or
# https://www.rdocumentation.org/packages/naniar/versions/1.0.0
if (!is.element("naniar", installed.packages()[, 1])) {
install.packages("naniar", dependencies = TRUE,
repos = "https://cloud.r-project.org")
}
require("naniar")## Loading required package: naniar
## ggplot2 ----
# We require the "ggplot2" package to create more appealing visualizations
if (!is.element("ggplot2", installed.packages()[, 1])) {
install.packages("ggplot2", dependencies = TRUE,
repos = "https://cloud.r-project.org")
}
require("ggplot2")
## MICE ----
# We use the MICE package to perform data imputation
if (!is.element("mice", installed.packages()[, 1])) {
install.packages("mice", dependencies = TRUE,
repos = "https://cloud.r-project.org")
}
require("mice")## Loading required package: mice
##
## Attaching package: 'mice'
## The following object is masked from 'package:stats':
##
## filter
## The following objects are masked from 'package:base':
##
## cbind, rbind
## Amelia ----
if (!is.element("Amelia", installed.packages()[, 1])) {
install.packages("Amelia", dependencies = TRUE,
repos = "https://cloud.r-project.org")
}
require("Amelia")## Loading required package: Amelia
## Loading required package: Rcpp
## ##
## ## Amelia II: Multiple Imputation
## ## (Version 1.8.1, built: 2022-11-18)
## ## Copyright (C) 2005-2023 James Honaker, Gary King and Matthew Blackwell
## ## Refer to http://gking.harvard.edu/amelia/ for more information
## ##
library(readr)
heart <- read_csv(
"../data/heart.csv",
col_types = cols(
age = col_double(),
sex = col_factor(levels = c("0", "1")),
cp = col_factor(levels = c("0", "1", "2", "3")),
trestbps = col_double(),
chol = col_double(),
fbs = col_factor(levels = c("0", "1")),
restecg = col_factor(levels = c("0", "1", "2")),
thalach = col_double(),
exang = col_factor(levels = c("0", "1")),
oldpeak = col_double(),
slope = col_factor(levels = c("0", "1", "2")),
ca = col_double(),
thal = col_factor(levels = c("0", "1", "2", "3")),
target = col_factor(levels = c("neg", "pos"))
)
)
#View(heart)### STEP 3a. Pre#View the Loaded Datasets, Identify the Data Types ----
# Dimensions refer to the number of observations (rows) and the number of
# attributes/variables/features (columns).
#Understanding data types is key for effective analysis.It helps choose suitable visualizations and algorithms,
#and highlights the need for conversions between categorical and numerical data when necessary.
dim(heart)## [1] 1025 14
## age sex cp trestbps chol fbs restecg thalach
## "numeric" "factor" "factor" "numeric" "numeric" "factor" "factor" "numeric"
## exang oldpeak slope ca thal target
## "factor" "numeric" "factor" "numeric" "factor" "factor"
# It is more sensible to count categorical variables (factors or dimensions)
# than numeric variables, e.g., counting the number of male and female
# participants instead of counting the frequency of each participant’s height.
heart_freq <- heart$target
cbind(frequency = table(heart_freq),
percentage = prop.table(table(heart_freq)) * 100)## frequency percentage
## neg 499 48.68293
## pos 526 51.31707
# We, therefore, must manually create a function that can calculate the mode.
heart_target_mode <- names(table(heart$target))[
which(table(heart$target) == max(table(heart$target)))
]
print(heart_target_mode)## [1] "pos"
## age sex cp trestbps chol fbs restecg
## Min. :29.00 0:312 0:497 Min. : 94.0 Min. :126 0:872 0:497
## 1st Qu.:48.00 1:713 1:167 1st Qu.:120.0 1st Qu.:211 1:153 1:513
## Median :56.00 2:284 Median :130.0 Median :240 2: 15
## Mean :54.43 3: 77 Mean :131.6 Mean :246
## 3rd Qu.:61.00 3rd Qu.:140.0 3rd Qu.:275
## Max. :77.00 Max. :200.0 Max. :564
## thalach exang oldpeak slope ca thal
## Min. : 71.0 0:680 Min. :0.000 0: 74 Min. :0.0000 0: 7
## 1st Qu.:132.0 1:345 1st Qu.:0.000 1:482 1st Qu.:0.0000 1: 64
## Median :152.0 Median :0.800 2:469 Median :0.0000 2:544
## Mean :149.1 Mean :1.072 Mean :0.7541 3:410
## 3rd Qu.:166.0 3rd Qu.:1.800 3rd Qu.:1.0000
## Max. :202.0 Max. :6.200 Max. :4.0000
## target
## neg:499
## pos:526
##
##
##
##
# calculate the standard deviation of only columns that are numeric, thus
# leaving out the columns termed as “factors” (categorical) or those that have
# a string data type.
sapply(heart[, -c(2, 3, 6, 7, 9, 11, 13, 14)], sd)## age trestbps chol thalach oldpeak ca
## 9.072290 17.516718 51.592510 23.005724 1.175053 1.030798
## age trestbps chol thalach oldpeak ca
## 9.072290 17.516718 51.592510 23.005724 1.175053 1.030798
# The Kurtosis informs you of how often outliers occur in the results.
# There are different formulas for calculating kurtosis.
# Specifying “type = 2” allows us to use the 2nd formula which is the same
# kurtosis formula used in SPSS and SAS.
# In “type = 2” (used in SPSS and SAS):
# 1. Kurtosis < 3 implies a low number of outliers
# 2. Kurtosis = 3 implies a medium number of outliers
# 3. Kurtosis > 3 implies a high number of outliers
if (!is.element("e1071", installed.packages()[, 1])) {
install.packages("e1071", dependencies = TRUE)
}
require("e1071")
sapply(heart[, -c(2, 3, 6, 7, 9, 11, 13, 14)], kurtosis, type = 2)## age trestbps chol thalach oldpeak ca
## -0.52561781 0.99122074 3.99680305 -0.08882249 1.31447089 0.70112287
# The skewness informs you of the asymmetry of the distribution of results.
# Using “type = 2” can be interpreted as:
# 1. Skewness between -0.4 and 0.4 (inclusive) implies that there is no skew
# in the distribution of results; the distribution of results is symmetrical;
# it is a normal distribution.
# 2. Skewness above 0.4 implies a positive skew; a right-skewed distribution.
# 3. Skewness below -0.4 implies a negative skew; a left-skewed distribution.
sapply(heart[, -c(2, 3, 6, 7, 9, 11, 13, 14)], skewness, type = 2)## age trestbps chol thalach oldpeak ca
## -0.2488659 0.7397682 1.0740728 -0.5137772 1.2108994 1.2611886
# Note that the covariance and the correlation are computed for numeric values
# only, not categorical values.
heart_cov <- cov(heart[, -c(2, 3, 6, 7, 9, 11, 13, 14)])
#View(heart_cov)# One-Way ANOVA can be used to test the effect of the 3 types of fertilizer on
# crop yield whereas,
# Two-Way ANOVA can be used to test the effect of the 3 types of fertilizer and
# the 2 types of planting density on crop yield.
heart_one_way_anova <- aov(trestbps ~ age, data = heart)
summary(heart_one_way_anova)## Df Sum Sq Mean Sq F value Pr(>F)
## age 1 23096 23096 81.16 <2e-16 ***
## Residuals 1023 291104 285
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#The ANOVA rejects the null hypothesis,The ANOVA indicates a significant difference in resting blood pressure among age groups
#(F(1, 1023) = 81.16, p < 2e-16), highlighting age as a key factor
#in determining blood pressure.
#This aligns with cardiovascular knowledge, correlating increased age with a higher risk of cardiovascular disease.
heart_two_way_anova <- aov(trestbps ~ exang + ca, # nolint
data = heart)
summary(heart_two_way_anova)## Df Sum Sq Mean Sq F value Pr(>F)
## exang 1 1177 1176.7 3.88 0.04914 *
## ca 1 3050 3050.2 10.06 0.00156 **
## Residuals 1022 309973 303.3
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#both variables, exercise-induced angina and the number of major vessels, are associated with statistically significant differences in
#resting blood pressure.# Histograms help in determining whether an attribute has a Gaussian
# distribution. They can also be used to identify the presence of outliers.
par(mfrow = c(1, 3))
for (i in c(1, 4, 5)) {
heart_variable <- as.numeric(unlist(heart[, i]))
hist(heart_variable, main = names(heart)[i])
}heart_health_variable <- as.numeric( unlist(heart[, 8]))
hist(heart_health_variable , main = names(heart)[8])
heart_health_variable <- as.numeric( unlist(heart [, 10]))
hist(heart_health_variable , main = names(heart)[10])
heart_health_variable <- as.numeric( unlist(heart [, 12]))
hist(heart_health_variable , main = names(heart)[12])# Box and whisker plots are useful in understanding the distribution of data.
par(mfrow = c(1, 3))
for (i in c(1, 4, 5)) {
boxplot(heart[, i], main = names(heart)[i])
}boxplot(heart[, 8], main = names(heart)[8])
boxplot(heart[, 10], main = names(heart)[10])
boxplot(heart[, 12], main = names(heart)[12])# Categorical attributes (factors) can also be visualized. This is done using a
# bar chart to give an idea of the proportion of instances that belong to each
# category.
barplot(table(heart[, 2]), main = names(heart)[2])







# Execute the following to create a map to identify the missing data in each
# dataset:
if (!is.element("Amelia", installed.packages()[, 1])) {
install.packages("Amelia", dependencies = TRUE)
}
require("Amelia")
#comment
missmap(heart, col = c("red", "grey"), legend = TRUE)
# Correlation plots can be used to get an idea of which attributes change
# together. The function “corrplot()” found in the package “corrplot” is
# required to perform this. The larger the dot in the correlation plot, the
# larger the correlation. Blue represents a positive correlation whereas red
# represents a negative correlation.
if (!is.element("corrplot", installed.packages()[, 1])) {
install.packages("corrplot", dependencies = TRUE)
}
require("corrplot")## Loading required package: corrplot
## corrplot 0.92 loaded
#heart <- heart[, -which(names(heart) == "target_numeric")]
# Alternatively, the 'ggcorrplot::ggcorrplot()' function can be used to plot a
# more visually appealing plot.
# The code below shows how to install a package in R:
if (!is.element("ggcorrplot", installed.packages()[, 1])) {
install.packages("ggcorrplot", dependencies = TRUE)
}
require("ggcorrplot")## Loading required package: ggcorrplot

# Alternatively, the ggcorrplot package can be used to make the plots more
# appealing:
ggplot(heart,
aes(x = age, y = sex, shape = target, color = target)) +
geom_point() +
geom_smooth(method = lm)## `geom_smooth()` using formula = 'y ~ x'

### Subset of rows ----
# We then select 500 random observations to be included in the dataset
rand_ind <- sample(seq_len(nrow(heart)), 500)
heart <- heart[rand_ind, ]## [1] FALSE
## [1] 0
## [1] 0
## age sex cp trestbps chol fbs restecg thalach
## 0 0 0 0 0 0 0 0
## exang oldpeak slope ca thal target
## 0 0 0 0 0 0
# What is the number and percentage of missing values grouped by
# each variable?
miss_var_summary(heart)## # A tibble: 14 × 3
## variable n_miss pct_miss
## <chr> <int> <dbl>
## 1 age 0 0
## 2 sex 0 0
## 3 cp 0 0
## 4 trestbps 0 0
## 5 chol 0 0
## 6 fbs 0 0
## 7 restecg 0 0
## 8 thalach 0 0
## 9 exang 0 0
## 10 oldpeak 0 0
## 11 slope 0 0
## 12 ca 0 0
## 13 thal 0 0
## 14 target 0 0
# What is the number and percentage of missing values grouped by
# each observation?
miss_case_summary(heart)## # A tibble: 500 × 3
## case n_miss pct_miss
## <int> <int> <dbl>
## 1 1 0 0
## 2 2 0 0
## 3 3 0 0
## 4 4 0 0
## 5 5 0 0
## 6 6 0 0
## 7 7 0 0
## 8 8 0 0
## 9 9 0 0
## 10 10 0 0
## # ℹ 490 more rows
# Which variables contain the most missing values?
#gg_miss_var(heart)
# Where are missing values located (the shaded regions in the plot)?
#vis_miss(heart) + theme(axis.text.x = element_text(angle = 80))
# Which combinations of variables are missing together?
#gg_miss_upset(heart)
# Create a heatmap of "missingness" broken down by "target"
# First, confirm that the "target" variable is a categorical variable
is.factor(heart$target)## [1] TRUE
# Second, create the visualization
#gg_miss_fct(heart, fct = target)
# We can also create a heatmap of "missingness" broken down by "exang"
# First, confirm that the "exang" variable is a categorical variable
is.factor(heart$exang)## [1] TRUE
# Scaling Data Transformation Purpose:
# The scaling data transformation is performed to standardize or normalize
# the numeric features in a dataset. It ensures that different features
# with varying scales are brought to a common scale, preventing one feature
# from dominating the others during model training.
#
# Scaling is essential for algorithms that are sensitive to the magnitude
# of input features, such as distance-based methods (e.g., k-Nearest Neighbors)
# or gradient descent-based optimization algorithms (e.g., Support Vector Machines).
#
# By scaling the data, we make the features comparable and contribute equally
# to the model's learning process, improving the stability and performance of
# machine learning models.
# Summary of each variable
summary(heart)## age sex cp trestbps chol fbs restecg
## Min. :29.0 0:158 0:247 Min. : 94.0 Min. :131.0 0:430 0:247
## 1st Qu.:47.0 1:342 1: 83 1st Qu.:120.0 1st Qu.:209.0 1: 70 1:246
## Median :55.5 2:128 Median :130.0 Median :240.0 2: 7
## Mean :54.4 3: 42 Mean :131.7 Mean :248.4
## 3rd Qu.:61.0 3rd Qu.:140.0 3rd Qu.:277.0
## Max. :77.0 Max. :200.0 Max. :564.0
## thalach exang oldpeak slope ca thal
## Min. : 71.0 0:327 Min. :0.000 0: 35 Min. :0.000 0: 3
## 1st Qu.:132.0 1:173 1st Qu.:0.000 1:242 1st Qu.:0.000 1: 29
## Median :152.0 Median :0.800 2:223 Median :0.000 2:259
## Mean :148.7 Mean :1.104 Mean :0.748 3:209
## 3rd Qu.:165.2 3rd Qu.:1.600 3rd Qu.:1.000
## Max. :202.0 Max. :6.200 Max. :4.000
## target
## neg:248
## pos:252
##
##
##
##
# BEFORE
heart_health_variable <- as.numeric( unlist(heart [, 1]))
hist(heart_health_variable , main = names(heart_health_variable )[1])heart_health_variable <- as.numeric( unlist(heart [, 4]))
hist(heart_health_variable , main = names(heart)[4])heart_health_variable <- as.numeric( unlist(heart [, 5]))
hist(heart_health_variable , main = names(heart)[5])heart_health_variable <- as.numeric( unlist(heart [, 8]))
hist(heart_health_variable , main = names(heart)[8])heart_health_variable <- as.numeric( unlist(heart [, 10]))
hist(heart_health_variable , main = names(heart)[10])heart_health_variable <- as.numeric( unlist(heart [, 12]))
hist(heart_health_variable , main = names(heart)[12])## Created from 500 samples and 14 variables
##
## Pre-processing:
## - ignored (8)
## - scaled (6)
heart_scale_transform <- predict(model_of_the_transform,
heart)
# AFTER
#1, 4, 5, 8, 10, 12
heart_health_variable <- as.numeric( unlist(heart_scale_transform [, 1]))
hist(heart_health_variable , main = names(heart_scale_transform)[1])heart_health_variable <- as.numeric( unlist(heart_scale_transform [, 4]))
hist(heart_health_variable , main = names(heart_scale_transform)[4])heart_health_variable <- as.numeric( unlist(heart_scale_transform [, 5]))
hist(heart_health_variable , main = names(heart_scale_transform)[5])heart_health_variable <- as.numeric( unlist(heart_scale_transform [, 8]))
hist(heart_health_variable , main = names(heart_scale_transform)[8])heart_health_variable <- as.numeric( unlist(heart_scale_transform [, 10]))
hist(heart_health_variable , main = names(heart_scale_transform)[10])heart_health_variable <- as.numeric( unlist(heart_scale_transform [, 12]))
hist(heart_health_variable , main = names(heart_scale_transform)[12])# Centering Data Transformation Purpose:
# Shifts numeric features by subtracting their mean,
# ensuring a centered distribution around zero.
# Useful for algorithms sensitive to variable means,
# promoting better model interpretability.
# Summary of each variable
summary(heart)## age sex cp trestbps chol fbs restecg
## Min. :29.0 0:158 0:247 Min. : 94.0 Min. :131.0 0:430 0:247
## 1st Qu.:47.0 1:342 1: 83 1st Qu.:120.0 1st Qu.:209.0 1: 70 1:246
## Median :55.5 2:128 Median :130.0 Median :240.0 2: 7
## Mean :54.4 3: 42 Mean :131.7 Mean :248.4
## 3rd Qu.:61.0 3rd Qu.:140.0 3rd Qu.:277.0
## Max. :77.0 Max. :200.0 Max. :564.0
## thalach exang oldpeak slope ca thal
## Min. : 71.0 0:327 Min. :0.000 0: 35 Min. :0.000 0: 3
## 1st Qu.:132.0 1:173 1st Qu.:0.000 1:242 1st Qu.:0.000 1: 29
## Median :152.0 Median :0.800 2:223 Median :0.000 2:259
## Mean :148.7 Mean :1.104 Mean :0.748 3:209
## 3rd Qu.:165.2 3rd Qu.:1.600 3rd Qu.:1.000
## Max. :202.0 Max. :6.200 Max. :4.000
## target
## neg:248
## pos:252
##
##
##
##
# BEFORE
heart_health_variable <- as.numeric( unlist(heart_scale_transform [, 1]))
boxplot(heart_health_variable , main = names(heart_scale_transform )[1])heart_health_variable <- as.numeric( unlist(heart_scale_transform [, 4]))
boxplot(heart_health_variable , main = names(heart_scale_transform)[4])heart_health_variable <- as.numeric( unlist(heart_scale_transform [, 5]))
boxplot(heart_health_variable , main = names(heart_scale_transform)[5])heart_health_variable <- as.numeric( unlist(heart_scale_transform [, 8]))
boxplot(heart_health_variable , main = names(heart_scale_transform)[8])heart_health_variable <- as.numeric( unlist(heart_scale_transform [, 10]))
boxplot(heart_health_variable , main = names(heart_scale_transform)[10])heart_health_variable <- as.numeric( unlist(heart_scale_transform [, 12]))
boxplot(heart_health_variable , main = names(heart_scale_transform)[12])model_of_the_transform <- preProcess(heart_scale_transform, method = c("center"))
print(model_of_the_transform)## Created from 500 samples and 14 variables
##
## Pre-processing:
## - centered (6)
## - ignored (8)
heart_center_transform <- predict(model_of_the_transform,
heart_scale_transform)
# AFTER
#1, 4, 5, 8, 10, 12
heart_scale_transform <- as.numeric( unlist(heart_center_transform [, 1]))
boxplot(heart_health_variable , main = names(heart_center_transform)[1])heart_scale_transform <- as.numeric( unlist(heart_center_transform [, 4]))
boxplot(heart_health_variable , main = names(heart_center_transform)[4])heart_scale_transform <- as.numeric( unlist(heart_center_transform [, 5]))
boxplot(heart_health_variable , main = names(heart_center_transform)[5])heart_scale_transform <- as.numeric( unlist(heart_center_transform [, 8]))
boxplot(heart_health_variable , main = names(heart_center_transform)[8])heart_scale_transform <- as.numeric( unlist(heart_center_transform [, 10]))
boxplot(heart_health_variable , main = names(heart_center_transform)[10])heart_scale_transform <- as.numeric( unlist(heart_center_transform [, 12]))
boxplot(heart_health_variable , main = names(heart_center_transform)[12])# BEFORE
#If you've already scaled and centered your data, you have made it comparable and adjusted for differences in means.
#Standardization is typically done to bring variables to a standard normal distribution (mean of 0 and standard deviation
#of 1).
summary(heart_center_transform)## age sex cp trestbps chol fbs
## Min. :-2.7842 0:158 0:247 Min. :-2.18805 Min. :-2.0537 0:430
## 1st Qu.:-0.8111 1:342 1: 83 1st Qu.:-0.67721 1st Qu.:-0.6889 1: 70
## Median : 0.1206 2:128 Median :-0.09611 Median :-0.1465
## Mean : 0.0000 3: 42 Mean : 0.00000 Mean : 0.0000
## 3rd Qu.: 0.7235 3rd Qu.: 0.48498 3rd Qu.: 0.5009
## Max. : 2.4773 Max. : 3.97155 Max. : 5.5224
## restecg thalach exang oldpeak slope ca
## 0:247 Min. :-3.3335 0:327 Min. :-0.9140 0: 35 Min. :-0.7256
## 1:246 1st Qu.:-0.7181 1:173 1st Qu.:-0.9140 1:242 1st Qu.:-0.7256
## 2: 7 Median : 0.1394 Median :-0.2517 2:223 Median :-0.7256
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.7075 3rd Qu.: 0.4106 3rd Qu.: 0.2445
## Max. : 2.2832 Max. : 4.2190 Max. : 3.1547
## thal target
## 0: 3 neg:248
## 1: 29 pos:252
## 2:259
## 3:209
##
##
## age trestbps chol thalach oldpeak ca
## 1 1 1 1 1 1
model_of_the_transform <- preProcess(heart_center_transform,
method = c("scale", "center"))
print(model_of_the_transform)## Created from 500 samples and 14 variables
##
## Pre-processing:
## - centered (6)
## - ignored (8)
## - scaled (6)
heart_standardize_transform <- predict(model_of_the_transform, # nolint
heart_center_transform)
# AFTER
summary(heart_standardize_transform)## age sex cp trestbps chol fbs
## Min. :-2.7842 0:158 0:247 Min. :-2.18805 Min. :-2.0537 0:430
## 1st Qu.:-0.8111 1:342 1: 83 1st Qu.:-0.67721 1st Qu.:-0.6889 1: 70
## Median : 0.1206 2:128 Median :-0.09611 Median :-0.1465
## Mean : 0.0000 3: 42 Mean : 0.00000 Mean : 0.0000
## 3rd Qu.: 0.7235 3rd Qu.: 0.48498 3rd Qu.: 0.5009
## Max. : 2.4773 Max. : 3.97155 Max. : 5.5224
## restecg thalach exang oldpeak slope ca
## 0:247 Min. :-3.3335 0:327 Min. :-0.9140 0: 35 Min. :-0.7256
## 1:246 1st Qu.:-0.7181 1:173 1st Qu.:-0.9140 1:242 1st Qu.:-0.7256
## 2: 7 Median : 0.1394 Median :-0.2517 2:223 Median :-0.7256
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.7075 3rd Qu.: 0.4106 3rd Qu.: 0.2445
## Max. : 2.2832 Max. : 4.2190 Max. : 3.1547
## thal target
## 0: 3 neg:248
## 1: 29 pos:252
## 2:259
## 3:209
##
##
## age trestbps chol thalach oldpeak ca
## 1 1 1 1 1 1
## age sex cp trestbps chol fbs
## Min. :-2.7842 0:158 0:247 Min. :-2.18805 Min. :-2.0537 0:430
## 1st Qu.:-0.8111 1:342 1: 83 1st Qu.:-0.67721 1st Qu.:-0.6889 1: 70
## Median : 0.1206 2:128 Median :-0.09611 Median :-0.1465
## Mean : 0.0000 3: 42 Mean : 0.00000 Mean : 0.0000
## 3rd Qu.: 0.7235 3rd Qu.: 0.48498 3rd Qu.: 0.5009
## Max. : 2.4773 Max. : 3.97155 Max. : 5.5224
## restecg thalach exang oldpeak slope ca
## 0:247 Min. :-3.3335 0:327 Min. :-0.9140 0: 35 Min. :-0.7256
## 1:246 1st Qu.:-0.7181 1:173 1st Qu.:-0.9140 1:242 1st Qu.:-0.7256
## 2: 7 Median : 0.1394 Median :-0.2517 2:223 Median :-0.7256
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.7075 3rd Qu.: 0.4106 3rd Qu.: 0.2445
## Max. : 2.2832 Max. : 4.2190 Max. : 3.1547
## thal target
## 0: 3 neg:248
## 1: 29 pos:252
## 2:259
## 3:209
##
##
#Calculate the skewness before the Box-Cox transform
sapply(heart_standardize_transform[, -c(2, 3, 6, 7, 9, 11, 13, 14)], skewness, type = 2)## age trestbps chol thalach oldpeak ca
## -0.1456606 0.7240690 1.4269084 -0.5321020 1.3041407 1.2469767
# **************************************************************************************************************
# RESULTS
# Age: The skewness is relatively small (-0.27). You might not need a Box-Cox transformation for age,
# especially since the skewness is not highly pronounced.
# trestbps (resting blood pressure): The skewness is moderate (0.78). Considering the moderate skewness,
# you could experiment with a Box-Cox transformation to see if it improves the distribution.
# chol (serum cholesterol): The skewness is high (1.49). A Box-Cox transformation is often beneficial for
# skewed variables, so you might consider applying it to cholesterol.
# thalach (maximum heart rate achieved): The skewness is relatively small (-0.56). A Box-Cox transformation
# might not be necessary for thalach, especially if the skewness is not a significant concern.
# oldpeak (ST depression induced by exercise): The skewness is high (1.21). Given the high skewness, a Box-Cox
# transformation could be beneficial for oldpeak.
# ca (number of major vessels colored by fluoroscopy): The skewness is high (1.35). Similar to cholesterol and
# oldpeak, a Box-Cox transformation might be considered for ca.
# **************************************************************************************************************
#Plot a histogram to view the skewness before the Box-Cox transform
heart_health_variable <- as.numeric( unlist(heart_standardize_transform [, 1]))
hist(heart_health_variable , main = names(heart_standardize_transform)[1])
heart_health_variable <- as.numeric( unlist(heart_standardize_transform [, 4]))
hist(heart_health_variable , main = names(heart_standardize_transform)[4])
heart_health_variable <- as.numeric( unlist(heart_standardize_transform [, 5]))
hist(heart_health_variable , main = names(heart_standardize_transform)[5])
heart_health_variable <- as.numeric( unlist(heart_standardize_transform [, 8]))
hist(heart_health_variable , main = names(heart_standardize_transform)[8])
heart_health_variable <- as.numeric( unlist(heart_standardize_transform [, 10]))
hist(heart_health_variable , main = names(heart_standardize_transform)[10])
heart_health_variable <- as.numeric( unlist(heart_standardize_transform [, 12]))
hist(heart_health_variable , main = names(heart_standardize_transform)[12])
# Select the columns of interest
columns_of_interest <- c(12, 10, 5, 4)
# Apply Box-Cox transformation only to selected columns
model_of_the_transform <- preProcess(heart_standardize_transform[, columns_of_interest], method = c("BoxCox"))
# Print the transformation details
print(model_of_the_transform)## Created from 500 samples and 0 variables
##
## Pre-processing:
## - ignored (0)
# Apply the transformation to the selected columns
heart_box_cox_transform <- predict(model_of_the_transform, heart_standardize_transform[, columns_of_interest])
# AFTER
#1, 4, 5, 8, 10, 12
sapply(heart_box_cox_transform, skewness, type = 2)## ca oldpeak chol trestbps
## 1.246977 1.304141 1.426908 0.724069
# **************************************************************************************************************
#RESULT
#ca: Skewness is approximately 1.35. A positive skewness indicates that the distribution
#has a longer right tail.
#oldpeak: Skewness is approximately 1.21. Similar to "ca," the positive skewness
#suggests a longer right tail in the distribution.
#chol: Skewness is approximately 1.49. Again, positive skewness indicates a longer
#right tail.
#trestbps: Skewness is approximately 0.78. The positive skewness suggests a longer
#right tail, but it's less pronounced compared to the other variables.
# **************************************************************************************************************
heart_health_variable <- as.numeric( unlist(heart_box_cox_transform[, 1]))
hist(heart_health_variable , main = names(heart_box_cox_transform)[1])
heart_health_variable <- as.numeric( unlist(heart_box_cox_transform [, 2]))
hist(heart_health_variable , main = names(heart_box_cox_transform)[2])
heart_health_variable <- as.numeric( unlist(heart_box_cox_transform[, 3]))
hist(heart_health_variable , main = names(heart_box_cox_transform)[3])
heart_health_variable <- as.numeric( unlist(heart_box_cox_transform [, 4]))
hist(heart_health_variable , main = names(heart_box_cox_transform)[4])
### PCA for Dimensionality Reduction on the heart Dataset ----
# Combine original and transformed columns
heart_combined <- cbind(heart_standardize_transform[, c("age", "thalach")], heart_box_cox_transform)
summary(heart_combined )## age thalach ca oldpeak
## Min. :-2.7842 Min. :-3.3335 Min. :-0.7256 Min. :-0.9140
## 1st Qu.:-0.8111 1st Qu.:-0.7181 1st Qu.:-0.7256 1st Qu.:-0.9140
## Median : 0.1206 Median : 0.1394 Median :-0.7256 Median :-0.2517
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.7235 3rd Qu.: 0.7075 3rd Qu.: 0.2445 3rd Qu.: 0.4106
## Max. : 2.4773 Max. : 2.2832 Max. : 3.1547 Max. : 4.2190
## chol trestbps
## Min. :-2.0537 Min. :-2.18805
## 1st Qu.:-0.6889 1st Qu.:-0.67721
## Median :-0.1465 Median :-0.09611
## Mean : 0.0000 Mean : 0.00000
## 3rd Qu.: 0.5009 3rd Qu.: 0.48498
## Max. : 5.5224 Max. : 3.97155
model_of_the_transform <- preProcess(heart_combined, method =
c("scale", "center", "pca"))
print(model_of_the_transform)## Created from 500 samples and 6 variables
##
## Pre-processing:
## - centered (6)
## - ignored (0)
## - principal component signal extraction (6)
## - scaled (6)
##
## PCA needed 6 components to capture 95 percent of the variance
## PC1 PC2 PC3 PC4
## Min. :-3.3924 Min. :-3.85409 Min. :-2.92125 Min. :-2.66548
## 1st Qu.:-1.0653 1st Qu.:-0.60769 1st Qu.:-0.62205 1st Qu.:-0.45029
## Median :-0.1536 Median :-0.01135 Median :-0.03444 Median :-0.03523
## Mean : 0.0000 Mean : 0.00000 Mean : 0.00000 Mean : 0.00000
## 3rd Qu.: 1.0955 3rd Qu.: 0.66329 3rd Qu.: 0.60957 3rd Qu.: 0.53835
## Max. : 3.3997 Max. : 2.57545 Max. : 3.66201 Max. : 2.27423
## PC5 PC6
## Min. :-3.46848 Min. :-1.669969
## 1st Qu.:-0.31319 1st Qu.:-0.475317
## Median : 0.05336 Median : 0.007813
## Mean : 0.00000 Mean : 0.000000
## 3rd Qu.: 0.48328 3rd Qu.: 0.491988
## Max. : 2.76574 Max. : 1.784355
### PCA for Feature Extraction ----
heart_pca_fe <- princomp(cor(heart_combined))
summary(heart_pca_fe)## Importance of components:
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6
## Standard deviation 0.6984533 0.3854196 0.3472493 0.3044072 0.2224859 0
## Proportion of Variance 0.5425650 0.1652131 0.1341096 0.1030592 0.0550531 0
## Cumulative Proportion 0.5425650 0.7077781 0.8418877 0.9449469 1.0000000 1
# **************************************************************************************************************
#RESULTS
#the PCA results suggest that the first five principal components retain the majority of the information in your dataset.
#The subsequent components (Comp.6 ) contribute very little or no additional information. I may consider using
#the first five components for further analysis, as they represent the most important features in terms of explaining the
#variance in the data. The negligible contribution of Comp.6 might indicate that these components are not providing
#meaningful information for the analysis.
# **************************************************************************************************************
#### Scree Plot ----
# The cumulative proportion reaches 100% after Comp.5, indicating that the first five components capture
#all the variance in the original data.
factoextra::fviz_eig(heart_pca_fe, addlabels = TRUE)## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5
## age 0.48612515 0.42020582 0.09352262 0.094325642 0.63945646
## thalach -0.66716441 -0.06325629 0.02440605 0.076575510 0.07385337
## ca 0.38117978 -0.24585582 -0.28376984 0.693774428 -0.37718779
## oldpeak 0.38534547 -0.47996358 -0.12766117 -0.662478454 -0.10740644
## chol 0.01712078 0.71581179 -0.38915157 -0.255011045 -0.49312205
## trestbps 0.15649829 0.12739335 0.86162418 0.002751837 -0.43435583
## [1] "age" "thalach" "ca" "oldpeak" "chol" "trestbps"
factoextra::fviz_pca_var(heart_pca_fe, col.var = "cos2",
gradient.cols = c("red", "orange", "green"),
repel = TRUE)# Convert relevant columns to factors
categorical_cols <- c("sex", "cp", "fbs", "restecg", "exang", "slope", "thal", "target")
heart_categorical <- heart
heart_categorical[categorical_cols] <- lapply(heart_categorical[categorical_cols], as.factor)
# Perform Multiple Correspondence Analysis (MCA)
heart_mca <- MCA(heart_categorical[, c(2, 3, 6, 7, 9, 11, 13, 14)])##
## Call:
## MCA(X = heart_categorical[, c(2, 3, 6, 7, 9, 11, 13, 14)])
##
##
## Eigenvalues
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7
## Variance 0.348 0.167 0.155 0.149 0.140 0.126 0.121
## % of var. 19.859 9.527 8.862 8.515 7.980 7.222 6.941
## Cumulative % of var. 19.859 29.387 38.248 46.763 54.743 61.965 68.907
## Dim.8 Dim.9 Dim.10 Dim.11 Dim.12 Dim.13 Dim.14
## Variance 0.105 0.101 0.089 0.083 0.067 0.054 0.046
## % of var. 6.011 5.747 5.065 4.733 3.846 3.059 2.632
## Cumulative % of var. 74.918 80.664 85.730 90.463 94.308 97.368 100.000
##
## Individuals (the 10 first)
## Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3 ctr cos2
## 1 | 0.033 0.001 0.001 | 0.163 0.032 0.023 | -0.742 0.709 0.476
## 2 | -0.106 0.007 0.009 | -0.341 0.139 0.092 | 0.191 0.047 0.029
## 3 | -0.896 0.462 0.645 | 0.079 0.007 0.005 | -0.204 0.054 0.033
## 4 | 0.335 0.065 0.131 | -0.311 0.116 0.113 | 0.037 0.002 0.002
## 5 | -0.765 0.337 0.452 | -0.221 0.059 0.038 | 0.158 0.032 0.019
## 6 | -0.007 0.000 0.000 | -0.366 0.160 0.099 | 0.182 0.043 0.024
## 7 | 0.786 0.355 0.614 | -0.350 0.147 0.122 | -0.170 0.037 0.029
## 8 | -0.328 0.062 0.135 | -0.079 0.008 0.008 | -0.062 0.005 0.005
## 9 | 0.881 0.446 0.772 | -0.262 0.083 0.069 | -0.245 0.078 0.060
## 10 | -0.423 0.103 0.225 | -0.167 0.033 0.035 | 0.013 0.000 0.000
##
## 1 |
## 2 |
## 3 |
## 4 |
## 5 |
## 6 |
## 7 |
## 8 |
## 9 |
## 10 |
##
## Categories (the 10 first)
## Dim.1 ctr cos2 v.test Dim.2 ctr cos2 v.test
## sex_0 | -0.596 4.040 0.164 -9.053 | 0.433 4.444 0.087 6.576 |
## sex_1 | 0.275 1.867 0.164 9.053 | -0.200 2.053 0.087 -6.576 |
## cp_0 | 0.685 8.332 0.458 15.115 | -0.019 0.014 0.000 -0.427 |
## cp_1 | -0.929 5.157 0.172 -9.262 | -0.197 0.484 0.008 -1.964 |
## cp_2 | -0.673 4.175 0.156 -8.823 | 0.149 0.428 0.008 1.957 |
## cp_3 | -0.139 0.058 0.002 -0.937 | 0.048 0.015 0.000 0.326 |
## fbs_0 | -0.019 0.011 0.002 -1.059 | -0.050 0.162 0.015 -2.779 |
## fbs_1 | 0.117 0.069 0.002 1.059 | 0.308 0.998 0.015 2.779 |
## restecg_0 | 0.214 0.811 0.045 4.716 | 0.061 0.137 0.004 1.343 |
## restecg_1 | -0.234 0.967 0.053 -5.138 | -0.225 1.867 0.049 -4.945 |
## Dim.3 ctr cos2 v.test
## sex_0 -0.856 18.657 0.338 -12.994 |
## sex_1 0.395 8.619 0.338 12.994 |
## cp_0 -0.373 5.538 0.136 -8.232 |
## cp_1 0.082 0.089 0.001 0.813 |
## cp_2 0.194 0.778 0.013 2.544 |
## cp_3 1.440 14.047 0.190 9.744 |
## fbs_0 -0.241 4.033 0.357 -13.354 |
## fbs_1 1.482 24.773 0.357 13.354 |
## restecg_0 -0.103 0.426 0.010 -2.284 |
## restecg_1 0.134 0.710 0.017 2.942 |
##
## Categorical variables (eta2)
## Dim.1 Dim.2 Dim.3
## sex | 0.164 0.087 0.338 |
## cp | 0.493 0.013 0.254 |
## fbs | 0.002 0.015 0.357 |
## restecg | 0.056 0.491 0.030 |
## exang | 0.437 0.005 0.031 |
## slope | 0.365 0.294 0.105 |
## thal | 0.568 0.422 0.125 |
## target | 0.695 0.007 0.001 |
heart_numerical_combined_with_factors <- cbind( heart_combined, heart[, c(2, 3, 6, 7, 9, 11, 13, 14)])
summary(heart_numerical_combined_with_factors)## age thalach ca oldpeak
## Min. :-2.7842 Min. :-3.3335 Min. :-0.7256 Min. :-0.9140
## 1st Qu.:-0.8111 1st Qu.:-0.7181 1st Qu.:-0.7256 1st Qu.:-0.9140
## Median : 0.1206 Median : 0.1394 Median :-0.7256 Median :-0.2517
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.7235 3rd Qu.: 0.7075 3rd Qu.: 0.2445 3rd Qu.: 0.4106
## Max. : 2.4773 Max. : 2.2832 Max. : 3.1547 Max. : 4.2190
## chol trestbps sex cp fbs restecg exang
## Min. :-2.0537 Min. :-2.18805 0:158 0:247 0:430 0:247 0:327
## 1st Qu.:-0.6889 1st Qu.:-0.67721 1:342 1: 83 1: 70 1:246 1:173
## Median :-0.1465 Median :-0.09611 2:128 2: 7
## Mean : 0.0000 Mean : 0.00000 3: 42
## 3rd Qu.: 0.5009 3rd Qu.: 0.48498
## Max. : 5.5224 Max. : 3.97155
## slope thal target
## 0: 35 0: 3 neg:248
## 1:242 1: 29 pos:252
## 2:223 2:259
## 3:209
##
##
## age thalach ca oldpeak
## Min. :-2.7842 Min. :-3.3335 Min. :-0.7256 Min. :-0.9140
## 1st Qu.:-0.8111 1st Qu.:-0.7181 1st Qu.:-0.7256 1st Qu.:-0.9140
## Median : 0.1206 Median : 0.1394 Median :-0.7256 Median :-0.2517
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.7235 3rd Qu.: 0.7075 3rd Qu.: 0.2445 3rd Qu.: 0.4106
## Max. : 2.4773 Max. : 2.2832 Max. : 3.1547 Max. : 4.2190
## chol trestbps sex cp fbs restecg exang
## Min. :-2.0537 Min. :-2.18805 0:158 0:247 0:430 0:247 0:327
## 1st Qu.:-0.6889 1st Qu.:-0.67721 1:342 1: 83 1: 70 1:246 1:173
## Median :-0.1465 Median :-0.09611 2:128 2: 7
## Mean : 0.0000 Mean : 0.00000 3: 42
## 3rd Qu.: 0.5009 3rd Qu.: 0.48498
## Max. : 5.5224 Max. : 3.97155
## slope thal target
## 0: 35 0: 3 neg:248
## 1:242 1: 29 pos:252
## 2:223 2:259
## 3:209
##
##
model_of_the_transform <- preProcess(heart_numerical_combined_with_factors ,
method = c("scale", "center", "ica"),
n.comp = 6)
print(model_of_the_transform)## Created from 500 samples and 14 variables
##
## Pre-processing:
## - centered (6)
## - independent component signal extraction (6)
## - ignored (8)
## - scaled (6)
##
## ICA used 6 components
heart_numerical_combined_with_factors_ica_dr <- predict(model_of_the_transform, heart_numerical_combined_with_factors )
summary(heart_numerical_combined_with_factors_ica_dr)## sex cp fbs restecg exang slope thal target
## 0:158 0:247 0:430 0:247 0:327 0: 35 0: 3 neg:248
## 1:342 1: 83 1: 70 1:246 1:173 1:242 1: 29 pos:252
## 2:128 2: 7 2:223 2:259
## 3: 42 3:209
##
##
## ICA1 ICA2 ICA3 ICA4
## Min. :-3.9573 Min. :-2.61710 Min. :-2.11943 Min. :-2.44287
## 1st Qu.:-0.5342 1st Qu.:-0.80111 1st Qu.:-0.66894 1st Qu.:-0.75176
## Median : 0.1085 Median :-0.06699 Median :-0.08604 Median : 0.03837
## Mean : 0.0000 Mean : 0.00000 Mean : 0.00000 Mean : 0.00000
## 3rd Qu.: 0.6142 3rd Qu.: 0.82801 3rd Qu.: 0.41691 3rd Qu.: 0.73536
## Max. : 2.3785 Max. : 2.45315 Max. : 5.81968 Max. : 2.46712
## ICA5 ICA6
## Min. :-4.2519 Min. :-2.76676
## 1st Qu.:-0.4082 1st Qu.:-0.57321
## Median : 0.1103 Median :-0.06007
## Mean : 0.0000 Mean : 0.00000
## 3rd Qu.: 0.5802 3rd Qu.: 0.59384
## Max. : 2.6668 Max. : 4.18615
# ************************************************************************************************************************************
#RESULTS
# Summary of the Transformed Dataset after Independent Component Analysis (ICA)
# Categorical Variables:
# - sex, cp, fbs, restecg, exang, slope, thal, target are categorical variables with counts and percentages for each level.
# Independent Component Analysis (ICA) Components:
# - ICA1 to ICA6 represent the Independent Component Analysis components.
# - For each component, descriptive statistics are provided:
# - Minimum, 1st Quartile, Median, Mean, 3rd Quartile, Maximum.
# Example for ICA1:
# ICA1: Min. -4.3196, 1st Qu. -0.3524, Median 0.1066, Mean 0.0000, 3rd Qu. 0.5823, Max. 2.4614.
# These statistics offer insights into the distribution and characteristics of the transformed variables after applying ICA.
# ************************************************************************************************************************************## 'data.frame': 500 obs. of 14 variables:
## $ age : num -1.03 -0.373 1.381 -1.469 -1.14 ...
## $ thalach : num 0.139 0.225 0.997 0.397 0.911 ...
## $ ca : num -0.726 0.244 0.244 -0.726 -0.726 ...
## $ oldpeak : num -0.748 -0.914 -0.914 -0.914 -0.914 ...
## $ chol : num -0.217 -0.374 0.501 -1.336 -0.496 ...
## $ trestbps: num 0.369 -2.188 1.182 -1.258 -0.677 ...
## $ sex : Factor w/ 2 levels "0","1": 1 2 1 2 2 2 2 2 2 2 ...
## $ cp : Factor w/ 4 levels "0","1","2","3": 1 3 3 1 2 2 1 1 1 1 ...
## $ fbs : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
## $ restecg : Factor w/ 3 levels "0","1","2": 1 2 2 1 2 1 2 1 1 2 ...
## $ exang : Factor w/ 2 levels "0","1": 2 2 1 1 1 1 2 1 2 1 ...
## $ slope : Factor w/ 3 levels "0","1","2": 2 3 3 3 3 3 2 3 2 3 ...
## $ thal : Factor w/ 4 levels "0","1","2","3": 3 4 3 4 3 4 4 3 4 3 ...
## $ target : Factor w/ 2 levels "neg","pos": 2 2 2 1 2 1 1 2 1 2 ...
# Define a 75:25 train:test data split of the dataset.
# That is, 75% of the original data will be used to train the model and
# 25% of the original data will be used to test the model.
train_index <- createDataPartition(heart_preprocessed$target,
p = 0.75,
list = FALSE)
heart_preprocessed_train <- heart_preprocessed[train_index, ]
heart_preprocessed_test <- heart_preprocessed[-train_index, ]# Train a Naive Bayes model using the caret package.
heart_model_nb_caret <- # nolint
caret::train(target ~ ., data =
heart_preprocessed_train[, c("age", "sex", "cp", "trestbps" , "chol" , "fbs" ,
"restecg" , "thalach" , "exang",
"oldpeak", "slope", "ca", "thal", "target")],
method = "naive_bayes")### 3.b. Test the trained caret Naive Bayes model using the testing dataset ----
predictions_nb_caret <-
predict(heart_model_nb_caret,
heart_preprocessed_test[, c("age", "sex", "cp", "trestbps" , "chol" , "fbs" ,
"restecg" , "thalach" , "exang",
"oldpeak", "slope", "ca", "thal")])heart_freq <- heart_preprocessed_train$target
cbind(frequency =
table(heart_freq),
percentage = prop.table(table(heart_freq)) * 100)## frequency percentage
## neg 186 49.6
## pos 189 50.4
# The glm function in this code is used to train a Generalized Linear Model
# for predicting the target variable based on the provided features in the training dataset.
# The subsequent printing of model details and performance metrics allows for an assessment of its effectiveness.
# Set up train control with classProbs = TRUE
train_control <- trainControl(method = "repeatedcv", number = 10, repeats = 3, classProbs = TRUE)
set.seed(7)
heart_model_glm <-
train(target ~ ., data = heart_preprocessed_train, method = "glm",
metric = "Accuracy", trControl = train_control)
print(heart_model_glm)## Generalized Linear Model
##
## 375 samples
## 13 predictor
## 2 classes: 'neg', 'pos'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 337, 338, 337, 337, 337, 338, ...
## Resampling results:
##
## Accuracy Kappa
## 0.8684369 0.7367949
# Set the seed for reproducibility
set.seed(7)
# Train a Linear Discriminant Analysis (LDA) model using the specified training control
heart_model_lda <- train(target ~ ., data = heart_preprocessed_train,
method = "lda", trControl = train_control)# Set the seed for reproducibility
set.seed(7)
# Train a Classification and Regression Trees (CART) model using the specified training control
heart_model_cart <- train(target ~ ., data = heart_preprocessed_train,
method = "rpart", trControl = train_control)# Set the seed for reproducibility
set.seed(7)
# Train a k-Nearest Neighbors (knn) model using the specified training control
heart_model_knn <- train(target ~ ., data = heart_preprocessed_train,
method = "knn", trControl = train_control)# Set the seed for reproducibility
set.seed(7)
# Train a Random Forest (rf) model using the specified training control
heart_model_rf <- train(target ~ ., data = heart_preprocessed_train,
method = "rf", trControl = train_control)# We then create a list of the model results and pass the list as an argument
# to the `resamples` function.
results <- resamples(list(LDA = heart_model_lda, CART = heart_model_cart,
KNN = heart_model_knn, GLM = heart_model_glm,
RF = heart_model_rf))## Type 'citation("pROC")' for a citation.
##
## Attaching package: 'pROC'
## The following objects are masked from 'package:stats':
##
## cov, smooth, var
# Create an empty plot
plot(0, 0, type = "n", main = "ROC Curve", xlab = "False Positive Rate", ylab = "True Positive Rate")predictions_lda <- predict(heart_model_lda, heart_preprocessed_test[, 1:13],type = "prob")
predictions_cart <- predict(heart_model_cart, heart_preprocessed_test[, 1:13],type = "prob")
predictions_knn <- predict(heart_model_knn, heart_preprocessed_test[, 1:13],type = "prob")
predictions_glm <- predict(heart_model_glm, heart_preprocessed_test[, 1:13],type = "prob")
predictions_rf <- predict(heart_model_rf, heart_preprocessed_test[, 1:13],type = "prob")
# Add ROC curves for each model to the plot
roc_curve_lda <- roc(heart_preprocessed_test$target, predictions_lda$neg)## Setting levels: control = neg, case = pos
## Setting direction: controls > cases
## Setting levels: control = neg, case = pos
## Setting direction: controls > cases
## Setting levels: control = neg, case = pos
## Setting direction: controls > cases
## Setting levels: control = neg, case = pos
## Setting direction: controls > cases
## Setting levels: control = neg, case = pos
## Setting direction: controls > cases
# Plot each ROC curve with a different color
plot(roc_curve_lda, main = "ROC curve for LDA", print.auc = TRUE,
print.auc.x = 0.6, print.auc.y = 0.6, col = "red", lwd = 2.5)plot(roc_curve_cart, main = "ROC curve for CART", print.auc = TRUE,
print.auc.x = 0.6, print.auc.y = 0.6, col = "blue", lwd = 2.5)plot(roc_curve_knn, main = "ROC curve for KNN", print.auc = TRUE,
print.auc.x = 0.6, print.auc.y = 0.6, col = "green", lwd = 2.5)plot(roc_curve_glm,main = "ROC curve for GLM", print.auc = TRUE,
print.auc.x = 0.6, print.auc.y = 0.6, col = "purple")plot(roc_curve_rf, main = "ROC curve for RF", print.auc = TRUE,
print.auc.x = 0.6, print.auc.y = 0.6, col = "orange", lwd = 2.5)## 1. Table Summary ----
# This is the simplest comparison. It creates a table with one model per row
# and its corresponding evaluation metrics displayed per column.
summary(results)##
## Call:
## summary.resamples(object = results)
##
## Models: LDA, CART, KNN, GLM, RF
## Number of resamples: 30
##
## Accuracy
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## LDA 0.7567568 0.8389047 0.8684211 0.8692666 0.9189189 0.9473684 0
## CART 0.6578947 0.7567568 0.8157895 0.8017478 0.8639264 0.8947368 0
## KNN 0.7567568 0.8175676 0.8648649 0.8566553 0.8947368 0.9473684 0
## GLM 0.7631579 0.8389047 0.8684211 0.8684369 0.8947368 0.9459459 0
## RF 0.8108108 0.8918919 0.9199858 0.9146252 0.9210526 1.0000000 0
##
## Kappa
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## LDA 0.5138686 0.6761997 0.7368421 0.7384781 0.8374817 0.8947368 0
## CART 0.3157895 0.5113524 0.6315789 0.6033816 0.7280008 0.7894737 0
## KNN 0.5124451 0.6352830 0.7295316 0.7131978 0.7894737 0.8947368 0
## GLM 0.5263158 0.6790468 0.7368421 0.7367949 0.7894737 0.8914956 0
## RF 0.6207906 0.7842566 0.8402666 0.8292298 0.8421053 1.0000000 0
## 2. Box and Whisker Plot ----
# This is useful for visually observing the spread of the estimated accuracies
# for different algorithms and how they relate.
scales <- list(x = list(relation = "free"), y = list(relation = "free"))
bwplot(results, scales = scales)## 3. Dot Plots ----
# They show both the mean estimated accuracy as well as the 95% confidence
# interval (e.g. the range in which 95% of observed scores fell).
scales <- list(x = list(relation = "free"), y = list(relation = "free"))
dotplot(results, scales = scales)## 4. Scatter Plot Matrix ----
# This is useful when considering whether the predictions from two
# different algorithms are correlated. If weakly correlated, then they are good
# candidates for being combined in an ensemble prediction.
splom(results)## 5. Pairwise xyPlots ----
# You can zoom in on one pairwise comparison of the accuracy of trial-folds for
# two models using an xyplot.
# xyplot plots to compare models
xyplot(results, models = c("LDA", "RF"))# Explanation:
# - Upper diagonal: Estimates of the difference in accuracy and kappa values between models.
# - Lower diagonal: P-values for testing the hypothesis that the difference is zero.
# Accuracy:
# - Positive values indicate higher accuracy in the row model compared to the column model.
# - Negative values indicate lower accuracy.
# Kappa:
# - Positive values indicate higher kappa values in the row model compared to the column model.
# - Negative values indicate lower kappa values.
# P-values:
# - Assess the statistical significance of the observed differences.
# - Values below the significance level (e.g., 0.05) suggest a significant difference.
# - Bonferroni adjustment is applied for multiple comparisons.
diffs <- diff(results)
summary(diffs)##
## Call:
## summary.diff.resamples(object = diffs)
##
## p-value adjustment: bonferroni
## Upper diagonal: estimates of the difference
## Lower diagonal: p-value for H0: difference = 0
##
## Accuracy
## LDA CART KNN GLM RF
## LDA 0.0675188 0.0126113 0.0008298 -0.0453585
## CART 2.081e-05 -0.0549075 -0.0666891 -0.1128774
## KNN 1.0000000 0.0002257 -0.0117815 -0.0579698
## GLM 1.0000000 4.444e-05 1.0000000 -0.0461883
## RF 0.0004036 1.062e-10 9.016e-07 1.850e-05
##
## Kappa
## LDA CART KNN GLM RF
## LDA 0.135097 0.025280 0.001683 -0.090752
## CART 2.155e-05 -0.109816 -0.133413 -0.225848
## KNN 1.0000000 0.0002298 -0.023597 -0.116032
## GLM 1.0000000 4.763e-05 1.0000000 -0.092435
## RF 0.0004052 1.124e-10 9.284e-07 1.901e-05
# Define train control settings for a random search
train_control <- trainControl(method = "repeatedcv", number = 10, repeats = 3, search = "random")
# Set a seed for reproducibility
set.seed(7)
# Perform a random search for Random Forest hyperparameters
heart_model_random_search_rf <- train(target ~ ., data = heart_preprocessed_train, method = "rf",
metric = "Accuracy",
tuneLength = 12, # Search 12 options for the value of mtry
trControl = train_control)
# Display the details of the random search model
print(heart_model_random_search_rf)## Random Forest
##
## 375 samples
## 13 predictor
## 2 classes: 'neg', 'pos'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 337, 338, 337, 337, 337, 338, ...
## Resampling results across tuning parameters:
##
## mtry Accuracy Kappa
## 2 0.9172804 0.8344811
## 3 0.9155023 0.8309790
## 7 0.9137243 0.8274241
## 8 0.9137243 0.8274241
## 12 0.9137243 0.8274608
## 15 0.9110690 0.8221357
## 18 0.9128708 0.8257366
## 19 0.9146252 0.8292454
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was mtry = 2.
## 2.a. Bagged CART ----
set.seed(7)
heart_model_bagged_cart <- train(target ~ ., data = heart_preprocessed_train, method = "treebag",
metric = "Accuracy",
trControl = train_control)
## 2.b. Random Forest ----
set.seed(7)
heart_model_rf <- train(target ~ ., data = heart_preprocessed_train, method = "rf",
metric = "Accuracy", trControl = train_control)
# Summarize results
bagging_results <-
resamples(list("Bagged Decision Tree" = heart_model_bagged_cart,
"Random Forest" = heart_model_rf))
summary(bagging_results)##
## Call:
## summary.resamples(object = bagging_results)
##
## Models: Bagged Decision Tree, Random Forest
## Number of resamples: 30
##
## Accuracy
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## Bagged Decision Tree 0.8378378 0.8918919 0.9068279 0.9119936 0.9385965 1
## Random Forest 0.8108108 0.8918919 0.9199858 0.9155498 0.9459459 1
## NA's
## Bagged Decision Tree 0
## Random Forest 0
##
## Kappa
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## Bagged Decision Tree 0.6754386 0.7844134 0.8134777 0.8240193 0.8771930 1
## Random Forest 0.6207906 0.7842566 0.8400307 0.8310450 0.8919701 1
## NA's
## Bagged Decision Tree 0
## Random Forest 0

##
## Call:
## randomForest(x = x, y = y, mtry = param$mtry)
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 2
##
## OOB estimate of error rate: 7.47%
## Confusion matrix:
## neg pos class.error
## neg 174 12 0.06451613
## pos 16 173 0.08465608
# We can test the model
set.seed(9)
predictions <- predict(heart_model_rf, newdata = heart_preprocessed_test)
confusionMatrix(predictions, heart_preprocessed_test$target)## Confusion Matrix and Statistics
##
## Reference
## Prediction neg pos
## neg 56 5
## pos 6 58
##
## Accuracy : 0.912
## 95% CI : (0.848, 0.9552)
## No Information Rate : 0.504
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.824
##
## Mcnemar's Test P-Value : 1
##
## Sensitivity : 0.9032
## Specificity : 0.9206
## Pos Pred Value : 0.9180
## Neg Pred Value : 0.9062
## Prevalence : 0.4960
## Detection Rate : 0.4480
## Detection Prevalence : 0.4880
## Balanced Accuracy : 0.9119
##
## 'Positive' Class : neg
##
# Saving a model into a file allows you to load it later and use it to make
# predictions. Saved models can be loaded by calling the `readRDS()` function
saveRDS(heart_model_rf, "../models/saved_heart_model_rf.rds")
# The saved model can then be loaded later as follows:
loaded_heart_model_rf <- readRDS("../models/saved_heart_model_rf.rds")
print(loaded_heart_model_rf)## Random Forest
##
## 375 samples
## 13 predictor
## 2 classes: 'neg', 'pos'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 337, 338, 337, 337, 337, 338, ...
## Resampling results across tuning parameters:
##
## mtry Accuracy Kappa
## 2 0.9155498 0.8310450
## 7 0.9146014 0.8291785
## 15 0.9137480 0.8275017
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was mtry = 2.
predictions_with_loaded_model <-
predict(loaded_heart_model_rf, newdata = heart_preprocessed_test)
confusionMatrix(predictions_with_loaded_model, heart_preprocessed_test$target)## Confusion Matrix and Statistics
##
## Reference
## Prediction neg pos
## neg 56 5
## pos 6 58
##
## Accuracy : 0.912
## 95% CI : (0.848, 0.9552)
## No Information Rate : 0.504
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.824
##
## Mcnemar's Test P-Value : 1
##
## Sensitivity : 0.9032
## Specificity : 0.9206
## Pos Pred Value : 0.9180
## Neg Pred Value : 0.9062
## Prevalence : 0.4960
## Detection Rate : 0.4480
## Detection Prevalence : 0.4880
## Balanced Accuracy : 0.9119
##
## 'Positive' Class : neg
##
# Plumber requires functions, an example of the syntax for creating a function
# in R is:
name_of_function <- function(arg) {
# Do something with the argument called `arg`
}# We can also create and use our own data frame as follows:
# Convert categorical variables to factors
to_be_predicted <-
data.frame(age=70, sex=1, cp=0, trestbps=145, chol=174,
fbs=0, restecg=1, thalach=125, exang=1, oldpeak=2.6,
slope=0,
ca=0, thal=3)
to_be_predicted$sex <- as.factor(to_be_predicted$sex)
to_be_predicted$cp <- as.factor(to_be_predicted$cp)
to_be_predicted$fbs <- as.factor(to_be_predicted$fbs)
to_be_predicted$restecg <- as.factor(to_be_predicted$restecg)
to_be_predicted$exang <- as.factor(to_be_predicted$exang)
to_be_predicted$slope <- as.factor(to_be_predicted$slope)
to_be_predicted$thal <- as.factor(to_be_predicted$thal)
# We then use the data frame to make predictions
predict(loaded_heart_model_rf, newdata = to_be_predicted)## [1] neg
## Levels: neg pos
# An alternative is to create a function and then use the function to make
# predictions
predict_target <- function(arg_age, arg_sex, arg_cp, arg_trestbps, arg_chol,
arg_fbs, arg_restecg, arg_thalach, arg_exang, arg_oldpeak, arg_slope,
arg_ca, arg_thal) {
# Convert categorical variables to factors
arg_sex <- as.factor(arg_sex)
arg_cp <- as.factor(arg_cp)
arg_fbs <- as.factor(arg_fbs)
arg_restecg <- as.factor(arg_restecg)
arg_exang <- as.factor(arg_exang)
arg_slope <- as.factor(arg_slope)
arg_thal <- as.factor(arg_thal)
# Create a data frame using the arguments
to_be_predicted <- data.frame(age = arg_age, sex = arg_sex, cp = arg_cp, trestbps = arg_trestbps,
chol = arg_chol, fbs = arg_fbs, restecg = arg_restecg,
thalach = arg_thalach, exang = arg_exang, oldpeak = arg_oldpeak,
slope = arg_slope, ca = arg_ca, thal = arg_thal)
# Make a prediction based on the data frame
predict(loaded_heart_model_rf, newdata = to_be_predicted)
}# STEP 1. Install and Load the Required Packages ----
## plumber ----
if (require("plumber")) {
require("plumber")
} else {
install.packages("plumber", dependencies = TRUE,
repos = "https://cloud.r-project.org")
}## Loading required package: plumber
## caret ----
if (require("caret")) {
require("caret")
} else {
install.packages("caret", dependencies = TRUE,
repos = "https://cloud.r-project.org")
}
###LAB 12
# This requires the "plumber" package that was installed and loaded earlier in
# STEP 1. The commenting below makes R recognize the code as the definition of
# an API, i.e., #* comments.
loaded_heart_model_rf <- readRDS("../models/saved_heart_model_rf.rds")
#* @apiTitle CVDetect Prediction Model API
#* @apiDescription Used to predict whether a patient has heart disease or not.
#* @param arg_age Age of the patient
#* @param arg_sex Gender of the patient (0: Female, 1: Male)
#* @param arg_cp Chest pain type (0-3)
#* @param arg_trestbps Resting blood pressure (mm Hg)
#* @param arg_chol Serum cholesterol (mg/dl)
#* @param arg_fbs Fasting blood sugar (> 120 mg/dl, 0: No, 1: Yes)
#* @param arg_restecg Resting electrocardiographic results (0-2)
#* @param arg_thalach Maximum heart rate achieved
#* @param arg_exang Exercise-induced angina (0: No, 1: Yes)
#* @param arg_oldpeak ST depression induced by exercise relative to rest
#* @param arg_slope Slope of the peak exercise ST segment (0-2)
#* @param arg_ca Number of major vessels colored by fluoroscopy (0-3)
#* @param arg_thal Thallium stress test result (3: Normal, 6: Fixed defect, 7: Reversible defect)
#* @get /target
predict_diabetes <-
function(arg_age, arg_sex, arg_cp, arg_trestbps, arg_chol,
arg_fbs, arg_restecg, arg_thalach, arg_exang, arg_oldpeak, arg_slope,
arg_ca, arg_thal) {
# Create a data frame using the arguments
to_be_predicted <- data.frame(
age = as.numeric(arg_age),
sex = as.factor(arg_sex),
cp = as.factor(arg_cp),
trestbps = as.numeric(arg_trestbps),
chol = as.numeric(arg_chol),
fbs = as.factor(arg_fbs),
restecg = as.factor(arg_restecg),
thalach = as.numeric(arg_thalach),
exang = as.factor(arg_exang),
oldpeak = as.numeric(arg_oldpeak),
slope = as.factor(arg_slope),
ca = as.numeric(arg_ca),
thal = as.factor(arg_thal)
)
# Make a prediction based on the data frame
predict(loaded_heart_model_rf, newdata = to_be_predicted)
}##Run Plumber
# STEP 1. Install and load the required packages ----
## plumber ----
if (require("plumber")) {
require("plumber")
} else {
install.packages("plumber", dependencies = TRUE,
repos = "https://cloud.r-project.org")
}
# STEP 2. Process a Plumber API ----
# This allows us to process a plumber API
#api <- plumber::plumb("lab12.R")
# STEP 3. Run the API on a specific port ----
# Specify a constant localhost port to use
#api$run(host = "127.0.0.1", port = 5022)