Praktikum 10 APG : Korespondensi dan Biplot
Pengantar
Materi 1 Summary Analisis Korespondensi dan Biplot
Penerapan 1
1. Load Dataset
kores = matrix(c(5,5,30,5,25,5,15,5,5,15,5,0),nrow = 4,byrow = TRUE)
dimnames(kores)=list(c("MerkA","MerkB","MerkC","MerkD"),c("Region1","Region2","Region3"))
names(dimnames(kores))=c("Pasta Gigi","Daerah")
kores## Daerah
## Pasta Gigi Region1 Region2 Region3
## MerkA 5 5 30
## MerkB 5 25 5
## MerkC 15 5 5
## MerkD 15 5 02. Melihat Chi-Square
chisq.test(kores)##
## Pearson's Chi-squared test
##
## data: kores
## X-squared = 79.607, df = 6, p-value = 4.307e-153. Matriks Profil Baris
prop.table(kores,1)## Daerah
## Pasta Gigi Region1 Region2 Region3
## MerkA 0.1250000 0.1250000 0.7500000
## MerkB 0.1428571 0.7142857 0.1428571
## MerkC 0.6000000 0.2000000 0.2000000
## MerkD 0.7500000 0.2500000 0.00000004. Matriks Profil Kolom
prop.table(kores,2)## Daerah
## Pasta Gigi Region1 Region2 Region3
## MerkA 0.125 0.125 0.750
## MerkB 0.125 0.625 0.125
## MerkC 0.375 0.125 0.125
## MerkD 0.375 0.125 0.0005. Hasil Inersia
library(ca)
fit=ca(kores)
fit##
## Principal inertias (eigenvalues):
## 1 2
## Value 0.410259 0.253134
## Percentage 61.84% 38.16%
##
##
## Rows:
## MerkA MerkB MerkC MerkD
## Mass 0.333333 0.291667 0.208333 0.166667
## ChiDist 0.883883 0.808122 0.565685 0.935414
## Inertia 0.260417 0.190476 0.066667 0.145833
## Dim. 1 -1.370161 0.496387 0.529432 1.209854
## Dim. 2 0.208974 -1.476672 0.899927 1.041319
##
##
## Columns:
## Region1 Region2 Region3
## Mass 0.333333 0.333333 0.333333
## ChiDist 0.786890 0.744923 0.903367
## Inertia 0.206399 0.184970 0.272024
## Dim. 1 0.847773 0.556400 -1.404173
## Dim. 2 1.131937 -1.300161 0.1682246. Analisis Tabel Kontingensi
7. Kontribusi Baris
8. Kontribusi Kolom
summary(fit)##
## Principal inertias (eigenvalues):
##
## dim value % cum% scree plot
## 1 0.410259 61.8 61.8 ***************
## 2 0.253134 38.2 100.0 **********
## -------- -----
## Total: 0.663393 100.0
##
##
## Rows:
## name mass qlt inr k=1 cor ctr k=2 cor ctr
## 1 | MrkA | 333 1000 393 | -878 986 626 | 105 14 15 |
## 2 | MrkB | 292 1000 287 | 318 155 72 | -743 845 636 |
## 3 | MrkC | 208 1000 100 | 339 359 58 | 453 641 169 |
## 4 | MrkD | 167 1000 220 | 775 686 244 | 524 314 181 |
##
## Columns:
## name mass qlt inr k=1 cor ctr k=2 cor ctr
## 1 | Rgn1 | 333 1000 311 | 543 476 240 | 570 524 427 |
## 2 | Rgn2 | 333 1000 279 | 356 229 103 | -654 771 563 |
## 3 | Rgn3 | 333 1000 410 | -899 991 657 | 85 9 9 |9. Plot Analisis Korespondensi
plot(fit, mass = TRUE, contrib = "absolute", map="rowgreen")
Penerapan 2
1. Prosedur Biplot
Saat ini sudah banyak bank indonesia.Semakin banyak yang beroperasi,akan meningkatkan suatu persaingan di antara mereka.Persaingan untuk menarik pasar dilakukan dengan berbagai cara baik dalam bentuk fasilitas yang diberikan,hadiah,pelayan,lokasi,dan penggunan ATM.Untuk mengantisipasi persaingan ini pihak bank terkait perlu mengetahui posisi pesaing mereka.Berikut ini adalah rata-rata nilai yang diberikan responden :
2. Matriks X data
library(readxl)
Data1 <- read_excel("Data10.xlsx")
Data1## # A tibble: 8 x 6
## ...1 Fasilitas Hadiah Pelayanan Lokasi ATM
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 BCA 9.88 9.16 7.13 9.69 9.2
## 2 BNI 6.32 7.5 7.71 7.49 7.89
## 3 MANDIRI 4.2 5.94 5.18 6.72 4.25
## 4 BI 7.79 8.22 7.24 7.69 7.09
## 5 MEGA 7.79 7.27 6.95 5.34 6.59
## 6 UNIVERSAL 5.42 5.06 9.11 5.61 7.25
## 7 MUAMALAT 6.18 5.69 6.25 6.01 6.26
## 8 SYARIAH 7.36 6.98 6.08 7.41 6.99mdata1 = matrix(c(Data1$Fasilitas,Data1$Hadiah,Data1$Pelayanan,Data1$Lokasi,Data1$ATM),8,5)
mdata1## [,1] [,2] [,3] [,4] [,5]
## [1,] 9.88 9.16 7.13 9.69 9.20
## [2,] 6.32 7.50 7.71 7.49 7.89
## [3,] 4.20 5.94 5.18 6.72 4.25
## [4,] 7.79 8.22 7.24 7.69 7.09
## [5,] 7.79 7.27 6.95 5.34 6.59
## [6,] 5.42 5.06 9.11 5.61 7.25
## [7,] 6.18 5.69 6.25 6.01 6.26
## [8,] 7.36 6.98 6.08 7.41 6.993. Transformasi nilai X terhadap nilai tengahnya
Cara 1
rata = matrix(c(colMeans(mdata1)),5,1)
rata## [,1]
## [1,] 6.86750
## [2,] 6.97750
## [3,] 6.95625
## [4,] 6.99500
## [5,] 6.94000satu = matrix(c(rep(1,8)),1,8)
satu## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
## [1,] 1 1 1 1 1 1 1 1mrat = rata %*% satu
X = mdata1 - t(mrat)
X## [,1] [,2] [,3] [,4] [,5]
## [1,] 3.0125 2.1825 0.17375 2.695 2.26
## [2,] -0.5475 0.5225 0.75375 0.495 0.95
## [3,] -2.6675 -1.0375 -1.77625 -0.275 -2.69
## [4,] 0.9225 1.2425 0.28375 0.695 0.15
## [5,] 0.9225 0.2925 -0.00625 -1.655 -0.35
## [6,] -1.4475 -1.9175 2.15375 -1.385 0.31
## [7,] -0.6875 -1.2875 -0.70625 -0.985 -0.68
## [8,] 0.4925 0.0025 -0.87625 0.415 0.05Cara 2
biplot1=scale(mdata1,center = TRUE, scale = FALSE)
biplot1## [,1] [,2] [,3] [,4] [,5]
## [1,] 3.0125 2.1825 0.17375 2.695 2.26
## [2,] -0.5475 0.5225 0.75375 0.495 0.95
## [3,] -2.6675 -1.0375 -1.77625 -0.275 -2.69
## [4,] 0.9225 1.2425 0.28375 0.695 0.15
## [5,] 0.9225 0.2925 -0.00625 -1.655 -0.35
## [6,] -1.4475 -1.9175 2.15375 -1.385 0.31
## [7,] -0.6875 -1.2875 -0.70625 -0.985 -0.68
## [8,] 0.4925 0.0025 -0.87625 0.415 0.05
## attr(,"scaled:center")
## [1] 6.86750 6.97750 6.95625 6.99500 6.940004. Matrix X’X
sq = t(X) %*% X
sq## [,1] [,2] [,3] [,4] [,5]
## [1,] 21.002950 14.134250 2.041325 10.58200 13.3226
## [2,] 14.134250 13.076550 -0.256075 10.73020 8.5849
## [3,] 2.041325 -0.256075 9.739187 -1.11355 7.0357
## [4,] 10.582000 10.730200 -1.113550 13.86640 8.2454
## [5,] 13.322600 8.584900 7.035700 8.24540 13.95225. Nilai eigen dari sq
eigen(sq)## eigen() decomposition
## $values
## [1] 49.5634638 14.3119212 5.6099251 1.7274341 0.4245434
##
## $vectors
## [,1] [,2] [,3] [,4] [,5]
## [1,] -0.61259089 0.01267564 0.62791476 0.2649402 -0.4001268
## [2,] -0.47036883 0.26344316 0.06105456 -0.7821383 0.3064032
## [3,] -0.09783043 -0.78006818 -0.19392846 -0.3905949 -0.4378929
## [4,] -0.42632532 0.35141752 -0.72899711 0.1751783 -0.3641816
## [5,] -0.46060991 -0.44546200 -0.18152235 0.3671710 0.64933606. Menentukan matriks L, A, dan U dengan metode Singular Value Decomposition (SVD)
# Matriks L
L = diag(sqrt(eigen(sq)$values))
L## [,1] [,2] [,3] [,4] [,5]
## [1,] 7.040132 0.00000 0.000000 0.000000 0.0000000
## [2,] 0.000000 3.78311 0.000000 0.000000 0.0000000
## [3,] 0.000000 0.00000 2.368528 0.000000 0.0000000
## [4,] 0.000000 0.00000 0.000000 1.314319 0.0000000
## [5,] 0.000000 0.00000 0.000000 0.000000 0.6515699# Matriks A
A = matrix(c(eigen(sq)$vectors),5,5)
A## [,1] [,2] [,3] [,4] [,5]
## [1,] -0.61259089 0.01267564 0.62791476 0.2649402 -0.4001268
## [2,] -0.47036883 0.26344316 0.06105456 -0.7821383 0.3064032
## [3,] -0.09783043 -0.78006818 -0.19392846 -0.3905949 -0.4378929
## [4,] -0.42632532 0.35141752 -0.72899711 0.1751783 -0.3641816
## [5,] -0.46060991 -0.44546200 -0.18152235 0.3671710 0.6493360# Matriks U
U = X%*%A%*%solve(L)
U## [,1] [,2] [,3] [,4] [,5]
## [1,] -0.72142581 0.11047506 -0.16201538 0.2473995 -0.1944701
## [2,] -0.08987393 -0.18675230 -0.41855350 -0.3139324 0.7454344
## [3,] 0.51876088 0.57627574 -0.29768362 -0.1805721 -0.1831142
## [4,] -0.21912874 0.07800274 0.02795117 -0.5032311 -0.4118804
## [5,] 0.02339379 -0.08777394 0.78882111 -0.3046117 0.1514737
## [6,] 0.28772566 -0.74763318 -0.20699062 0.1112411 -0.3771979
## [7,] 0.25979540 0.04223866 0.19765870 0.5162274 0.1642576
## [8,] -0.05924726 0.21516722 0.07081214 0.4274793 0.1054970
G = U
G## [,1] [,2] [,3] [,4] [,5]
## [1,] -0.72142581 0.11047506 -0.16201538 0.2473995 -0.1944701
## [2,] -0.08987393 -0.18675230 -0.41855350 -0.3139324 0.7454344
## [3,] 0.51876088 0.57627574 -0.29768362 -0.1805721 -0.1831142
## [4,] -0.21912874 0.07800274 0.02795117 -0.5032311 -0.4118804
## [5,] 0.02339379 -0.08777394 0.78882111 -0.3046117 0.1514737
## [6,] 0.28772566 -0.74763318 -0.20699062 0.1112411 -0.3771979
## [7,] 0.25979540 0.04223866 0.19765870 0.5162274 0.1642576
## [8,] -0.05924726 0.21516722 0.07081214 0.4274793 0.1054970H = A %*% L
H## [,1] [,2] [,3] [,4] [,5]
## [1,] -4.3127209 0.04795332 1.4872337 0.3482159 -0.2607106
## [2,] -3.3114588 0.99663445 0.1446094 -1.0279791 0.1996431
## [3,] -0.6887392 -2.95108373 -0.4593250 -0.5133663 -0.2853178
## [4,] -3.0013867 1.32945111 -1.7266501 0.2302402 -0.2372898
## [5,] -3.2427548 -1.68523173 -0.4299408 0.4825798 0.42308787. Mengambil 2 kolom pertama dari masing-masing matriks G dan H
G = G[,1:2]
G## [,1] [,2]
## [1,] -0.72142581 0.11047506
## [2,] -0.08987393 -0.18675230
## [3,] 0.51876088 0.57627574
## [4,] -0.21912874 0.07800274
## [5,] 0.02339379 -0.08777394
## [6,] 0.28772566 -0.74763318
## [7,] 0.25979540 0.04223866
## [8,] -0.05924726 0.21516722H = H[,1:2]
H## [,1] [,2]
## [1,] -4.3127209 0.04795332
## [2,] -3.3114588 0.99663445
## [3,] -0.6887392 -2.95108373
## [4,] -3.0013867 1.32945111
## [5,] -3.2427548 -1.685231738. Keragaman yang diterangkan oleh biplot
9. Membuat biplot dengan menggunakan princomp (PCA)
model1 = princomp(mdata1,cor = T)
summary(model1)## Importance of components:
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5
## Standard deviation 1.7856835 1.1415977 0.58910957 0.36227759 0.17260909
## Proportion of Variance 0.6377331 0.2606491 0.06941002 0.02624901 0.00595878
## Cumulative Proportion 0.6377331 0.8983822 0.96779221 0.99404122 1.00000000biplot(model1)
model2 = princomp(mdata1,scale = T)
summary(model2)## Importance of components:
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5
## Standard deviation 2.4890627 1.3375314 0.83740112 0.46468189 0.230364760
## Proportion of Variance 0.6918668 0.1997831 0.07831013 0.02411362 0.005926291
## Cumulative Proportion 0.6918668 0.8916500 0.96996009 0.99407371 1.000000000biplot(model2)
10. Dengan fungsi svd
y = svd(biplot1)
y## $d
## [1] 7.0401324 3.7831100 2.3685280 1.3143189 0.6515699
##
## $u
## [,1] [,2] [,3] [,4] [,5]
## [1,] -0.72142581 0.11047506 0.16201538 0.2473995 0.1944701
## [2,] -0.08987393 -0.18675230 0.41855350 -0.3139324 -0.7454344
## [3,] 0.51876088 0.57627574 0.29768362 -0.1805721 0.1831142
## [4,] -0.21912874 0.07800274 -0.02795117 -0.5032311 0.4118804
## [5,] 0.02339379 -0.08777394 -0.78882111 -0.3046117 -0.1514737
## [6,] 0.28772566 -0.74763318 0.20699062 0.1112411 0.3771979
## [7,] 0.25979540 0.04223866 -0.19765870 0.5162274 -0.1642576
## [8,] -0.05924726 0.21516722 -0.07081214 0.4274793 -0.1054970
##
## $v
## [,1] [,2] [,3] [,4] [,5]
## [1,] -0.61259089 0.01267564 -0.62791476 0.2649402 0.4001268
## [2,] -0.47036883 0.26344316 -0.06105456 -0.7821383 -0.3064032
## [3,] -0.09783043 -0.78006818 0.19392846 -0.3905949 0.4378929
## [4,] -0.42632532 0.35141752 0.72899711 0.1751783 0.3641816
## [5,] -0.46060991 -0.44546200 0.18152235 0.3671710 -0.6493360L = diag(y$d)
L## [,1] [,2] [,3] [,4] [,5]
## [1,] 7.040132 0.00000 0.000000 0.000000 0.0000000
## [2,] 0.000000 3.78311 0.000000 0.000000 0.0000000
## [3,] 0.000000 0.00000 2.368528 0.000000 0.0000000
## [4,] 0.000000 0.00000 0.000000 1.314319 0.0000000
## [5,] 0.000000 0.00000 0.000000 0.000000 0.6515699A = y$v
A## [,1] [,2] [,3] [,4] [,5]
## [1,] -0.61259089 0.01267564 -0.62791476 0.2649402 0.4001268
## [2,] -0.47036883 0.26344316 -0.06105456 -0.7821383 -0.3064032
## [3,] -0.09783043 -0.78006818 0.19392846 -0.3905949 0.4378929
## [4,] -0.42632532 0.35141752 0.72899711 0.1751783 0.3641816
## [5,] -0.46060991 -0.44546200 0.18152235 0.3671710 -0.6493360U = y$u
U## [,1] [,2] [,3] [,4] [,5]
## [1,] -0.72142581 0.11047506 0.16201538 0.2473995 0.1944701
## [2,] -0.08987393 -0.18675230 0.41855350 -0.3139324 -0.7454344
## [3,] 0.51876088 0.57627574 0.29768362 -0.1805721 0.1831142
## [4,] -0.21912874 0.07800274 -0.02795117 -0.5032311 0.4118804
## [5,] 0.02339379 -0.08777394 -0.78882111 -0.3046117 -0.1514737
## [6,] 0.28772566 -0.74763318 0.20699062 0.1112411 0.3771979
## [7,] 0.25979540 0.04223866 -0.19765870 0.5162274 -0.1642576
## [8,] -0.05924726 0.21516722 -0.07081214 0.4274793 -0.1054970G = U
H = A %*%L
H## [,1] [,2] [,3] [,4] [,5]
## [1,] -4.3127209 0.04795332 -1.4872337 0.3482159 0.2607106
## [2,] -3.3114588 0.99663445 -0.1446094 -1.0279791 -0.1996431
## [3,] -0.6887392 -2.95108373 0.4593250 -0.5133663 0.2853178
## [4,] -3.0013867 1.32945111 1.7266501 0.2302402 0.2372898
## [5,] -3.2427548 -1.68523173 0.4299408 0.4825798 -0.4230878G2 = G[,1:2]
H2 = H[,1:2]
G2## [,1] [,2]
## [1,] -0.72142581 0.11047506
## [2,] -0.08987393 -0.18675230
## [3,] 0.51876088 0.57627574
## [4,] -0.21912874 0.07800274
## [5,] 0.02339379 -0.08777394
## [6,] 0.28772566 -0.74763318
## [7,] 0.25979540 0.04223866
## [8,] -0.05924726 0.21516722H2## [,1] [,2]
## [1,] -4.3127209 0.04795332
## [2,] -3.3114588 0.99663445
## [3,] -0.6887392 -2.95108373
## [4,] -3.0013867 1.32945111
## [5,] -3.2427548 -1.68523173biplot(G2,H2)
Penerapan 3
library(readxl)
jatim <- read_excel("Data Modul 10.xlsx", sheet = "Contoh")
jatim## # A tibble: 38 x 7
## Kab Density PddkKota Depend Gini Miskin KapitaNMkn
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Pacitan 422 21.8 49.3 0.35 14.5 47.3
## 2 Ponorogo 727 34.7 46.6 0.38 9.95 55.0
## 3 Trenggalek 637 35.8 45.5 0.38 11.6 50.9
## 4 Tulungagung 1032 53.0 47.9 0.34 7.33 51.2
## 5 Blitar 916 45 49.2 0.35 9.33 52.7
## 6 Kediri 1180 52.5 47.0 0.33 11.4 49.0
## 7 Malang 752 54.8 45.7 0.37 10.2 53.0
## 8 Lumajang 625 35.1 43.4 0.3 9.83 42.7
## 9 Jember 820 50.8 45.4 0.32 10.1 44.9
## 10 Banyuwangi 295 60.2 46.3 0.32 8.06 49.6
## # ... with 28 more rowsjatim2 <- jatim[,-1] #membuang variable yang bukan numeric di kolom 1
library(psych)
library(GPArotation)1. Analisis Faktor metode Komponen Utama
fa1 <- fa(jatim2, nfactors=2, fm="pa", scores=TRUE) # factor analysis 2 common factor
fa1## Factor Analysis using method = pa
## Call: fa(r = jatim2, nfactors = 2, scores = TRUE, fm = "pa")
## Standardized loadings (pattern matrix) based upon correlation matrix
## PA1 PA2 h2 u2 com
## Density 0.88 -0.02 0.75 0.246 1.0
## PddkKota 0.91 0.09 0.93 0.070 1.0
## Depend -0.67 0.13 0.37 0.635 1.1
## Gini -0.18 0.85 0.58 0.418 1.1
## Miskin -0.48 -0.51 0.76 0.243 2.0
## KapitaNMkn 0.32 0.76 0.96 0.041 1.3
##
## PA1 PA2
## SS loadings 2.59 1.75
## Proportion Var 0.43 0.29
## Cumulative Var 0.43 0.72
## Proportion Explained 0.60 0.40
## Cumulative Proportion 0.60 1.00
##
## With factor correlations of
## PA1 PA2
## PA1 1.00 0.57
## PA2 0.57 1.00
##
## Mean item complexity = 1.3
## Test of the hypothesis that 2 factors are sufficient.
##
## The degrees of freedom for the null model are 15 and the objective function was 4.86 with Chi Square of 166.21
## The degrees of freedom for the model are 4 and the objective function was 0.24
##
## The root mean square of the residuals (RMSR) is 0.03
## The df corrected root mean square of the residuals is 0.05
##
## The harmonic number of observations is 38 with the empirical chi square 0.79 with prob < 0.94
## The total number of observations was 38 with Likelihood Chi Square = 7.81 with prob < 0.099
##
## Tucker Lewis Index of factoring reliability = 0.901
## RMSEA index = 0.156 and the 90 % confidence intervals are 0 0.328
## BIC = -6.74
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy
## PA1 PA2
## Correlation of (regression) scores with factors 0.97 0.97
## Multiple R square of scores with factors 0.95 0.94
## Minimum correlation of possible factor scores 0.89 0.882. Biplot
biplot(fa1, labels=rownames(jatim2))
3. Biplot Analisis Korespondensi
library(FactoMineR)
library(factoextra)
library(ggplot2)
data(housetasks)
housetasks## Wife Alternating Husband Jointly
## Laundry 156 14 2 4
## Main_meal 124 20 5 4
## Dinner 77 11 7 13
## Breakfeast 82 36 15 7
## Tidying 53 11 1 57
## Dishes 32 24 4 53
## Shopping 33 23 9 55
## Official 12 46 23 15
## Driving 10 51 75 3
## Finances 13 13 21 66
## Insurance 8 1 53 77
## Repairs 0 3 160 2
## Holidays 0 1 6 1534. Plot data
library(gplots)
# 1. convert data "housetasks" menjadi sebuah tabel
data1 <- as.table(as.matrix(housetasks))
# 2. membuat plot
balloonplot(t(data1), main ="Tugas Rumah", xlab ="", ylab="",
label = FALSE, show.margins = FALSE,dotsize=4, text.size=0.5)
5. Analisis Korespondensi
an.ca <- CA(housetasks, graph = FALSE)
print(an.ca)## **Results of the Correspondence Analysis (CA)**
## The row variable has 13 categories; the column variable has 4 categories
## The chi square of independence between the two variables is equal to 1944.456 (p-value = 0 ).
## *The results are available in the following objects:
##
## name description
## 1 "$eig" "eigenvalues"
## 2 "$col" "results for the columns"
## 3 "$col$coord" "coord. for the columns"
## 4 "$col$cos2" "cos2 for the columns"
## 5 "$col$contrib" "contributions of the columns"
## 6 "$row" "results for the rows"
## 7 "$row$coord" "coord. for the rows"
## 8 "$row$cos2" "cos2 for the rows"
## 9 "$row$contrib" "contributions of the rows"
## 10 "$call" "summary called parameters"
## 11 "$call$marge.col" "weights of the columns"
## 12 "$call$marge.row" "weights of the rows"summary(an.ca)##
## Call:
## CA(X = housetasks, graph = FALSE)
##
## The chi square of independence between the two variables is equal to 1944.456 (p-value = 0 ).
##
## Eigenvalues
## Dim.1 Dim.2 Dim.3
## Variance 0.543 0.445 0.127
## % of var. 48.692 39.913 11.395
## Cumulative % of var. 48.692 88.605 100.000
##
## Rows (the 10 first)
## Iner*1000 Dim.1 ctr cos2 Dim.2 ctr cos2
## Laundry | 134.160 | -0.992 18.287 0.740 | 0.495 5.564 0.185 |
## Main_meal | 90.692 | -0.876 12.389 0.742 | 0.490 4.736 0.232 |
## Dinner | 38.246 | -0.693 5.471 0.777 | 0.308 1.321 0.154 |
## Breakfeast | 41.124 | -0.509 3.825 0.505 | 0.453 3.699 0.400 |
## Tidying | 24.667 | -0.394 1.998 0.440 | -0.434 2.966 0.535 |
## Dishes | 19.587 | -0.189 0.426 0.118 | -0.442 2.844 0.646 |
## Shopping | 14.970 | -0.118 0.176 0.064 | -0.403 2.515 0.748 |
## Official | 53.300 | 0.227 0.521 0.053 | 0.254 0.796 0.066 |
## Driving | 101.509 | 0.742 8.078 0.432 | 0.653 7.647 0.335 |
## Finances | 29.564 | 0.271 0.875 0.161 | -0.618 5.559 0.837 |
## Dim.3 ctr cos2
## Laundry -0.317 7.968 0.075 |
## Main_meal -0.164 1.859 0.026 |
## Dinner -0.207 2.097 0.070 |
## Breakfeast 0.220 3.069 0.095 |
## Tidying -0.094 0.489 0.025 |
## Dishes 0.267 3.634 0.236 |
## Shopping 0.203 2.223 0.189 |
## Official 0.923 36.940 0.881 |
## Driving 0.544 18.596 0.233 |
## Finances 0.035 0.062 0.003 |
##
## Columns
## Iner*1000 Dim.1 ctr cos2 Dim.2 ctr cos2
## Wife | 301.019 | -0.838 44.462 0.802 | 0.365 10.312 0.152 |
## Alternating | 117.824 | -0.062 0.104 0.005 | 0.292 2.783 0.105 |
## Husband | 381.373 | 1.161 54.234 0.772 | 0.602 17.787 0.208 |
## Jointly | 314.725 | 0.149 1.200 0.021 | -1.027 69.118 0.977 |
## Dim.3 ctr cos2
## Wife -0.200 10.822 0.046 |
## Alternating 0.849 82.549 0.890 |
## Husband -0.189 6.133 0.020 |
## Jointly -0.046 0.495 0.002 |6. Nilai Kritis (Chi-square tabel)
df1 <- (nrow(housetasks) - 1) * (ncol(housetasks) - 1)
qchisq(1-0.05,df=df1)## [1] 50.998467. Scree Plot (menentukan banyaknya dimensi)
fviz_screeplot(an.ca,addlabels = TRUE) +
geom_hline(yintercept=33.33, linetype=2, color="red")
8. Biplot Simetris
library(Rcpp)
# repel= TRUE untuk menghindari text tumpang tindih(running lambat jika titiknya banyak)
fviz_ca_biplot(an.ca, repel = F)
9. Biplot Asimetris Baris
#"rowprincipal": kolom direpresentasikan dalam ruang baris
fviz_ca_biplot(an.ca,
map ="rowprincipal", arrow = c(TRUE, TRUE), repel = F)
10. Biplot Asimetris Kolom
#"colprincipal": baris direpresentasikan dalam ruang kolom
fviz_ca_biplot(an.ca,
map ="colprincipal", arrow = c(TRUE, TRUE), repel = F)
11. Biplot Kontribusi Baris
#Biplot kontribusi setiap kategori Baris terhadap pembentukan Dimensi
fviz_ca_biplot(an.ca, map ="colgreen", arrow = c(TRUE, FALSE), repel = F)
12. Biplot Kontribusi Kolom
#Biplot kontribusi setiap kategori Kolom terhadap Dimensi
fviz_ca_biplot(an.ca, map ="rowgreen", arrow = c(FALSE, TRUE), repel = F)
13. Nilai Kontribusi Setiap Dimensi
# Dimension description
deskripsi.dimensi <- dimdesc(an.ca, axes = c(1,2))
deskripsi.dimensi## $`Dim 1`
## $`Dim 1`$row
## coord
## Laundry -0.9918368
## Main_meal -0.8755855
## Dinner -0.6925740
## Breakfeast -0.5086002
## Tidying -0.3938084
## Dishes -0.1889641
## Shopping -0.1176813
## Official 0.2266324
## Holidays 0.2524863
## Finances 0.2707669
## Insurance 0.6470759
## Driving 0.7417696
## Repairs 1.5287787
##
## $`Dim 1`$col
## coord
## Wife -0.83762154
## Alternating -0.06218462
## Jointly 0.14942609
## Husband 1.16091847Penugasan Modul Praktikum
Nomor 1
Data
library(psych)
library(GPArotation)
library(readxl)
papua <- read_excel("Data Modul 10.xlsx", sheet = "Penugasan 1")
papua## # A tibble: 29 x 5
## Kab Miskin IPM TPT Gini
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Merauke 10.0 70.1 2.61 0.38
## 2 Jayawijaya 37.2 58.0 2.39 0.342
## 3 Jayapura 12.4 71.7 9.68 0.432
## 4 Nabire 24.2 68.8 6.31 0.349
## 5 Kepulauan Yapen 26.3 67.7 5.78 0.4
## 6 Biak Numfor 24.6 72.2 10.4 0.401
## 7 Paniai 36.7 56.3 0.66 0.38
## 8 Puncak Jaya 34.7 48.4 1.78 0.376
## 9 Mimika 14.3 74.2 7.51 0.339
## 10 Boven Digoel 19.4 61.5 3.08 0.448
## # ... with 19 more rowspapua <- papua[,-1]Summary data
summary(papua)## Miskin IPM TPT Gini
## Min. :10.03 Min. :31.55 Min. : 0.000 Min. :0.187
## 1st Qu.:24.15 1st Qu.:48.37 1st Qu.: 0.710 1st Qu.:0.326
## Median :29.54 Median :56.31 Median : 2.390 Median :0.362
## Mean :28.21 Mean :57.29 Mean : 3.279 Mean :0.355
## 3rd Qu.:36.72 3rd Qu.:66.40 3rd Qu.: 4.680 3rd Qu.:0.400
## Max. :41.76 Max. :79.94 Max. :12.370 Max. :0.448Analisis Faktor
fac <- fa(papua, nfactors = 2, fm = "pa", scores = TRUE)
fac## Factor Analysis using method = pa
## Call: fa(r = papua, nfactors = 2, scores = TRUE, fm = "pa")
## Standardized loadings (pattern matrix) based upon correlation matrix
## PA1 PA2 h2 u2 com
## Miskin -0.70 -0.29 0.70 0.30 1.3
## IPM 0.87 0.16 0.87 0.13 1.1
## TPT 0.98 -0.18 0.88 0.12 1.1
## Gini 0.11 0.53 0.33 0.67 1.1
##
## PA1 PA2
## SS loadings 2.30 0.49
## Proportion Var 0.57 0.12
## Cumulative Var 0.57 0.70
## Proportion Explained 0.82 0.18
## Cumulative Proportion 0.82 1.00
##
## With factor correlations of
## PA1 PA2
## PA1 1.00 0.32
## PA2 0.32 1.00
##
## Mean item complexity = 1.1
## Test of the hypothesis that 2 factors are sufficient.
##
## The degrees of freedom for the null model are 6 and the objective function was 2.27 with Chi Square of 58.61
## The degrees of freedom for the model are -1 and the objective function was 0
##
## The root mean square of the residuals (RMSR) is 0
## The df corrected root mean square of the residuals is NA
##
## The harmonic number of observations is 29 with the empirical chi square 0 with prob < NA
## The total number of observations was 29 with Likelihood Chi Square = 0 with prob < NA
##
## Tucker Lewis Index of factoring reliability = 1.121
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy
## PA1 PA2
## Correlation of (regression) scores with factors 0.97 0.75
## Multiple R square of scores with factors 0.94 0.56
## Minimum correlation of possible factor scores 0.88 0.13Biplot
biplot(fac, labels = rownames(papua))
Nomor 2
library(FactoMineR)
library(factoextra)
library(ggplot2)
jateng <- as.data.frame(read_excel("Data Modul 10.xlsx", sheet = "Penugasan 2"))
rownames(jateng) <- jateng$Pendidikan
jateng <- jateng[,-1]
jateng## Tani_Tambang Industri Listrik_Air_Gas Konstruksi Dagang Transport
## No_Ijazah 127 38 2 8 28 5
## SD 177 86 1 45 76 13
## SMP 54 60 4 32 57 6
## SMA 60 50 4 22 96 11
## PT 6 0 0 2 10 1
## Akomodasi Jasa
## No_Ijazah 5 17
## SD 19 23
## SMP 23 35
## SMA 24 62
## PT 1 67Plot data
library(gplots)
# 1. convert data "jateng" menjadi sebuah tabel
data1 <- as.table(as.matrix(jateng))
# 2. membuat plot
balloonplot(t(data1), main ="Pekerjaan dan Pendidikan", xlab ="", ylab="",
label = FALSE, show.margins = FALSE,dotsize=4, text.size=0.5)
Analisis Korespondensi
an.ca <- CA(jateng, graph = FALSE)
print(an.ca)## **Results of the Correspondence Analysis (CA)**
## The row variable has 5 categories; the column variable has 8 categories
## The chi square of independence between the two variables is equal to 449.4398 (p-value = 1.615109e-77 ).
## *The results are available in the following objects:
##
## name description
## 1 "$eig" "eigenvalues"
## 2 "$col" "results for the columns"
## 3 "$col$coord" "coord. for the columns"
## 4 "$col$cos2" "cos2 for the columns"
## 5 "$col$contrib" "contributions of the columns"
## 6 "$row" "results for the rows"
## 7 "$row$coord" "coord. for the rows"
## 8 "$row$cos2" "cos2 for the rows"
## 9 "$row$contrib" "contributions of the rows"
## 10 "$call" "summary called parameters"
## 11 "$call$marge.col" "weights of the columns"
## 12 "$call$marge.row" "weights of the rows"summary(an.ca)##
## Call:
## CA(X = jateng, graph = FALSE)
##
## The chi square of independence between the two variables is equal to 449.4398 (p-value = 1.615109e-77 ).
##
## Eigenvalues
## Dim.1 Dim.2 Dim.3 Dim.4
## Variance 0.244 0.072 0.012 0.004
## % of var. 73.532 21.877 3.483 1.108
## Cumulative % of var. 73.532 95.409 98.892 100.000
##
## Rows
## Iner*1000 Dim.1 ctr cos2 Dim.2 ctr cos2
## No_Ijazah | 50.319 | -0.328 7.505 0.363 | -0.421 41.461 0.597
## SD | 35.072 | -0.308 12.640 0.878 | -0.067 2.021 0.042
## SMP | 20.338 | -0.006 0.003 0.000 | 0.284 22.266 0.793
## SMA | 30.472 | 0.197 3.867 0.309 | 0.252 21.192 0.504
## PT | 195.000 | 1.699 75.986 0.949 | -0.384 13.060 0.049
## Dim.3 ctr cos2
## No_Ijazah | -0.081 9.548 0.022 |
## SD | 0.063 11.223 0.037 |
## SMP | 0.124 26.425 0.150 |
## SMA | -0.152 48.796 0.185 |
## PT | 0.085 4.007 0.002 |
##
## Columns
## Iner*1000 Dim.1 ctr cos2 Dim.2 ctr cos2
## Tani_Tambang | 73.028 | -0.356 16.278 0.543 | -0.326 45.860 0.455
## Industri | 15.468 | -0.255 4.610 0.726 | 0.125 3.705 0.174
## Listrik_Air_Gas | 3.470 | -0.037 0.004 0.003 | 0.417 1.944 0.406
## Konstruksi | 13.036 | -0.166 0.911 0.170 | 0.255 7.189 0.400
## Dagang | 19.297 | 0.023 0.041 0.005 | 0.273 20.245 0.760
## Transport | 1.385 | -0.102 0.114 0.200 | 0.115 0.481 0.252
## Akomodasi | 11.434 | -0.034 0.025 0.005 | 0.455 15.136 0.959
## Jasa | 194.083 | 1.124 78.017 0.979 | -0.162 5.440 0.020
## Dim.3 ctr cos2
## Tani_Tambang | -0.022 1.345 0.002 |
## Industri | 0.086 11.093 0.083 |
## Listrik_Air_Gas | -0.181 2.291 0.076 |
## Konstruksi | 0.254 44.801 0.397 |
## Dagang | -0.146 36.429 0.218 |
## Transport | -0.112 2.864 0.239 |
## Akomodasi | 0.009 0.035 0.000 |
## Jasa | 0.030 1.143 0.001 |Nilai Kritis (Chi-square tabel)
df1 <- (nrow(jateng) - 1) * (ncol(jateng) - 1)
qchisq(1-0.05,df=df1)## [1] 41.33714Scree Plot (menentukan banyaknya dimensi)
fviz_screeplot(an.ca,addlabels = TRUE) +
geom_hline(yintercept=25, linetype=2, color="red")
Biplot Simetris
library(Rcpp)
# repel= TRUE untuk menghindari text tumpang tindih(running lambat jika titiknya banyak)
fviz_ca_biplot(an.ca, repel = F)
Biplot Asimetris Baris
#"rowprincipal": kolom direpresentasikan dalam ruang baris
fviz_ca_biplot(an.ca,
map ="rowprincipal", arrow = c(TRUE, TRUE), repel = F)
Biplot Asimetris Kolom
#"colprincipal": baris direpresentasikan dalam ruang kolom
fviz_ca_biplot(an.ca,
map ="colprincipal", arrow = c(TRUE, TRUE), repel = F)
Biplot Kontribusi Baris
#Biplot kontribusi setiap kategori Baris terhadap pembentukan Dimensi
fviz_ca_biplot(an.ca, map ="colgreen", arrow = c(TRUE, FALSE), repel = F)
Biplot Kontribusi Kolom
#Biplot kontribusi setiap kategori Kolom terhadap Dimensi
fviz_ca_biplot(an.ca, map ="rowgreen", arrow = c(FALSE, TRUE), repel = F)
Nilai Kontribusi Setiap Dimensi
# Dimension description
deskripsi.dimensi <- dimdesc(an.ca, axes = c(1,2))
deskripsi.dimensi## $`Dim 1`
## $`Dim 1`$row
## coord
## No_Ijazah -0.328378314
## SD -0.308121933
## SMP -0.005726466
## SMA 0.197093697
## PT 1.698950677
##
## $`Dim 1`$col
## coord
## Tani_Tambang -0.35619612
## Industri -0.25516251
## Konstruksi -0.16623151
## Transport -0.10215373
## Listrik_Air_Gas -0.03673402
## Akomodasi -0.03373645
## Dagang 0.02255728
## Jasa 1.12422676