DÚ 7

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)