Implementasi PCA & FA pada Laporan Keuangan McDonalds tahun 2002-2022
Naufal Shalih & Muhammad Nadhif Fathoni
2026-02-22
Dataset: McDonalds Financial Statements
Link Dataset: https://www.kaggle.com/datasets/mikhail1681/mcdonalds-financial-statements-2002-2022
# Import Data
data <- read.csv("McDonalds_Financial_Statements.csv")
#head(data)
names(data)## [1] "Year" "Market.cap...B."
## [3] "Revenue...B." "Earnings...B."
## [5] "P.E.ratio" "P.S.ratio"
## [7] "P.B.ratio" "Operating.Margin...."
## [9] "EPS...." "Shares.Outstanding...B."
## [11] "Cash.on.Hand...B." "Dividend.Yield...."
## [13] "Dividend..stock.split.adjusted....." "Net.assets...B."
## [15] "Total.assets...B." "Total.debt...B."
## [17] "Total.liabilities...B."Dataset yang kami ambil untuk dijadikan bahan penelitian PCA dan FA yaitu Laporan Keuangan McDonalds tahun 2002-2022 dengan berisikan 21 observasi (baris data) dan 17 variabel bersifat numerik kontinu yang tentunya mendukung dataset untuk dilakukan penelitian PCA dan FA. Adapun variabel Year pada dataset ini berfungsi sebagai penanda waktu dan tidak akan kami gunakan dalam analisis multivariat.
library("psych")
library("vctrs")
library("dplyr")##
## Attaching package: 'dplyr'## The following object is masked from 'package:vctrs':
##
## data_frame## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary("corrplot")## corrplot 0.95 loaded# Standarisasi nama variabel
colnames(data) <- paste0("X", 1:ncol(data))
# Hapus variabel 'Year'
data_pca <- data [-1]
str(data_pca)## 'data.frame': 21 obs. of 16 variables:
## $ X2 : num 193 200 160 147 136 ...
## $ X3 : num 23.2 23.2 19.2 21.3 21 ...
## $ X4 : num 7.82 9.12 6.14 8.01 7.81 8.57 6.86 6.55 7.37 8.2 ...
## $ X5 : num 31.3 26.5 33.8 24.8 23.2 26.7 22 24.2 19.2 17.3 ...
## $ X6 : num 8.33 8.63 8.32 6.93 6.48 6.01 4.11 4.22 3.29 3.42 ...
## $ X7 : num -32.2 -43.5 -20.4 -18 -21.8 -42 -45.9 15.1 7.02 6 ...
## $ X8 : num 33.8 39.3 32 38 37.2 ...
## $ X9 : num 8.42 10.11 6.35 7.98 7.65 ...
## $ X10: num 0.73 0.74 0.74 0.74 0.76 0.79 0.81 0.9 0.96 0.99 ...
## $ X11: num 2.58 4.7 3.44 0.89 0.86 2.46 1.22 7.68 2.07 2.79 ...
## $ X12: num 2.15 1.96 2.35 2.39 2.36 2.23 2.97 2.91 3.5 3.22 ...
## $ X13: num 5.66 5.25 5.04 4.73 4.19 3.83 3.61 3.44 3.28 3.12 ...
## $ X14: num -6.01 -4.61 -7.83 -8.22 -6.26 ...
## $ X15: num 50.4 53.6 52.6 47.5 32.8 ...
## $ X16: num 48 48.6 48.5 46.9 31.1 ...
## $ X17: num 56.4 58.2 60.5 55.7 39.1 ...#Pre-processing
cat("misssing value:", sum(is.na(data_pca)))## misssing value: 0# Assumptions
# 1. Correlation
cor(data_pca)## X2 X3 X4 X5 X6 X7
## X2 1.00000000 0.295814134 0.7835900 0.6445175 0.97427395 -0.70410546
## X3 0.29581413 1.000000000 0.7224537 -0.2361473 0.09360057 0.09782630
## X4 0.78359001 0.722453664 1.0000000 0.1313240 0.66162587 -0.43278413
## X5 0.64451750 -0.236147309 0.1313240 1.0000000 0.72124372 -0.57937631
## X6 0.97427395 0.093600567 0.6616259 0.7212437 1.00000000 -0.73675161
## X7 -0.70410546 0.097826305 -0.4327841 -0.5793763 -0.73675161 1.00000000
## X8 0.87682817 0.455022896 0.9386283 0.2937782 0.82463055 -0.59773641
## X9 0.95586296 0.417322935 0.8945832 0.4206212 0.90124145 -0.66099870
## X10 -0.93783543 -0.337207446 -0.8182852 -0.5898843 -0.91020985 0.71880786
## X11 0.32033121 0.356948392 0.2719384 0.1540625 0.25321289 0.07546795
## X12 0.09822181 0.831201477 0.5490708 -0.3088139 -0.04445342 0.22792745
## X13 0.96992780 0.375619874 0.8211278 0.6059756 0.93393160 -0.66383287
## X14 -0.80926040 0.182582330 -0.4482283 -0.7448273 -0.88287884 0.84675509
## X15 0.90517221 0.188553068 0.6140843 0.6294108 0.90822461 -0.52492153
## X16 0.91957973 -0.030306133 0.5515636 0.7534015 0.96441902 -0.75665173
## X17 0.92659993 -0.005331058 0.5717085 0.7471648 0.96977312 -0.75050179
## X8 X9 X10 X11 X12 X13
## X2 0.8768282 0.9558630 -0.9378354 0.32033121 0.09822181 0.9699278
## X3 0.4550229 0.4173229 -0.3372074 0.35694839 0.83120148 0.3756199
## X4 0.9386283 0.8945832 -0.8182852 0.27193843 0.54907078 0.8211278
## X5 0.2937782 0.4206212 -0.5898843 0.15406253 -0.30881386 0.6059756
## X6 0.8246305 0.9012414 -0.9102099 0.25321289 -0.04445342 0.9339316
## X7 -0.5977364 -0.6609987 0.7188079 0.07546795 0.22792745 -0.6638329
## X8 1.0000000 0.9548084 -0.9022749 0.20138656 0.33651963 0.8888641
## X9 0.9548084 1.0000000 -0.9339015 0.25514434 0.23685503 0.9503267
## X10 -0.9022749 -0.9339015 1.0000000 -0.23831236 -0.24387122 -0.9799122
## X11 0.2013866 0.2551443 -0.2383124 1.00000000 0.19270393 0.2907289
## X12 0.3365196 0.2368550 -0.2438712 0.19270393 1.00000000 0.2636309
## X13 0.8888641 0.9503267 -0.9799122 0.29072894 0.26363087 1.0000000
## X14 -0.6739585 -0.7384590 0.8546215 -0.03468226 0.22087151 -0.8059165
## X15 0.7142596 0.8302356 -0.7986038 0.41140936 0.04613261 0.8785405
## X16 0.7352795 0.8378675 -0.8854187 0.22258444 -0.13328785 0.8991597
## X17 0.7511744 0.8477262 -0.8969413 0.23309491 -0.10082927 0.9108918
## X14 X15 X16 X17
## X2 -0.80926040 0.90517221 0.91957973 0.926599934
## X3 0.18258233 0.18855307 -0.03030613 -0.005331058
## X4 -0.44822828 0.61408432 0.55156356 0.571708501
## X5 -0.74482731 0.62941077 0.75340149 0.747164830
## X6 -0.88287884 0.90822461 0.96441902 0.969773117
## X7 0.84675509 -0.52492153 -0.75665173 -0.750501792
## X8 -0.67395845 0.71425964 0.73527948 0.751174388
## X9 -0.73845900 0.83023562 0.83786746 0.847726160
## X10 0.85462152 -0.79860377 -0.88541870 -0.896941295
## X11 -0.03468226 0.41140936 0.22258444 0.233094913
## X12 0.22087151 0.04613261 -0.13328785 -0.100829266
## X13 -0.80591647 0.87854048 0.89915971 0.910891759
## X14 1.00000000 -0.70299610 -0.93437626 -0.929448988
## X15 -0.70299610 1.00000000 0.90796855 0.915794303
## X16 -0.93437626 0.90796855 1.00000000 0.998719433
## X17 -0.92944899 0.91579430 0.99871943 1.000000000# corrplot
corrplot::corrplot(cor(data_pca), tl.col = "black", tl.srt = 45, tl.cex = 0.5)
Berdasarkan visualisasi dari heatmap berikut, kami memutuskan untuk menghapus Variabel Net Assets (X14) karena mempresentasikan variabel Total Assets (X15) dan Total Liabilities (X17).
# Hapus Variabel yang dirasa tidak dibutuhkan
names(data_pca)## [1] "X2" "X3" "X4" "X5" "X6" "X7" "X8" "X9" "X10" "X11" "X12" "X13"
## [13] "X14" "X15" "X16" "X17"data_pca <- subset(data_pca, select = -c(X14))
names(data_pca)## [1] "X2" "X3" "X4" "X5" "X6" "X7" "X8" "X9" "X10" "X11" "X12" "X13"
## [13] "X15" "X16" "X17"# 2. Check MSA (Measure of Sampling Adequacy)
r <- cor(data_pca)
KMO(r)## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = r)
## Overall MSA = 0.7
## MSA for each item =
## X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X15 X16 X17
## 0.70 0.60 0.65 0.70 0.69 0.69 0.68 0.85 0.78 0.31 0.40 0.80 0.75 0.69 0.71# Delete satu-satu variabel dengan nilai korelasi dibawah 0.5
data_pca = data_pca[-10]
# Korelasi hasil delete data pertama
r <- cor(data_pca)
KMO(r)## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = r)
## Overall MSA = 0.7
## MSA for each item =
## X2 X3 X4 X5 X6 X7 X8 X9 X10 X12 X13 X15 X16 X17
## 0.73 0.62 0.63 0.68 0.68 0.68 0.65 0.90 0.74 0.35 0.77 0.71 0.67 0.67# Korelasi hasil delete data kedua
data_pca = data_pca[-10]
r <- cor(data_pca)
KMO(r)## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = r)
## Overall MSA = 0.71
## MSA for each item =
## X2 X3 X4 X5 X6 X7 X8 X9 X10 X13 X15 X16 X17
## 0.68 0.73 0.71 0.80 0.66 0.67 0.70 0.91 0.70 0.81 0.67 0.64 0.64# 3. Bartlett Test
bartlett.test(data_pca)##
## Bartlett test of homogeneity of variances
##
## data: data_pca
## Bartlett's K-squared = 609.88, df = 12, p-value < 2.2e-16# PCA
# 1. Scaling Data
scale_data <- scale(data_pca)
r = cov(scale_data)
head(r)## X2 X3 X4 X5 X6 X7
## X2 1.0000000 0.29581413 0.7835900 0.6445175 0.97427395 -0.7041055
## X3 0.2958141 1.00000000 0.7224537 -0.2361473 0.09360057 0.0978263
## X4 0.7835900 0.72245366 1.0000000 0.1313240 0.66162587 -0.4327841
## X5 0.6445175 -0.23614731 0.1313240 1.0000000 0.72124372 -0.5793763
## X6 0.9742739 0.09360057 0.6616259 0.7212437 1.00000000 -0.7367516
## X7 -0.7041055 0.09782630 -0.4327841 -0.5793763 -0.73675161 1.0000000
## X8 X9 X10 X13 X15 X16
## X2 0.8768282 0.9558630 -0.9378354 0.9699278 0.9051722 0.91957973
## X3 0.4550229 0.4173229 -0.3372074 0.3756199 0.1885531 -0.03030613
## X4 0.9386283 0.8945832 -0.8182852 0.8211278 0.6140843 0.55156356
## X5 0.2937782 0.4206212 -0.5898843 0.6059756 0.6294108 0.75340149
## X6 0.8246305 0.9012414 -0.9102099 0.9339316 0.9082246 0.96441902
## X7 -0.5977364 -0.6609987 0.7188079 -0.6638329 -0.5249215 -0.75665173
## X17
## X2 0.926599934
## X3 -0.005331058
## X4 0.571708501
## X5 0.747164830
## X6 0.969773117
## X7 -0.750501792# 2. Cari eigen value dan eigen vector
pc <- eigen(r)
print(pc$values)## [1] 9.797874e+00 2.015243e+00 5.484317e-01 3.482071e-01 1.484601e-01
## [6] 8.475861e-02 2.972770e-02 1.361096e-02 7.585633e-03 3.164357e-03
## [11] 2.444905e-03 4.406689e-04 5.185293e-05print(pc$vectors)## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] -0.31597767 0.01087155 0.07744527 0.01867105 -0.06998563 -0.37997087
## [2,] -0.08600826 0.62666805 0.26462568 0.47442193 -0.34454023 0.07317548
## [3,] -0.25164947 0.42337180 -0.10700582 0.01100091 0.15765912 -0.14446494
## [4,] -0.20431652 -0.43061944 0.34357530 0.61848758 0.28202314 -0.25609534
## [5,] -0.31099057 -0.12086942 0.04836457 -0.10902181 0.08042165 -0.35591989
## [6,] 0.23652468 0.21597430 0.71822891 -0.33605915 0.48378611 0.04680312
## [7,] -0.28590829 0.24193541 -0.23437846 -0.22127112 0.39931786 -0.20773278
## [8,] -0.30619970 0.15965582 -0.10117611 -0.16645474 -0.03244269 -0.16212077
## [9,] 0.30966203 -0.05829061 0.08204191 -0.16413789 -0.31563949 -0.53713558
## [10,] -0.31419506 0.06621936 0.09998987 0.09658405 0.08096959 0.31178289
## [11,] -0.28697269 -0.06970290 0.43457461 -0.32211187 -0.50663327 -0.03975089
## [12,] -0.30082873 -0.21389263 0.04639837 -0.16025454 -0.07125748 0.29327323
## [13,] -0.30342507 -0.19703753 0.05816128 -0.15725911 -0.05511273 0.30363541
## [,7] [,8] [,9] [,10] [,11]
## [1,] 0.3576713529 -0.03401014 0.17216911 0.56344965 0.059576370
## [2,] 0.0101027225 -0.14304865 0.32971599 -0.19413471 0.106065590
## [3,] -0.3394395099 0.39222080 -0.17594060 0.45495031 -0.128743706
## [4,] -0.1925208672 0.23835392 -0.04368120 -0.17626020 0.006860275
## [5,] 0.1829133104 -0.57701556 0.12331408 -0.05314009 -0.171251601
## [6,] 0.1412146230 0.05885235 0.08697720 0.02811256 0.003718094
## [7,] -0.4258850734 -0.19177922 0.12556301 -0.33684340 0.286804449
## [8,] 0.5197275666 0.49560694 -0.10906588 -0.51032644 -0.164987234
## [9,] -0.0587857218 0.14633987 -0.05877186 -0.07321332 0.585290362
## [10,] 0.2233480400 -0.22189668 -0.65419178 0.04699892 0.486505836
## [11,] -0.3926432388 -0.03169833 -0.27851101 -0.07459457 -0.249822122
## [12,] 0.0006755337 0.27424706 0.43072819 0.11673853 0.433434909
## [13,] -0.0853387820 0.04522010 0.28953931 -0.05016679 -0.015184808
## [,12] [,13]
## [1,] -0.447259509 0.254212670
## [2,] 0.050037013 0.002165032
## [3,] 0.413915159 -0.072382050
## [4,] -0.013385367 0.007077740
## [5,] 0.501080511 -0.276515281
## [6,] 0.019478114 0.015145595
## [7,] -0.339111985 0.092634943
## [8,] 0.002083037 -0.013257186
## [9,] 0.283104684 0.149993588
## [10,] 0.067510267 0.057109832
## [11,] -0.226589217 -0.099295721
## [12,] 0.019006865 -0.531260040
## [13,] 0.350824909 0.725795026# 3. Hitung proporsi varians dan kumulatif
sumvar <- sum(pc$values)
propvar <- sapply(pc$values, function(x) x/sumvar)*100
cumvar <- data.frame(cbind(pc$values, propvar)) %>% mutate(cum = cumsum(propvar))
colnames(cumvar)[1] <- "eigen_value"
row.names(cumvar) <- paste0("PC",c(1:ncol(scale_data)))
print(cumvar)## eigen_value propvar cum
## PC1 9.797874e+00 7.536826e+01 75.36826
## PC2 2.015243e+00 1.550187e+01 90.87013
## PC3 5.484317e-01 4.218705e+00 95.08883
## PC4 3.482071e-01 2.678516e+00 97.76735
## PC5 1.484601e-01 1.142001e+00 98.90935
## PC6 8.475861e-02 6.519893e-01 99.56134
## PC7 2.972770e-02 2.286747e-01 99.79001
## PC8 1.361096e-02 1.046997e-01 99.89471
## PC9 7.585633e-03 5.835102e-02 99.95306
## PC10 3.164357e-03 2.434121e-02 99.97740
## PC11 2.444905e-03 1.880696e-02 99.99621
## PC12 4.406689e-04 3.389760e-03 99.99960
## PC13 5.185293e-05 3.988687e-04 100.00000Berdasarkan output diatas, maka kami ambil 2 PC dengan threshold > 1 (kriteria kaiser) yang dimana kedua PC tersebut mampu menjelaskan 90.87% total variansi data sehingga bisa dikatakan reduksi dimensi yang dilakukan dianggap representatif dalam menggambarkan keseluruhan data
# 4. Hasil PCA
hasil <- as.matrix(scale_data) %*% pc$vectors
hasil_pca <- hasil[,1:2]
colnames(hasil_pca) <- paste("PC", 1:2, sep = "")
head(hasil_pca)## PC1 PC2
## 1 -5.206876 -1.05885877
## 2 -5.855698 -0.37740390
## 3 -4.364093 -2.46401128
## 4 -4.060517 -0.54011427
## 5 -2.581093 -0.05648151
## 6 -2.750592 -0.10168101#install.packages('FactoMineR')
library('FactoMineR')# Sumber: https://rpubs.com/cahyaalkahfi/pca-with-r
# Hitung Eigen Value, Proporsi, dan Cumulative Variance
hasil_pca <- PCA(scale_data,
scale.unit = TRUE,
graph = FALSE,
ncp=ncol(scale_data))
hasil_pca$eig ## eigenvalue percentage of variance cumulative percentage of variance
## comp 1 9.797874e+00 7.536826e+01 75.36826
## comp 2 2.015243e+00 1.550187e+01 90.87013
## comp 3 5.484317e-01 4.218705e+00 95.08883
## comp 4 3.482071e-01 2.678516e+00 97.76735
## comp 5 1.484601e-01 1.142001e+00 98.90935
## comp 6 8.475861e-02 6.519893e-01 99.56134
## comp 7 2.972770e-02 2.286747e-01 99.79001
## comp 8 1.361096e-02 1.046997e-01 99.89471
## comp 9 7.585633e-03 5.835102e-02 99.95306
## comp 10 3.164357e-03 2.434121e-02 99.97740
## comp 11 2.444905e-03 1.880696e-02 99.99621
## comp 12 4.406689e-04 3.389760e-03 99.99960
## comp 13 5.185293e-05 3.988687e-04 100.00000# Hitung eigen vector
hasil_pca$svd$V ## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 0.31597767 0.01087155 0.07744527 -0.01867105 -0.06998563 0.37997087
## [2,] 0.08600826 0.62666805 0.26462568 -0.47442193 -0.34454023 -0.07317548
## [3,] 0.25164947 0.42337180 -0.10700582 -0.01100091 0.15765912 0.14446494
## [4,] 0.20431652 -0.43061944 0.34357530 -0.61848758 0.28202314 0.25609534
## [5,] 0.31099057 -0.12086942 0.04836457 0.10902181 0.08042165 0.35591989
## [6,] -0.23652468 0.21597430 0.71822891 0.33605915 0.48378611 -0.04680312
## [7,] 0.28590829 0.24193541 -0.23437846 0.22127112 0.39931786 0.20773278
## [8,] 0.30619970 0.15965582 -0.10117611 0.16645474 -0.03244269 0.16212077
## [9,] -0.30966203 -0.05829061 0.08204191 0.16413789 -0.31563949 0.53713558
## [10,] 0.31419506 0.06621936 0.09998987 -0.09658405 0.08096959 -0.31178289
## [11,] 0.28697269 -0.06970290 0.43457461 0.32211187 -0.50663327 0.03975089
## [12,] 0.30082873 -0.21389263 0.04639837 0.16025454 -0.07125748 -0.29327323
## [13,] 0.30342507 -0.19703753 0.05816128 0.15725911 -0.05511273 -0.30363541
## [,7] [,8] [,9] [,10] [,11]
## [1,] -0.3576713529 -0.03401014 0.17216911 -0.56344965 0.059576370
## [2,] -0.0101027225 -0.14304865 0.32971599 0.19413471 0.106065590
## [3,] 0.3394395099 0.39222080 -0.17594060 -0.45495031 -0.128743706
## [4,] 0.1925208672 0.23835392 -0.04368120 0.17626020 0.006860275
## [5,] -0.1829133104 -0.57701556 0.12331408 0.05314009 -0.171251601
## [6,] -0.1412146230 0.05885235 0.08697720 -0.02811256 0.003718094
## [7,] 0.4258850734 -0.19177922 0.12556301 0.33684340 0.286804449
## [8,] -0.5197275666 0.49560694 -0.10906588 0.51032644 -0.164987234
## [9,] 0.0587857218 0.14633987 -0.05877186 0.07321332 0.585290362
## [10,] -0.2233480400 -0.22189668 -0.65419178 -0.04699892 0.486505836
## [11,] 0.3926432388 -0.03169833 -0.27851101 0.07459457 -0.249822122
## [12,] -0.0006755337 0.27424706 0.43072819 -0.11673853 0.433434909
## [13,] 0.0853387820 0.04522010 0.28953931 0.05016679 -0.015184808
## [,12] [,13]
## [1,] -0.447259509 0.254212670
## [2,] 0.050037013 0.002165032
## [3,] 0.413915159 -0.072382050
## [4,] -0.013385367 0.007077740
## [5,] 0.501080511 -0.276515281
## [6,] 0.019478114 0.015145595
## [7,] -0.339111985 0.092634943
## [8,] 0.002083037 -0.013257186
## [9,] 0.283104684 0.149993588
## [10,] 0.067510267 0.057109832
## [11,] -0.226589217 -0.099295721
## [12,] 0.019006865 -0.531260040
## [13,] 0.350824909 0.725795026# Hasil PCA
hasil_pca$ind$coord[, 1:2]## Dim.1 Dim.2
## 1 5.33546067 -1.08500737
## 2 6.00030520 -0.38672392
## 3 4.47186470 -2.52486023
## 4 4.16079137 -0.55345244
## 5 2.64483354 -0.05787633
## 6 2.81851855 -0.10419204
## 7 1.27062882 0.08705456
## 8 0.45078026 0.55419074
## 9 -0.30469422 1.73433400
## 10 -0.05330974 2.25916343
## 11 -0.33968591 2.22102940
## 12 -0.33563035 1.93087790
## 13 -1.08006146 1.32074243
## 14 -1.66589359 1.06777223
## 15 -1.94052331 0.98264194
## 16 -2.49563155 -1.15274739
## 17 -3.15531322 -0.19792456
## 18 -3.42461197 -0.51927880
## 19 -3.69030310 -0.99277185
## 20 -4.11772864 -1.94868984
## 21 -4.54979604 -2.63428187Visualisasi PCA
#install.packages("factoextra")
library(factoextra)## Loading required package: ggplot2##
## Attaching package: 'ggplot2'## The following objects are masked from 'package:psych':
##
## %+%, alpha## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBafviz_eig(hasil_pca,
addlabels = TRUE,
ncp = ncol(scale_data),
barfill = "lightgreen",
barcolor = "darkblue",
linecolor = "red")## Warning in geom_bar(stat = "identity", fill = barfill, color = barcolor, :
## Ignoring empty aesthetic: `width`.
#Biplot
fviz_pca_biplot(hasil_pca,
geom.ind = "point",
addEllipses = TRUE)
# correlation circle
contrib_circle <- fviz_pca_var(hasil_pca,
col.var = "contrib",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE) + ggtitle("Kontribusi Variabel")## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## ℹ The deprecated feature was likely used in the factoextra package.
## Please report the issue at <https://github.com/kassambara/factoextra/issues>.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## ℹ The deprecated feature was likely used in the factoextra package.
## Please report the issue at <https://github.com/kassambara/factoextra/issues>.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.plot(contrib_circle)
# Kontribusi variabel di setiap PC
contrib_v_PC1 <- fviz_contrib(hasil_pca, choice = "var", axes = 1, top = 10) + ggtitle("PC1")
plot(contrib_v_PC1)
contrib_v_PC2 <- fviz_contrib(hasil_pca, choice = "var", axes = 2, top = 10) + ggtitle("PC2")
plot(contrib_v_PC2)
Factor Analysis (FA)
# Factor Analysis
# 1. Cari eigen value dan eigen vector
varcov = cov(scale_data)
pc = eigen(varcov)
pc$values## [1] 9.797874e+00 2.015243e+00 5.484317e-01 3.482071e-01 1.484601e-01
## [6] 8.475861e-02 2.972770e-02 1.361096e-02 7.585633e-03 3.164357e-03
## [11] 2.444905e-03 4.406689e-04 5.185293e-05pc$vectors## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] -0.31597767 0.01087155 0.07744527 0.01867105 -0.06998563 -0.37997087
## [2,] -0.08600826 0.62666805 0.26462568 0.47442193 -0.34454023 0.07317548
## [3,] -0.25164947 0.42337180 -0.10700582 0.01100091 0.15765912 -0.14446494
## [4,] -0.20431652 -0.43061944 0.34357530 0.61848758 0.28202314 -0.25609534
## [5,] -0.31099057 -0.12086942 0.04836457 -0.10902181 0.08042165 -0.35591989
## [6,] 0.23652468 0.21597430 0.71822891 -0.33605915 0.48378611 0.04680312
## [7,] -0.28590829 0.24193541 -0.23437846 -0.22127112 0.39931786 -0.20773278
## [8,] -0.30619970 0.15965582 -0.10117611 -0.16645474 -0.03244269 -0.16212077
## [9,] 0.30966203 -0.05829061 0.08204191 -0.16413789 -0.31563949 -0.53713558
## [10,] -0.31419506 0.06621936 0.09998987 0.09658405 0.08096959 0.31178289
## [11,] -0.28697269 -0.06970290 0.43457461 -0.32211187 -0.50663327 -0.03975089
## [12,] -0.30082873 -0.21389263 0.04639837 -0.16025454 -0.07125748 0.29327323
## [13,] -0.30342507 -0.19703753 0.05816128 -0.15725911 -0.05511273 0.30363541
## [,7] [,8] [,9] [,10] [,11]
## [1,] 0.3576713529 -0.03401014 0.17216911 0.56344965 0.059576370
## [2,] 0.0101027225 -0.14304865 0.32971599 -0.19413471 0.106065590
## [3,] -0.3394395099 0.39222080 -0.17594060 0.45495031 -0.128743706
## [4,] -0.1925208672 0.23835392 -0.04368120 -0.17626020 0.006860275
## [5,] 0.1829133104 -0.57701556 0.12331408 -0.05314009 -0.171251601
## [6,] 0.1412146230 0.05885235 0.08697720 0.02811256 0.003718094
## [7,] -0.4258850734 -0.19177922 0.12556301 -0.33684340 0.286804449
## [8,] 0.5197275666 0.49560694 -0.10906588 -0.51032644 -0.164987234
## [9,] -0.0587857218 0.14633987 -0.05877186 -0.07321332 0.585290362
## [10,] 0.2233480400 -0.22189668 -0.65419178 0.04699892 0.486505836
## [11,] -0.3926432388 -0.03169833 -0.27851101 -0.07459457 -0.249822122
## [12,] 0.0006755337 0.27424706 0.43072819 0.11673853 0.433434909
## [13,] -0.0853387820 0.04522010 0.28953931 -0.05016679 -0.015184808
## [,12] [,13]
## [1,] -0.447259509 0.254212670
## [2,] 0.050037013 0.002165032
## [3,] 0.413915159 -0.072382050
## [4,] -0.013385367 0.007077740
## [5,] 0.501080511 -0.276515281
## [6,] 0.019478114 0.015145595
## [7,] -0.339111985 0.092634943
## [8,] 0.002083037 -0.013257186
## [9,] 0.283104684 0.149993588
## [10,] 0.067510267 0.057109832
## [11,] -0.226589217 -0.099295721
## [12,] 0.019006865 -0.531260040
## [13,] 0.350824909 0.725795026sp = sum(pc$values[1:2])
L1 = sqrt(pc$values[1])*pc$vectors[,1]
L2 = sqrt(pc$values[2])*pc$vectors[,2]
L = cbind(L1,L2)
L## L1 L2
## [1,] -0.9890593 0.01543316
## [2,] -0.2692192 0.88961321
## [3,] -0.7877020 0.60101540
## [4,] -0.6395425 -0.61130409
## [5,] -0.9734489 -0.17158531
## [6,] 0.7403590 0.30659548
## [7,] -0.8949374 0.34344968
## [8,] -0.9584527 0.22664619
## [9,] 0.9692903 -0.08274891
## [10,] -0.9834794 0.09400450
## [11,] -0.8982692 -0.09894971
## [12,] -0.9416407 -0.30364035
## [13,] -0.9497677 -0.27971298rotasi <- varimax(L)
L_rotasi <- rotasi$loadings
L_rotasi##
## Loadings:
## L1 L2
## [1,] -0.845 0.514
## [2,] 0.218 0.904
## [3,] -0.375 0.917
## [4,] -0.861 -0.204
## [5,] -0.927 0.344
## [6,] 0.794 -0.110
## [7,] -0.598 0.749
## [8,] -0.712 0.680
## [9,] 0.794 -0.562
## [10,] -0.801 0.579
## [11,] -0.825 0.369
## [12,] -0.966 0.214
## [13,] -0.961 0.239
##
## L1 L2
## SS loadings 7.806 4.007
## Proportion Var 0.600 0.308
## Cumulative Var 0.600 0.909Setelah melakukan pengecekan pada loading awal, ternyata masih terdapat cross-loading pada variabel sehingga kami melakukan rotasi orthogonal varimax
library(GPArotation)##
## Attaching package: 'GPArotation'## The following objects are masked from 'package:psych':
##
## equamax, variminrot_oblimin <- oblimin(L)$loadings
rownames(rot_oblimin) <- colnames(scale_data)
rot_oblimin## L1 L2
## X2 -0.95186207 0.13807891
## X3 0.03046145 0.93516305
## X4 -0.56554757 0.70678172
## X5 -0.81866799 -0.54053601
## X6 -0.99791959 -0.05344167
## X7 0.81655881 0.21916068
## X8 -0.75352874 0.45895137
## X9 -0.85317756 0.34840538
## X10 0.91072152 -0.20387245
## X13 -0.92076848 0.21703914
## X15 -0.90142970 0.01088564
## X16 -1.01033127 -0.19124868
## X17 -1.01036907 -0.16598652Rotasi Oblimin merupakan metode rotasi terbaik setelah dilakukan beberapa percobaan pada metode lain untuk data yang kami gunakan penelitian
Visualisasi FA
library(psych)
hasil_fa <- fa(scale_data, nfactors = 2, rotate = "oblimin", fm = "pa")## Warning in log(det(m.inv.r)): NaNs produced## Warning in fac(r = r, nfactors = nfactors, n.obs = n.obs, rotate = rotate, : An
## ultra-Heywood case was detected. Examine the results carefullycolnames(hasil_fa$loadings) <- c("F1", "F2")
print(hasil_fa$loadings, cutoff = 0.3)##
## Loadings:
## F1 F2
## X2 0.920
## X3 0.871
## X4 0.433 0.798
## X5 0.845 -0.460
## X6 0.999
## X7 -0.785
## X8 0.666 0.508
## X9 0.785 0.405
## X10 -0.864
## X13 0.876
## X15 0.874
## X16 1.038
## X17 1.034
##
## F1 F2
## SS loadings 8.865 2.269
## Proportion Var 0.682 0.175
## Cumulative Var 0.682 0.856# Tampilkan diagram
fa.diagram(hasil_fa)