Dimension Reduction Project
Anna Lorenz
2024/2025
Introduction
Understanding heart disease risk factors begins with analysing patient data. It is very important to identify the main attributes that contribute to the development of cardiovascular conditions and health issues. By identifying these influential factors, healthcare professionals can improve diagnosis accuracy and optimise prevention strategies. Recognising patterns in medical data can uncover opportunities for more effective treatments and better health outcomes.
For this analysis, I apply dimension reduction techniques to better understand the underlying structure of the data. Dimension reduction methods, like Principal Component Analysis (PCA), help simplify complex data by reducing the number of features while retaining the essential information. This approach enables a clearer view of the most important factors which leads to heart disease risk, facilitating further analysis and predictive modeling.
Dataset
For this analysis, I used the Heart Attack Prediction Dataset. The dataset contains medical data related to heart disease patients: - Age - age. - Sex - gender (0 = female, 1 = male). - ChestPain - type of chest pain (0 = typical, 1 = asymptomatic, 2 = nonanginal, 3 = nontypical). - RestBP - resting blood pressure. - Chol - cholesterol level. - Fbs - fasting blood sugar. - RestECG - resting electrocardiographic results. - MaxHR -maximum heart rate. - ExAng - exercise induced angina (0 = No chest pain during exercise, 1 = Chest pain induced during exercise). - Oldpeak - depression induced by exercise relative to rest. - Slope - slope of the peak exercise ST segment in the ECG. - Ca - number of major vessels colored by fluoroscopy. - Thal - whether the individual has thalassemia (0 = normal, 1 = reversable, 2 = fixed)
This dataset is suitable for understanding the relationships between multiple factors and their impact on cardiovascular health.
Each row in the dataset represents an individual patient, with features that may influence the likelihood of developing heart disease. By analysing these features through dimension reduction, we can find the most significant patterns and correlations in the data, leading to more efficient diagnostic tools and healthcare strategies.
Analysis
Uploading useful packages.
library(tidyverse)
library(dplyr)
library(corrplot)
library(clusterSim)
library(psych)
library(factoextra)
library(gridExtra)Loading Heart Attack Prediction dataset.
heart <- read.csv("heart.csv", sep=",", dec=".", header=TRUE)
heart <- heart[, -14]
head(heart)## Age Sex ChestPain RestBP Chol Fbs RestECG MaxHR ExAng Oldpeak Slope Ca
## 1 63 1 typical 145 233 1 2 150 0 2.3 3 0
## 2 67 1 asymptomatic 160 286 0 2 108 1 1.5 2 3
## 3 67 1 asymptomatic 120 229 0 2 129 1 2.6 2 2
## 4 37 1 nonanginal 130 250 0 0 187 0 3.5 3 0
## 5 41 0 nontypical 130 204 0 2 172 0 1.4 1 0
## 6 56 1 nontypical 120 236 0 0 178 0 0.8 1 0
## Thal
## 1 fixed
## 2 normal
## 3 reversable
## 4 normal
## 5 normal
## 6 normalsummary(heart)## Age Sex ChestPain RestBP
## Min. :29.00 Min. :0.0000 Length:303 Min. : 94.0
## 1st Qu.:48.00 1st Qu.:0.0000 Class :character 1st Qu.:120.0
## Median :56.00 Median :1.0000 Mode :character Median :130.0
## Mean :54.44 Mean :0.6799 Mean :131.7
## 3rd Qu.:61.00 3rd Qu.:1.0000 3rd Qu.:140.0
## Max. :77.00 Max. :1.0000 Max. :200.0
## Chol Fbs RestECG MaxHR
## Min. :126.0 Min. :0.0000 Min. :0.0000 Min. : 71.0
## 1st Qu.:211.0 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:133.5
## Median :241.0 Median :0.0000 Median :1.0000 Median :153.0
## Mean :246.7 Mean :0.1485 Mean :0.9901 Mean :149.6
## 3rd Qu.:275.0 3rd Qu.:0.0000 3rd Qu.:2.0000 3rd Qu.:166.0
## Max. :564.0 Max. :1.0000 Max. :2.0000 Max. :202.0
## ExAng Oldpeak Slope Ca
## Min. :0.0000 Min. :0.00 Min. :1.000 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:0.00 1st Qu.:1.000 1st Qu.:0.0000
## Median :0.0000 Median :0.80 Median :2.000 Median :0.0000
## Mean :0.3267 Mean :1.04 Mean :1.601 Mean :0.6865
## 3rd Qu.:1.0000 3rd Qu.:1.60 3rd Qu.:2.000 3rd Qu.:1.0000
## Max. :1.0000 Max. :6.20 Max. :3.000 Max. :3.0000
## Thal
## Length:303
## Class :character
## Mode :character
##
##
## Checking if there are any missing values.
colSums(is.na(heart))## Age Sex ChestPain RestBP Chol Fbs RestECG MaxHR
## 0 0 0 0 0 0 0 0
## ExAng Oldpeak Slope Ca Thal
## 0 0 0 0 2There is just two missing values. I decided to delete rows with missing values, because it is not too much data in comparison to all data (303 observations).
heart <- na.omit(heart)head(heart)## Age Sex ChestPain RestBP Chol Fbs RestECG MaxHR ExAng Oldpeak Slope Ca
## 1 63 1 typical 145 233 1 2 150 0 2.3 3 0
## 2 67 1 asymptomatic 160 286 0 2 108 1 1.5 2 3
## 3 67 1 asymptomatic 120 229 0 2 129 1 2.6 2 2
## 4 37 1 nonanginal 130 250 0 0 187 0 3.5 3 0
## 5 41 0 nontypical 130 204 0 2 172 0 1.4 1 0
## 6 56 1 nontypical 120 236 0 0 178 0 0.8 1 0
## Thal
## 1 fixed
## 2 normal
## 3 reversable
## 4 normal
## 5 normal
## 6 normalAssigning numbers to the character data for ChestPain column (0 = typical, 1 = asymptomatic, 2 = nonanginal, 4 = nontypical).
unique(heart$ChestPain)## [1] "typical" "asymptomatic" "nonanginal" "nontypical"heart$ChestPain <- ifelse(heart$ChestPain == "typical", 0,
ifelse(heart$ChestPain == "asymptomatic", 1,
ifelse(heart$ChestPain == "nonanginal", 2, 3)))unique(heart$Thal)## [1] "fixed" "normal" "reversable"Assigning numbers to the character data for Tal column (0 = normal, 1 = reversable, 2 = fixed).
heart$Thal <- ifelse(heart$Thal == "normal", 0,
ifelse(heart$Thal == "reversable", 1, 2))summary(heart)## Age Sex ChestPain RestBP
## Min. :29.00 Min. :0.0000 Min. :0.000 Min. : 94.0
## 1st Qu.:48.00 1st Qu.:0.0000 1st Qu.:1.000 1st Qu.:120.0
## Median :56.00 Median :1.0000 Median :1.000 Median :130.0
## Mean :54.45 Mean :0.6811 Mean :1.538 Mean :131.7
## 3rd Qu.:61.00 3rd Qu.:1.0000 3rd Qu.:2.000 3rd Qu.:140.0
## Max. :77.00 Max. :1.0000 Max. :3.000 Max. :200.0
## Chol Fbs RestECG MaxHR
## Min. :126.0 Min. :0.0000 Min. :0.00 Min. : 71.0
## 1st Qu.:211.0 1st Qu.:0.0000 1st Qu.:0.00 1st Qu.:134.0
## Median :242.0 Median :0.0000 Median :1.00 Median :153.0
## Mean :246.9 Mean :0.1462 Mean :0.99 Mean :149.7
## 3rd Qu.:275.0 3rd Qu.:0.0000 3rd Qu.:2.00 3rd Qu.:166.0
## Max. :564.0 Max. :1.0000 Max. :2.00 Max. :202.0
## ExAng Oldpeak Slope Ca
## Min. :0.0000 Min. :0.000 Min. :1.000 Min. :0.000
## 1st Qu.:0.0000 1st Qu.:0.000 1st Qu.:1.000 1st Qu.:0.000
## Median :0.0000 Median :0.800 Median :2.000 Median :0.000
## Mean :0.3256 Mean :1.043 Mean :1.601 Mean :0.691
## 3rd Qu.:1.0000 3rd Qu.:1.600 3rd Qu.:2.000 3rd Qu.:1.000
## Max. :1.0000 Max. :6.200 Max. :3.000 Max. :3.000
## Thal
## Min. :0.0000
## 1st Qu.:0.0000
## Median :0.0000
## Mean :0.5083
## 3rd Qu.:1.0000
## Max. :2.0000dim(heart)## [1] 301 13Correlation
heart_cor<-cor(heart, method="pearson")
print(heart_cor, digits=2)## Age Sex ChestPain RestBP Chol Fbs RestECG MaxHR ExAng
## Age 1.000 -0.098 -0.174 0.285 0.2083 0.1217 0.149 -0.3960 0.093
## Sex -0.098 1.000 -0.119 -0.065 -0.2021 0.0410 0.029 -0.0571 0.141
## ChestPain -0.174 -0.119 1.000 -0.145 -0.0161 -0.0185 -0.162 0.2810 -0.312
## RestBP 0.285 -0.065 -0.145 1.000 0.1294 0.1785 0.147 -0.0464 0.066
## Chol 0.208 -0.202 -0.016 0.129 1.0000 0.0158 0.171 -0.0057 0.064
## Fbs 0.122 0.041 -0.018 0.178 0.0158 1.0000 0.080 -0.0123 0.014
## RestECG 0.149 0.029 -0.162 0.147 0.1712 0.0799 1.000 -0.0780 0.093
## MaxHR -0.396 -0.057 0.281 -0.046 -0.0057 -0.0123 -0.078 1.0000 -0.386
## ExAng 0.093 0.141 -0.312 0.066 0.0643 0.0135 0.093 -0.3860 1.000
## Oldpeak 0.204 0.098 -0.334 0.189 0.0448 0.0049 0.118 -0.3494 0.288
## Slope 0.162 0.032 -0.248 0.117 -0.0042 0.0541 0.140 -0.3935 0.254
## Ca 0.332 0.100 -0.188 0.101 0.1061 0.1647 0.127 -0.2564 0.152
## Thal 0.132 0.373 -0.270 0.143 -0.0360 0.1026 0.041 -0.3013 0.294
## Oldpeak Slope Ca Thal
## Age 0.2036 0.1622 0.33 0.132
## Sex 0.0985 0.0316 0.10 0.373
## ChestPain -0.3340 -0.2483 -0.19 -0.270
## RestBP 0.1888 0.1174 0.10 0.143
## Chol 0.0448 -0.0042 0.11 -0.036
## Fbs 0.0049 0.0541 0.16 0.103
## RestECG 0.1176 0.1401 0.13 0.041
## MaxHR -0.3494 -0.3935 -0.26 -0.301
## ExAng 0.2879 0.2541 0.15 0.294
## Oldpeak 1.0000 0.5768 0.27 0.322
## Slope 0.5768 1.0000 0.10 0.319
## Ca 0.2745 0.1020 1.00 0.238
## Thal 0.3223 0.3194 0.24 1.000## Warning: pakiet 'corrplot' został zbudowany w wersji R 4.4.2## corrplot 0.95 loaded
``` r
corrplot(heart_cor,
method = "ellipse",
col=colorRampPalette(c("tomato1", "tomato3", "white", "darkseagreen2", "darkseagreen4"))(100),
addCoef.col = "black",
order = "hclust",
tl.cex = 0.7,
tl.col = "black",
number.cex = 0.5)
## Warning: pakiet 'psych' został zbudowany w wersji R 4.4.2KMO(heart_cor)## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = heart_cor)
## Overall MSA = 0.72
## MSA for each item =
## Age Sex ChestPain RestBP Chol Fbs RestECG MaxHR
## 0.67 0.55 0.87 0.64 0.58 0.58 0.71 0.74
## ExAng Oldpeak Slope Ca Thal
## 0.79 0.74 0.69 0.74 0.76In the KMO test Overall MSA is equal to 0.72, which is higher value than 0.7. That indicates that our dataset is suitable for factor analysis.
Principal Component Analysis (PCA)
Calculating optimal number of components.
heart.pca1<-prcomp(heart, scale.=TRUE)
heart.pca1## Standard deviations (1, .., p=13):
## [1] 1.7727048 1.2602815 1.0967221 1.0038224 0.9933236 0.9172948 0.9004695
## [8] 0.8936983 0.8516118 0.7858897 0.7177972 0.6396988 0.5947884
##
## Rotation (n x k) = (13 x 13):
## PC1 PC2 PC3 PC4 PC5
## Age -0.28204690 -0.40997845 -0.03539585 0.394934244 0.01677579
## Sex -0.12344158 0.47937430 -0.44710669 -0.083901593 -0.25928950
## ChestPain 0.32297156 -0.07756201 -0.05869874 0.196633969 0.18029819
## RestBP -0.18756681 -0.34659962 -0.23373205 -0.304532940 0.36615031
## Chol -0.06953147 -0.48280285 0.13199703 -0.109378346 -0.38962301
## Fbs -0.09543804 -0.17867666 -0.59872195 -0.003947186 0.32028596
## RestECG -0.16372585 -0.25195528 -0.09146586 -0.563792658 -0.38787763
## MaxHR 0.37784588 -0.04007648 -0.22769088 -0.379910279 0.02285644
## ExAng -0.31392018 0.16586376 0.15112732 -0.026792652 -0.29083519
## Oldpeak -0.39825699 0.07383480 0.21276588 -0.141975921 0.25248887
## Slope -0.36173769 0.10227068 0.29031041 -0.198899235 0.39677544
## Ca -0.28058782 -0.14848362 -0.28857475 0.413409294 -0.23401695
## Thal -0.33980125 0.28353169 -0.26268211 -0.008117503 -0.00479180
## PC6 PC7 PC8 PC9 PC10
## Age 0.03067803 -0.21619131 0.211466370 -0.29985031 0.22743877
## Sex 0.00379029 -0.22058517 -0.118033945 -0.22795546 0.09218345
## ChestPain -0.26508216 0.03502931 -0.449011893 -0.56219169 -0.46500989
## RestBP 0.52298197 -0.26403788 0.091841976 -0.12819231 -0.32789793
## Chol 0.17592312 0.12778320 -0.629714923 0.01706882 0.29116828
## Fbs -0.17787111 0.62959104 0.005750695 0.12328466 0.17687804
## RestECG -0.48694280 -0.04134818 0.278728648 -0.25561958 -0.11381886
## MaxHR 0.06435773 -0.16614499 -0.222431012 0.35313011 -0.08393785
## ExAng 0.34373560 0.54355398 0.036921951 -0.06005749 -0.48928256
## Oldpeak -0.17220494 -0.18310199 -0.248416473 0.26706538 -0.14791609
## Slope -0.31511640 0.06464295 -0.192019354 -0.06941087 0.10253386
## Ca -0.26205546 -0.21728904 -0.116911585 0.44515721 -0.40148542
## Thal 0.18879461 -0.10612582 -0.306513358 -0.20539478 0.21674211
## PC11 PC12 PC13
## Age 0.217054280 0.558240991 0.04558347
## Sex 0.570461614 -0.106083466 0.14505762
## ChestPain 0.003581245 0.049216085 -0.08496814
## RestBP 0.028600657 -0.279482199 0.09333088
## Chol 0.137077879 -0.179290352 0.03240057
## Fbs 0.099653610 -0.007967634 -0.11560375
## RestECG -0.161948486 0.022906106 -0.10711878
## MaxHR 0.003720403 0.637758213 0.19801905
## ExAng 0.081141123 0.306739109 0.08459024
## Oldpeak 0.302717689 0.128393635 -0.61688334
## Slope -0.003131726 0.023799766 0.64896762
## Ca -0.157872104 -0.135618358 0.24093402
## Thal -0.669710783 0.166070637 -0.17012190heart.pca1$rotation## PC1 PC2 PC3 PC4 PC5
## Age -0.28204690 -0.40997845 -0.03539585 0.394934244 0.01677579
## Sex -0.12344158 0.47937430 -0.44710669 -0.083901593 -0.25928950
## ChestPain 0.32297156 -0.07756201 -0.05869874 0.196633969 0.18029819
## RestBP -0.18756681 -0.34659962 -0.23373205 -0.304532940 0.36615031
## Chol -0.06953147 -0.48280285 0.13199703 -0.109378346 -0.38962301
## Fbs -0.09543804 -0.17867666 -0.59872195 -0.003947186 0.32028596
## RestECG -0.16372585 -0.25195528 -0.09146586 -0.563792658 -0.38787763
## MaxHR 0.37784588 -0.04007648 -0.22769088 -0.379910279 0.02285644
## ExAng -0.31392018 0.16586376 0.15112732 -0.026792652 -0.29083519
## Oldpeak -0.39825699 0.07383480 0.21276588 -0.141975921 0.25248887
## Slope -0.36173769 0.10227068 0.29031041 -0.198899235 0.39677544
## Ca -0.28058782 -0.14848362 -0.28857475 0.413409294 -0.23401695
## Thal -0.33980125 0.28353169 -0.26268211 -0.008117503 -0.00479180
## PC6 PC7 PC8 PC9 PC10
## Age 0.03067803 -0.21619131 0.211466370 -0.29985031 0.22743877
## Sex 0.00379029 -0.22058517 -0.118033945 -0.22795546 0.09218345
## ChestPain -0.26508216 0.03502931 -0.449011893 -0.56219169 -0.46500989
## RestBP 0.52298197 -0.26403788 0.091841976 -0.12819231 -0.32789793
## Chol 0.17592312 0.12778320 -0.629714923 0.01706882 0.29116828
## Fbs -0.17787111 0.62959104 0.005750695 0.12328466 0.17687804
## RestECG -0.48694280 -0.04134818 0.278728648 -0.25561958 -0.11381886
## MaxHR 0.06435773 -0.16614499 -0.222431012 0.35313011 -0.08393785
## ExAng 0.34373560 0.54355398 0.036921951 -0.06005749 -0.48928256
## Oldpeak -0.17220494 -0.18310199 -0.248416473 0.26706538 -0.14791609
## Slope -0.31511640 0.06464295 -0.192019354 -0.06941087 0.10253386
## Ca -0.26205546 -0.21728904 -0.116911585 0.44515721 -0.40148542
## Thal 0.18879461 -0.10612582 -0.306513358 -0.20539478 0.21674211
## PC11 PC12 PC13
## Age 0.217054280 0.558240991 0.04558347
## Sex 0.570461614 -0.106083466 0.14505762
## ChestPain 0.003581245 0.049216085 -0.08496814
## RestBP 0.028600657 -0.279482199 0.09333088
## Chol 0.137077879 -0.179290352 0.03240057
## Fbs 0.099653610 -0.007967634 -0.11560375
## RestECG -0.161948486 0.022906106 -0.10711878
## MaxHR 0.003720403 0.637758213 0.19801905
## ExAng 0.081141123 0.306739109 0.08459024
## Oldpeak 0.302717689 0.128393635 -0.61688334
## Slope -0.003131726 0.023799766 0.64896762
## Ca -0.157872104 -0.135618358 0.24093402
## Thal -0.669710783 0.166070637 -0.17012190## Ładowanie wymaganego pakietu: ggplot2##
## Dołączanie pakietu: 'ggplot2'## Następujące obiekty zostały zakryte z 'package:psych':
##
## %+%, alpha## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBafviz_eig(heart.pca1,
barfill = "darkseagreen3",
barcolor = "black",
linecolor = "midnightblue",
ncp = 10,
addlabels = TRUE)
fviz_eig(heart.pca1,
choice='eigenvalue',
barfill = "darkseagreen3",
barcolor = "black",
linecolor = "midnightblue",
ncp = 10,
addlabels = TRUE)
fviz_pca_var(heart.pca1, col.var = "darkseagreen4")
summary(heart.pca1)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 1.7727 1.2603 1.09672 1.00382 0.9933 0.91729 0.90047
## Proportion of Variance 0.2417 0.1222 0.09252 0.07751 0.0759 0.06473 0.06237
## Cumulative Proportion 0.2417 0.3639 0.45643 0.53394 0.6098 0.67457 0.73694
## PC8 PC9 PC10 PC11 PC12 PC13
## Standard deviation 0.89370 0.85161 0.78589 0.71780 0.63970 0.59479
## Proportion of Variance 0.06144 0.05579 0.04751 0.03963 0.03148 0.02721
## Cumulative Proportion 0.79838 0.85417 0.90168 0.94131 0.97279 1.00000I have decided to choose 6 components. I see that from the plot I should choose 4, but looking at the table 4 components explain only 53% of the variance. Because of that I decided to choose first six principal components which explain 67% of the variance
Plots for princal components
var <- get_pca_var(heart.pca1)
dim1 <- fviz_contrib(heart.pca1, "var", axes = 1, xtickslab.rt = 90, fill = "darkseagreen3", color = "black")
dim2 <- fviz_contrib(heart.pca1, "var", axes = 2, xtickslab.rt = 90, fill = "darkseagreen3", color = "black")
dim3 <- fviz_contrib(heart.pca1, "var", axes = 3, xtickslab.rt = 90, fill = "darkseagreen3", color = "black")
dim4 <- fviz_contrib(heart.pca1, "var", axes = 4, xtickslab.rt = 90, fill = "darkseagreen3", color = "black")
dim5 <- fviz_contrib(heart.pca1, "var", axes = 5, xtickslab.rt = 90, fill = "darkseagreen3", color = "black")
dim6 <- fviz_contrib(heart.pca1, "var", axes = 6, xtickslab.rt = 90, fill = "darkseagreen3", color = "black")
grid.arrange(dim1, dim2, dim3, dim4, dim5, dim6, top='Contribution to the first six Principal Components')
Conclusions
Based on plots and calculations above I choose 6 principal components, as they exlplain 67% of the variance.