library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(psych)
library(corrplot)
## corrplot 0.95 loaded
library(FactoMineR)
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/ve3WBa
Export <- read.csv("export.csv")
Import <- read.csv("Import.csv")
Export$Product.Name <- tolower(Export$Product.Name)
Import$Product.Name <- tolower(Import$Product.Name)
Hapus baris terakhir (jika merupakan total)} Export <- Export[-nrow(Export), ] Import <- Import[-nrow(Import), ]
merged_data <- merge(Export, Import, by = "Product.Name")
colnames(merged_data) <- c("Product.Name",
"Qty_Export",
"Value_Export",
"ShareQty_Export",
"ShareValue_Export",
"MTperCrore_Export",
"Qty_Import",
"Value_Import",
"ShareQty_Import",
"ShareValue_Import",
"MTperCrore_Import")
sum(is.na(merged_data))
## [1] 0
data_numeric <- merged_data %>% select(-Product.Name)
cor_matrix <- cor(data_numeric)
round(cor_matrix, 3)
## Qty_Export Value_Export ShareQty_Export ShareValue_Export
## Qty_Export 1.000 0.983 1.000 0.983
## Value_Export 0.983 1.000 0.983 1.000
## ShareQty_Export 1.000 0.983 1.000 0.983
## ShareValue_Export 0.983 1.000 0.983 1.000
## MTperCrore_Export 0.098 0.021 0.098 0.021
## Qty_Import 0.837 0.885 0.837 0.885
## Value_Import 0.869 0.919 0.869 0.919
## ShareQty_Import 0.837 0.885 0.837 0.885
## ShareValue_Import 0.869 0.919 0.869 0.919
## MTperCrore_Import 0.025 0.001 0.025 0.001
## MTperCrore_Export Qty_Import Value_Import ShareQty_Import
## Qty_Export 0.098 0.837 0.869 0.837
## Value_Export 0.021 0.885 0.919 0.885
## ShareQty_Export 0.098 0.837 0.869 0.837
## ShareValue_Export 0.021 0.885 0.919 0.885
## MTperCrore_Export 1.000 -0.036 -0.053 -0.036
## Qty_Import -0.036 1.000 0.990 1.000
## Value_Import -0.053 0.990 1.000 0.990
## ShareQty_Import -0.036 1.000 0.990 1.000
## ShareValue_Import -0.053 0.990 1.000 0.990
## MTperCrore_Import 0.582 0.032 0.001 0.032
## ShareValue_Import MTperCrore_Import
## Qty_Export 0.869 0.025
## Value_Export 0.919 0.001
## ShareQty_Export 0.869 0.025
## ShareValue_Export 0.919 0.001
## MTperCrore_Export -0.053 0.582
## Qty_Import 0.990 0.032
## Value_Import 1.000 0.001
## ShareQty_Import 0.990 0.032
## ShareValue_Import 1.000 0.001
## MTperCrore_Import 0.001 1.000
corrplot(cor_matrix,
method = "color",
tl.col = "black",
tl.srt = 45)
kmo_result <- KMO(cor_matrix)
kmo_result
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = cor_matrix)
## Overall MSA = 0.82
## MSA for each item =
## Qty_Export Value_Export ShareQty_Export ShareValue_Export
## 0.84 0.83 0.84 0.83
## MTperCrore_Export Qty_Import Value_Import ShareQty_Import
## 0.38 0.83 0.84 0.83
## ShareValue_Import MTperCrore_Import
## 0.84 0.37
bartlett_result <- cortest.bartlett(cor_matrix,
n = nrow(data_numeric))
bartlett_result
## $chisq
## [1] 3535.835
##
## $p.value
## [1] 0
##
## $df
## [1] 45
scale_data <- scale(data_numeric)
cov_matrix <- cov(scale_data)
eigen_result <- eigen(cov_matrix)
eigen_values <- eigen_result$values
eigen_vectors <- eigen_result$vectors
prop_var <- eigen_values / sum(eigen_values) * 100
cum_var <- cumsum(prop_var)
pca_table <- data.frame(
Eigenvalue = eigen_values,
Proporsi_Varians = prop_var,
Kumulatif_Varians = cum_var
)
pca_table
## Eigenvalue Proporsi_Varians Kumulatif_Varians
## 1 7.484483e+00 7.484483e+01 74.84483
## 2 1.595583e+00 1.595583e+01 90.80066
## 3 5.579899e-01 5.579899e+00 96.38056
## 4 3.295737e-01 3.295737e+00 99.67629
## 5 2.409800e-02 2.409800e-01 99.91727
## 6 8.272536e-03 8.272536e-02 100.00000
## 7 2.216056e-10 2.216056e-09 100.00000
## 8 1.407201e-10 1.407201e-09 100.00000
## 9 1.244432e-10 1.244432e-09 100.00000
## 10 8.242113e-11 8.242113e-10 100.00000
scores_manual <- scale_data %*% eigen_vectors
head(scores_manual)
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 0.72132876 1.1155302 -0.01958587 0.11860456 -0.0006472645 -0.036276178
## [2,] -0.03288758 0.7409715 0.28313052 -0.36113914 0.2641885140 -0.431951614
## [3,] 0.78197409 1.0763936 -0.18675273 0.00740504 -0.0215629503 0.038362225
## [4,] 0.77860718 1.1420315 -0.08986356 0.11286430 -0.0293587526 0.018530303
## [5,] -0.76497968 0.6498809 1.38755067 -0.35873556 -0.0713768247 -0.156268549
## [6,] 0.77035662 -1.2525942 0.53165491 0.52931943 0.0406755663 0.002736997
## [,7] [,8] [,9] [,10]
## [1,] -1.450616e-05 1.739087e-05 -1.395188e-05 2.125570e-06
## [2,] 8.676069e-06 3.115852e-06 -6.389416e-06 9.188226e-06
## [3,] 1.121212e-05 -2.039753e-06 -2.687467e-06 6.123943e-06
## [4,] -1.143128e-05 -8.575540e-06 1.946928e-05 8.321629e-06
## [5,] 1.231189e-05 1.970879e-06 1.094277e-05 -1.442119e-05
## [6,] 2.846961e-05 -8.630814e-06 7.404427e-06 3.535020e-06
pca_result <- PCA(data_numeric,
scale.unit = TRUE,
graph = FALSE,
ncp = ncol(data_numeric))
pca_result$eig
## eigenvalue percentage of variance cumulative percentage of variance
## comp 1 7.484483e+00 7.484483e+01 74.84483
## comp 2 1.595583e+00 1.595583e+01 90.80066
## comp 3 5.579899e-01 5.579899e+00 96.38056
## comp 4 3.295737e-01 3.295737e+00 99.67629
## comp 5 2.409800e-02 2.409800e-01 99.91727
## comp 6 8.272536e-03 8.272536e-02 100.00000
## comp 7 2.216054e-10 2.216054e-09 100.00000
## comp 8 1.407200e-10 1.407200e-09 100.00000
## comp 9 1.244433e-10 1.244433e-09 100.00000
## comp 10 8.242117e-11 8.242117e-10 100.00000
round(pca_result$var$coord, 3)
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7 Dim.8 Dim.9
## Qty_Export 0.954 0.070 -0.251 -0.136 -0.061 0.020 0 0 0
## Value_Export 0.979 0.006 -0.152 -0.115 0.065 -0.031 0 0 0
## ShareQty_Export 0.954 0.070 -0.251 -0.136 -0.061 0.020 0 0 0
## ShareValue_Export 0.979 0.006 -0.152 -0.115 0.065 -0.031 0 0 0
## MTperCrore_Export 0.010 0.897 -0.287 0.337 0.011 -0.002 0 0 0
## Qty_Import 0.959 -0.032 0.232 0.147 -0.048 -0.032 0 0 0
## Value_Import 0.977 -0.056 0.169 0.105 0.042 0.042 0 0 0
## ShareQty_Import 0.959 -0.032 0.232 0.147 -0.048 -0.032 0 0 0
## ShareValue_Import 0.977 -0.056 0.169 0.105 0.042 0.042 0 0 0
## MTperCrore_Import 0.018 0.879 0.373 -0.296 0.000 0.002 0 0 0
## Dim.10
## Qty_Export 0
## Value_Export 0
## ShareQty_Export 0
## ShareValue_Export 0
## MTperCrore_Export 0
## Qty_Import 0
## Value_Import 0
## ShareQty_Import 0
## ShareValue_Import 0
## MTperCrore_Import 0
round(pca_result$var$contrib, 2)
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7 Dim.8 Dim.9 Dim.10
## Qty_Export 12.15 0.31 11.33 5.60 15.64 4.97 27.42 11.64 10.68 0.27
## Value_Export 12.80 0.00 4.16 4.02 17.51 11.50 12.58 0.01 35.80 1.61
## ShareQty_Export 12.15 0.31 11.33 5.60 15.64 4.97 27.42 11.64 10.68 0.27
## ShareValue_Export 12.80 0.00 4.16 4.02 17.51 11.50 12.58 0.01 35.80 1.61
## MTperCrore_Export 0.00 50.41 14.72 34.38 0.46 0.03 0.00 0.00 0.00 0.00
## Qty_Import 12.30 0.06 9.61 6.54 9.43 12.05 6.06 9.26 0.03 34.65
## Value_Import 12.75 0.20 5.10 3.33 7.18 21.44 3.94 29.09 3.50 13.47
## ShareQty_Import 12.30 0.06 9.61 6.54 9.43 12.05 6.06 9.26 0.03 34.65
## ShareValue_Import 12.75 0.20 5.10 3.33 7.18 21.44 3.94 29.09 3.50 13.47
## MTperCrore_Import 0.00 48.45 24.88 26.61 0.00 0.05 0.00 0.00 0.00 0.00
round(pca_result$var$cos2, 3)
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7 Dim.8 Dim.9 Dim.10
## Qty_Export 0.909 0.005 0.063 0.018 0.004 0.000 0 0 0 0
## Value_Export 0.958 0.000 0.023 0.013 0.004 0.001 0 0 0 0
## ShareQty_Export 0.909 0.005 0.063 0.018 0.004 0.000 0 0 0 0
## ShareValue_Export 0.958 0.000 0.023 0.013 0.004 0.001 0 0 0 0
## MTperCrore_Export 0.000 0.804 0.082 0.113 0.000 0.000 0 0 0 0
## Qty_Import 0.921 0.001 0.054 0.022 0.002 0.001 0 0 0 0
## Value_Import 0.954 0.003 0.028 0.011 0.002 0.002 0 0 0 0
## ShareQty_Import 0.921 0.001 0.054 0.022 0.002 0.001 0 0 0 0
## ShareValue_Import 0.954 0.003 0.028 0.011 0.002 0.002 0 0 0 0
## MTperCrore_Import 0.000 0.773 0.139 0.088 0.000 0.000 0 0 0 0
head(pca_result$ind$coord)
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6
## 1 -0.73028971 -1.1293883 -0.01982918 -0.120077966 -0.0006553053 0.036726831
## 2 0.03329613 -0.7501765 0.28664781 0.365625511 0.2674704848 0.437317678
## 3 -0.79168843 -1.0897655 -0.18907273 -0.007497032 -0.0218308234 -0.038838793
## 4 -0.78827969 -1.1562188 -0.09097992 -0.114266392 -0.0297234716 -0.018760502
## 5 0.77448290 -0.6579543 1.40478798 0.363192077 -0.0722635273 0.158209848
## 6 -0.77992663 1.2681550 0.53825957 -0.535895076 0.0411808722 -0.002770999
## Dim.7 Dim.8 Dim.9 Dim.10
## 1 1.468640e-05 -1.760717e-05 1.412486e-05 -2.152010e-06
## 2 -8.783838e-06 -3.154657e-06 6.468753e-06 -9.302375e-06
## 3 -1.135140e-05 2.065058e-06 2.720915e-06 -6.200016e-06
## 4 1.157323e-05 8.682406e-06 -1.971104e-05 -8.424986e-06
## 5 -1.246487e-05 -1.995178e-06 -1.107870e-05 1.460036e-05
## 6 -2.882330e-05 8.738182e-06 -7.496182e-06 -3.578907e-06
fviz_eig(pca_result,
addlabels = TRUE,
ylim = c(0,100))
## Warning in geom_bar(stat = "identity", fill = barfill, color = barcolor, :
## Ignoring empty aesthetic: `width`.
fviz_pca_var(pca_result,
repel = TRUE)
## 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.
fviz_pca_biplot(pca_result,
geom.ind = "point",
addEllipses = TRUE)
```markdown # Analisis PCA dan FA