#Cada vez que se inicia sesión en R se deben cargar las librerías
library(ggplot2)
library(FactoMineR)
library(factoextra)
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(corrplot)
## corrplot 0.92 loaded
library(psych)
##
## Attaching package: 'psych'
## The following objects are masked from 'package:ggplot2':
##
## %+%, alpha
# Se importa el conjunto de datos
# archivo .csv delimitado por tabulaciones
datos <- read.csv("~/Maestria en Estadistica/6-Tecnicas-Multivariadas/M2-ACP/ACP/nadadores.csv", sep = ";")
# Evaluación de los tipos de datos
str(datos)
## 'data.frame': 40 obs. of 13 variables:
## $ lumbosacra: num 12.5 11 7 7 6 16 11 14 17.5 7 ...
## $ hespalda : num 39 50 18 55 3 57 56 64 55 22 ...
## $ vespalda : num 62 40 37 38.5 39 24 47 38 47 48 ...
## $ ventralcol: num 19 33 40 33 32 12 29 29 28 42 ...
## $ dorsalcol : num 24 36 32 34 34 19 47 34.5 43 42 ...
## $ anhombro : num 62 62 57 70 75 75 62 83 73 78 ...
## $ poshombro : num 55 62 62.5 66 57 73 67 62 60 62 ...
## $ plantobi : num 9.75 7.25 8.25 9.25 6.5 7.25 7 9.75 8 8.25 ...
## $ dortobi : num 11 6.5 7.5 8.75 12.25 ...
## $ edad : int 12 13 13 14 13 14 15 14 17 16 ...
## $ sentadi : int 1 0 0 0 1 1 1 0 1 1 ...
## $ sexo : chr "f" "f" "f" "f" ...
## $ medicion : chr "A" "A" "A" "A" ...
# Las columnas numericas como num,
# las enteras como int,
# los factores estan como caracter
# los pondremos como factores,
# a sentadilla también indicaremos como factor
datos$sexo<-as.factor(datos$sexo)
datos$medicion<-as.factor(datos$medicion)
datos$sentadi<-as.factor(datos$sentadi)
#Visualizamos los datos
head(datos)
## lumbosacra hespalda vespalda ventralcol dorsalcol anhombro poshombro plantobi
## 1 12.5 39 62.0 19 24 62 55.0 9.75
## 2 11.0 50 40.0 33 36 62 62.0 7.25
## 3 7.0 18 37.0 40 32 57 62.5 8.25
## 4 7.0 55 38.5 33 34 70 66.0 9.25
## 5 6.0 3 39.0 32 34 75 57.0 6.50
## 6 16.0 57 24.0 12 19 75 73.0 7.25
## dortobi edad sentadi sexo medicion
## 1 11.00 12 1 f A
## 2 6.50 13 0 f A
## 3 7.50 13 0 f A
## 4 8.75 14 0 f A
## 5 12.25 13 1 f A
## 6 8.00 14 1 f A
# Seleccionamos las columnas con datos cuantitativos
datos_cuantit <- datos[,-c(11,12,13)]
datos_cuantit
## lumbosacra hespalda vespalda ventralcol dorsalcol anhombro poshombro
## 1 12.5 39.0 62.0 19.0 24.0 62.0 55.0
## 2 11.0 50.0 40.0 33.0 36.0 62.0 62.0
## 3 7.0 18.0 37.0 40.0 32.0 57.0 62.5
## 4 7.0 55.0 38.5 33.0 34.0 70.0 66.0
## 5 6.0 3.0 39.0 32.0 34.0 75.0 57.0
## 6 16.0 57.0 24.0 12.0 19.0 75.0 73.0
## 7 11.0 56.0 47.0 29.0 47.0 62.0 67.0
## 8 14.0 64.0 38.0 29.0 34.5 83.0 62.0
## 9 17.5 55.0 47.0 28.0 43.0 73.0 60.0
## 10 7.0 22.0 48.0 42.0 42.0 78.0 62.0
## 11 10.5 55.0 69.0 29.0 38.0 85.0 70.0
## 12 6.0 43.0 53.0 46.5 21.0 70.0 76.0
## 13 5.0 68.0 31.0 46.0 34.0 54.0 75.0
## 14 3.0 65.0 67.0 53.0 34.0 60.0 75.0
## 15 -3.0 69.0 18.0 48.0 15.5 70.0 72.0
## 16 6.0 56.0 54.5 44.0 21.0 63.0 66.0
## 17 -2.0 22.0 42.0 47.0 18.0 71.0 65.0
## 18 4.5 45.0 59.0 39.0 25.0 82.0 60.0
## 19 8.0 27.5 60.0 35.0 36.0 52.0 65.5
## 20 11.0 28.0 58.0 25.0 27.0 42.0 65.0
## 21 14.0 31.0 67.0 14.0 43.0 62.0 58.0
## 22 13.0 50.0 29.0 43.0 20.0 57.0 60.0
## 23 11.0 16.0 38.0 38.0 34.0 55.0 62.0
## 24 11.5 43.0 38.0 34.0 41.0 53.0 63.0
## 25 13.0 -3.0 70.0 30.0 36.0 71.5 57.0
## 26 16.0 22.0 31.0 10.0 44.0 71.0 73.0
## 27 17.5 22.0 48.0 20.0 54.0 65.0 67.0
## 28 15.0 36.0 53.0 23.0 38.0 78.0 67.0
## 29 20.0 37.0 39.0 21.0 45.0 60.0 59.0
## 30 10.0 19.0 50.0 45.0 44.0 78.0 64.0
## 31 18.5 42.0 63.0 25.0 36.0 76.0 69.0
## 32 10.0 23.0 53.0 44.0 45.0 72.0 67.5
## 33 7.0 68.0 32.0 40.0 36.0 62.0 73.0
## 34 14.0 55.0 75.0 41.0 35.0 76.0 74.0
## 35 0.0 41.0 22.0 51.0 26.0 72.0 74.0
## 36 13.0 56.0 62.0 42.0 41.0 67.0 64.0
## 37 5.5 6.0 58.0 43.0 30.0 92.0 60.0
## 38 7.0 28.0 65.0 44.0 42.0 82.0 60.0
## 39 10.5 8.0 65.0 34.0 40.0 54.0 64.0
## 40 15.5 -4.0 67.0 21.5 42.0 48.0 64.0
## plantobi dortobi edad
## 1 9.75 11.00 12
## 2 7.25 6.50 13
## 3 8.25 7.50 13
## 4 9.25 8.75 14
## 5 6.50 12.25 13
## 6 7.25 8.00 14
## 7 7.00 10.75 15
## 8 9.75 7.75 14
## 9 8.00 8.75 17
## 10 8.25 10.50 16
## 11 8.75 9.75 16
## 12 11.00 9.25 16
## 13 8.50 7.50 16
## 14 12.75 8.25 15
## 15 13.75 7.50 13
## 16 10.25 8.25 13
## 17 11.25 11.00 11
## 18 9.25 8.50 12
## 19 8.75 9.75 13
## 20 11.75 10.50 13
## 21 8.00 10.75 12
## 22 7.00 6.50 13
## 23 7.25 7.75 13
## 24 8.25 8.00 14
## 25 5.75 12.25 13
## 26 6.75 8.00 14
## 27 6.50 10.50 15
## 28 8.75 7.50 14
## 29 8.00 8.50 17
## 30 6.75 9.00 16
## 31 8.50 10.00 16
## 32 8.75 8.25 16
## 33 8.25 7.25 16
## 34 10.50 8.00 15
## 35 13.50 8.50 13
## 36 8.50 9.50 13
## 37 9.00 11.50 11
## 38 9.00 10.25 12
## 39 8.25 9.75 13
## 40 9.25 10.50 13
# Descripción del conjunto de datos
summary(datos)
## lumbosacra hespalda vespalda ventralcol
## Min. :-3.00 Min. :-4.00 Min. :18.00 Min. :10.00
## 1st Qu.: 6.75 1st Qu.:22.00 1st Qu.:38.00 1st Qu.:27.25
## Median :10.75 Median :40.00 Median :49.00 Median :34.50
## Mean :10.00 Mean :37.34 Mean :48.92 Mean :34.33
## 3rd Qu.:14.00 3rd Qu.:55.00 3rd Qu.:62.00 3rd Qu.:43.25
## Max. :20.00 Max. :69.00 Max. :75.00 Max. :53.00
## dorsalcol anhombro poshombro plantobi
## Min. :15.50 Min. :42.00 Min. :55.00 Min. : 5.750
## 1st Qu.:29.25 1st Qu.:60.00 1st Qu.:61.50 1st Qu.: 7.812
## Median :36.00 Median :70.00 Median :64.50 Median : 8.500
## Mean :34.67 Mean :67.44 Mean :65.39 Mean : 8.844
## 3rd Qu.:42.00 3rd Qu.:75.25 3rd Qu.:69.25 3rd Qu.: 9.375
## Max. :54.00 Max. :92.00 Max. :76.00 Max. :13.750
## dortobi edad sentadi sexo medicion
## Min. : 6.500 Min. :11.00 0 :10 f:20 A:20
## 1st Qu.: 8.000 1st Qu.:13.00 1 :10 m:20 D:20
## Median : 8.750 Median :13.50 NA's:20
## Mean : 9.106 Mean :13.95
## 3rd Qu.:10.500 3rd Qu.:15.25
## Max. :12.250 Max. :17.00
# Para aplicar ACP es necesario que las variables presenten altas correlaciones
# por lo tanto se evaluan las correlaciones
#Matriz de Correlaciones (en burbujas)
corrplot(cor(datos_cuantit), type="upper")
#Comentario:Se muestran la diagonal principal y el triangulo superior de la matriz. El tamaño, color e intensidad del color,indican la fuerza y direccion de las correlaciones. Aquí la escala de color abarca de -1 a +1
# Matriz de correlación
M_corr <- cor(datos_cuantit)
M_corr
## lumbosacra hespalda vespalda ventralcol dorsalcol
## lumbosacra 1.000000000 -0.11266654 0.23410165 -0.76230586 0.54328143
## hespalda -0.112666538 1.00000000 -0.28831454 0.18195009 -0.26352647
## vespalda 0.234101648 -0.28831454 1.00000000 -0.07641674 0.29178792
## ventralcol -0.762305865 0.18195009 -0.07641674 1.00000000 -0.33010148
## dorsalcol 0.543281426 -0.26352647 0.29178792 -0.33010148 1.00000000
## anhombro -0.091513232 0.04704393 0.07599386 0.10001443 -0.02711065
## poshombro -0.239728606 0.47781676 -0.22443605 0.23958631 -0.15823088
## plantobi -0.599567064 0.35042962 -0.01319930 0.47062984 -0.53890559
## dortobi 0.005117946 -0.58904038 0.51694154 -0.20426627 0.17754963
## edad 0.345579940 0.34175175 -0.07971409 -0.03550502 0.42493095
## anhombro poshombro plantobi dortobi edad
## lumbosacra -0.09151323 -0.23972861 -0.59956706 0.005117946 0.34557994
## hespalda 0.04704393 0.47781676 0.35042962 -0.589040378 0.34175175
## vespalda 0.07599386 -0.22443605 -0.01319930 0.516941539 -0.07971409
## ventralcol 0.10001443 0.23958631 0.47062984 -0.204266275 -0.03550502
## dorsalcol -0.02711065 -0.15823088 -0.53890559 0.177549630 0.42493095
## anhombro 1.00000000 -0.00680451 -0.01882475 0.143607285 0.05202405
## poshombro -0.00680451 1.00000000 0.42701336 -0.407870551 0.41114796
## plantobi -0.01882475 0.42701336 1.00000000 -0.125829963 -0.16049318
## dortobi 0.14360729 -0.40787055 -0.12582996 1.000000000 -0.26311671
## edad 0.05202405 0.41114796 -0.16049318 -0.263116707 1.00000000
# Se calculan los p-values de las correlaciones
# mat : is a matrix of data
# ... : further arguments to pass to the native R cor.test function
cor.mtest <- function(mat, ...) {
mat <- as.matrix(mat)
n <- ncol(mat)
p.mat<- matrix(NA, n, n)
diag(p.mat) <- 0
for (i in 1:(n - 1)) {
for (j in (i + 1):n) {
tmp <- cor.test(mat[, i], mat[, j], ...)
p.mat[i, j] <- p.mat[j, i] <- tmp$p.value
}
}
colnames(p.mat) <- rownames(p.mat) <- colnames(mat)
p.mat
}
# Matriz de p-values
p.mat <- cor.mtest(M_corr)
p.mat
## lumbosacra hespalda vespalda ventralcol dorsalcol
## lumbosacra 0.000000e+00 0.2759920842 0.274747848 3.148285e-05 0.0011650676
## hespalda 2.759921e-01 0.0000000000 0.004208691 1.891710e-01 0.0889390739
## vespalda 2.747478e-01 0.0042086910 0.000000000 2.097742e-01 0.1807797421
## ventralcol 3.148285e-05 0.1891710092 0.209774153 0.000000e+00 0.0077671995
## dorsalcol 1.165068e-03 0.0889390739 0.180779742 7.767200e-03 0.0000000000
## anhombro 6.136022e-01 0.8074134857 0.980463208 7.343581e-01 0.6590899310
## poshombro 1.452941e-01 0.0029323070 0.008638522 1.094174e-01 0.0960004595
## plantobi 4.195477e-04 0.0912498871 0.221888984 3.235020e-03 0.0001296096
## dortobi 5.186249e-01 0.0001714639 0.002497834 2.721281e-01 0.2958958943
## edad 1.811656e-01 0.2578325279 0.214634832 4.407624e-01 0.2141891736
## anhombro poshombro plantobi dortobi edad
## lumbosacra 0.6136022 0.145294063 0.0004195477 0.5186249310 0.1811656
## hespalda 0.8074135 0.002932307 0.0912498871 0.0001714639 0.2578325
## vespalda 0.9804632 0.008638522 0.2218889841 0.0024978345 0.2146348
## ventralcol 0.7343581 0.109417361 0.0032350204 0.2721280998 0.4407624
## dorsalcol 0.6590899 0.096000459 0.0001296096 0.2958958943 0.2141892
## anhombro 0.0000000 0.659194983 0.9434794262 0.6260410014 0.5494138
## poshombro 0.6591950 0.000000000 0.0452894275 0.0038412514 0.2664836
## plantobi 0.9434794 0.045289428 0.0000000000 0.2561184583 0.2988087
## dortobi 0.6260410 0.003841251 0.2561184583 0.0000000000 0.0960507
## edad 0.5494138 0.266483614 0.2988087058 0.0960506962 0.0000000
# Correlograma que muestra las correlaciones significativas
col <- colorRampPalette(c("#BB4444", "#EE9988", "#FFFFFF", "#77AADD", "#4477AA"))
corrplot(M_corr, method="color", col = col(200),
type="upper", order="hclust",
addCoef.col = "black", # Add coefficient of correlation
tl.col="black", tl.srt=45, #Text label color and rotation
# Combine with significance
p.mat = p.mat, sig.level = 0.01, insig = "blank", tl.cex = 0.8,
# hide correlation coefficient on the principal diagonal
diag=FALSE
)
#Comentario: Se muestra solo el triangulo superior de la matriz. El color e intensidad, indican la magnitud y signo de la correlación (esta el valor exacto).Escala de color nuevamente abarca de -1 a +1
# Análisis de componentes principales
# Se omiten los datos perdidos
datos_PCA<- na.omit(datos_cuantit)
datos_PCA
## lumbosacra hespalda vespalda ventralcol dorsalcol anhombro poshombro
## 1 12.5 39.0 62.0 19.0 24.0 62.0 55.0
## 2 11.0 50.0 40.0 33.0 36.0 62.0 62.0
## 3 7.0 18.0 37.0 40.0 32.0 57.0 62.5
## 4 7.0 55.0 38.5 33.0 34.0 70.0 66.0
## 5 6.0 3.0 39.0 32.0 34.0 75.0 57.0
## 6 16.0 57.0 24.0 12.0 19.0 75.0 73.0
## 7 11.0 56.0 47.0 29.0 47.0 62.0 67.0
## 8 14.0 64.0 38.0 29.0 34.5 83.0 62.0
## 9 17.5 55.0 47.0 28.0 43.0 73.0 60.0
## 10 7.0 22.0 48.0 42.0 42.0 78.0 62.0
## 11 10.5 55.0 69.0 29.0 38.0 85.0 70.0
## 12 6.0 43.0 53.0 46.5 21.0 70.0 76.0
## 13 5.0 68.0 31.0 46.0 34.0 54.0 75.0
## 14 3.0 65.0 67.0 53.0 34.0 60.0 75.0
## 15 -3.0 69.0 18.0 48.0 15.5 70.0 72.0
## 16 6.0 56.0 54.5 44.0 21.0 63.0 66.0
## 17 -2.0 22.0 42.0 47.0 18.0 71.0 65.0
## 18 4.5 45.0 59.0 39.0 25.0 82.0 60.0
## 19 8.0 27.5 60.0 35.0 36.0 52.0 65.5
## 20 11.0 28.0 58.0 25.0 27.0 42.0 65.0
## 21 14.0 31.0 67.0 14.0 43.0 62.0 58.0
## 22 13.0 50.0 29.0 43.0 20.0 57.0 60.0
## 23 11.0 16.0 38.0 38.0 34.0 55.0 62.0
## 24 11.5 43.0 38.0 34.0 41.0 53.0 63.0
## 25 13.0 -3.0 70.0 30.0 36.0 71.5 57.0
## 26 16.0 22.0 31.0 10.0 44.0 71.0 73.0
## 27 17.5 22.0 48.0 20.0 54.0 65.0 67.0
## 28 15.0 36.0 53.0 23.0 38.0 78.0 67.0
## 29 20.0 37.0 39.0 21.0 45.0 60.0 59.0
## 30 10.0 19.0 50.0 45.0 44.0 78.0 64.0
## 31 18.5 42.0 63.0 25.0 36.0 76.0 69.0
## 32 10.0 23.0 53.0 44.0 45.0 72.0 67.5
## 33 7.0 68.0 32.0 40.0 36.0 62.0 73.0
## 34 14.0 55.0 75.0 41.0 35.0 76.0 74.0
## 35 0.0 41.0 22.0 51.0 26.0 72.0 74.0
## 36 13.0 56.0 62.0 42.0 41.0 67.0 64.0
## 37 5.5 6.0 58.0 43.0 30.0 92.0 60.0
## 38 7.0 28.0 65.0 44.0 42.0 82.0 60.0
## 39 10.5 8.0 65.0 34.0 40.0 54.0 64.0
## 40 15.5 -4.0 67.0 21.5 42.0 48.0 64.0
## plantobi dortobi edad
## 1 9.75 11.00 12
## 2 7.25 6.50 13
## 3 8.25 7.50 13
## 4 9.25 8.75 14
## 5 6.50 12.25 13
## 6 7.25 8.00 14
## 7 7.00 10.75 15
## 8 9.75 7.75 14
## 9 8.00 8.75 17
## 10 8.25 10.50 16
## 11 8.75 9.75 16
## 12 11.00 9.25 16
## 13 8.50 7.50 16
## 14 12.75 8.25 15
## 15 13.75 7.50 13
## 16 10.25 8.25 13
## 17 11.25 11.00 11
## 18 9.25 8.50 12
## 19 8.75 9.75 13
## 20 11.75 10.50 13
## 21 8.00 10.75 12
## 22 7.00 6.50 13
## 23 7.25 7.75 13
## 24 8.25 8.00 14
## 25 5.75 12.25 13
## 26 6.75 8.00 14
## 27 6.50 10.50 15
## 28 8.75 7.50 14
## 29 8.00 8.50 17
## 30 6.75 9.00 16
## 31 8.50 10.00 16
## 32 8.75 8.25 16
## 33 8.25 7.25 16
## 34 10.50 8.00 15
## 35 13.50 8.50 13
## 36 8.50 9.50 13
## 37 9.00 11.50 11
## 38 9.00 10.25 12
## 39 8.25 9.75 13
## 40 9.25 10.50 13
# La sentencia prcomp es una de las muchas disponibles en R
# para el análisis de componentes principales
pca_datos <- prcomp(datos_PCA, scale=T)
pca_datos
## Standard deviations (1, .., p=10):
## [1] 1.8030625 1.4787641 1.1132627 0.9800480 0.8951332 0.7562077 0.6006247
## [8] 0.5419936 0.5070555 0.2786551
##
## Rotation (n x k) = (10 x 10):
## PC1 PC2 PC3 PC4 PC5
## lumbosacra -0.41120208 0.35546461 -0.08015855 -0.03968683 0.32414437
## hespalda 0.33757564 0.35942916 0.05297386 0.04738565 0.38016155
## vespalda -0.24962897 -0.21861022 0.50353918 -0.41488831 0.28404150
## ventralcol 0.37960185 -0.19251847 0.26673461 -0.01480826 -0.55888565
## dorsalcol -0.37519534 0.25733103 0.27818144 -0.12944222 -0.39586384
## anhombro 0.01329966 -0.07465768 0.51321035 0.79445078 0.21356636
## poshombro 0.33602178 0.30490095 0.26271460 -0.23539630 0.07242709
## plantobi 0.41365609 -0.18221989 0.17131506 -0.33116493 0.31564562
## dortobi -0.29221657 -0.41435067 0.28343487 -0.08883459 0.07228013
## edad -0.01350598 0.53847341 0.38287911 -0.05429017 -0.21202323
## PC6 PC7 PC8 PC9 PC10
## lumbosacra 0.12452109 -0.15004436 -0.18701824 -0.2670489416 -0.668713677
## hespalda 0.39931896 0.43312959 0.22073943 0.4477887447 -0.104792170
## vespalda 0.41822098 -0.25678001 -0.21204824 0.1508762074 0.273785518
## ventralcol 0.37203202 -0.03523615 -0.20724524 -0.0002654207 -0.502512882
## dorsalcol 0.05593732 -0.07038973 0.72825232 0.0420077183 -0.044283449
## anhombro -0.03573429 -0.18279655 0.08596015 -0.1096357522 0.001094346
## poshombro -0.56499716 -0.43562422 -0.06623430 0.3552223291 -0.157761150
## plantobi -0.07638492 0.08303440 0.37014267 -0.6328098149 -0.082765341
## dortobi -0.41443989 0.56477424 -0.03545676 0.2329822165 -0.321252884
## edad -0.10246685 0.41073772 -0.38469844 -0.3327309390 0.278313840
# Valores singulares
pca_datos$sdev
## [1] 1.8030625 1.4787641 1.1132627 0.9800480 0.8951332 0.7562077 0.6006247
## [8] 0.5419936 0.5070555 0.2786551
# Autovectores o coeficientes de las CP
pca_datos$rotation[,1:5]
## PC1 PC2 PC3 PC4 PC5
## lumbosacra -0.41120208 0.35546461 -0.08015855 -0.03968683 0.32414437
## hespalda 0.33757564 0.35942916 0.05297386 0.04738565 0.38016155
## vespalda -0.24962897 -0.21861022 0.50353918 -0.41488831 0.28404150
## ventralcol 0.37960185 -0.19251847 0.26673461 -0.01480826 -0.55888565
## dorsalcol -0.37519534 0.25733103 0.27818144 -0.12944222 -0.39586384
## anhombro 0.01329966 -0.07465768 0.51321035 0.79445078 0.21356636
## poshombro 0.33602178 0.30490095 0.26271460 -0.23539630 0.07242709
## plantobi 0.41365609 -0.18221989 0.17131506 -0.33116493 0.31564562
## dortobi -0.29221657 -0.41435067 0.28343487 -0.08883459 0.07228013
## edad -0.01350598 0.53847341 0.38287911 -0.05429017 -0.21202323
# Autovalores, porcentaje de variancia explicada y
# porcentaje de variancia explicada acumulada
get_eig(pca_datos)
## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 3.25103445 32.5103445 32.51034
## Dim.2 2.18674315 21.8674315 54.37778
## Dim.3 1.23935373 12.3935373 66.77131
## Dim.4 0.96049409 9.6049409 76.37625
## Dim.5 0.80126348 8.0126348 84.38889
## Dim.6 0.57185008 5.7185008 90.10739
## Dim.7 0.36075004 3.6075004 93.71489
## Dim.8 0.29375706 2.9375706 96.65246
## Dim.9 0.25710528 2.5710528 99.22351
## Dim.10 0.07764865 0.7764865 100.00000
#Scree Test para los autovalores de la matriz de correlaciones
# Gráfico scree
fviz_eig(pca_datos, geom="line")+ labs(title = "Screeplot", x = "Principal Components", y = "% of variances")+ theme_classic()
# Comentario:Hay dos autovalores dominantes. La curva cambia de tangente a partir del tercero. Ahí hace un “codo”.Si bien queda mucha variabilidad por explicar, cada eje muestra una variabilidad poco diferente de la siguiente (decrecimiento sostenido pero lento). No se ven dimensiones dominantes (en variabilidad explicada) a partir de la tercera.Si tuvieran “interpretación” se pueden agregar al análisis. Sino se consideran “ruido”
#Test de Bartlett (igualdad entre variancias) aplicado sobre las dimensiones remanentes
#Las CP son incorrelacionadas (covariancias nulas). Si las variancias (lambda) son iguales
#la nube es esferica en esas dimensiones
#saco del listado de scores ($x) las CP valorizadas y me quedo con las ultimas
sco <- pca_datos$x[,4:10]
bartlett.test(data.frame(sco))
##
## Bartlett test of homogeneity of variances
##
## data: data.frame(sco)
## Bartlett's K-squared = 68.114, df = 6, p-value = 9.955e-13
#Grafico circular de las cargas de las variables sobre las dos primeras CP
# Gráfico de las cargas (loading plot)
fviz_pca_var(pca_datos, col.var = "black")
# Comentario:Variables y significado de flexibilidad (+) o) (-)
#Flexibilidad de la articulacion lumbo-sacra(con enlogacion maxima de musculos isquio-tibiales)(+), Flexibilidad horizontal de la espalda(-),Flexibilidad vertical de la espalda (+), Flexibilidad ventral de la columna dorso-lumbar(-), Flexibilidad dorsal de la columna dorso-lumbar(+), Flexibilidad anterior de la articulacion del hombro (+),Flexibilidad posterior de la articulacion del hombro (+),Flexibilidad del bloque articular del tobillo y pie en flexion plantar (+),Edad en años (en primera medicion), Prueba de sentadilla (pasa o no pasa),Sexo.
#Cargas
var<-get_pca_var(pca_datos)
var$coord
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## lumbosacra -0.74142306 0.5256483 -0.08923751 -0.03889500 0.29015239
## hespalda 0.60866998 0.5315109 0.05897382 0.04644021 0.34029523
## vespalda -0.45009663 -0.3232729 0.56057136 -0.40661046 0.25425498
## ventralcol 0.68444586 -0.2846894 0.29694568 -0.01451281 -0.50027711
## dorsalcol -0.67650065 0.3805319 0.30968901 -0.12685959 -0.35435088
## anhombro 0.02398012 -0.1104011 0.57133791 0.77859990 0.19117034
## poshombro 0.60586827 0.4508766 0.29247035 -0.23069967 0.06483189
## plantobi 0.74584780 -0.2694602 0.19071866 -0.32455753 0.28254488
## dortobi -0.52688474 -0.6127269 0.31553746 -0.08706217 0.06470034
## edad -0.02435212 0.7962751 0.42624501 -0.05320698 -0.18978904
## Dim.6 Dim.7 Dim.8 Dim.9 Dim.10
## lumbosacra 0.09416381 -0.09012035 -0.10136269 -0.135408634 -0.186340454
## hespalda 0.30196807 0.26014834 0.11963936 0.227053745 -0.029200869
## vespalda 0.31626193 -0.15422842 -0.11492879 0.076502610 0.076291722
## ventralcol 0.28133348 -0.02116370 -0.11232559 -0.000134583 -0.140027760
## dorsalcol 0.04230023 -0.04227781 0.39470809 0.021300244 -0.012339807
## anhombro -0.02702255 -0.10979213 0.04658985 -0.055591411 0.000304945
## poshombro -0.42725520 -0.26164667 -0.03589857 0.180117435 -0.043960944
## plantobi -0.05776286 0.04987251 0.20061496 -0.320869696 -0.023062982
## dortobi -0.31340263 0.33921736 -0.01921733 0.118134914 -0.089518744
## edad -0.07748622 0.24669923 -0.20850409 -0.168713052 0.077553562
#Comentario:
# CP1: Esta asociada positivamente a: Flexibilidad horizontal de espalda (-), ventral de columna (-), posterior del hombro (+) y planta y tobillo (-) y negativamente con lumbosacra (+), vertical espalda (+), dorsal columna (+), dorsal tobillo (+).
# Representa una diferenciación de flexibilidad global (excepto anterior de hombro que no pesa y la posterior de hombro que pesa alreves). Esta flexibilidad general NO está asociada con la Edad.
# Nadadores con valores altos de CP1 tienen mediciones valores grandes de los coeficientes (o corr) positivos: Flex.horizontal de espalda, ventral de columna, y plantatobillo (poco flexible en estas), y pequeñas de las variables con coeficiente (o correlación) negativo ( Flex. Lumbosacra, vertical de espalda, dorsal de columna y dorsal de tobillo….y entonces tambien poco flexible en estas otras.
# A la derecha se ubican los nadadores menos flexibles y la izquierda los mas flexibles
#CP2 esta correlacionada fuerte y positivamente con lumbosacra (+), horizontal de espalda (-) posterior de hombro (+) y edad y negativa con dorsal de tobillo (+). Es una flexibilidad particular en esos aspectos específicos
#Gráfico de los nadadores según las puntuaciones de cada test (antes y después) en las dos primeras CP
# Gráfico de los individuos (scores plot)
graf_datos <- fviz_pca_ind(pca_datos)
ggpubr::ggpar(graf_datos,
xlab = "PC1 (32.51%)", ylab = "PC2 (21.87%)",
ggtheme = theme_minimal())
#Comentario: Aquí reconoceríamos los nadadores mas o menos flexibles en goma global y respecto de las flexibilidades que indica CP2 (positivamente con lumbosacra (+), horizontal de espalda (-) posterior de hombro y edad y negativa con dorsal de tobillo (+)). Sin embargo como los individuos esta separados por un antes-despues, conviene tenerlo en cuenta
# Nadadores en el plano de las dos primeras CP, según tiempo de la medición (antes-despues)
# Gráfico de los individuos caracterizado por
# antes y despues (scores plot)
# Se crea un nuevo factor para identificar a los individuos
datos$id <- as.factor(rep(seq(1, 20), times = 2))
basic_plot <- fviz_pca_ind(pca_datos, label="none")
ggplot(cbind(basic_plot$data,datos[,c("id","medicion")]),
aes(x=x,y=y, label = id, col=medicion)) + geom_point() +
geom_text(aes(label = id), vjust = 1.5, hjust = 0.5, color = "black") + # Agregar etiquetas dentro del gráfico
theme_bw()+
labs(x = "PC1 (32.51%)", y = "PC2 (21.87%)") +
geom_vline(xintercept = 0, linetype="dashed") +
geom_hline(yintercept = 0, linetype="dashed")
# Comentario: Se observa el desplazamiento de izquierda derecha (mejora global de flexibilidad) y hacia arriba (mayores edades con mejora en lumbosacra y posterior de hombre)
# Gráfico de los individuos caracterizado por
# la realización o no de sentadillas (scores plot)
graf_datos_sentadi <- fviz_pca_ind(pca_datos,
col.ind=datos$sentadi,
mean.point = FALSE,
repel = TRUE,
geom.ind = "point",
legend.title = "sentadilla")
ggpubr::ggpar(graf_datos_sentadi,
xlab = "PC1 (32.51%)", ylab = "PC2 (21.87%)",
ggtheme = theme_minimal() , palette="Dark2",
legend.title = "sentadilla", legend.position = "top")
## Warning: Removed 20 rows containing missing values (`geom_point()`).
# Comentario: Nadadores en el plano de las dos primeras CP, según resultado de la prueba de sentadilla. Pasar la prueba de sentadilla (1) indica mejor flexibilidad. Los puntos rojos (1) están mas a la izquierda concordando con el sentido de la CP o flex. global
# Gráfico de los individuos caracterizado por
# sexo y medición (scores plot)
basic_plot <- fviz_pca_ind(pca_datos, label="none")
ggplot(cbind(basic_plot$data,datos[,c("sexo","medicion")]),
aes(x=x,y=y,col=sexo,shape=medicion)) + geom_point() +
geom_text(aes(label = sexo), vjust = 1.5, hjust = 0.5, color = "black") + # Agregar etiquetas dentro del gráfico
theme_bw()+
labs(x = "PC1 (32.51%)", y = "PC2 (21.87%)") +
geom_vline(xintercept = 0, linetype="dashed") +
geom_hline(yintercept = 0, linetype="dashed")
# Comentario:Nadadores en el plano de las dos primeras CP, según sexo y momento de medicion. Observen puntos masc o fem y observen triángulos masc o fem
# Individuo suplementario
# Datos del individuo nuevo
new_individual_A <- data.frame(13.25, 39.75, 64, 19, 26, 63, 55, 9.75, 11, 13, 1, "m", "A", 21)
# Agregamos el nombre de las columnas al individuo nuevo
colnames(new_individual_A) <- colnames(datos)
# Visualizamos el conjunto de datos
new_individual_A
## lumbosacra hespalda vespalda ventralcol dorsalcol anhombro poshombro plantobi
## 1 13.25 39.75 64 19 26 63 55 9.75
## dortobi edad sentadi sexo medicion id
## 1 11 13 1 m A 21
# Calculamos la proyección del nuevo individuo
indiv_sup_A <- predict(pca_datos, newdata=new_individual_A[,-c(11,12,13,14)])
# Las coordenadas del individuo suplementario se encuentran en las columnas "PC1" y "PC2"
coord_sup_A <- as.data.frame(indiv_sup_A)
# Agregar un identificador para el nuevo individuo (opcional)
coord_sup_A$Individuo <- "Nuevo Individuo"
# Obtener las coordenadas de los datos originales
coord_originales <- as.data.frame(pca_datos$x)
# Agregar un identificador para los datos originales (opcional)
coord_originales$Individuo <- "Datos Originales"
# Combinar los datos originales y las coordenadas del nuevo individuo
combined_data <- rbind(coord_originales, coord_sup_A)
# Gráfico del individuo suplementario en el PCA previo
ggplot(data = combined_data, aes(x = PC1, y = PC2, color = Individuo)) +
geom_point(alpha = 0.8) +
labs(title = "PCA Plot", x = "PC1", y = "PC2")+
theme_bw()+
labs(x = "PC1 (32.51%)", y = "PC2 (21.87%)") +
geom_vline(xintercept = 0, linetype="dashed") +
geom_hline(yintercept = 0, linetype="dashed")
