V tejto domácej úlohe použijeme rovnaké dáta ako v predošlej. Pracujeme teda so škálovanými dátami carc
bez regresorov R78
, R77
a C
. Budeme sledovať, aký počet faktorov bude pre naše dáta najvhodnejší. V nasledujúcej tabuľke sa nachádza kumulatívny rozptyl a p-hodnoty porade 2,3,4 a 5 faktorov.
## Cumul. variance p-values
## 2 faktory 0.697 0.000
## 3 faktory 0.779 0.000
## 4 faktory 0.812 0.017
## 5 faktorov 0.856 0.629
Možeme si všimnúť, že zamietame hypotézu, že sú postačujúce 2 a 3 faktory. Keďže chceme minimalizovať počet faktorov, zvolíme si 4 faktory, ktoré spolu vysvetľujú \(81.2 \, \%\) variability a zároveň nezamietame model so 4 faktormi. Nasledujúca tabuľka zorazuje korelácie uvedených 4 faktorov z jednotlivými premennými (regresormi). Napríklad, faktor 1 je vysoko korelovaný so všetkými premennými okrem G
, C
, R78
, R77
a P
. Faktor 2 je zase vysoko korelovaný s premennými T
, D
, G
a C
a tak ďalej.
##
## Loadings:
## Factor1 Factor2 Factor3 Factor4
## M -0.67
## H 0.54
## R 0.66
## Tr 0.77
## W 0.74
## L 0.86
## T 0.72 0.52
## D 0.59 0.54 0.50
## G -0.63
## C -0.94
## R78 0.70
## R77 1.00
## P 0.83
##
## Factor1 Factor2 Factor3 Factor4
## SS loadings 4.26 2.53 1.71 1.60
## Proportion Var 0.33 0.19 0.13 0.12
## Cumulative Var 0.33 0.52 0.65 0.78
rbPal <- colorRampPalette(c('red','blue'))
loadings <- data.frame(fa4$loadings[,1:4])
loadings$colF1 <- rbPal(20)[as.numeric(cut(loadings[,1],breaks = seq(-1,1,length = 20)))]
loadings$nam1 <- paste(row.names(loadings), round(loadings[,1], digits = 3), sep = "\n")
loadings$colF2 <- rbPal(20)[as.numeric(cut(loadings[,2],breaks = seq(-1,1,length = 20)))]
loadings$nam2 <- paste(row.names(loadings), round(loadings[,2], digits = 3), sep = "\n")
loadings$colF3 <- rbPal(20)[as.numeric(cut(loadings[,3],breaks = seq(-1,1,length = 20)))]
loadings$nam3 <- paste(row.names(loadings), round(loadings[,3], digits = 3), sep = "\n")
loadings$colF4 <- rbPal(20)[as.numeric(cut(loadings[,4],breaks = seq(-1,1,length = 20)))]
loadings$nam4 <- paste(row.names(loadings), round(loadings[,4], digits = 3), sep = "\n")
par(mfrow = c(2,1))
barplot(abs(loadings[,1]), col = loadings$colF1, ylim = c(0,1), ylab = "Factor 1", names.arg = loadings$nam1, cex.names = 0.7)
barplot(abs(loadings[,2]), col = loadings$colF2, ylim = c(0,1), ylab = "Factor 2", names.arg = loadings$nam2, cex.names = 0.7)
barplot(abs(loadings[,3]), col = loadings$colF3, ylim = c(0,1), ylab = "Factor 3", names.arg = loadings$nam3, cex.names = 0.7)
barplot(abs(loadings[,4]), col = loadings$colF4, ylim = c(0,1), ylab = "Factor 4", names.arg = loadings$nam4, cex.names = 0.7)