Análise de Componentes Principais - ACP

---

PCA baseado na matriz de correlação: dados dos recordes nacionais masculinos de oito provas de pista em 2005.

O conjunto de dados dos recordes nacionais masculinos de oito provas de pista encontram-se na página http://www.stat.wisc.edu/~rich/JWMULT06dat/T8-6.DAT (vide também Johnson and Wichern, 2007, Applied Multivariate Statistical Analysis, 6th ed., p. 477). Os dados são de 2005 e dizem respeito a 54 países, listados na primeira coluna do arquivo. As demais colunas contêm os resultados das seguintes provas (unidades): 100 m (s), 200 m (s), 400 m (s), 800 m (min), 1500 m (min), 5000 m (min), 10000 m (min) e maratona (min).

dados <- read.table(file = "T8-6.DAT")
# dimensão  54 x 9
dim(dados)

[1] 54  9

#O vetor provas contém os nomes e unidades dos resultados das provas.
provas <- c("100 m (s)", "200 m (s)", "400 m (s)", "800 m (min)",
            "1500 m (min)", "5000 m (min)", "10000 m (min)",
            "Maratona (min)")
# armazena só os países
paises <- dados[, 1]
# excluir os países
dados <- dados[, -1]
#renomeia as variáveis e linhas
colnames(dados) <- provas
rownames(dados) <- paises
# sumário estatístico 
describe(dados)

               vars  n   mean   sd median trimmed  mad    min    max range skew
100 m (s)         1 54  10.22 0.22  10.20   10.20 0.18   9.78  10.97  1.19 0.86
200 m (s)         2 54  20.54 0.55  20.43   20.50 0.47  19.32  22.46  3.14 0.91
400 m (s)         3 54  45.83 1.44  45.58   45.64 1.09  43.18  51.40  8.22 1.56
800 m (min)       4 54   1.77 0.05   1.76    1.76 0.04   1.69   1.94  0.25 1.24
1500 m (min)      5 54   3.65 0.15   3.61    3.64 0.12   3.44   4.24  0.80 1.44
5000 m (min)      6 54  13.62 0.76  13.42   13.49 0.49  12.66  16.70  4.04 2.10
10000 m (min)     7 54  28.54 1.68  27.92   28.24 0.85  26.46  35.38  8.92 2.27
Maratona (min)    8 54 133.48 8.95 130.31  131.88 4.40 124.55 171.26 46.71 2.18
               kurtosis   se
100 m (s)          1.65 0.03
200 m (s)          1.62 0.07
400 m (s)          3.46 0.20
800 m (min)        2.12 0.01
1500 m (min)       2.72 0.02
5000 m (min)       5.30 0.10
10000 m (min)      6.01 0.23
Maratona (min)     5.30 1.22

# gráfico boxplot 
boxplot(dados)

boxplot(scale(dados))

correlações

# Correlation matrix
matcor <- round(cor(dados), 2)
matcor

               100 m (s) 200 m (s) 400 m (s) 800 m (min) 1500 m (min) 5000 m (min)
100 m (s)           1.00      0.91      0.80        0.71         0.77         0.74
200 m (s)           0.91      1.00      0.84        0.80         0.80         0.76
400 m (s)           0.80      0.84      1.00        0.77         0.77         0.78
800 m (min)         0.71      0.80      0.77        1.00         0.90         0.86
1500 m (min)        0.77      0.80      0.77        0.90         1.00         0.92
5000 m (min)        0.74      0.76      0.78        0.86         0.92         1.00
10000 m (min)       0.71      0.75      0.77        0.84         0.90         0.99
Maratona (min)      0.68      0.72      0.71        0.81         0.88         0.94
               10000 m (min) Maratona (min)
100 m (s)               0.71           0.68
200 m (s)               0.75           0.72
400 m (s)               0.77           0.71
800 m (min)             0.84           0.81
1500 m (min)            0.90           0.88
5000 m (min)            0.99           0.94
10000 m (min)           1.00           0.95
Maratona (min)          0.95           1.00

# Plot
ggcorrplot(matcor, hc.order = TRUE, 
           type = "lower", 
           lab = TRUE, 
           lab_size = 3, 
           method="circle", 
           colors = c("tomato2", "white", "springgreen3"), 
           title="Correlograma", 
           ggtheme=theme_bw)

teste de Bartlett

Bartlett.sphericity.test

Bartlett.sphericity.test <- function(x)
{
  method <- "Bartlett's test of sphericity"
  data.name <- deparse(substitute(x))
  x <- subset(x, complete.cases(x)) # Omit missing values
  n <- nrow(x)
  p <- ncol(x)
  chisq <- (1-n+(2*p+5)/6)*log(det(cor(x)))
  df <- p*(p-1)/2
  p.value <- pchisq(chisq, df, lower.tail=FALSE)
  names(chisq) <- "X-squared"
  names(df) <- "df"
  return(structure(list(statistic=chisq, parameter=df, p.value=p.value,
                        method=method, data.name=data.name), class="htest"))
}
Bartlett.sphericity.test(dados)

    Bartlett's test of sphericity

data:  dados
X-squared = 706.68, df = 28, p-value < 2.2e-16

PCA

A análise de componentes principais será baseada na matriz de correlações amostral

# PCA com a matriz de cor
res.pca.cor <- PCA(dados, scale.unit = T, graph = FALSE, ncp = Inf)
# matriz de covariância
round(cor(dados),4)

               100 m (s) 200 m (s) 400 m (s) 800 m (min) 1500 m (min) 5000 m (min)
100 m (s)         1.0000    0.9148    0.8041      0.7119       0.7658       0.7399
200 m (s)         0.9148    1.0000    0.8449      0.7969       0.7951       0.7613
400 m (s)         0.8041    0.8449    1.0000      0.7677       0.7716       0.7797
800 m (min)       0.7119    0.7969    0.7677      1.0000       0.8958       0.8607
1500 m (min)      0.7658    0.7951    0.7716      0.8958       1.0000       0.9165
5000 m (min)      0.7399    0.7613    0.7797      0.8607       0.9165       1.0000
10000 m (min)     0.7148    0.7480    0.7657      0.8431       0.9013       0.9882
Maratona (min)    0.6765    0.7211    0.7127      0.8070       0.8778       0.9441
               10000 m (min) Maratona (min)
100 m (s)             0.7148         0.6765
200 m (s)             0.7480         0.7211
400 m (s)             0.7657         0.7127
800 m (min)           0.8431         0.8070
1500 m (min)          0.9013         0.8778
5000 m (min)          0.9882         0.9441
10000 m (min)         1.0000         0.9542
Maratona (min)        0.9542         1.0000

# autovalores
round(res.pca.cor$eig,3)

# autovetores
round(res.pca.cor$svd$V,3)

      [,1]   [,2]   [,3]   [,4]   [,5]   [,6]   [,7]   [,8]
[1,] 0.332  0.529  0.344 -0.381 -0.300  0.362  0.348  0.066
[2,] 0.346  0.470 -0.004 -0.217  0.541 -0.349 -0.440 -0.061
[3,] 0.339  0.345 -0.067  0.851 -0.133 -0.077  0.114  0.003
[4,] 0.353 -0.089 -0.783 -0.134  0.227  0.341  0.259  0.039
[5,] 0.366 -0.154 -0.244 -0.233 -0.652 -0.530 -0.147  0.040
[6,] 0.370 -0.295  0.183  0.055 -0.072  0.359 -0.328 -0.706
[7,] 0.366 -0.334  0.244  0.087  0.061  0.273 -0.351  0.697
[8,] 0.354 -0.387  0.335 -0.018  0.338 -0.375  0.594 -0.069

# A proporção de variação retida pelos componentes principais (CP) pode ser extraída da seguinte forma
res.pca.cor$eig

# A importância dos CP pode ser visualizada usando o scree plot :
fviz_screeplot(res.pca.cor, ncp=4)+ theme_minimal()

# A correlação entre uma variável e um CP é chamada de carga (loadings). 
round(res.pca.cor$var$cor,4)

                Dim.1   Dim.2   Dim.3   Dim.4   Dim.5   Dim.6   Dim.7   Dim.8
100 m (s)      0.8606  0.4230  0.1640 -0.1727 -0.0936  0.0963  0.0753  0.0065
200 m (s)      0.8960  0.3758 -0.0018 -0.0985  0.1691 -0.0927 -0.0953 -0.0060
400 m (s)      0.8780  0.2759 -0.0320  0.3862 -0.0415 -0.0205  0.0246  0.0003
800 m (min)    0.9140 -0.0715 -0.3733 -0.0609  0.0710  0.0907  0.0561  0.0039
1500 m (min)   0.9476 -0.1228 -0.1165 -0.1057 -0.2036 -0.1409 -0.0319  0.0039
5000 m (min)   0.9575 -0.2355  0.0872  0.0248 -0.0224  0.0955 -0.0711 -0.0696
10000 m (min)  0.9475 -0.2666  0.1164  0.0395  0.0192  0.0726 -0.0761  0.0687
Maratona (min) 0.9173 -0.3089  0.1596 -0.0082  0.1055 -0.0997  0.1287 -0.0068

O quadrado da correlação entre a variável e a CP representa a porcentagem de variância de uma das variáveis originais explicada por uma das CP

Conceito de Comunalidade

a comunalidade é a soma dos quadrados das correlações entre cada variável i e a componente principal j (ou o mesmo que o índice cos2). A soma limite-se ao número do componenentes retidos. Em nosso exemplo ilustrativo retemos todos os componentes que é igual ao número de variáveis.

# banseando-se na matriz de cor
round(res.pca.cor$var$cor^2,4)

                Dim.1  Dim.2  Dim.3  Dim.4  Dim.5  Dim.6  Dim.7  Dim.8
100 m (s)      0.7406 0.1789 0.0269 0.0298 0.0088 0.0093 0.0057 0.0000
200 m (s)      0.8027 0.1413 0.0000 0.0097 0.0286 0.0086 0.0091 0.0000
400 m (s)      0.7709 0.0761 0.0010 0.1492 0.0017 0.0004 0.0006 0.0000
800 m (min)    0.8354 0.0051 0.1394 0.0037 0.0050 0.0082 0.0031 0.0000
1500 m (min)   0.8979 0.0151 0.0136 0.0112 0.0414 0.0198 0.0010 0.0000
5000 m (min)   0.9168 0.0555 0.0076 0.0006 0.0005 0.0091 0.0051 0.0048
10000 m (min)  0.8977 0.0711 0.0135 0.0016 0.0004 0.0053 0.0058 0.0047
Maratona (min) 0.8413 0.0954 0.0255 0.0001 0.0111 0.0099 0.0166 0.0000

# ou  round(res.pca.cor$var$cos2,4)

Mapa Fatorial

Quando um subespaço projetivo bidimensional determinado por duas direções principais escolhidas (CP), sua imagem geométrica plana com os pontos projetados e o círculo de correlações é denominada MAPA FATORIAL

# Quanto mais próxima uma variável for do círculo de correlações, melhor sua representação no mapa fatorial (e mais importante é a variável para a interpretação desses componentes)
# As variáveis próximas ao centro do gráfico são menos importantes para os primeiros componentes.
# No gráfico abaixo os componentes são coloridas de acordo com os valores do coseno quadrado:
fviz_pca_var(res.pca.cor, col.var="cos2") +
scale_color_gradient2(low="white", mid="blue", 
                    high="red", midpoint=0.5) + theme_minimal()

# Coordenadas de variáveis
round(res.pca.cor$var$coord,2)

               Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7 Dim.8
100 m (s)       0.86  0.42  0.16 -0.17 -0.09  0.10  0.08  0.01
200 m (s)       0.90  0.38  0.00 -0.10  0.17 -0.09 -0.10 -0.01
400 m (s)       0.88  0.28 -0.03  0.39 -0.04 -0.02  0.02  0.00
800 m (min)     0.91 -0.07 -0.37 -0.06  0.07  0.09  0.06  0.00
1500 m (min)    0.95 -0.12 -0.12 -0.11 -0.20 -0.14 -0.03  0.00
5000 m (min)    0.96 -0.24  0.09  0.02 -0.02  0.10 -0.07 -0.07
10000 m (min)   0.95 -0.27  0.12  0.04  0.02  0.07 -0.08  0.07
Maratona (min)  0.92 -0.31  0.16 -0.01  0.11 -0.10  0.13 -0.01

# Cos2: é uma medida que indica a qualidade da representação para variáveis no mapa fatorial
round(res.pca.cor$var$cos2,2)

               Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7 Dim.8
100 m (s)       0.74  0.18  0.03  0.03  0.01  0.01  0.01     0
200 m (s)       0.80  0.14  0.00  0.01  0.03  0.01  0.01     0
400 m (s)       0.77  0.08  0.00  0.15  0.00  0.00  0.00     0
800 m (min)     0.84  0.01  0.14  0.00  0.01  0.01  0.00     0
1500 m (min)    0.90  0.02  0.01  0.01  0.04  0.02  0.00     0
5000 m (min)    0.92  0.06  0.01  0.00  0.00  0.01  0.01     0
10000 m (min)   0.90  0.07  0.01  0.00  0.00  0.01  0.01     0
Maratona (min)  0.84  0.10  0.03  0.00  0.01  0.01  0.02     0

Contribuições das variáveis para os componentes principais

As variáveis que são correlacionadas com PC1 e PC2 são as mais importantes para explicar a variabilidade no conjunto de dados. Variáveis que não se correlacionam com nenhum PC ou correlacionadas com as últimas dimensões são variáveis com baixa contribuição e podem ser removidas para simplificar a análise geral. As contribuições das variáveis na contabilização da variabilidade em uma determinada componente principal são (em porcentagem): (variável.cos2 * 100) / (cos2 total da componente)

# A contribuição das variáveis pode ser extraída da seguinte forma:
round(res.pca.cor$var$contrib,2)

               Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7 Dim.8
100 m (s)      11.05 28.03 11.82 14.50  8.98 13.11 12.09  0.43
200 m (s)      11.98 22.13  0.00  4.71 29.32 12.15 19.35  0.37
400 m (s)      11.50 11.93  0.45 72.47  1.77  0.59  1.29  0.00
800 m (min)    12.46  0.80 61.26  1.80  5.17 11.65  6.70  0.15
1500 m (min)   13.39  2.36  5.97  5.43 42.46 28.07  2.16  0.16
5000 m (min)   13.68  8.69  3.34  0.30  0.52 12.90 10.78 49.80
10000 m (min)  13.39 11.13  5.95  0.76  0.38  7.46 12.33 48.61
Maratona (min) 12.55 14.94 11.20  0.03 11.42 14.08 35.30  0.48

# veja que a soma é igual a 100%
sum (res.pca.cor$var$contrib[,1])  

[1] 100

# Quanto maior o valor da contribuição, mais a variável contribui para o componente.
# As variáveis mais importantes associadas a um determinado PC podem ser visualizadas, usando a função fviz_contrib () [factoextra package], da seguinte forma:
# Contribuições de variáveis no PC1
fviz_contrib(res.pca.cor, choice = "var", axes = 1)+ theme_minimal()

# Contribuições de variáveis no PC2
fviz_contrib(res.pca.cor, choice = "var", axes = 2)+ theme_minimal()

# Contribuição total nos PC1 e PC2
fviz_contrib(res.pca.cor, choice = "var", axes = 1:2)+ theme_minimal()

# Controle as cores das variáveis usando suas contribuições
# a cor representa a contribuição conjunta dim1-dim2
fviz_pca_var(res.pca.cor, col.var="contrib")+ theme_minimal()

# Alterar a cor 
fviz_pca_var(res.pca.cor, col.var="contrib") +
scale_color_gradient2(low="white", mid="blue", 
                  high="red", midpoint=50) + theme_minimal()

A função dimdesc () [em FactoMineR] pode ser usada para identificar as variáveis mais correlacionadas com uma determinada componente principal.

res.desc <- dimdesc(res.pca.cor, axes = c(1,2))
# Descrição da dimensão 1
res.desc$Dim.1

$quanti
               correlation      p.value
5000 m (min)     0.9574913 9.652035e-30
1500 m (min)     0.9475610 2.005000e-27
10000 m (min)    0.9474679 2.097262e-27
Maratona (min)   0.9172508 1.947035e-22
800 m (min)      0.9139768 5.125109e-22
200 m (s)        0.8959509 5.745353e-20
400 m (s)        0.8780162 2.857744e-18
100 m (s)        0.8605755 7.377897e-17

# Descrição da dimensão 2
res.desc$Dim.2

$quanti
               correlation     p.value
100 m (s)        0.4229929 0.001439320
200 m (s)        0.3758447 0.005098467
400 m (s)        0.2759201 0.043431434
Maratona (min)  -0.3088643 0.023059523

# Descrição da dimensão 3
res.desc$Dim.3

NULL

Análise de pontos (escores, objetos, indivíduos)

# Gráfico de escores (indivíduos ou pontos objetos)
# As coordenadas dos escores nos componentes principais são:
round(res.pca.cor$ind$coord,2)

               Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7 Dim.8
Argentina      -0.42  0.40 -0.41  0.15 -0.48 -0.09  0.22 -0.04
Australia      -2.37 -0.56 -0.29  0.00  0.26 -0.08 -0.09  0.18
Austria        -0.74  0.18 -0.27  0.18  0.28 -0.03  0.29 -0.02
Belgium        -2.00  0.38 -0.04 -0.11 -0.20 -0.20  0.26  0.05
Bermuda         1.50 -1.66  0.73 -0.31  0.10  0.52  0.30 -0.17
Brazil         -2.23 -0.80  0.53  0.01 -0.43  0.17 -0.55 -0.05
Canada         -2.03 -0.86 -0.42  0.31  0.58 -0.20 -0.22 -0.12
Chile          -0.73 -0.35 -0.23  0.40 -0.30 -0.12  0.21  0.04
China          -0.73  0.02 -0.27 -0.18  0.03  0.22 -0.10  0.05
Columbia        0.39  0.61 -0.69 -0.47 -0.04 -0.17  0.00 -0.11
CookIslands    10.81 -0.29  0.54  0.40 -0.03 -0.23  0.11  0.00
CostaRica       1.83  0.29 -1.64 -0.52 -0.15  0.00  0.06  0.11
CzechRepublic  -0.57  0.51  0.20  0.01  0.20  0.00  0.07 -0.14
Denmark        -1.14  0.82  1.21  0.29 -0.05  0.06 -0.17 -0.12
DominicanRepub  1.49 -1.62  0.12 -0.60  0.60  0.00  0.02  0.07
Finland        -0.92  0.37  0.18 -0.10 -0.06 -0.21  0.13 -0.11
France         -2.42 -0.04  0.16  0.08  0.29  0.09 -0.12  0.07
Germany        -2.16 -0.09  0.07 -0.31  0.24 -0.11  0.04  0.13
GreatBritain   -2.94 -0.67  0.25  0.30  0.19 -0.20 -0.26 -0.03
Greece         -1.11 -0.64  0.04  0.39 -0.47  0.24  0.37 -0.01
Guatemala       2.01  0.92 -0.72  0.96 -0.03  0.06 -0.29  0.04
Hungary        -1.04 -0.49 -0.13  0.26 -0.02  0.14  0.21 -0.06
India           0.04  0.45  0.31 -0.41  0.10  0.17 -0.12  0.24
Indonesia       1.82 -0.50 -0.65 -0.05  0.33 -0.09 -0.22 -0.10
Ireland        -0.82  0.94  0.24 -0.26  0.02  0.24  0.30  0.23
Israel          0.80  0.26 -0.56  0.20  0.27 -0.23 -0.14  0.03
Italy          -2.26 -0.45 -0.10  0.51 -0.43  0.13  0.28 -0.01
Japan          -1.67 -0.52 -0.77 -0.06 -0.24  0.12 -0.09  0.01
Kenya          -2.63  1.17  0.68 -0.70  0.26  0.15  0.19  0.02
Korea,South    -0.38  0.33  0.47 -0.31 -0.58  0.54 -0.37 -0.14
Korea,North     1.87  1.67 -0.53 -0.56 -0.41  0.36 -0.10 -0.16
Luxembourg      1.00  1.08  0.36  0.82 -0.31 -0.03  0.21  0.11
Malaysia        2.00 -0.55  0.45 -0.12  0.43 -0.64  0.52 -0.15
Mauritius       0.87 -2.03 -0.16 -0.61 -0.52 -0.12  0.28  0.07
Mexico         -1.24  0.24 -0.64 -0.93 -0.08  0.13  0.15 -0.07
Myanmar(Burma)  3.27  1.64  0.33  0.32 -0.14 -0.19  0.05 -0.04
Netherlands    -1.45  0.37  0.26  0.28 -0.22  0.15  0.20 -0.07
NewZealand     -1.22  0.40  0.02  0.58  0.19 -0.02 -0.05  0.00
Norway         -1.45  0.09  0.31  0.67 -0.43 -0.53  0.06  0.03
PapuaNewGuinea  3.72 -0.82  0.43 -0.43 -0.51 -0.80 -0.43  0.14
Philippines     2.14  0.88  0.16 -1.42  0.02 -0.31 -0.11 -0.08
Poland         -1.93 -0.71  0.21  0.05 -0.24 -0.11 -0.17  0.01
Portugal       -2.09 -0.17 -0.65  1.14  0.36 -0.10 -0.09 -0.08
Romania        -0.57  0.62 -0.01 -0.03  0.51 -0.17  0.12 -0.06
Russia         -1.84 -0.13  0.59 -0.15  0.04 -0.01 -0.17  0.08
Samoa           8.50 -0.65  0.12  0.44  0.40  0.83  0.08  0.13
Singapore       3.73 -0.57 -0.13  0.27  0.02  0.16 -0.40 -0.08
Spain          -1.75  0.72  0.26 -0.19  0.55  0.08 -0.10 -0.05
Sweden         -0.77  0.19 -0.14 -0.03  0.01  0.00  0.07  0.06
Switzerland    -1.60  0.26  0.67 -0.07  0.18 -0.08 -0.14  0.14
Taiwan          1.36  0.35 -0.14 -0.01 -0.39 -0.04 -0.13  0.06
Thailand        1.53 -0.71 -0.27 -0.15 -0.01  0.02 -0.11 -0.11
Turkey          0.43  1.31 -0.05  0.05  0.41  0.23 -0.06  0.08
U.S.A.         -3.86 -1.59 -0.02  0.02 -0.08  0.32  0.00  0.03

fviz_pca_ind(res.pca.cor)+ theme_minimal()

#Cos2: qualidade da representação para escores nos componentes principais
# O coseno quadrado mostra a importância de um componente para uma determinada observação.
round(res.pca.cor$ind$cos2,3)

               Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7 Dim.8
Argentina      0.216 0.194 0.208 0.027 0.285 0.009 0.060 0.002
Australia      0.917 0.050 0.014 0.000 0.011 0.001 0.001 0.005
Austria        0.643 0.039 0.083 0.037 0.096 0.001 0.099 0.001
Belgium        0.928 0.034 0.000 0.003 0.009 0.009 0.016 0.001
Bermuda        0.374 0.456 0.088 0.016 0.002 0.044 0.015 0.005
Brazil         0.776 0.100 0.043 0.000 0.029 0.005 0.047 0.000
Canada         0.740 0.132 0.032 0.017 0.060 0.007 0.008 0.003
Chile          0.524 0.119 0.050 0.160 0.091 0.013 0.043 0.001
China          0.761 0.001 0.102 0.046 0.002 0.072 0.013 0.004
Columbia       0.121 0.291 0.379 0.174 0.001 0.024 0.000 0.009
CookIslands    0.995 0.001 0.002 0.001 0.000 0.000 0.000 0.000
CostaRica      0.518 0.013 0.420 0.042 0.004 0.000 0.001 0.002
CzechRepublic  0.468 0.379 0.059 0.000 0.057 0.000 0.007 0.029
Denmark        0.363 0.189 0.411 0.023 0.001 0.001 0.008 0.004
DominicanRepub 0.398 0.468 0.002 0.065 0.065 0.000 0.000 0.001
Finland        0.766 0.126 0.029 0.008 0.003 0.041 0.016 0.011
France         0.976 0.000 0.004 0.001 0.014 0.001 0.003 0.001
Germany        0.959 0.002 0.001 0.020 0.012 0.003 0.000 0.004
GreatBritain   0.921 0.047 0.007 0.009 0.004 0.004 0.007 0.000
Greece         0.555 0.187 0.001 0.069 0.099 0.026 0.063 0.000
Guatemala      0.629 0.131 0.080 0.145 0.000 0.001 0.013 0.000
Hungary        0.731 0.167 0.012 0.044 0.000 0.013 0.030 0.003
India          0.003 0.345 0.166 0.298 0.016 0.047 0.027 0.097
Indonesia      0.795 0.061 0.103 0.001 0.026 0.002 0.011 0.002
Ireland        0.355 0.471 0.030 0.035 0.000 0.031 0.048 0.028
Israel         0.532 0.055 0.258 0.034 0.060 0.044 0.017 0.001
Italy          0.871 0.034 0.002 0.045 0.032 0.003 0.014 0.000
Japan          0.745 0.073 0.160 0.001 0.015 0.004 0.002 0.000
Kenya          0.739 0.146 0.049 0.053 0.007 0.002 0.004 0.000
Korea,South    0.104 0.078 0.165 0.072 0.249 0.215 0.102 0.015
Korea,North    0.485 0.387 0.039 0.043 0.023 0.018 0.001 0.003
Luxembourg     0.321 0.375 0.042 0.214 0.031 0.000 0.014 0.004
Malaysia       0.738 0.056 0.038 0.003 0.035 0.077 0.049 0.004
Mauritius      0.134 0.730 0.005 0.065 0.048 0.003 0.014 0.001
Mexico         0.525 0.020 0.141 0.297 0.002 0.005 0.008 0.002
Myanmar(Burma) 0.783 0.196 0.008 0.008 0.002 0.003 0.000 0.000
Netherlands    0.842 0.054 0.026 0.032 0.019 0.009 0.016 0.002
NewZealand     0.737 0.080 0.000 0.163 0.018 0.000 0.001 0.000
Norway         0.671 0.003 0.031 0.144 0.060 0.090 0.001 0.000
PapuaNewGuinea 0.865 0.042 0.012 0.012 0.016 0.040 0.011 0.001
Philippines    0.610 0.103 0.003 0.268 0.000 0.013 0.002 0.001
Poland         0.850 0.116 0.011 0.001 0.013 0.003 0.007 0.000
Portugal       0.696 0.005 0.067 0.208 0.021 0.002 0.001 0.001
Romania        0.320 0.378 0.000 0.001 0.254 0.028 0.014 0.004
Russia         0.887 0.004 0.093 0.006 0.000 0.000 0.007 0.002
Samoa          0.980 0.006 0.000 0.003 0.002 0.009 0.000 0.000
Singapore      0.958 0.022 0.001 0.005 0.000 0.002 0.011 0.000
Spain          0.765 0.130 0.017 0.009 0.075 0.001 0.002 0.001
Sweden         0.905 0.053 0.028 0.001 0.000 0.000 0.008 0.006
Switzerland    0.811 0.022 0.141 0.002 0.010 0.002 0.006 0.006
Taiwan         0.852 0.057 0.009 0.000 0.071 0.001 0.008 0.002
Thailand       0.790 0.169 0.025 0.007 0.000 0.000 0.004 0.004
Turkey         0.085 0.804 0.001 0.001 0.079 0.025 0.002 0.003
U.S.A.         0.850 0.144 0.000 0.000 0.000 0.006 0.000 0.000

fviz_pca_ind(res.pca.cor, col.ind="cos2") +
scale_color_gradient2(low="white", mid="blue", 
   high="red", midpoint=0.50) + theme_minimal()

# Contribuição dos escores para os componentes principais 
round(res.pca.cor$ind$contrib,2)

               Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7 Dim.8
Argentina       0.05  0.46  1.39  0.20  4.43  0.19  1.93  0.29
Australia       1.56  0.89  0.70  0.00  1.28  0.16  0.31  6.14
Austria         0.15  0.10  0.57  0.29  1.54  0.02  3.32  0.12
Belgium         1.10  0.42  0.01  0.12  0.77  1.02  2.74  0.52
Bermuda         0.62  7.97  4.31  0.89  0.19  6.95  3.63  5.40
Brazil          1.37  1.85  2.25  0.00  3.52  0.77 11.91  0.52
Canada          1.13  2.13  1.45  0.86  6.32  1.09  1.84  2.88
Chile           0.15  0.35  0.41  1.46  1.75  0.35  1.71  0.28
China           0.15  0.00  0.58  0.29  0.02  1.32  0.36  0.55
Columbia        0.04  1.06  3.88  1.97  0.04  0.79  0.00  2.22
CookIslands    32.29  0.25  2.39  1.47  0.02  1.42  0.49  0.00
CostaRica       0.92  0.25 21.98  2.45  0.45  0.00  0.16  2.10
CzechRepublic   0.09  0.77  0.34  0.00  0.76  0.00  0.20  3.85
Denmark         0.36  1.96 11.98  0.74  0.05  0.10  1.19  2.53
DominicanRepub  0.61  7.57  0.11  3.27  6.93  0.00  0.01  0.89
Finland         0.23  0.40  0.26  0.08  0.07  1.19  0.69  2.28
France          1.62  0.01  0.22  0.06  1.57  0.19  0.60  0.85
Germany         1.29  0.02  0.04  0.87  1.14  0.33  0.05  3.31
GreatBritain    2.39  1.29  0.52  0.80  0.70  1.08  2.67  0.22
Greece          0.34  1.20  0.02  1.38  4.14  1.53  5.48  0.04
Guatemala       1.11  2.44  4.18  8.35  0.01  0.09  3.32  0.36
Hungary         0.30  0.71  0.15  0.59  0.01  0.50  1.72  0.70
India           0.00  0.57  0.78  1.54  0.18  0.71  0.61 10.66
Indonesia       0.91  0.73  3.48  0.03  2.02  0.20  1.83  1.97
Ireland         0.18  2.57  0.46  0.60  0.01  1.54  3.58 10.17
Israel          0.18  0.19  2.51  0.36  1.35  1.36  0.81  0.13
Italy           1.42  0.59  0.07  2.38  3.57  0.47  3.15  0.02
Japan           0.77  0.80  4.87  0.04  1.08  0.38  0.30  0.02
Kenya           1.91  3.98  3.73  4.45  1.26  0.59  1.35  0.05
Korea,South     0.04  0.31  1.83  0.89  6.45  7.70  5.53  3.95
Korea,North     0.97  8.14  2.29  2.83  3.22  3.38  0.43  4.67
Luxembourg      0.28  3.40  1.06  6.02  1.82  0.02  1.69  2.25
Malaysia        1.10  0.88  1.68  0.12  3.56 10.87 10.51  4.36
Mauritius       0.21 11.90  0.22  3.30  5.10  0.40  3.15  0.91
Mexico          0.42  0.17  3.32  7.76  0.13  0.42  0.89  0.84
Myanmar(Burma)  2.95  7.76  0.91  0.94  0.39  0.99  0.09  0.33
Netherlands     0.58  0.39  0.54  0.71  0.90  0.61  1.56  0.98
NewZealand      0.41  0.47  0.00  2.97  0.69  0.01  0.11  0.00
Norway          0.58  0.02  0.79  4.08  3.57  7.43  0.13  0.20
PapuaNewGuinea  3.81  1.96  1.51  1.69  4.89 16.81  7.18  3.67
Philippines     1.27  2.24  0.20 18.18  0.01  2.52  0.49  1.32
Poland          1.03  1.47  0.37  0.02  1.10  0.31  1.13  0.02
Portugal        1.21  0.09  3.42 11.78  2.47  0.26  0.34  1.27
Romania         0.09  1.11  0.00  0.01  4.87  0.75  0.57  0.75
Russia          0.94  0.05  2.88  0.21  0.03  0.00  1.11  1.36
Samoa          19.96  1.24  0.12  1.72  3.10 17.98  0.24  3.31
Singapore       3.84  0.94  0.13  0.65  0.01  0.67  6.23  1.26
Spain           0.84  1.50  0.54  0.31  5.68  0.15  0.37  0.47
Sweden          0.17  0.10  0.15  0.01  0.00  0.00  0.21  0.69
Switzerland     0.71  0.20  3.63  0.04  0.61  0.18  0.73  3.73
Taiwan          0.51  0.36  0.15  0.00  2.91  0.04  0.71  0.70
Thailand        0.65  1.45  0.59  0.19  0.00  0.01  0.48  2.38
Turkey          0.05  4.99  0.02  0.02  3.20  1.39  0.14  1.33
U.S.A.          4.13  7.32  0.00  0.00  0.13  2.76  0.00  0.14

# Contribuições de escores para PC1
fviz_contrib(res.pca.cor, choice = "ind", axes = 1)+ theme_minimal()

# Contribuições de escores para PC2
fviz_contrib(res.pca.cor, choice = "ind", axes = 2)+ theme_minimal()

# Contribuição total em PC1 e PC2
fviz_contrib(res.pca.cor, choice = "ind", axes = 1:2)+ theme_minimal()

# Contribuições dos escores para PC1  (apenas os "top")
fviz_contrib(res.pca.cor, choice = "ind", axes = 1:2, top = 5)+ theme_minimal()

# Mundando a cor
fviz_pca_ind(res.pca.cor, col.ind="contrib") +
scale_color_gradient2(low="white", mid="blue", 
                  high="red", midpoint=50) + theme_minimal()

O gráfico de dispersão dos escores dos dois primeiros componentes baseados na matriz de correlações juntamente com os respectivos autovetores

Este gráfico é chamado de biplot. É uma representação bidimensional de dados multivariados.

fviz_pca_biplot(res.pca.cor) + theme_minimal()

As posições dos pontos (países) no gráfico indicam semelhanças e diferenças entre eles.

Os países à esquerda são aqueles com menor desempenho atlético.

sumário

# sumário
facto_summarize(res.pca.cor, "var") # para variáveis

facto_summarize(res.pca.cor, "ind") # para escores

Extra

simulação para reter o número de CP

Parallel analysis (see Hayton, Allen, and Scarpello, 2004 for more details)

Rotação varimax

A rotação pode facilitar a interpretação dos componentes

fa.parallel(dados, fa="pc", show.legend=FALSE,
            main="Scree plot with parallel analysis")

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

# sugere duas CP
pc <- principal(r=dados, nfactors=2, rotate="none", scores=T)
pc$loadings

Loadings:
               PC1    PC2   
100 m (s)       0.861  0.423
200 m (s)       0.896  0.376
400 m (s)       0.878  0.276
800 m (min)     0.914       
1500 m (min)    0.948 -0.123
5000 m (min)    0.957 -0.236
10000 m (min)   0.947 -0.267
Maratona (min)  0.917 -0.309

                 PC1   PC2
SS loadings    6.703 0.638
Proportion Var 0.838 0.080
Cumulative Var 0.838 0.918

pc <- principal(r=dados, nfactors=2, rotate="varimax", scores=T)
pc$loadings

Loadings:
               RC1   RC2  
100 m (s)      0.370 0.885
200 m (s)      0.427 0.872
400 m (s)      0.480 0.785
800 m (min)    0.735 0.547
1500 m (min)   0.794 0.531
5000 m (min)   0.876 0.453
10000 m (min)  0.889 0.423
Maratona (min) 0.894 0.371

                 RC1   RC2
SS loadings    4.078 3.263
Proportion Var 0.510 0.408
Cumulative Var 0.510 0.918

observe que a rotação facilita na identificação de que provas são representadas pelo PC1 e PC2. Basicamente, o PC2 representa as provas de curta distância.

Os últimos componentes principais podem ser úteis na identificação de observações discrepantes.

A análise deve ser efetuada sem estas observações e comparada com os resultados da análise incluindo todas as observações. O gráfico não sugere a existência de observações discrepantes.

plot(res.pca.cor$ind$coord[,7],res.pca.cor$ind$coord[,8])