TUGAS PCA DAN FA
Darista Wardhani/146 dan Royhan Jinan Ramadlani/167
2026-03-03
knitr::opts_chunk$set(echo = TRUE)
library(readxl)
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.0 ✔ readr 2.1.6
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.2 ✔ tibble 3.3.1
## ✔ lubridate 1.9.5 ✔ tidyr 1.3.2
## ✔ purrr 1.2.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(psych)##
## Attaching package: 'psych'
##
## The following objects are masked from 'package:ggplot2':
##
## %+%, alphalibrary(corrplot)## corrplot 0.95 loadedlibrary(GGally)data <- read_excel("parkinsons_dataset.xlsx")## New names:
## • `MDVP:Jitter` -> `MDVP:Jitter...4`
## • `MDVP:Jitter` -> `MDVP:Jitter...5`
## • `MDVP:Shimmer` -> `MDVP:Shimmer...9`
## • `MDVP:Shimmer` -> `MDVP:Shimmer...10`head(data)## # A tibble: 6 × 23
## `MDVP:Fo` `MDVP:Fhi` `MDVP:Flo` `MDVP:Jitter...4` `MDVP:Jitter...5` `MDVP:RAP`
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 120. 157. 75.0 0.00784 0.00784 0.0037
## 2 122. 149. 114. 0.00968 0.00968 0.00465
## 3 117. 131. 112. 0.0105 0.0105 0.00544
## 4 117. 138. 111. 0.00997 0.00997 0.00502
## 5 116. 142. 111. 0.0128 0.0128 0.00655
## 6 121. 131. 114. 0.00968 0.00968 0.00463
## # ℹ 17 more variables: `MDVP:PPQ` <dbl>, `Jitter:DDP` <dbl>,
## # `MDVP:Shimmer...9` <dbl>, `MDVP:Shimmer...10` <dbl>, `Shimmer:APQ3` <dbl>,
## # `Shimmer:APQ5` <dbl>, `MDVP:APQ` <dbl>, `Shimmer:DDA` <dbl>, NHR <dbl>,
## # HNR <dbl>, RPDE <dbl>, DFA <dbl>, spread1 <dbl>, spread2 <dbl>, D2 <dbl>,
## # PPE <dbl>, target <dbl># Struktur data
str(data)## tibble [195 × 23] (S3: tbl_df/tbl/data.frame)
## $ MDVP:Fo : num [1:195] 120 122 117 117 116 ...
## $ MDVP:Fhi : num [1:195] 157 149 131 138 142 ...
## $ MDVP:Flo : num [1:195] 75 114 112 111 111 ...
## $ MDVP:Jitter...4 : num [1:195] 0.00784 0.00968 0.0105 0.00997 0.01284 ...
## $ MDVP:Jitter...5 : num [1:195] 0.00784 0.00968 0.0105 0.00997 0.01284 ...
## $ MDVP:RAP : num [1:195] 0.0037 0.00465 0.00544 0.00502 0.00655 0.00463 0.00155 0.00144 0.00293 0.00268 ...
## $ MDVP:PPQ : num [1:195] 0.00554 0.00696 0.00781 0.00698 0.00908 0.0075 0.00202 0.00182 0.00332 0.00332 ...
## $ Jitter:DDP : num [1:195] 0.0111 0.0139 0.0163 0.015 0.0197 ...
## $ MDVP:Shimmer...9 : num [1:195] 0.0437 0.0613 0.0523 0.0549 0.0643 ...
## $ MDVP:Shimmer...10: num [1:195] 0.0437 0.0613 0.0523 0.0549 0.0643 ...
## $ Shimmer:APQ3 : num [1:195] 0.0218 0.0313 0.0276 0.0292 0.0349 ...
## $ Shimmer:APQ5 : num [1:195] 0.0313 0.0452 0.0386 0.0401 0.0483 ...
## $ MDVP:APQ : num [1:195] 0.0297 0.0437 0.0359 0.0377 0.0447 ...
## $ Shimmer:DDA : num [1:195] 0.0654 0.094 0.0827 0.0877 0.1047 ...
## $ NHR : num [1:195] 0.0221 0.0193 0.0131 0.0135 0.0177 ...
## $ HNR : num [1:195] 21 19.1 20.7 20.6 19.6 ...
## $ RPDE : num [1:195] 0.415 0.458 0.43 0.435 0.417 ...
## $ DFA : num [1:195] 0.815 0.82 0.825 0.819 0.823 ...
## $ spread1 : num [1:195] -4.81 -4.08 -4.44 -4.12 -3.75 ...
## $ spread2 : num [1:195] 0.266 0.336 0.311 0.334 0.235 ...
## $ D2 : num [1:195] 2.3 2.49 2.34 2.41 2.33 ...
## $ PPE : num [1:195] 0.285 0.369 0.333 0.369 0.41 ...
## $ target : num [1:195] 1 1 1 1 1 1 1 1 1 1 ...# Dimensi data
dim(data)## [1] 195 23str(data) digunakan untuk mengetahui tipe masing-masing variabel, sedangkan dim(data) digunakan untuk mengetahui jumlah baris (observasi) dan kolom (variabel).
summary(data)## MDVP:Fo MDVP:Fhi MDVP:Flo MDVP:Jitter...4
## Min. : 88.33 Min. :102.1 Min. : 65.48 Min. :0.001680
## 1st Qu.:117.57 1st Qu.:134.9 1st Qu.: 84.29 1st Qu.:0.003460
## Median :148.79 Median :175.8 Median :104.31 Median :0.004940
## Mean :154.23 Mean :197.1 Mean :116.32 Mean :0.006220
## 3rd Qu.:182.77 3rd Qu.:224.2 3rd Qu.:140.02 3rd Qu.:0.007365
## Max. :260.11 Max. :592.0 Max. :239.17 Max. :0.033160
## MDVP:Jitter...5 MDVP:RAP MDVP:PPQ Jitter:DDP
## Min. :0.001680 Min. :0.000680 Min. :0.000920 Min. :0.002040
## 1st Qu.:0.003460 1st Qu.:0.001660 1st Qu.:0.001860 1st Qu.:0.004985
## Median :0.004940 Median :0.002500 Median :0.002690 Median :0.007490
## Mean :0.006220 Mean :0.003306 Mean :0.003446 Mean :0.009920
## 3rd Qu.:0.007365 3rd Qu.:0.003835 3rd Qu.:0.003955 3rd Qu.:0.011505
## Max. :0.033160 Max. :0.021440 Max. :0.019580 Max. :0.064330
## MDVP:Shimmer...9 MDVP:Shimmer...10 Shimmer:APQ3 Shimmer:APQ5
## Min. :0.00954 Min. :0.00954 Min. :0.004550 Min. :0.00570
## 1st Qu.:0.01650 1st Qu.:0.01650 1st Qu.:0.008245 1st Qu.:0.00958
## Median :0.02297 Median :0.02297 Median :0.012790 Median :0.01347
## Mean :0.02971 Mean :0.02971 Mean :0.015664 Mean :0.01788
## 3rd Qu.:0.03789 3rd Qu.:0.03789 3rd Qu.:0.020265 3rd Qu.:0.02238
## Max. :0.11908 Max. :0.11908 Max. :0.056470 Max. :0.07940
## MDVP:APQ Shimmer:DDA NHR HNR
## Min. :0.00719 Min. :0.01364 Min. :0.000650 Min. : 8.441
## 1st Qu.:0.01308 1st Qu.:0.02474 1st Qu.:0.005925 1st Qu.:19.198
## Median :0.01826 Median :0.03836 Median :0.011660 Median :22.085
## Mean :0.02408 Mean :0.04699 Mean :0.024847 Mean :21.886
## 3rd Qu.:0.02940 3rd Qu.:0.06080 3rd Qu.:0.025640 3rd Qu.:25.076
## Max. :0.13778 Max. :0.16942 Max. :0.314820 Max. :33.047
## RPDE DFA spread1 spread2
## Min. :0.2566 Min. :0.5743 Min. :-7.965 Min. :0.006274
## 1st Qu.:0.4213 1st Qu.:0.6748 1st Qu.:-6.450 1st Qu.:0.174350
## Median :0.4960 Median :0.7223 Median :-5.721 Median :0.218885
## Mean :0.4985 Mean :0.7181 Mean :-5.684 Mean :0.226510
## 3rd Qu.:0.5876 3rd Qu.:0.7619 3rd Qu.:-5.046 3rd Qu.:0.279234
## Max. :0.6852 Max. :0.8253 Max. :-2.434 Max. :0.450493
## D2 PPE target
## Min. :1.423 Min. :0.04454 Min. :0.0000
## 1st Qu.:2.099 1st Qu.:0.13745 1st Qu.:1.0000
## Median :2.362 Median :0.19405 Median :1.0000
## Mean :2.382 Mean :0.20655 Mean :0.7538
## 3rd Qu.:2.636 3rd Qu.:0.25298 3rd Qu.:1.0000
## Max. :3.671 Max. :0.52737 Max. :1.0000Fungsi summary(data) digunakan untuk menampilkan ringkasan statistik setiap variabel, seperti nilai minimum, maksimum, median, mean, dan kuartil. Informasi ini berguna untuk mendeteksi kejanggalan nilai, sebaran data, serta indikasi awal adanya outlier.
colSums(is.na(data))## MDVP:Fo MDVP:Fhi MDVP:Flo MDVP:Jitter...4
## 0 0 0 0
## MDVP:Jitter...5 MDVP:RAP MDVP:PPQ Jitter:DDP
## 0 0 0 0
## MDVP:Shimmer...9 MDVP:Shimmer...10 Shimmer:APQ3 Shimmer:APQ5
## 0 0 0 0
## MDVP:APQ Shimmer:DDA NHR HNR
## 0 0 0 0
## RPDE DFA spread1 spread2
## 0 0 0 0
## D2 PPE target
## 0 0 0colSums(is.na(data)) digunakan untuk menghitung jumlah missing value pada setiap variabel. karena keberadaan nilai yang hilang dapat memengaruhi perhitungan matriks korelasi dan hasil PCA.
data_numeric <- data %>%
select(where(is.numeric))
colnames(data_numeric)## [1] "MDVP:Fo" "MDVP:Fhi" "MDVP:Flo"
## [4] "MDVP:Jitter...4" "MDVP:Jitter...5" "MDVP:RAP"
## [7] "MDVP:PPQ" "Jitter:DDP" "MDVP:Shimmer...9"
## [10] "MDVP:Shimmer...10" "Shimmer:APQ3" "Shimmer:APQ5"
## [13] "MDVP:APQ" "Shimmer:DDA" "NHR"
## [16] "HNR" "RPDE" "DFA"
## [19] "spread1" "spread2" "D2"
## [22] "PPE" "target"dim(data_numeric)## [1] 195 23pemilihan variabel numerik menggunakan select(where(is.numeric)) karena PCA hanya dapat diterapkan pada data numerik, sehingga pemisahan ini memastikan bahwa seluruh variabel yang dianalisis memenuhi syarat. Fungsi colnames() digunakan untuk menampilkan nama variabel numerik, dan dim() untuk memastikan ukuran data setelah seleksi.
EDA Awal
data_numeric %>%
pivot_longer(cols = everything()) %>%
ggplot(aes(x = value)) +
geom_histogram(bins = 30, fill = "skyblue", color = "black") +
facet_wrap(~ name, scales = "free") +
theme_minimal()
histogram dibuat untuk setiap variabel numerik menggunakan pivot_longer() dan geom_histogram(). Visualisasi ini bertujuan untuk melihat bentuk distribusi data, apakah cenderung simetris, menceng, atau memiliki nilai ekstrem. Penggunaan facet_wrap() memungkinkan setiap variabel ditampilkan dalam panel terpisah sehingga mudah dibandingkan.
cor_matrix <- cor(data_numeric)
corrplot(cor_matrix,
method = "color",
type = "upper",
tl.cex = 0.6,
tl.col = "black")
Matriks korelasi dihitung menggunakan fungsi cor() dan divisualisasikan dengan corrplot(). Visualisasi korelasi ini bertujuan untuk mengidentifikasi hubungan antarvariabel, terutama korelasi tinggi yang menjadi dasar kelayakan PCA dan deteksi multikolinearitas.
data_numeric %>%
pivot_longer(cols = everything()) %>%
ggplot(aes(y = value)) +
geom_boxplot(fill="lightblue") +
facet_wrap(~ name, scales="free") +
theme_minimal()
Boxplot kemudian dibuat untuk setiap variabel menggunakan geom_boxplot(). Visualisasi ini membantu mengidentifikasi sebaran data serta mendeteksi adanya outlier secara visual, meskipun outlier tidak langsung dihapus karena PCA relatif toleran terhadapnya.
Cleaning
data_numeric <- na.omit(data_numeric)dim(data_numeric)## [1] 195 23na.omit() digunakan untuk menghapus observasi yang memiliki nilai hilang. Metode ini dipilih karena sederhana dan tidak mengubah struktur varians data, selama jumlah observasi yang dihapus relatif kecil. Setelah itu, dim(data_numeric) digunakan untuk memastikan ukuran data setelah penghapusan nilai hilang.
apply(data_numeric, 2, var)## MDVP:Fo MDVP:Fhi MDVP:Flo MDVP:Jitter...4
## 1.713137e+03 8.370703e+03 1.894113e+03 2.350440e-05
## MDVP:Jitter...5 MDVP:RAP MDVP:PPQ Jitter:DDP
## 2.350440e-05 8.807685e-06 7.611952e-06 7.926954e-05
## MDVP:Shimmer...9 MDVP:Shimmer...10 Shimmer:APQ3 Shimmer:APQ5
## 3.555839e-04 3.555839e-04 1.030867e-04 1.445695e-04
## MDVP:APQ Shimmer:DDA NHR HNR
## 2.871919e-04 9.277580e-04 1.633651e-03 1.958739e+01
## RPDE DFA spread1 spread2
## 1.080388e-02 3.062054e-03 1.188553e+00 6.956521e-03
## D2 PPE target
## 1.465351e-01 8.121492e-03 1.865186e-01apply(data_numeric, 2, var) untuk memastikan tidak ada variabel dengan varians nol atau sangat kecil.
cor_matrix_final <- cor(data_numeric)
round(cor_matrix_final, 3)## MDVP:Fo MDVP:Fhi MDVP:Flo MDVP:Jitter...4 MDVP:Jitter...5
## MDVP:Fo 1.000 0.401 0.597 -0.118 -0.118
## MDVP:Fhi 0.401 1.000 0.085 0.102 0.102
## MDVP:Flo 0.597 0.085 1.000 -0.140 -0.140
## MDVP:Jitter...4 -0.118 0.102 -0.140 1.000 1.000
## MDVP:Jitter...5 -0.118 0.102 -0.140 1.000 1.000
## MDVP:RAP -0.076 0.097 -0.101 0.990 0.990
## MDVP:PPQ -0.112 0.091 -0.096 0.974 0.974
## Jitter:DDP -0.076 0.097 -0.100 0.990 0.990
## MDVP:Shimmer...9 -0.098 0.002 -0.145 0.769 0.769
## MDVP:Shimmer...10 -0.098 0.002 -0.145 0.769 0.769
## Shimmer:APQ3 -0.095 -0.004 -0.151 0.747 0.747
## Shimmer:APQ5 -0.071 -0.010 -0.101 0.726 0.726
## MDVP:APQ -0.078 0.005 -0.107 0.758 0.758
## Shimmer:DDA -0.095 -0.004 -0.151 0.747 0.747
## NHR -0.022 0.164 -0.109 0.907 0.907
## HNR 0.059 -0.025 0.211 -0.728 -0.728
## RPDE -0.384 -0.112 -0.400 0.361 0.361
## DFA -0.446 -0.343 -0.050 0.099 0.099
## spread1 -0.414 -0.077 -0.395 0.694 0.694
## spread2 -0.249 -0.003 -0.244 0.385 0.385
## D2 0.178 0.176 -0.101 0.433 0.433
## PPE -0.372 -0.070 -0.340 0.722 0.722
## target -0.384 -0.166 -0.380 0.278 0.278
## MDVP:RAP MDVP:PPQ Jitter:DDP MDVP:Shimmer...9
## MDVP:Fo -0.076 -0.112 -0.076 -0.098
## MDVP:Fhi 0.097 0.091 0.097 0.002
## MDVP:Flo -0.101 -0.096 -0.100 -0.145
## MDVP:Jitter...4 0.990 0.974 0.990 0.769
## MDVP:Jitter...5 0.990 0.974 0.990 0.769
## MDVP:RAP 1.000 0.957 1.000 0.760
## MDVP:PPQ 0.957 1.000 0.957 0.798
## Jitter:DDP 1.000 0.957 1.000 0.760
## MDVP:Shimmer...9 0.760 0.798 0.760 1.000
## MDVP:Shimmer...10 0.760 0.798 0.760 1.000
## Shimmer:APQ3 0.745 0.764 0.745 0.988
## Shimmer:APQ5 0.710 0.787 0.710 0.983
## MDVP:APQ 0.737 0.804 0.737 0.950
## Shimmer:DDA 0.745 0.764 0.745 0.988
## NHR 0.920 0.845 0.920 0.722
## HNR -0.722 -0.732 -0.721 -0.835
## RPDE 0.342 0.333 0.342 0.447
## DFA 0.064 0.196 0.064 0.160
## spread1 0.648 0.716 0.648 0.655
## spread2 0.324 0.408 0.324 0.452
## D2 0.427 0.413 0.427 0.507
## PPE 0.671 0.770 0.671 0.694
## target 0.267 0.289 0.267 0.367
## MDVP:Shimmer...10 Shimmer:APQ3 Shimmer:APQ5 MDVP:APQ
## MDVP:Fo -0.098 -0.095 -0.071 -0.078
## MDVP:Fhi 0.002 -0.004 -0.010 0.005
## MDVP:Flo -0.145 -0.151 -0.101 -0.107
## MDVP:Jitter...4 0.769 0.747 0.726 0.758
## MDVP:Jitter...5 0.769 0.747 0.726 0.758
## MDVP:RAP 0.760 0.745 0.710 0.737
## MDVP:PPQ 0.798 0.764 0.787 0.804
## Jitter:DDP 0.760 0.745 0.710 0.737
## MDVP:Shimmer...9 1.000 0.988 0.983 0.950
## MDVP:Shimmer...10 1.000 0.988 0.983 0.950
## Shimmer:APQ3 0.988 1.000 0.960 0.897
## Shimmer:APQ5 0.983 0.960 1.000 0.949
## MDVP:APQ 0.950 0.897 0.949 1.000
## Shimmer:DDA 0.988 1.000 0.960 0.897
## NHR 0.722 0.716 0.658 0.694
## HNR -0.835 -0.827 -0.814 -0.800
## RPDE 0.447 0.435 0.400 0.451
## DFA 0.160 0.151 0.214 0.157
## spread1 0.655 0.611 0.647 0.673
## spread2 0.452 0.402 0.457 0.502
## D2 0.507 0.467 0.502 0.537
## PPE 0.694 0.645 0.702 0.722
## target 0.367 0.348 0.351 0.364
## Shimmer:DDA NHR HNR RPDE DFA spread1 spread2
## MDVP:Fo -0.095 -0.022 0.059 -0.384 -0.446 -0.414 -0.249
## MDVP:Fhi -0.004 0.164 -0.025 -0.112 -0.343 -0.077 -0.003
## MDVP:Flo -0.151 -0.109 0.211 -0.400 -0.050 -0.395 -0.244
## MDVP:Jitter...4 0.747 0.907 -0.728 0.361 0.099 0.694 0.385
## MDVP:Jitter...5 0.747 0.907 -0.728 0.361 0.099 0.694 0.385
## MDVP:RAP 0.745 0.920 -0.722 0.342 0.064 0.648 0.324
## MDVP:PPQ 0.764 0.845 -0.732 0.333 0.196 0.716 0.408
## Jitter:DDP 0.745 0.920 -0.721 0.342 0.064 0.648 0.324
## MDVP:Shimmer...9 0.988 0.722 -0.835 0.447 0.160 0.655 0.452
## MDVP:Shimmer...10 0.988 0.722 -0.835 0.447 0.160 0.655 0.452
## Shimmer:APQ3 1.000 0.716 -0.827 0.435 0.151 0.611 0.402
## Shimmer:APQ5 0.960 0.658 -0.814 0.400 0.214 0.647 0.457
## MDVP:APQ 0.897 0.694 -0.800 0.451 0.157 0.673 0.502
## Shimmer:DDA 1.000 0.716 -0.827 0.435 0.151 0.611 0.402
## NHR 0.716 1.000 -0.714 0.371 -0.132 0.541 0.318
## HNR -0.827 -0.714 1.000 -0.599 -0.009 -0.673 -0.432
## RPDE 0.435 0.371 -0.599 1.000 -0.111 0.591 0.480
## DFA 0.151 -0.132 -0.009 -0.111 1.000 0.196 0.167
## spread1 0.611 0.541 -0.673 0.591 0.196 1.000 0.652
## spread2 0.402 0.318 -0.432 0.480 0.167 0.652 1.000
## D2 0.467 0.471 -0.601 0.237 -0.165 0.495 0.524
## PPE 0.645 0.553 -0.693 0.546 0.270 0.962 0.645
## target 0.348 0.189 -0.362 0.309 0.232 0.565 0.455
## D2 PPE target
## MDVP:Fo 0.178 -0.372 -0.384
## MDVP:Fhi 0.176 -0.070 -0.166
## MDVP:Flo -0.101 -0.340 -0.380
## MDVP:Jitter...4 0.433 0.722 0.278
## MDVP:Jitter...5 0.433 0.722 0.278
## MDVP:RAP 0.427 0.671 0.267
## MDVP:PPQ 0.413 0.770 0.289
## Jitter:DDP 0.427 0.671 0.267
## MDVP:Shimmer...9 0.507 0.694 0.367
## MDVP:Shimmer...10 0.507 0.694 0.367
## Shimmer:APQ3 0.467 0.645 0.348
## Shimmer:APQ5 0.502 0.702 0.351
## MDVP:APQ 0.537 0.722 0.364
## Shimmer:DDA 0.467 0.645 0.348
## NHR 0.471 0.553 0.189
## HNR -0.601 -0.693 -0.362
## RPDE 0.237 0.546 0.309
## DFA -0.165 0.270 0.232
## spread1 0.495 0.962 0.565
## spread2 0.524 0.645 0.455
## D2 1.000 0.481 0.340
## PPE 0.481 1.000 0.531
## target 0.340 0.531 1.000Output matriks korelasi menunjukkan hubungan linear antar seluruh variabel numerik. Terlihat bahwa banyak variabel memiliki korelasi sangat tinggi (mendekati 1), khususnya pada kelompok variabel Jitter (MDVP:Jitter…4, MDVP:Jitter…5, MDVP:RAP, Jitter:DDP) dan Shimmer (MDVP:Shimmer…9, MDVP:Shimmer…10, Shimmer:APQ3, Shimmer:DDA). Korelasi sebesar 1.000 menunjukkan adanya duplikasi informasi sempurna, yang menyebabkan matriks korelasi menjadi singular (tidak dapat diinvers). Selain itu, variabel seperti spread1 dan PPE juga menunjukkan korelasi yang sangat tinggi (0.962), menandakan redundansi informasi. Kondisi ini menjadi indikasi awal adanya multikolinearitas ekstrem.
Uji KMO dan Bartlett
kmo_result <- KMO(data_numeric)## Error in solve.default(r) :
## Lapack routine dgesv: system is exactly singular: U[22,22] = 0## matrix is not invertible, image not foundkmo_result## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = data_numeric)
## Overall MSA = 0.5
## MSA for each item =
## MDVP:Fo MDVP:Fhi MDVP:Flo MDVP:Jitter...4
## 0.5 0.5 0.5 0.5
## MDVP:Jitter...5 MDVP:RAP MDVP:PPQ Jitter:DDP
## 0.5 0.5 0.5 0.5
## MDVP:Shimmer...9 MDVP:Shimmer...10 Shimmer:APQ3 Shimmer:APQ5
## 0.5 0.5 0.5 0.5
## MDVP:APQ Shimmer:DDA NHR HNR
## 0.5 0.5 0.5 0.5
## RPDE DFA spread1 spread2
## 0.5 0.5 0.5 0.5
## D2 PPE target
## 0.5 0.5 0.5KMO(data_numeric) dijalankan, muncul error “matrix is not invertible”. Hal ini terjadi karena adanya korelasi sempurna atau hampir sempurna antarvariabel, sehingga matriks korelasi tidak dapat diinvers. Meskipun demikian, output tetap menampilkan nilai Overall MSA = 0.5, yang menunjukkan kelayakan data berada pada batas minimum. Nilai MSA tiap variabel juga bernilai 0.5, yang menandakan bahwa struktur korelasi masih lemah dan PCA belum optimal dilakukan pada data ini tanpa perbaikan.
bartlett_result <- cortest.bartlett(cor_matrix_final,
n = nrow(data_numeric))
bartlett_result## $chisq
## [1] Inf
##
## $p.value
## [1] 0
##
## $df
## [1] 253Hasil uji Bartlett menunjukkan nilai chi-square = ∞ (infinite) dengan p-value = 0, yang menandakan bahwa matriks korelasi secara signifikan berbeda dari matriks identitas. Namun, nilai chi-square yang tidak terbatas ini muncul akibat masalah singularitas matriks. Artinya, meskipun terdapat korelasi antarvariabel, struktur korelasi tersebut tidak stabil untuk analisis PCA pada tahap ini.
Mendeteksi Multikolinearitas tinggi
cor_matrix <- cor(data_numeric)
which(abs(cor_matrix) > 0.9 & abs(cor_matrix) < 1, arr.ind = TRUE)## row col
## MDVP:RAP 6 4
## MDVP:PPQ 7 4
## Jitter:DDP 8 4
## NHR 15 4
## MDVP:RAP 6 5
## MDVP:PPQ 7 5
## Jitter:DDP 8 5
## NHR 15 5
## MDVP:Jitter...4 4 6
## MDVP:Jitter...5 5 6
## MDVP:PPQ 7 6
## Jitter:DDP 8 6
## NHR 15 6
## MDVP:Jitter...4 4 7
## MDVP:Jitter...5 5 7
## MDVP:RAP 6 7
## Jitter:DDP 8 7
## MDVP:Jitter...4 4 8
## MDVP:Jitter...5 5 8
## MDVP:RAP 6 8
## MDVP:PPQ 7 8
## NHR 15 8
## Shimmer:APQ3 11 9
## Shimmer:APQ5 12 9
## MDVP:APQ 13 9
## Shimmer:DDA 14 9
## Shimmer:APQ3 11 10
## Shimmer:APQ5 12 10
## MDVP:APQ 13 10
## Shimmer:DDA 14 10
## MDVP:Shimmer...9 9 11
## MDVP:Shimmer...10 10 11
## Shimmer:APQ5 12 11
## Shimmer:DDA 14 11
## MDVP:Shimmer...9 9 12
## MDVP:Shimmer...10 10 12
## Shimmer:APQ3 11 12
## MDVP:APQ 13 12
## Shimmer:DDA 14 12
## MDVP:Shimmer...9 9 13
## MDVP:Shimmer...10 10 13
## Shimmer:APQ5 12 13
## MDVP:Shimmer...9 9 14
## MDVP:Shimmer...10 10 14
## Shimmer:APQ3 11 14
## Shimmer:APQ5 12 14
## MDVP:Jitter...4 4 15
## MDVP:Jitter...5 5 15
## MDVP:RAP 6 15
## Jitter:DDP 8 15
## PPE 22 19
## spread1 19 22Output dari fungsi which(abs(cor_matrix) > 0.9 & abs(cor_matrix) < 1) menampilkan banyak pasangan variabel yang memiliki korelasi lebih dari 0.9. Hal ini mengonfirmasi adanya multikolinearitas ekstrem, terutama pada kelompok Jitter dan Shimmer. Temuan ini menjelaskan mengapa uji KMO gagal dan memperkuat alasan perlunya seleksi variabel sebelum PCA.
colnames(data_numeric)## [1] "MDVP:Fo" "MDVP:Fhi" "MDVP:Flo"
## [4] "MDVP:Jitter...4" "MDVP:Jitter...5" "MDVP:RAP"
## [7] "MDVP:PPQ" "Jitter:DDP" "MDVP:Shimmer...9"
## [10] "MDVP:Shimmer...10" "Shimmer:APQ3" "Shimmer:APQ5"
## [13] "MDVP:APQ" "Shimmer:DDA" "NHR"
## [16] "HNR" "RPDE" "DFA"
## [19] "spread1" "spread2" "D2"
## [22] "PPE" "target"Korelasi Setelah memilih beberapa variabel
data_selected <- data_numeric %>%
select(
`MDVP:Fo`,
`MDVP:Fhi`,
`MDVP:Flo`,
`MDVP:Jitter...4`,
`MDVP:RAP`,
NHR,
`MDVP:Shimmer...9`,
`Shimmer:APQ3`,
HNR,
RPDE,
DFA,
spread1,
D2,
PPE
)KMO(data_selected)## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = data_selected)
## Overall MSA = 0.8
## MSA for each item =
## MDVP:Fo MDVP:Fhi MDVP:Flo MDVP:Jitter...4
## 0.57 0.65 0.65 0.80
## MDVP:RAP NHR MDVP:Shimmer...9 Shimmer:APQ3
## 0.80 0.91 0.80 0.78
## HNR RPDE DFA spread1
## 0.91 0.79 0.42 0.81
## D2 PPE
## 0.78 0.82cor_matrix2 <- cor(data_selected)
cortest.bartlett(cor_matrix2, n = nrow(data_selected))## $chisq
## [1] 3730.203
##
## $p.value
## [1] 0
##
## $df
## [1] 91Setelah memilih 14 variabel yang lebih representatif dan mengurangi redundansi, dilakukan kembali uji KMO. Hasilnya menunjukkan Overall MSA = 0.8, yang tergolong baik dan menandakan bahwa data sudah layak untuk PCA. Nilai MSA per variabel sebagian besar berada di atas 0.7, meskipun variabel DFA memiliki nilai relatif rendah (0.42), yang menunjukkan kontribusinya terhadap struktur faktor relatif lemah namun masih dapat dipertahankan.
Standarisasi
data_scaled <- scale(data_selected)
data_scaled <- as.data.frame(data_scaled)
# Verifikasi
apply(data_scaled, 2, mean)## MDVP:Fo MDVP:Fhi MDVP:Flo MDVP:Jitter...4
## 3.538725e-17 1.154964e-16 1.104969e-16 8.340399e-18
## MDVP:RAP NHR MDVP:Shimmer...9 Shimmer:APQ3
## -6.980941e-19 -2.407346e-18 4.124861e-17 9.951614e-17
## HNR RPDE DFA spread1
## 3.984957e-17 -9.771886e-17 6.390702e-16 3.789404e-16
## D2 PPE
## 5.612591e-16 5.388207e-18apply(data_scaled, 2, sd)## MDVP:Fo MDVP:Fhi MDVP:Flo MDVP:Jitter...4
## 1 1 1 1
## MDVP:RAP NHR MDVP:Shimmer...9 Shimmer:APQ3
## 1 1 1 1
## HNR RPDE DFA spread1
## 1 1 1 1
## D2 PPE
## 1 1Output hasil pengecekan mean menunjukkan nilai yang sangat mendekati nol, sedangkan standar deviasi seluruh variabel bernilai satu. Hal ini membuktikan bahwa proses standardisasi berhasil.
PCA
matrix korelasi dan eigenvalue
# Matriks korelasi
cor_matrix <- cor(data_scaled)
# Eigenvalue
eigen_result <- eigen(cor_matrix)
eigen_values <- eigen_result$values
eigen_values## [1] 6.983828661 2.324704014 1.290673724 0.835885960 0.767218606 0.560734648
## [7] 0.527141078 0.268566474 0.217816676 0.119798769 0.058456740 0.030054688
## [13] 0.009818755 0.005301209Nilai eigen menunjukkan bahwa tiga komponen pertama memiliki eigenvalue > 1, yaitu sekitar 6.98, 2.32, dan 1.29. Ini berarti ketiga komponen tersebut menjelaskan varians yang lebih besar dibandingkan satu variabel asli, sehingga layak dipertahankan menurut kriteria Kaiser.
n_components <- sum(eigen_values > 1)
n_components## [1] 3scree plot
plot(eigen_values,
type = "b",
pch = 19,
xlab = "Komponen",
ylab = "Eigenvalue",
main = "Scree Plot")
abline(h = 1, col = "red", lty = 2)
Scree plot memperlihatkan penurunan tajam eigenvalue dari PC1 ke PC3, kemudian melandai setelahnya. Pola ini mengindikasikan adanya titik siku (elbow) pada komponen ke-3, yang memperkuat keputusan untuk mempertahankan tiga komponen utama.
library(psych)
fa.parallel(data_scaled, fa = "pc", n.iter = 100)
## Parallel analysis suggests that the number of factors = NA and the number of components = 2Hasil parallel analysis menyarankan dua komponen utama, yang lebih konservatif dibandingkan kriteria Kaiser. Perbedaan ini umum terjadi dan menunjukkan bahwa secara statistik ketat, dua komponen sudah cukup, namun tiga komponen masih dapat dipertahankan untuk menjaga informasi tambahan.
pca_result <- prcomp(data_scaled,
center = FALSE,
scale. = FALSE)summary(pca_result)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.6427 1.5247 1.13608 0.91427 0.8759 0.74882 0.72604
## Proportion of Variance 0.4988 0.1661 0.09219 0.05971 0.0548 0.04005 0.03765
## Cumulative Proportion 0.4988 0.6649 0.75709 0.81679 0.8716 0.91165 0.94930
## PC8 PC9 PC10 PC11 PC12 PC13 PC14
## Standard deviation 0.51823 0.46671 0.34612 0.24178 0.17336 0.09909 0.07281
## Proportion of Variance 0.01918 0.01556 0.00856 0.00418 0.00215 0.00070 0.00038
## Cumulative Proportion 0.96848 0.98404 0.99260 0.99677 0.99892 0.99962 1.00000Ringkasan PCA menunjukkan bahwa PC1 menjelaskan 49.9% varians, PC2 menjelaskan 16.6%, dan PC3 menjelaskan 9.2%. Secara kumulatif, ketiga komponen tersebut menjelaskan sekitar 75.7% varians total, yang merupakan hasil yang baik dalam reduksi dimensi.
# Ambil loading PCA
loadings <- pca_result$rotation[, 1:n_components]
# Hitung communalities (h2)
h2 <- rowSums(loadings^2)
pc_table <- data.frame(
Variable = rownames(loadings),
round(loadings, 3),
h2 = round(h2, 3)
)
pc_table## Variable PC1 PC2 PC3 h2
## MDVP:Fo MDVP:Fo 0.091 0.571 -0.065 0.339
## MDVP:Fhi MDVP:Fhi -0.005 0.404 0.277 0.239
## MDVP:Flo MDVP:Flo 0.116 0.371 -0.475 0.376
## MDVP:Jitter...4 MDVP:Jitter...4 -0.341 0.106 -0.158 0.152
## MDVP:RAP MDVP:RAP -0.334 0.136 -0.170 0.159
## NHR NHR -0.316 0.206 -0.031 0.144
## MDVP:Shimmer...9 MDVP:Shimmer...9 -0.340 0.064 -0.162 0.146
## Shimmer:APQ3 Shimmer:APQ3 -0.332 0.066 -0.167 0.142
## HNR HNR 0.337 -0.078 -0.059 0.123
## RPDE RPDE -0.225 -0.192 0.424 0.267
## DFA DFA -0.043 -0.374 -0.594 0.495
## spread1 spread1 -0.322 -0.184 0.099 0.147
## D2 D2 -0.222 0.220 0.196 0.136
## PPE PPE -0.326 -0.167 0.009 0.134Tabel loading menunjukkan kontribusi masing-masing variabel terhadap setiap komponen. PC1 didominasi oleh variabel Jitter, Shimmer, NHR, dan HNR, sedangkan PC2 lebih dipengaruhi oleh variabel frekuensi (MDVP:Fo, MDVP:Fhi, MDVP:Flo). PC3 terutama dipengaruhi oleh variabel nonlinier seperti DFA dan RPDE. Nilai communality (h²) menunjukkan proporsi varians setiap variabel yang berhasil dijelaskan oleh tiga komponen utama, dengan nilai tertinggi pada variabel DFA.
importance <- summary(pca_result)$importance
round(importance[, 1:n_components], 3)## PC1 PC2 PC3
## Standard deviation 2.643 1.525 1.136
## Proportion of Variance 0.499 0.166 0.092
## Cumulative Proportion 0.499 0.665 0.757scores <- as.data.frame(pca_result$x[, 1:n_components])
head(scores)## PC1 PC2 PC3
## 1 -1.224799 -1.698307 -1.239611
## 2 -2.833640 -1.429951 -1.785067
## 3 -2.164274 -1.606432 -2.041774
## 4 -2.456567 -1.641508 -1.876906
## 5 -3.476575 -1.577141 -2.317853
## 6 -1.731965 -1.793448 -2.006584plot(scores$PC1,
scores$PC2,
xlab = "PC1",
ylab = "PC2",
main = "Plot PC1 vs PC2",
pch = 19,
col = "blue")
Plot PC1 dan PC2 memperlihatkan sebaran observasi berdasarkan dua komponen utama pertama yang menjelaskan sekitar 66% varians total. Plot ini membantu mengidentifikasi pola, kelompok, atau potensi pemisahan antarobservasi berdasarkan karakteristik utama data.
Factor Analysis
FA Manual
R <- cor(data_scaled)
round(R, 3)## MDVP:Fo MDVP:Fhi MDVP:Flo MDVP:Jitter...4 MDVP:RAP NHR
## MDVP:Fo 1.000 0.401 0.597 -0.118 -0.076 -0.022
## MDVP:Fhi 0.401 1.000 0.085 0.102 0.097 0.164
## MDVP:Flo 0.597 0.085 1.000 -0.140 -0.101 -0.109
## MDVP:Jitter...4 -0.118 0.102 -0.140 1.000 0.990 0.907
## MDVP:RAP -0.076 0.097 -0.101 0.990 1.000 0.920
## NHR -0.022 0.164 -0.109 0.907 0.920 1.000
## MDVP:Shimmer...9 -0.098 0.002 -0.145 0.769 0.760 0.722
## Shimmer:APQ3 -0.095 -0.004 -0.151 0.747 0.745 0.716
## HNR 0.059 -0.025 0.211 -0.728 -0.722 -0.714
## RPDE -0.384 -0.112 -0.400 0.361 0.342 0.371
## DFA -0.446 -0.343 -0.050 0.099 0.064 -0.132
## spread1 -0.414 -0.077 -0.395 0.694 0.648 0.541
## D2 0.178 0.176 -0.101 0.433 0.427 0.471
## PPE -0.372 -0.070 -0.340 0.722 0.671 0.553
## MDVP:Shimmer...9 Shimmer:APQ3 HNR RPDE DFA spread1
## MDVP:Fo -0.098 -0.095 0.059 -0.384 -0.446 -0.414
## MDVP:Fhi 0.002 -0.004 -0.025 -0.112 -0.343 -0.077
## MDVP:Flo -0.145 -0.151 0.211 -0.400 -0.050 -0.395
## MDVP:Jitter...4 0.769 0.747 -0.728 0.361 0.099 0.694
## MDVP:RAP 0.760 0.745 -0.722 0.342 0.064 0.648
## NHR 0.722 0.716 -0.714 0.371 -0.132 0.541
## MDVP:Shimmer...9 1.000 0.988 -0.835 0.447 0.160 0.655
## Shimmer:APQ3 0.988 1.000 -0.827 0.435 0.151 0.611
## HNR -0.835 -0.827 1.000 -0.599 -0.009 -0.673
## RPDE 0.447 0.435 -0.599 1.000 -0.111 0.591
## DFA 0.160 0.151 -0.009 -0.111 1.000 0.196
## spread1 0.655 0.611 -0.673 0.591 0.196 1.000
## D2 0.507 0.467 -0.601 0.237 -0.165 0.495
## PPE 0.694 0.645 -0.693 0.546 0.270 0.962
## D2 PPE
## MDVP:Fo 0.178 -0.372
## MDVP:Fhi 0.176 -0.070
## MDVP:Flo -0.101 -0.340
## MDVP:Jitter...4 0.433 0.722
## MDVP:RAP 0.427 0.671
## NHR 0.471 0.553
## MDVP:Shimmer...9 0.507 0.694
## Shimmer:APQ3 0.467 0.645
## HNR -0.601 -0.693
## RPDE 0.237 0.546
## DFA -0.165 0.270
## spread1 0.495 0.962
## D2 1.000 0.481
## PPE 0.481 1.000Pada output diatas terlihat bahwa variabel gangguan suara seperti MDVP:Jitter, MDVP:RAP, NHR, MDVP:Shimmer, Shimmer:APQ3, spread1, dan PPE memiliki korelasi yang sangat tinggi (di atas 0,7). Hal ini menunjukkan bahwa variabel-variabel tersebut cenderung mengukur dimensi yang sama. Selain itu, HNR memiliki korelasi negatif yang kuat terhadap jitter dan shimmer, yang berarti ketika gangguan suara meningkat, nilai HNR menurun.
# Factor Analysis
eigen_result <- eigen(R)
cat("Eigenvalue:\n")## Eigenvalue:eigen_result$values## [1] 6.983828661 2.324704014 1.290673724 0.835885960 0.767218606 0.560734648
## [7] 0.527141078 0.268566474 0.217816676 0.119798769 0.058456740 0.030054688
## [13] 0.009818755 0.005301209cat("Eigenvector:\n")## Eigenvector:eigen_result$vectors## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.091038821 -0.57097689 0.064964952 0.24964246 0.06423131
## [2,] -0.005420219 -0.40350034 -0.276520195 -0.52506374 0.41414205
## [3,] 0.115675326 -0.37081407 0.474987197 0.27441586 -0.10135801
## [4,] -0.340800371 -0.10588450 0.157619269 -0.30732038 -0.10560689
## [5,] -0.333826220 -0.13593780 0.169597817 -0.29563645 -0.16300268
## [6,] -0.316157166 -0.20642905 0.030739319 -0.26765568 -0.27766502
## [7,] -0.340172475 -0.06403024 0.162418591 0.15850761 -0.04852590
## [8,] -0.331760695 -0.06581191 0.166873244 0.14968736 -0.10282372
## [9,] 0.336655885 0.07804727 0.059198713 -0.25629079 0.05835749
## [10,] -0.225464796 0.19170430 -0.424097496 0.24230414 -0.33800422
## [11,] -0.042571661 0.37392472 0.594425136 -0.06321664 0.37052556
## [12,] -0.321555432 0.18408269 -0.098700456 0.02573087 0.27472257
## [13,] -0.221884791 -0.22022783 -0.195965381 0.39504809 0.51517756
## [14,] -0.326135629 0.16699344 -0.008719855 0.02340323 0.30086073
## [,6] [,7] [,8] [,9] [,10] [,11]
## [1,] -0.003687217 -0.04327519 -0.36552456 0.583099433 0.30657121 -0.14102976
## [2,] -0.380466744 -0.36857818 0.14373429 -0.093449781 -0.05205870 0.01680559
## [3,] 0.257076448 -0.52303225 0.22732852 -0.354264569 -0.13943929 0.03301346
## [4,] 0.212763829 0.03870889 0.02304286 0.142093665 0.08359961 0.36891380
## [5,] 0.215294979 0.06969986 0.05438592 0.145198130 0.09398974 0.41694781
## [6,] 0.159706422 0.18340310 0.24165425 -0.060064534 0.03801930 -0.75930455
## [7,] -0.398776343 0.05117515 -0.19364752 -0.278233076 0.15857984 0.04302211
## [8,] -0.466175476 0.08606183 -0.19891404 -0.270288879 0.12143222 0.01716305
## [9,] 0.204129188 0.01236481 -0.14864219 -0.378644031 0.77291715 -0.02826547
## [10,] -0.082994662 -0.49775993 0.33519942 0.178369808 0.39841483 0.03416733
## [11,] -0.227185351 -0.10099998 0.33811029 0.352042046 0.18450555 -0.14555754
## [12,] 0.303492463 -0.24362128 -0.32090391 -0.099198356 -0.03531205 -0.03628054
## [13,] 0.201940272 0.38334895 0.43270108 -0.146431303 0.17789006 0.10299875
## [14,] 0.250233744 -0.27252411 -0.34076531 0.002257011 -0.06024517 -0.23458088
## [,12] [,13] [,14]
## [1,] -0.073868520 -0.012226398 0.007001881
## [2,] -0.010848747 0.011376765 -0.015881544
## [3,] -0.003650318 0.011415316 0.020402920
## [4,] 0.136576455 -0.314090460 0.643677309
## [5,] -0.044583797 0.332978808 -0.597121674
## [6,] -0.086248082 -0.033060945 -0.009020738
## [7,] 0.111478523 -0.627817211 -0.340864688
## [8,] -0.109082614 0.593022595 0.329869178
## [9,] 0.034408093 0.034730349 0.009949658
## [10,] 0.024871774 0.011255703 0.011121254
## [11,] -0.091374399 -0.005202279 -0.008318646
## [12,] -0.706922672 -0.100034373 0.015840715
## [13,] 0.045486934 0.035528097 0.019998374
## [14,] 0.655778805 0.174673190 -0.048797281n_factors <- sum(eigen_result$values > 1)
n_factors## [1] 3Pada hasil eigenvalue menunjukkan nilai 6,98; 2,32; dan 1,29 sebagai tiga nilai terbesar yang melebihi 1. Berdasarkan kriteria Kaiser (eigenvalue > 1), maka dapat disimpulkan untuk mempertahankan tiga faktor. Nilai eigen pertama yang sangat besar (6,98) menunjukkan bahwa faktor pertama menjelaskan proporsi variasi terbesar dalam data. Secara keseluruhan, tiga faktor ini mampu menjelaskan sekitar 76% variasi total data, yang berarti sebagian besar informasi dari variabel asli telah diringkas secara efektif.
L_list <- list()
for (i in 1:n_factors) {
L_list[[i]] <- sqrt(eigen_result$values[i]) * eigen_result$vectors[, i]
}
L <- do.call(cbind, L_list)
colnames(L) <- paste0("Factor", 1:n_factors)
rownames(L) <- colnames(data_scaled)
cat("Factor Loading (Manual):\n")## Factor Loading (Manual):round(L, 3)## Factor1 Factor2 Factor3
## MDVP:Fo 0.241 -0.871 0.074
## MDVP:Fhi -0.014 -0.615 -0.314
## MDVP:Flo 0.306 -0.565 0.540
## MDVP:Jitter...4 -0.901 -0.161 0.179
## MDVP:RAP -0.882 -0.207 0.193
## NHR -0.836 -0.315 0.035
## MDVP:Shimmer...9 -0.899 -0.098 0.185
## Shimmer:APQ3 -0.877 -0.100 0.190
## HNR 0.890 0.119 0.067
## RPDE -0.596 0.292 -0.482
## DFA -0.113 0.570 0.675
## spread1 -0.850 0.281 -0.112
## D2 -0.586 -0.336 -0.223
## PPE -0.862 0.255 -0.010Hasil factor loading manual menunjukkan bahwa Faktor 1 memiliki loading sangat tinggi pada variabel jitter, RAP, shimmer, NHR, spread1, dan PPE, serta loading negatif pada HNR. Ini menunjukkan bahwa faktor pertama merepresentasikan dimensi gangguan kestabilan suara. Faktor 2 memiliki loading besar pada MDVP:Fo, MDVP:Fhi, dan MDVP:Flo, sehingga dapat diinterpretasikan sebagai dimensi frekuensi dasar suara. Faktor 3 memiliki loading tertinggi pada DFA dan RPDE, yang berkaitan dengan kompleksitas dan karakteristik nonlinear sinyal suara. Loading yang mendekati ±1 menunjukkan kontribusi yang sangat kuat terhadap faktor tersebut.
FA with function Principal
fa_none <- principal(data_scaled, nfactors = n_factors, rotate = "none", scores = TRUE)
print(fa_none)## Principal Components Analysis
## Call: principal(r = data_scaled, nfactors = n_factors, rotate = "none",
## scores = TRUE)
## Standardized loadings (pattern matrix) based upon correlation matrix
## PC1 PC2 PC3 h2 u2 com
## MDVP:Fo -0.24 0.87 0.07 0.82 0.18 1.2
## MDVP:Fhi 0.01 0.62 -0.31 0.48 0.52 1.5
## MDVP:Flo -0.31 0.57 0.54 0.70 0.30 2.5
## MDVP:Jitter...4 0.90 0.16 0.18 0.87 0.13 1.1
## MDVP:RAP 0.88 0.21 0.19 0.86 0.14 1.2
## NHR 0.84 0.31 0.03 0.80 0.20 1.3
## MDVP:Shimmer...9 0.90 0.10 0.18 0.85 0.15 1.1
## Shimmer:APQ3 0.88 0.10 0.19 0.81 0.19 1.1
## HNR -0.89 -0.12 0.07 0.81 0.19 1.0
## RPDE 0.60 -0.29 -0.48 0.67 0.33 2.4
## DFA 0.11 -0.57 0.68 0.79 0.21 2.0
## spread1 0.85 -0.28 -0.11 0.81 0.19 1.3
## D2 0.59 0.34 -0.22 0.51 0.49 1.9
## PPE 0.86 -0.25 -0.01 0.81 0.19 1.2
##
## PC1 PC2 PC3
## SS loadings 6.98 2.32 1.29
## Proportion Var 0.50 0.17 0.09
## Cumulative Var 0.50 0.66 0.76
## Proportion Explained 0.66 0.22 0.12
## Cumulative Proportion 0.66 0.88 1.00
##
## Mean item complexity = 1.5
## Test of the hypothesis that 3 components are sufficient.
##
## The root mean square of the residuals (RMSR) is 0.05
## with the empirical chi square 96.52 with prob < 0.00017
##
## Fit based upon off diagonal values = 0.99Pada output ini ditampilkan nilai loading yang sudah dihitung menggunakan fungsi principal. Nilai SS loadings menunjukkan jumlah variasi yang dijelaskan masing-masing komponen, yaitu 6,98; 2,32; dan 1,29. Proporsi varians kumulatif sebesar 0,76 berarti 76% variasi data dapat dijelaskan oleh tiga faktor. Nilai RMSR sebesar 0,05 menunjukkan residual error yang kecil, sehingga model dapat dikatakan memiliki kecocokan yang baik. Nilai fit sebesar 0,99 juga menunjukkan bahwa model sangat sesuai dengan data. Communality (h2) sebagian besar tinggi (di atas 0,7), yang berarti variabel-variabel cukup baik dijelaskan oleh faktor.
# Factor Analysis with rotation varimax
fa_varimax <- principal(data_scaled, nfactors = n_factors, rotate = "varimax", scores = TRUE)
print(fa_varimax)## Principal Components Analysis
## Call: principal(r = data_scaled, nfactors = n_factors, rotate = "varimax",
## scores = TRUE)
## Standardized loadings (pattern matrix) based upon correlation matrix
## RC1 RC3 RC2 h2 u2 com
## MDVP:Fo 0.00 -0.68 0.60 0.82 0.18 2.0
## MDVP:Fhi 0.09 -0.16 0.67 0.48 0.52 1.2
## MDVP:Flo -0.03 -0.84 0.06 0.70 0.30 1.0
## MDVP:Jitter...4 0.93 0.07 -0.02 0.87 0.13 1.0
## MDVP:RAP 0.93 0.02 0.00 0.86 0.14 1.0
## NHR 0.87 0.05 0.19 0.80 0.20 1.1
## MDVP:Shimmer...9 0.91 0.10 -0.07 0.85 0.15 1.0
## Shimmer:APQ3 0.89 0.09 -0.07 0.81 0.19 1.0
## HNR -0.85 -0.26 -0.11 0.81 0.19 1.2
## RPDE 0.38 0.72 0.10 0.67 0.33 1.6
## DFA 0.12 -0.08 -0.88 0.79 0.21 1.1
## spread1 0.71 0.54 -0.15 0.81 0.19 2.0
## D2 0.58 0.14 0.38 0.51 0.49 1.9
## PPE 0.75 0.45 -0.20 0.81 0.19 1.8
##
## RC1 RC3 RC2
## SS loadings 6.42 2.32 1.86
## Proportion Var 0.46 0.17 0.13
## Cumulative Var 0.46 0.62 0.76
## Proportion Explained 0.61 0.22 0.18
## Cumulative Proportion 0.61 0.82 1.00
##
## Mean item complexity = 1.3
## Test of the hypothesis that 3 components are sufficient.
##
## The root mean square of the residuals (RMSR) is 0.05
## with the empirical chi square 96.52 with prob < 0.00017
##
## Fit based upon off diagonal values = 0.99Setelah dilakukan rotasi varimax, struktur faktor menjadi lebih sederhana dan mudah diinterpretasikan. Faktor pertama (RC1) memiliki loading sangat tinggi pada jitter, RAP, shimmer, NHR, spread1, dan PPE, sehingga tetap merepresentasikan gangguan kestabilan suara. Faktor kedua (RC2) didominasi oleh DFA dengan loading sangat tinggi (-0,88), menunjukkan dimensi nonlinear scaling yang berdiri sendiri. Faktor ketiga (RC3) berkaitan dengan frekuensi dasar dan kompleksitas sinyal seperti Flo dan RPDE. Varians kumulatif tetap sebesar 76%, RMSR tetap 0,05, dan fit 0,99, yang menunjukkan model tetap sangat baik setelah rotasi.
cat("Communalities:\n")## Communalities:round(fa_varimax$communality, 3)## MDVP:Fo MDVP:Fhi MDVP:Flo MDVP:Jitter...4
## 0.821 0.477 0.704 0.869
## MDVP:RAP NHR MDVP:Shimmer...9 Shimmer:APQ3
## 0.858 0.798 0.852 0.815
## HNR RPDE DFA spread1
## 0.810 0.673 0.794 0.813
## D2 PPE
## 0.506 0.808Communality menunjukkan proporsi varians masing-masing variabel yang dapat dijelaskan oleh faktor. Sebagian besar nilai communalities berada di atas 0,7, yang berarti faktor mampu menjelaskan sebagian besar variasi variabel tersebut. Nilai terendah terdapat pada D2 (sekitar 0,50), yang berarti hanya sekitar 50% variasinya dijelaskan oleh faktor, namun masih dapat diterima.
scores_FA <- as.data.frame(fa_varimax$scores)
head(scores_FA)## RC1 RC3 RC2
## 1 0.4206147 0.09222119 -1.568643
## 2 1.1466952 -0.15548044 -1.777375
## 3 0.9314602 -0.32397861 -2.009523
## 4 0.9973320 -0.17130142 -1.930955
## 5 1.4602085 -0.34315701 -2.170984
## 6 0.7407270 -0.27846952 -2.075209FA tanpa DFA
data_scaled_no_dfa <- data_scaled[, !colnames(data_scaled) %in% c("DFA")]Nilai Overall MSA sebesar 0,81 menunjukkan bahwa data sangat layak untuk dilakukan analisis faktor meskipun variabel DFA dihapus. Nilai MSA per variabel sebagian besar di atas 0,7, meskipun MDVP:Fhi memiliki nilai lebih rendah (0,48) yang menunjukkan kecukupan sampel untuk variabel tersebut relatif lebih lemah dibanding variabel lainnya.
library(psych)
# KMO
KMO(data_scaled_no_dfa)## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = data_scaled_no_dfa)
## Overall MSA = 0.81
## MSA for each item =
## MDVP:Fo MDVP:Fhi MDVP:Flo MDVP:Jitter...4
## 0.63 0.48 0.69 0.80
## MDVP:RAP NHR MDVP:Shimmer...9 Shimmer:APQ3
## 0.80 0.94 0.80 0.78
## HNR RPDE spread1 D2
## 0.91 0.80 0.82 0.76
## PPE
## 0.82# Bartlett Test
R_no_dfa <- cor(data_scaled_no_dfa)
cortest.bartlett(R_no_dfa, n = nrow(data_scaled_no_dfa))## $chisq
## [1] 3558.988
##
## $p.value
## [1] 0
##
## $df
## [1] 78Nilai chi-square sebesar 3558,988 dengan p-value 0 menunjukkan bahwa matriks korelasi signifikan dan bukan matriks identitas. Artinya, antar variabel terdapat korelasi yang cukup untuk dilakukan analisis faktor.
eigen_result_no_dfa <- eigen(R_no_dfa)
eigen_values_no_dfa <- eigen_result_no_dfa$values
eigen_values_no_dfa## [1] 6.973124340 2.130681609 0.976393008 0.833789362 0.627359959 0.532282436
## [7] 0.435811002 0.243023734 0.132576948 0.066984225 0.032818083 0.009828364
## [13] 0.005326931# Jumlah faktor (Kaiser > 1)
n_factors_no_dfa <- sum(eigen_values_no_dfa > 1)
n_factors_no_dfa## [1] 2Setelah DFA dihapus, hanya terdapat dua eigenvalue yang lebih besar dari satu, yaitu 6,97 dan 2,13. Oleh karena itu, jumlah faktor yang dipertahankan hanya dua. Varians kumulatif yang dijelaskan menjadi 70%, lebih rendah dibandingkan model sebelumnya (76%), yang menunjukkan adanya penurunan kemampuan model dalam merangkum informasi.
plot(eigen_values_no_dfa,
type = "b",
pch = 19,
xlab = "Komponen",
ylab = "Eigenvalue",
main = "Scree Plot Tanpa DFA")
abline(h = 1, col = "red", lty = 2)
Pada model ini, faktor pertama menjelaskan 54% variasi, dan faktor kedua 16%, dengan total 70%. Nilai RMSR sebesar 0,06 sedikit lebih besar dibanding model dengan DFA (0,05), yang menunjukkan error sedikit meningkat meskipun masih tergolong baik. Fit tetap tinggi (0,99), sehingga model masih dapat diterima.
fa_none_no_dfa <- principal(data_scaled_no_dfa,
nfactors = n_factors_no_dfa,
rotate = "none",
scores = TRUE)
print(fa_none_no_dfa)## Principal Components Analysis
## Call: principal(r = data_scaled_no_dfa, nfactors = n_factors_no_dfa,
## rotate = "none", scores = TRUE)
## Standardized loadings (pattern matrix) based upon correlation matrix
## PC1 PC2 h2 u2 com
## MDVP:Fo -0.23 0.86 0.80 0.20 1.1
## MDVP:Fhi 0.02 0.56 0.31 0.69 1.0
## MDVP:Flo -0.30 0.67 0.55 0.45 1.4
## MDVP:Jitter...4 0.90 0.19 0.85 0.15 1.1
## MDVP:RAP 0.88 0.23 0.83 0.17 1.1
## NHR 0.84 0.29 0.79 0.21 1.2
## MDVP:Shimmer...9 0.90 0.13 0.82 0.18 1.0
## Shimmer:APQ3 0.88 0.14 0.79 0.21 1.0
## HNR -0.89 -0.09 0.80 0.20 1.0
## RPDE 0.60 -0.42 0.54 0.46 1.8
## spread1 0.85 -0.30 0.81 0.19 1.2
## D2 0.59 0.29 0.43 0.57 1.4
## PPE 0.86 -0.24 0.80 0.20 1.2
##
## PC1 PC2
## SS loadings 6.97 2.13
## Proportion Var 0.54 0.16
## Cumulative Var 0.54 0.70
## Proportion Explained 0.77 0.23
## Cumulative Proportion 0.77 1.00
##
## Mean item complexity = 1.2
## Test of the hypothesis that 2 components are sufficient.
##
## The root mean square of the residuals (RMSR) is 0.06
## with the empirical chi square 101.95 with prob < 6.2e-05
##
## Fit based upon off diagonal values = 0.99Setelah rotasi, faktor pertama tetap didominasi oleh variabel gangguan kestabilan suara seperti jitter, RAP, shimmer, dan NHR. Faktor kedua didominasi oleh variabel frekuensi dasar seperti Fo, Fhi, dan Flo. Namun, tidak ada lagi faktor ketiga yang merepresentasikan dimensi nonlinear karena variabel DFA telah dihapus. Struktur menjadi lebih sederhana tetapi kehilangan satu dimensi laten penting.
fa_varimax_no_dfa <- principal(data_scaled_no_dfa,
nfactors = n_factors_no_dfa,
rotate = "varimax",
scores = TRUE)
print(fa_varimax_no_dfa)## Principal Components Analysis
## Call: principal(r = data_scaled_no_dfa, nfactors = n_factors_no_dfa,
## rotate = "varimax", scores = TRUE)
## Standardized loadings (pattern matrix) based upon correlation matrix
## RC1 RC2 h2 u2 com
## MDVP:Fo -0.01 0.89 0.80 0.20 1.0
## MDVP:Fhi 0.16 0.53 0.31 0.69 1.2
## MDVP:Flo -0.12 0.73 0.55 0.45 1.1
## MDVP:Jitter...4 0.92 -0.05 0.85 0.15 1.0
## MDVP:RAP 0.91 0.00 0.83 0.17 1.0
## NHR 0.89 0.07 0.79 0.21 1.0
## MDVP:Shimmer...9 0.90 -0.10 0.82 0.18 1.0
## Shimmer:APQ3 0.88 -0.09 0.79 0.21 1.0
## HNR -0.89 0.14 0.80 0.20 1.0
## RPDE 0.47 -0.56 0.54 0.46 1.9
## spread1 0.74 -0.50 0.81 0.19 1.8
## D2 0.64 0.13 0.43 0.57 1.1
## PPE 0.77 -0.45 0.80 0.20 1.6
##
## RC1 RC2
## SS loadings 6.66 2.44
## Proportion Var 0.51 0.19
## Cumulative Var 0.51 0.70
## Proportion Explained 0.73 0.27
## Cumulative Proportion 0.73 1.00
##
## Mean item complexity = 1.2
## Test of the hypothesis that 2 components are sufficient.
##
## The root mean square of the residuals (RMSR) is 0.06
## with the empirical chi square 101.95 with prob < 6.2e-05
##
## Fit based upon off diagonal values = 0.99Nilai communalities sebagian besar tetap tinggi, namun beberapa variabel seperti D2 (0,43) dan RPDE (0,53) menunjukkan penurunan kemampuan faktor dalam menjelaskan variasinya. Hal ini menunjukkan bahwa penghapusan DFA sedikit mengurangi kekuatan model dalam menjelaskan beberapa variabel.
round(fa_varimax_no_dfa$communality, 3)## MDVP:Fo MDVP:Fhi MDVP:Flo MDVP:Jitter...4
## 0.796 0.312 0.546 0.847
## MDVP:RAP NHR MDVP:Shimmer...9 Shimmer:APQ3
## 0.833 0.788 0.824 0.786
## HNR RPDE spread1 D2
## 0.803 0.535 0.807 0.431
## PPE
## 0.796scores_FA_no_dfa <- as.data.frame(fa_varimax_no_dfa$scores)
head(scores_FA_no_dfa)## RC1 RC2
## 1 0.2414280 -0.7864874
## 2 0.8952044 -0.6911097
## 3 0.6295221 -0.6958576
## 4 0.7225793 -0.7841011
## 5 1.1217692 -0.7790116
## 6 0.4379155 -0.7794609