Passos adotados

# https://repositorio.enap.gov.br/bitstream/1/4790/1/Livro%20An%C3%A1lise%20Fatorial.pdfhttps://repositorio.enap.gov.br/bitstream/1/4790/1/Livro%20An%C3%A1lise%20Fatorial.pdf
# https://www.kaggle.com/datasets/fedesoriano/body-fat-prediction-dataset
library(psych)
library(polycor)
library(ggcorrplot)
library(xlsx)
library(dplyr)
bodyfat = read.xlsx2(file = "/Users/fagnersuteldemoura/OneDrive/PPGEP-UFRGS/Doutorado/MétodosQuantitativos/bodyfat_AF.xls", sheetIndex = 1,header = 1, colClasses = rep("numeric",14))
bodyfat$X. = NULL
glimpse(bodyfat)
## Rows: 252
## Columns: 13
## $ x1  <dbl> 23, 22, 22, 26, 24, 24, 26, 25, 25, 23, 26, 27, 32, 30, 35, 35, 34…
## $ x2  <dbl> 154.25, 173.25, 154.00, 184.75, 184.25, 210.25, 181.00, 176.00, 19…
## $ x3  <dbl> 67.75, 72.25, 66.25, 72.25, 71.25, 74.75, 69.75, 72.50, 74.00, 73.…
## $ x4  <dbl> 36.2, 38.5, 34.0, 37.4, 34.4, 39.0, 36.4, 37.8, 38.1, 42.1, 38.5, …
## $ x5  <dbl> 93.1, 93.6, 95.8, 101.8, 97.3, 104.5, 105.1, 99.6, 100.9, 99.6, 10…
## $ x6  <dbl> 85.2, 83.0, 87.9, 86.4, 100.0, 94.4, 90.7, 88.5, 82.5, 88.6, 83.6,…
## $ x7  <dbl> 94.5, 98.7, 99.2, 101.2, 101.9, 107.8, 100.3, 97.1, 99.9, 104.1, 9…
## $ x8  <dbl> 59.0, 58.7, 59.6, 60.1, 63.2, 66.0, 58.4, 60.0, 62.9, 63.1, 59.7, …
## $ x9  <dbl> 37.3, 37.3, 38.9, 37.3, 42.2, 42.0, 38.3, 39.4, 38.3, 41.7, 39.7, …
## $ x10 <dbl> 21.9, 23.4, 24.0, 22.8, 24.0, 25.6, 22.9, 23.2, 23.8, 25.0, 25.2, …
## $ x11 <dbl> 32.0, 30.5, 28.8, 32.4, 32.2, 35.7, 31.9, 30.5, 35.9, 35.6, 32.8, …
## $ x12 <dbl> 27.4, 28.9, 25.2, 29.4, 27.7, 30.6, 27.8, 29.0, 31.1, 30.0, 29.4, …
## $ x13 <dbl> 17.1, 18.2, 16.6, 18.2, 17.7, 18.8, 17.7, 18.8, 18.2, 19.2, 18.5, …

Obtenção da matriz de correlações

mat_cor <- hetcor(bodyfat)$correlations #matriz de correlação
ggcorrplot(mat_cor,type="lower",hc.order = T)

Análise de Espericidade

Nessa etapa é aplicado o teste de Bartlett para verificar se há corelação entre as variáveis do conjunto.

cortest.bartlett(mat_cor)->p_esf

Com um p-valor 7.4716675^{-246} < 0,05 rejeitamos a hipótese nula.

Segundo teste via KMO

Com essa abordagem é adotado o critério de Kaiser-Meyer-Olkin para verificar o grau de adequação dos dados À análise fatorial. Esse método avalia o quanto os dados são aderentes ao modelo fatorial considerando cada variável e também o modelo (conjunto) completo.

Para isso o teste mede a proporção da variabilidade entre variáveis que podem ser variações comuns (COMUNALIDADE). Para orientar no teste, o mesmo oferece os intervalos de aceitação, onde quanto mais próximo de 1 melhor; 0,5 como valor mínimo aceitável, mas o ideal seria um valor a partir de 0,7.:

KMO(mat_cor)
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = mat_cor)
## Overall MSA =  0.91
## MSA for each item = 
##   x1   x2   x3   x4   x5   x6   x7   x8   x9  x10  x11  x12  x13 
## 0.27 0.87 0.60 0.95 0.91 0.90 0.91 0.92 0.95 0.95 0.95 0.95 0.92

Como o teste fornece um valor de 0.9057908, assume-se que os dados são ótimos para análise fatorial.

Teste de modelo com três fatores

Modelo Máxima Verossimilhança

modelo1<-fa(mat_cor,
           nfactors = 3,
           rotate = "none",
           fm="mle") # modelo máxima verosimilhança
modelo1
## Factor Analysis using method =  ml
## Call: fa(r = mat_cor, nfactors = 3, rotate = "none", fm = "mle")
## Standardized loadings (pattern matrix) based upon correlation matrix
##      ML1   ML2   ML3   h2    u2 com
## x1  0.06 -0.63  0.37 0.54 0.461 1.6
## x2  0.98  0.13  0.04 0.98 0.018 1.0
## x3  0.22  0.40  0.32 0.31 0.689 2.5
## x4  0.83  0.06  0.28 0.77 0.233 1.2
## x5  0.92 -0.17  0.11 0.89 0.109 1.1
## x6  0.94 -0.29 -0.04 0.98 0.024 1.2
## x7  0.95  0.10 -0.18 0.95 0.055 1.1
## x8  0.87  0.23 -0.24 0.87 0.130 1.3
## x9  0.84  0.20  0.01 0.75 0.251 1.1
## x10 0.58  0.31  0.12 0.44 0.556 1.6
## x11 0.79  0.19  0.10 0.67 0.326 1.2
## x12 0.61  0.23  0.24 0.49 0.513 1.6
## x13 0.71  0.13  0.43 0.72 0.285 1.7
## 
##                        ML1  ML2  ML3
## SS loadings           7.66 0.99 0.69
## Proportion Var        0.59 0.08 0.05
## Cumulative Var        0.59 0.67 0.72
## Proportion Explained  0.82 0.11 0.07
## Cumulative Proportion 0.82 0.93 1.00
## 
## Mean item complexity =  1.4
## Test of the hypothesis that 3 factors are sufficient.
## 
## The degrees of freedom for the null model are  78  and the objective function was  15.16
## The degrees of freedom for the model are 42  and the objective function was  0.95 
## 
## The root mean square of the residuals (RMSR) is  0.03 
## The df corrected root mean square of the residuals is  0.05 
## 
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy             
##                                                    ML1  ML2  ML3
## Correlation of (regression) scores with factors   1.00 0.93 0.86
## Multiple R square of scores with factors          0.99 0.87 0.74
## Minimum correlation of possible factor scores     0.98 0.75 0.49
modelo1$communalities
##        x1        x2        x3        x4        x5        x6        x7        x8 
## 0.5387873 0.9823452 0.3115002 0.7667220 0.8911697 0.9756692 0.9451780 0.8703774 
##        x9       x10       x11       x12       x13 
## 0.7485881 0.4435499 0.6744940 0.4867841 0.7153759

Modelo de Resíduo Mínimo

modelo2<-fa(mat_cor,
           nfactors = 3,
           rotate = "none",
           fm="minres") # residuo
modelo2
## Factor Analysis using method =  minres
## Call: fa(r = mat_cor, nfactors = 3, rotate = "none", fm = "minres")
## Standardized loadings (pattern matrix) based upon correlation matrix
##      MR1   MR2   MR3   h2    u2 com
## x1  0.03  0.83  0.09 0.70 0.299 1.0
## x2  0.99 -0.05 -0.04 0.98 0.024 1.0
## x3  0.26 -0.23  0.35 0.24 0.756 2.6
## x4  0.85  0.10  0.13 0.75 0.249 1.1
## x5  0.89  0.22 -0.13 0.86 0.140 1.2
## x6  0.89  0.29 -0.27 0.95 0.049 1.4
## x7  0.93 -0.07 -0.24 0.92 0.080 1.1
## x8  0.88 -0.24 -0.25 0.89 0.107 1.3
## x9  0.86 -0.07  0.03 0.74 0.262 1.0
## x10 0.61 -0.17  0.17 0.44 0.565 1.3
## x11 0.83 -0.08  0.03 0.69 0.311 1.0
## x12 0.67 -0.11  0.17 0.49 0.506 1.2
## x13 0.78  0.16  0.45 0.84 0.158 1.7
## 
##                        MR1  MR2  MR3
## SS loadings           7.85 1.03 0.62
## Proportion Var        0.60 0.08 0.05
## Cumulative Var        0.60 0.68 0.73
## Proportion Explained  0.83 0.11 0.07
## Cumulative Proportion 0.83 0.93 1.00
## 
## Mean item complexity =  1.3
## Test of the hypothesis that 3 factors are sufficient.
## 
## The degrees of freedom for the null model are  78  and the objective function was  15.16
## The degrees of freedom for the model are 42  and the objective function was  1.12 
## 
## The root mean square of the residuals (RMSR) is  0.03 
## The df corrected root mean square of the residuals is  0.04 
## 
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy             
##                                                    MR1  MR2  MR3
## Correlation of (regression) scores with factors   1.00 0.92 0.93
## Multiple R square of scores with factors          0.99 0.85 0.86
## Minimum correlation of possible factor scores     0.98 0.71 0.72
modelo2$communalities
##        x1        x2        x3        x4        x5        x6        x7        x8 
## 0.7014030 0.9762967 0.2444840 0.7505387 0.8599970 0.9505587 0.9201387 0.8926146 
##        x9       x10       x11       x12       x13 
## 0.7377059 0.4352439 0.6893582 0.4936298 0.8421941

Comunalidades

sort(modelo1$communality,decreasing = T)->c1
sort(modelo2$communality,decreasing = T)->c2
cbind(c1,c2)
##            c1        c2
## x2  0.9823452 0.9762954
## x6  0.9756692 0.9505600
## x7  0.9451780 0.9201353
## x5  0.8911709 0.8926200
## x8  0.8703781 0.8599961
## x4  0.7667251 0.8421975
## x9  0.7485869 0.7505412
## x13 0.7153871 0.7377021
## x11 0.6744963 0.7014046
## x1  0.5387906 0.6893563
## x12 0.4867974 0.4936296
## x10 0.4435504 0.4352410
## x3  0.3114645 0.2444816

Os dados demonstram que as variáveis X1, X3 e X10 apresentam baixa comunalidade e serão suprimidas do modelo.

Unicidade

sort(modelo1$uniquenesses,decreasing = T)->u1
sort(modelo2$uniquenesses,decreasing = T)->u2
cbind(u1,u2)
##             u1         u2
## x3  0.68853550 0.75551836
## x10 0.55644963 0.56475900
## x12 0.51320259 0.50637036
## x1  0.46120943 0.31064374
## x11 0.32550372 0.29859539
## x13 0.28461295 0.26229787
## x9  0.25141311 0.24945883
## x4  0.23327487 0.15780254
## x8  0.12962194 0.14000390
## x5  0.10882913 0.10737999
## x7  0.05482199 0.07986471
## x6  0.02433075 0.04944003
## x2  0.01765482 0.02370461

Gráfico de Contribnuições (cotovelo)

Análise do Scree Plot: este método se baseia na análise da magnitude dos autovalores, mas a partir da tendência que se observa no Scree Plot. Você deve selecionar um grupo reduzido de fatores que tenham autovalores significativamente superiores aos demais, para que qual seja o ponto de inflexão na curva do Scree Plota partir de qual curva se transforma em uma linha “plana” ou relativamente reta (assíntota).

Essa análise sugere dois ou três fatores a serem utilizados.

scree(mat_cor)

Análise paralela: Esta regra é complementar à anteriore quando o número de variáveis iniciais e fatores resultantes é elevado. O procedimento é baseado no princípio de que os fatores a serem extraidos devem dar conta da variação que é esperada de forma aleatória. O procedimento reordena as observações de forma aleatória entre cada variável e os autovalores são recalculados a partir desta nova base de dados ordenada aleatoriamente. Os fatores com autovalores maiores nos valores aleatórios são mantidos para interpretação.

Está análise para o modelo atual sugere um único fator

fa.parallel(mat_cor,n.obs=200,fa="fa",fm="minres")

## Parallel analysis suggests that the number of factors =  3  and the number of components =  NA

A partir da análise de contribuições é possível entender que a análise de dois fatores é suficiente.

Rotação

Remoção de variáveis de baixa comunalidade

bodyfat$x1 = bodyfat$x3 = bodyfat$x10 = NULL
library(GPArotation)
rot<-c("none", "varimax", "quartimax","Promax")
bi_mod<-function(tipo){
biplot.psych(fa(bodyfat,nfactors = 2,fm="minres",rotate = tipo),main = paste("Plot com rotação ",tipo),col=c(2,3,4),pch = c(21,18),group = bfi[,"gender"])  
}
sapply(rot,bi_mod)

## $none
## NULL
## 
## $varimax
## NULL
## 
## $quartimax
## NULL
## 
## $Promax
## NULL

Varimax Dois Fatores

modelo_varimax<-fa(mat_cor,nfactors = 2,rotate = "varimax",
              fa="minres")
fa.diagram(modelo_varimax)

Nesse modelo os trÊs fatores combinam variáveis da seguinte maneira. MR1:
Medidas de peso, circunferência do quadril, torácica, abdômem, pescoço, coxa, joelho, bíceps, tornozelo, antebraço e pulso.
MR2:
Idade

Modelo Varimax

print(modelo_varimax$loadings,cut=0) 
## 
## Loadings:
##     MR1    MR2   
## x1   0.094  0.917
## x2   0.985 -0.111
## x3   0.244 -0.207
## x4   0.856  0.040
## x5   0.905  0.136
## x6   0.897  0.182
## x7   0.916 -0.128
## x8   0.855 -0.281
## x9   0.853 -0.114
## x10  0.602 -0.193
## x11  0.821 -0.134
## x12  0.661 -0.152
## x13  0.771  0.085
## 
##                  MR1   MR2
## SS loadings    7.760 1.143
## Proportion Var 0.597 0.088
## Cumulative Var 0.597 0.685

VarimaxTrês Fatores

modelo_varimax<-fa(mat_cor,nfactors = 3,rotate = "varimax",
              fa="minres")
fa.diagram(modelo_varimax)

Nesse modelo os trÊs fatores combinam variáveis da seguinte maneira. MR1:
Medidas de peso, circunferência do abdômem, quadril, coxa, torácica, joelho, bíceps, pescoço e antebraço.
MR2:
Idade MR3:
Altura, circunferência do antebraço e pulso

Modelo Varimax

print(modelo_varimax$loadings,cut=0) 
## 
## Loadings:
##     MR1    MR3    MR2   
## x1   0.022 -0.093  0.832
## x2   0.892  0.425  0.007
## x3   0.063  0.473 -0.130
## x4   0.701  0.475  0.181
## x5   0.863  0.244  0.237
## x6   0.930  0.104  0.274
## x7   0.930  0.229 -0.060
## x8   0.883  0.236 -0.237
## x9   0.748  0.422 -0.007
## x10  0.462  0.463 -0.088
## x11  0.718  0.416 -0.023
## x12  0.513  0.479 -0.033
## x13  0.503  0.705  0.303
## 
##                  MR1   MR3   MR2
## SS loadings    6.350 2.110 1.034
## Proportion Var 0.488 0.162 0.080
## Cumulative Var 0.488 0.651 0.730

Conclusões

O modelo apresentou dados de esfericidade adequada para análise fatorial, além disse as comunalidades foram explicitadas, demonstrando a necessidade de remover trÊs variáveis que apresentaram baixa contribuição para o modelo. Por meio dos gráficos de contribuições foi possível decidir pelo uso de deois fatores. Escolha reforçado quando percebe-se que o MR2 a dois fatores incorpora as variáveis que compõem o MR3 quando adotados três fatores.