Tugas 1 Regresi Terapan

Principal Component Analysis (PCA)

Naftali Brigitta Gunawan

May 01, 2024


Kontak \(\downarrow\)
Email
Instagram https://www.instagram.com/nbrigittag/
RPubs https://rpubs.com/naftalibrigitta/
Nama Naftali Brigitta Gunawan
NIM 20214920002

Latar Belakang

Analisis regresi digunakan untuk membangun model yang menjelaskan atau meramalkan fenomena berdasarkan hubungan antara variabel independen (prediktor) dan variabel dependen.
Dalam statistika, model regresi dianggap baik jika tidak terdapat autokorelasi, heteroskedastisitas, dan multikolinearitas.
Multikolinearitas dapat terjadi ketika variabel prediktor berkorelasi kuat, bisa diatasi dengan mengeluarkan variabel yang tidak penting dengan menggunakan metode Analisis Komponen Utama (PCA) untuk menghilangkan korelasi.

Apa itu PCA Regression?

Secara sederhana, PCA Regression memiliki arti sebagai pendekatan statistika yang digunakan untuk menganalisis high-dimensional data dan mendapatkan informasi yang penting dari data tersebut.

Cara Kerja PCA Regression

Kelebihan dan Kekurangan PCA Regression

Setiap metode pasti memiliki kelebihan dan kekurangannya sendiri, namun jangan hanya fokus kepada kekurangannya saja, tetapi kepada kelebihannya yang bisa membantu setiap kita dalam menyelesaikan masalah yang di dapat.

Kelebihan

  • Mengurangi Overfitting: Dengan mengurangi jumlah prediktor, PCA membantu mengurangi risiko overfitting.

  • Mengatasi Multikolinearitas: Menghilangkan multikolinearitas di antara prediktor, karena komponen utama adalah ortogonal (tidak berkorelasi).

  • Meningkatkan Interpretasi Model: Menyederhanakan model dengan cara mengurangi jumlah prediktor.

Kekurangan

  • Sulit menginterpretasikan: Komponen yang digunakan berasal dari banyak data, ehingga sulit untuk menjelaskan dengan mudah satu per satu dari setiap komponen.

  • Kehilangan Informasi: Informasi dapat hilang atau terlewatkan dikarenakan hanya memilih sebagian komponen

Penerapan PCA di R Studio

Dosen saya memberikan data yang berisi 5 variabel X (Independent) dan 1 variabel Y (Dependent).

Setiap mahasiswa/i akan mengidentifikasi adanya multikolinearitas di antara variabel-variabel bebas dan menerapkan menggunakan metode yang telah ditentukan untuk mengatasi multikolinearitas, yaitu PCA Regression.

Dibawah ini akan saya jelaskan bagaimana PCA Regression bekerja di R Studio

library(readxl)
library(PerformanceAnalytics)
library(psych)
library(factoextra)
# Membaca data dari file Excel
data <- read_excel("gantengnyaoiii.xlsx")
# Memeriksa struktur data untuk memastikan variabel yang ada
print(head(data))
## # A tibble: 6 x 6
##       Y    X1    X2    X3    X4    X5
##   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1  3269  1264   304   378   172   236
## 2  3280  1244   307   361   183   278
## 3  3323  1262   315   367   184   293
## 4  3361  1269   328   341   186   316
## 5  3426  1260   325   323   195   332
## 6  3413  1163   329   331   198   354
summary(data)
##        Y              X1             X2              X3              X4       
##  Min.   :3269   Min.   :1163   Min.   :304.0   Min.   :291.0   Min.   :172.0  
##  1st Qu.:3728   1st Qu.:1460   1st Qu.:431.5   1st Qu.:352.0   1st Qu.:223.2  
##  Median :4734   Median :1760   Median :513.5   Median :444.0   Median :272.0  
##  Mean   :4542   Mean   :1715   Mean   :485.4   Mean   :427.9   Mean   :270.8  
##  3rd Qu.:5262   3rd Qu.:2013   3rd Qu.:540.2   3rd Qu.:492.0   3rd Qu.:314.0  
##  Max.   :5760   Max.   :2091   Max.   :609.0   Max.   :564.0   Max.   :371.0  
##        X5       
##  Min.   : 58.0  
##  1st Qu.:267.5  
##  Median :408.5  
##  Mean   :392.4  
##  3rd Qu.:543.0  
##  Max.   :697.0
# cek multikolinearitas
chart.Correlation(data[,2:6]) # Memakai dari tabel kolom 2 sampai 6 (kolom X1 hingga X5)

Penjelasan Output:

  • Hasilnya ada beberapa variabel memiliki nilai korelasi lebih dari 0.5 dan lebih kecil dari -0.5, maka dapat dikatakan adanya multikolinearitas antar variabel independen.

HIPOTESIS:

  • \(H0\) : Tidak terdapat multikolinearitas

  • \(H1\) : Terdapat multikolinearitas pada salah satu variabel

# Uji Bartlett
uji_bart <- function(x) {
  method <- "Bartlett's test of sphericity"
  data.name <- deparse(substitute(x))
  x <- subset(x, complete.cases(x))
  n <- nrow(x)
  p <- ncol(x)
  chisq <- (1-n+(2*p+5)/6)*log(det(cor(x)))
  df <- p*(p-1)/2
  p.value <- pchisq(chisq, df, lower.tail=FALSE)
  names(chisq) <- "Khi-squared"
  names(df) <- "df"
  return(structure(list(statistic=chisq, parameter=df, p.value=p.value,
                        method=method, data.name=data.name), class="htest"))
}
uji_bart(data[,2:6])
## 
##  Bartlett's test of sphericity
## 
## data:  data[, 2:6]
## Khi-squared = 345.67, df = 10, p-value < 2.2e-16

Penjelasan Output:

  • Dalam uji Bartlett, yang harus kita lihat ialah hasil p-value, jika p-value di atas 0.05 maka data yang kita miliki tidak terdapat multikolinearitas. Namun, dalam data ini, nilai p-value di bawah 0.05, yang berarti salah satu variabel terdapat multikolinearitas.
# Uji KMO
data_clean <- na.omit(data)
kmo_results <- KMO(data_clean[,2:6])
print(kmo_results)
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = data_clean[, 2:6])
## Overall MSA =  0.72
## MSA for each item = 
##   X1   X2   X3   X4   X5 
## 0.71 0.77 0.83 0.75 0.16

Penjelasan Output:

  • Dengan menggunakan tingkat kepercayaan 95%, didapatkan kesimpulan bahwa gagal tolak Ho yang berarti data cukup untuk dilakukan analisis faktor dan model layak, karena nilai KMO > 0.05.
# Analisis PCA
pca_results <- prcomp(data_clean[,2:6], scale. = TRUE)
print(summary(pca_results))
## Importance of components:
##                          PC1    PC2    PC3    PC4    PC5
## Standard deviation     1.875 1.0101 0.6136 0.2480 0.1628
## Proportion of Variance 0.703 0.2041 0.0753 0.0123 0.0053
## Cumulative Proportion  0.703 0.9071 0.9824 0.9947 1.0000
print(dim(pca_results$rotation))  # Menampilkan dimensi matrix rotasi
## [1] 5 5
# Memastikan hanya mengakses kolom yang ada
num_components <- dim(pca_results$rotation)[2]
round(pca_results$rotation[, 1:num_components], 2)
##      PC1   PC2   PC3   PC4   PC5
## X1  0.52 -0.08  0.24 -0.26  0.77
## X2  0.51  0.21  0.13  0.82 -0.08
## X3  0.45  0.11 -0.87 -0.17 -0.08
## X4  0.51 -0.03  0.40 -0.44 -0.62
## X5 -0.10  0.97  0.10 -0.19  0.07
round(pca_results$sdev^2, 2)
## [1] 3.52 1.02 0.38 0.06 0.03
fviz_eig(pca_results, addlabels = TRUE, ylim = c(0, 80))

round(pca_results$rotation[, 1:num_components], 2)
##      PC1   PC2   PC3   PC4   PC5
## X1  0.52 -0.08  0.24 -0.26  0.77
## X2  0.51  0.21  0.13  0.82 -0.08
## X3  0.45  0.11 -0.87 -0.17 -0.08
## X4  0.51 -0.03  0.40 -0.44 -0.62
## X5 -0.10  0.97  0.10 -0.19  0.07
# Data hasil PCA
pca_fix <- pca_results$x[, 1:num_components]
pca_fix
##              PC1          PC2         PC3         PC4          PC5
##  [1,] -3.0438150 -1.097134623 -0.89989057 -0.34287591  0.124236222
##  [2,] -3.0770712 -0.913405012 -0.61845575 -0.38516316 -0.023667222
##  [3,] -2.9596155 -0.819297714 -0.64417327 -0.35735770  0.003180759
##  [4,] -3.0112551 -0.716068539 -0.29930539 -0.21447411  0.020854808
##  [5,] -3.0734900 -0.674103251 -0.03436746 -0.28335652 -0.077779893
##  [6,] -3.1563313 -0.524084374 -0.16405849 -0.22019536 -0.370175869
##  [7,] -2.6521818 -0.332475518 -0.58105717 -0.16070690 -0.365384841
##  [8,] -2.6514146 -0.281236312 -0.06746962  0.01921456 -0.248338195
##  [9,] -2.3007364 -0.162996356  0.06987284  0.05257121 -0.017068720
## [10,] -2.4689513 -0.102416162  0.09638252 -0.07487787 -0.080462445
## [11,] -2.0240554  0.060066150  0.04750323  0.10903153 -0.001023752
## [12,] -1.4719196  0.318357116 -0.43149787  0.11754471  0.006523261
## [13,] -1.8330633  0.277449062  0.25295721  0.22812345  0.167459194
## [14,] -2.3620288  0.262425794  0.45007039 -0.06944322  0.070963801
## [15,] -2.2953645  0.379472672  0.62307023  0.08911806  0.003179483
## [16,] -2.1272415  0.455640340  0.65810390  0.01888194  0.003377640
## [17,] -1.9405526  0.535815660  1.06919553  0.16532934  0.110627813
## [18,] -1.5444881  0.701854408  0.78078096  0.18854378  0.107165177
## [19,] -1.7143645  0.722134398  1.15718886  0.23477495  0.030691485
## [20,] -1.5848626  0.746910827  1.03412723  0.27657150  0.085966400
## [21,] -1.1766387  0.907003836  0.66836367  0.21457937  0.191512483
## [22,] -1.0276481  1.034405490  0.28073637  0.11373943  0.098088555
## [23,] -0.8850882  1.116120768  0.18140190 -0.04836486 -0.004943830
## [24,] -0.5463649  1.325516138  0.02964299  0.06595965 -0.003080205
## [25,]  0.8199317  1.616096212 -0.95561327  0.09545247 -0.175003598
## [26,]  1.1126612  1.708563862 -1.23712021  0.03101702 -0.253473084
## [27,]  0.5811707  1.618241940 -0.88983429  0.19334918  0.165393749
## [28,]  0.5268898  1.636713434 -0.86681458  0.23612060  0.193683108
## [29,]  0.7788874  1.745852070 -1.13398724  0.18393181  0.052021301
## [30,]  0.7523562  1.696073608 -0.68305726  0.10559700  0.144016155
## [31,]  0.6203257  1.664974225 -0.60741581  0.04902145  0.125773162
## [32,]  0.6390228  0.545707037 -0.50315773  0.08512549  0.140353783
## [33,]  0.3806552 -1.240550597  0.19462428  0.50115240  0.042640480
## [34,]  0.6098825 -1.512733843 -0.17491553  0.48191468 -0.014223106
## [35,]  1.1503486 -1.354708345 -0.87506344  0.50442823 -0.106817129
## [36,]  1.4207262 -1.364531414 -0.85540961  0.37454582 -0.164706112
## [37,]  1.3091863 -1.203801794 -0.71166334  0.34067562 -0.115931655
## [38,]  1.2909320 -1.269095674 -0.41236737  0.29749467 -0.051120433
## [39,]  1.0150696 -1.496146003  0.05073581  0.15265833  0.045933032
## [40,]  0.6993436 -1.534490143  0.63412894  0.15827819  0.163504326
## [41,]  1.0769340 -1.525622973  0.12872110  0.01482221  0.127611662
## [42,]  1.6155856 -1.320362289  0.06353367  0.26033508  0.020817176
## [43,]  1.2475554 -1.390391382  0.18026257 -0.10249717  0.141803964
## [44,]  1.4044509 -1.429631507  0.10171060 -0.09879398  0.189188853
## [45,]  1.5354851 -1.403236407  0.08995486 -0.13967862  0.198629914
## [46,]  1.6915372 -1.345912446 -0.38987634 -0.24364329  0.085687096
## [47,]  1.6600283  0.006843016 -0.40472984 -0.53784029  0.054290607
## [48,]  1.7525624  0.342860874  0.10491276 -0.48014883  0.230069621
## [49,]  1.9108441  0.476134040 -0.39985424 -0.41961808  0.309636388
## [50,]  2.1100907  0.210759923 -0.35806335 -0.36402799  0.176003458
## [51,]  1.7702161  0.083042488  0.32085696 -0.35308463  0.128227788
## [52,]  1.5556770 -0.031554312  0.86930575 -0.31695822  0.050718025
## [53,]  1.6236162  0.014704619  0.96827221 -0.08072283 -0.116200446
## [54,]  2.0961324  0.220432898  0.63990340 -0.15400690 -0.134810597
## [55,]  2.2238027  0.279756115  0.53352558  0.02675799 -0.199382234
## [56,]  2.1650828  0.236629371  0.88638913  0.05694521 -0.096764759
## [57,]  2.4748214  0.395617549  0.51833010 -0.05730309 -0.244448680
## [58,]  2.4962412  0.420515948  0.49185666 -0.10989120 -0.178277356
## [59,]  2.3242488  0.424523440  0.25555514 -0.32469097 -0.381620992
## [60,]  2.4862411  0.858771663  0.76724166 -0.10388520 -0.385125576

Data di atas merupakan output data terbaru.

new_Data <- as.data.frame(pca_fix)
print(new_Data)
##           PC1          PC2         PC3         PC4          PC5
## 1  -3.0438150 -1.097134623 -0.89989057 -0.34287591  0.124236222
## 2  -3.0770712 -0.913405012 -0.61845575 -0.38516316 -0.023667222
## 3  -2.9596155 -0.819297714 -0.64417327 -0.35735770  0.003180759
## 4  -3.0112551 -0.716068539 -0.29930539 -0.21447411  0.020854808
## 5  -3.0734900 -0.674103251 -0.03436746 -0.28335652 -0.077779893
## 6  -3.1563313 -0.524084374 -0.16405849 -0.22019536 -0.370175869
## 7  -2.6521818 -0.332475518 -0.58105717 -0.16070690 -0.365384841
## 8  -2.6514146 -0.281236312 -0.06746962  0.01921456 -0.248338195
## 9  -2.3007364 -0.162996356  0.06987284  0.05257121 -0.017068720
## 10 -2.4689513 -0.102416162  0.09638252 -0.07487787 -0.080462445
## 11 -2.0240554  0.060066150  0.04750323  0.10903153 -0.001023752
## 12 -1.4719196  0.318357116 -0.43149787  0.11754471  0.006523261
## 13 -1.8330633  0.277449062  0.25295721  0.22812345  0.167459194
## 14 -2.3620288  0.262425794  0.45007039 -0.06944322  0.070963801
## 15 -2.2953645  0.379472672  0.62307023  0.08911806  0.003179483
## 16 -2.1272415  0.455640340  0.65810390  0.01888194  0.003377640
## 17 -1.9405526  0.535815660  1.06919553  0.16532934  0.110627813
## 18 -1.5444881  0.701854408  0.78078096  0.18854378  0.107165177
## 19 -1.7143645  0.722134398  1.15718886  0.23477495  0.030691485
## 20 -1.5848626  0.746910827  1.03412723  0.27657150  0.085966400
## 21 -1.1766387  0.907003836  0.66836367  0.21457937  0.191512483
## 22 -1.0276481  1.034405490  0.28073637  0.11373943  0.098088555
## 23 -0.8850882  1.116120768  0.18140190 -0.04836486 -0.004943830
## 24 -0.5463649  1.325516138  0.02964299  0.06595965 -0.003080205
## 25  0.8199317  1.616096212 -0.95561327  0.09545247 -0.175003598
## 26  1.1126612  1.708563862 -1.23712021  0.03101702 -0.253473084
## 27  0.5811707  1.618241940 -0.88983429  0.19334918  0.165393749
## 28  0.5268898  1.636713434 -0.86681458  0.23612060  0.193683108
## 29  0.7788874  1.745852070 -1.13398724  0.18393181  0.052021301
## 30  0.7523562  1.696073608 -0.68305726  0.10559700  0.144016155
## 31  0.6203257  1.664974225 -0.60741581  0.04902145  0.125773162
## 32  0.6390228  0.545707037 -0.50315773  0.08512549  0.140353783
## 33  0.3806552 -1.240550597  0.19462428  0.50115240  0.042640480
## 34  0.6098825 -1.512733843 -0.17491553  0.48191468 -0.014223106
## 35  1.1503486 -1.354708345 -0.87506344  0.50442823 -0.106817129
## 36  1.4207262 -1.364531414 -0.85540961  0.37454582 -0.164706112
## 37  1.3091863 -1.203801794 -0.71166334  0.34067562 -0.115931655
## 38  1.2909320 -1.269095674 -0.41236737  0.29749467 -0.051120433
## 39  1.0150696 -1.496146003  0.05073581  0.15265833  0.045933032
## 40  0.6993436 -1.534490143  0.63412894  0.15827819  0.163504326
## 41  1.0769340 -1.525622973  0.12872110  0.01482221  0.127611662
## 42  1.6155856 -1.320362289  0.06353367  0.26033508  0.020817176
## 43  1.2475554 -1.390391382  0.18026257 -0.10249717  0.141803964
## 44  1.4044509 -1.429631507  0.10171060 -0.09879398  0.189188853
## 45  1.5354851 -1.403236407  0.08995486 -0.13967862  0.198629914
## 46  1.6915372 -1.345912446 -0.38987634 -0.24364329  0.085687096
## 47  1.6600283  0.006843016 -0.40472984 -0.53784029  0.054290607
## 48  1.7525624  0.342860874  0.10491276 -0.48014883  0.230069621
## 49  1.9108441  0.476134040 -0.39985424 -0.41961808  0.309636388
## 50  2.1100907  0.210759923 -0.35806335 -0.36402799  0.176003458
## 51  1.7702161  0.083042488  0.32085696 -0.35308463  0.128227788
## 52  1.5556770 -0.031554312  0.86930575 -0.31695822  0.050718025
## 53  1.6236162  0.014704619  0.96827221 -0.08072283 -0.116200446
## 54  2.0961324  0.220432898  0.63990340 -0.15400690 -0.134810597
## 55  2.2238027  0.279756115  0.53352558  0.02675799 -0.199382234
## 56  2.1650828  0.236629371  0.88638913  0.05694521 -0.096764759
## 57  2.4748214  0.395617549  0.51833010 -0.05730309 -0.244448680
## 58  2.4962412  0.420515948  0.49185666 -0.10989120 -0.178277356
## 59  2.3242488  0.424523440  0.25555514 -0.32469097 -0.381620992
## 60  2.4862411  0.858771663  0.76724166 -0.10388520 -0.385125576
uji_bart(new_Data)
## 
##  Bartlett's test of sphericity
## 
## data:  new_Data
## Khi-squared = 0, df = 10, p-value = 1

Penjelasan Output:

  • Dengan menggunakan tingkat kepercayaan 95%, maka data yang ada menjelaskan bahwa tidak terdapat multikolinearitas pada data, karena nilai p-value > 0.05. Maka asumsi pada data sudah terpenuhi dengan bantuan PCA.
new_Data$Y = data$Y #memasukkan nilai Y yang ada di data ke new_Data

# Membangun model regresi linier
model_reg_pca <- lm(Y ~ ., data = new_Data)
summary(model_reg_pca)
## 
## Call:
## lm(formula = Y ~ ., data = new_Data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -202.711  -35.501   -4.506   43.048  137.320 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 4541.800      8.334 544.960  < 2e-16 ***
## PC1          416.226      4.483  92.852  < 2e-16 ***
## PC2          -59.687      8.321  -7.173 2.16e-09 ***
## PC3          147.348     13.697  10.758 4.84e-15 ***
## PC4         -254.981     33.886  -7.525 5.80e-10 ***
## PC5          -47.213     51.610  -0.915    0.364    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 64.56 on 54 degrees of freedom
## Multiple R-squared:  0.9939, Adjusted R-squared:  0.9934 
## F-statistic:  1769 on 5 and 54 DF,  p-value: < 2.2e-16

Penjelasan Output:

  • Model regresi linier yang dihasilkan adalah: \(Y = 4541.800 + 416.226 PC1 - 59.687 PC2 + 147.348 PC3 - 254.981 PC4 - 47.213 PC5\)

  • Multiple R-squared: 0.9934, yang menunjukkan bahwa model regresi ini 99,34% variasi dalam variabel dependen \(Y\) dapat dijelaskan oleh variabel-variabel independen (\(PC1, PC2, PC3, PC4, PC5\))

  • p-value: < 2.2e-16, nilai tersebut menunjukkan bahwa model sangat signifikan secara statistik.