library(corrplot)
## corrplot 0.95 loaded
data <- read.csv("Maternal Health Risk Data Set.csv")
head(data)
## Age SystolicBP DiastolicBP BS BodyTemp HeartRate RiskLevel
## 1 25 130 80 15.00 98 86 high risk
## 2 35 140 90 13.00 98 70 high risk
## 3 29 90 70 8.00 100 80 high risk
## 4 30 140 85 7.00 98 70 high risk
## 5 35 120 60 6.10 98 76 low risk
## 6 23 140 80 7.01 98 70 high risk
data_features <- data[, -which(names(data) == "RiskLevel")]
head(data_features)
## Age SystolicBP DiastolicBP BS BodyTemp HeartRate
## 1 25 130 80 15.00 98 86
## 2 35 140 90 13.00 98 70
## 3 29 90 70 8.00 100 80
## 4 30 140 85 7.00 98 70
## 5 35 120 60 6.10 98 76
## 6 23 140 80 7.01 98 70
cor_matrix <- cor(data_features)
cor_matrix
## Age SystolicBP DiastolicBP BS BodyTemp
## Age 1.00000000 0.41604545 0.39802629 0.4732843 -0.25532314
## SystolicBP 0.41604545 1.00000000 0.78700648 0.4251717 -0.28661552
## DiastolicBP 0.39802629 0.78700648 1.00000000 0.4238241 -0.25753832
## BS 0.47328434 0.42517166 0.42382407 1.0000000 -0.10349336
## BodyTemp -0.25532314 -0.28661552 -0.25753832 -0.1034934 1.00000000
## HeartRate 0.07979763 -0.02310796 -0.04615057 0.1428672 0.09877104
## HeartRate
## Age 0.07979763
## SystolicBP -0.02310796
## DiastolicBP -0.04615057
## BS 0.14286723
## BodyTemp 0.09877104
## HeartRate 1.00000000
corrplot(cor_matrix,
method = "color",
type = "upper",
col = colorRampPalette(c("blue","white","red"))(200),
addCoef.col = "black",
tl.col = "black",
tl.srt = 45)
#### PENJELASAN : #### Warna merah pada heatmap menunjukkan korelasi
yang positif, sedangkan warna biru menunjukkan korelasi yang negatif.
Hubungan Systolic BP dan Diastolic BP paling kuat, dengan warna paling
jelas. Tidak perlu membaca seluruh matriks untuk menemukan pola hubungan
dengan visualisasi ini.
str(data_features)
## 'data.frame': 1014 obs. of 6 variables:
## $ Age : int 25 35 29 30 35 23 23 35 32 42 ...
## $ SystolicBP : int 130 140 90 140 120 140 130 85 120 130 ...
## $ DiastolicBP: int 80 90 70 85 60 80 70 60 90 80 ...
## $ BS : num 15 13 8 7 6.1 7.01 7.01 11 6.9 18 ...
## $ BodyTemp : num 98 98 100 98 98 98 98 102 98 98 ...
## $ HeartRate : int 86 70 80 70 76 70 78 86 70 70 ...
cov_matrix <- cov(data_features)
cov_matrix
## Age SystolicBP DiastolicBP BS BodyTemp HeartRate
## Age 181.559065 103.171539 74.471739 21.0035619 -4.7180044 8.697168
## SystolicBP 103.171539 338.704005 201.121845 25.7712999 -7.2338429 -3.439938
## DiastolicBP 74.471739 201.121845 192.815323 19.3828770 -4.9042413 -5.183543
## BS 21.003562 25.771300 19.382877 10.8473512 -0.4674483 3.806040
## BodyTemp -4.718004 -7.233843 -4.904241 -0.4674483 1.8806951 1.095640
## HeartRate 8.697168 -3.439938 -5.183543 3.8060397 1.0956395 65.427104
corrplot(cov_matrix,
method = "color",
type = "upper",
addCoef.col = "black",
tl.col = "black",
tl.srt = 45,
col = colorRampPalette(c("navy","white","darkred"))(200),
is.corr = FALSE)
#### PENJELASAN : #### Heatmap menunjukkan besar kecilnya covariance
dengan gradasi warna. Nilai yang lebih besar ditampilkan oleh warna yang
lebih gelap. Dengan covariance tertinggi, kombinasi Systolic BP dan
Diastolic BP tampak paling menonjol. Karena nilainya kecil, hubungan
yang melibatkan BodyTemp cenderung lebih lemah. Visualisasi ini membantu
melihat pola dominasi hubungan antar variabel dengan cepat tanpa membaca
angka secara keseluruhan.
eigen_result <- eigen(cov_matrix)
eigen_result$values
## [1] 529.521825 136.772898 64.572037 51.358769 7.360073 1.647943
eigen_result$vectors
## [,1] [,2] [,3] [,4] [,5]
## [1,] -0.346411189 0.923900546 -0.13192259 0.042731491 0.08198705
## [2,] -0.764857940 -0.293487053 0.14910706 0.553048994 0.02349903
## [3,] -0.537978589 -0.186074547 -0.12389090 -0.811464330 0.04575582
## [4,] -0.072118241 0.069777475 0.04387199 -0.031191932 -0.99247862
## [5,] 0.018657383 -0.008883756 0.01905652 -0.008215683 -0.04608110
## [6,] 0.004638836 0.143880423 0.97094112 -0.181096759 0.05911889
## [,6]
## [1,] 0.021345781
## [2,] 0.014469639
## [3,] 0.006196148
## [4,] -0.044928412
## [5,] 0.998508320
## [6,] -0.016098692
plot(eigen_result$values,
type = "b",
pch = 13,
xlab = "Principal Component",
ylab = "Eigenvalue",
main = "Scree Plot - Eigenvalues")
#### PENJELASAN : #### Eigenvalue untuk setiap principal component (PC)
ditunjukkan pada scree plot. Terlihat bahwa PC1 memiliki eigenvalue
paling tinggi (sekitar 2.61), kemudian turun cukup tajam ke PC2 (sekitar
1.14), dan kemudian turun lebih lambat pada PC3 hingga PC6. Komponen
pertama dan kedua bertanggung jawab atas sebagian besar variasi data,
seperti yang ditunjukkan oleh pola “turun tajam lalu melandai” ini.
Secara umum, dua komponen utama sudah cukup mewakili struktur variasi
data, karena titik siku (elbow) terlihat setelah PC2.
barplot(eigen_result$vectors[,1],
names.arg = colnames(data_features),
las = 2,
main = "Loadings PC1")
#### PENJELASAN : #### Pengaruh masing-masing variabel terhadap komponen
utama pertama ditunjukkan dalam barplot loading PC1. Terlihat bahwa
SystolicBP dan DiastolicBP memiliki beban negatif paling besar (sekitar
-0,52), diikuti oleh usia dan BS, yang keduanya memiliki beban negatif
yang cukup besar. Sebaliknya, BodyTemp dan HeartRate memiliki beban
positif. Artinya, PC1 terutama dipengaruhi oleh tekanan darah (sistolik
dan diastolik) dan usia. Oleh karena itu, komponen pertama dapat
dianggap sebagai dimensi yang menunjukkan faktor tekanan darah dan usia
dalam kumpulan data.