Contexto

La base de datos “CA” contiene información de dos conjunto de variables, actividades físicas y resultados de las actividades. Las variables que conforman los conjuntos de variables son:

Actividades físicas

Variables Descripción
Flexiones Número de flexiones realizadas
Sentadillas Número de sentadillas realizadas
Saltos Cántidad de saltos realizados

Resultados de las actividades físicas

Variables Descripción
Peso Peso de la persona medido en libras
Cintura Talla de la cintura de la persona medida en centímetros
Pulso Pulso de la persona

El objetivo de los investigadores es saber si hay una correlación entre los resultados de las actividades físicas y estas actividades.

Limitaciones

Se desconoce la población de estudio, es decir, no se cuenta con información si estas mediciones re realizaron a personas en condición de obesidad, si fueron hombres o mujeres, si se trató de una población joven o adulta, entre otras características que pueda tener la población que hagan variar los resultados.

Se cuestiona el tamaño de la muestra (n=20), algunos autores recomiendan 10 observaciones por variable.

Lectura de los datos

# Lectura de los datos
library(readxl)
# setwd("C:/Users/JONATHAN PATRICIO/OneDrive - Pontificia Universidad Javeriana/Documentos/Maestría Bioestadística/SEGUNDO SEMESTRE/Primer ciclo/Análisis multivariado/Sesión 14. Análisis de Correlación Canónica. Exposición Jonathan y Oscar")

CA <- read_excel("CA.xlsx")



names(CA)
FALSE [1] "observaciones" "peso"          "cintura"       "pulso"        
FALSE [5] "flexiones"     "sentadillas"   "saltos"
CA <- CA[,-1]

resultados <- CA[,1:3]
actividades <- CA[,4:6]

Análisis descriptivo de los datos

library(table1)
table1(~flexiones+sentadillas+saltos,
       data = CA,
         rowlabelhead = "Carácterísticas", caption = "Tabla 1: Estadísticas decriptivas de las variables sobre actividades físicas")
Tabla 1: Estadísticas decriptivas de las variables sobre actividades físicas
Carácterísticas Overall
(N=20)
flexiones
Mean (SD) 9.45 (5.29)
Median [Min, Max] 11.5 [1.00, 17.0]
sentadillas
Mean (SD) 146 (62.6)
Median [Min, Max] 123 [50.0, 251]
saltos
Mean (SD) 70.3 (51.3)
Median [Min, Max] 54.0 [25.0, 250] 
table1(~peso+cintura+pulso,
       data = CA,
         rowlabelhead = "Carácterísticas", caption = "Tabla 2: Estadísticas decriptivas de las variables sobre los resultados de las actividades físicas")
Tabla 2: Estadísticas decriptivas de las variables sobre los resultados de las actividades físicas
Carácterísticas Overall
(N=20)
peso
Mean (SD) 179 (24.7)
Median [Min, Max] 176 [138, 247]
cintura
Mean (SD) 35.4 (3.20)
Median [Min, Max] 35.0 [31.0, 46.0]
pulso
Mean (SD) 56.1 (7.21)
Median [Min, Max] 55.0 [46.0, 74.0] 
par(mfrow = c(1, 3))
boxplot(CA$peso, main="Gráfico 1: Boxplot peso")
boxplot(CA$cintura, main="Gráfico 2: Boxplot cintura")
boxplot(CA$pulso, main="Gráfico 3: Boxplot pulso")

par(mfrow = c(1, 3))
boxplot(CA$flexiones, main="Gráfico 4: Boxplot flexiones")
boxplot(CA$sentadillas, main="Gráfico 5: Boxplot sentadillas")
boxplot(CA$saltos, main="Gráfico 6: Boxplot saltos")

par(mfrow = c(1, 1))

Supuestos

Variables continuas

En este escenario estamos cumpliendo el supuesto, debido a que todas las variables a utilizar son de tipo continuas.

Correlación entre las variables

library(psych)
corPlot(actividades)

corPlot(resultados)

corPlot(CA)

Normalidad multivariada

Gráfico de la distribución multivariada para las variables de actividades

library("mvtnorm")
library(rockchalk)
set.seed(563254)
mu <- rep(0, ncol(actividades))
sigma <- cov(scale( actividades))
X <- mvrnorm(1000, mu, sigma)
density <- dmvnorm(X, mean = mu, sigma = sigma)

library(plotly)
plot_ly(x=~X[,1], y=~X[,2], z=~density, 
        type = "scatter3d", color=density)
library(MVN)
mvn(actividades,subset = NULL,mvn = "mardia", covariance = FALSE,showOutliers = T)
FALSE $multivariateNormality
FALSE              Test         Statistic           p value Result
FALSE 1 Mardia Skewness  21.2547594372168 0.019385509141582     NO
FALSE 2 Mardia Kurtosis 0.223650206280074   0.8230294940672    YES
FALSE 3             MVN              <NA>              <NA>     NO
FALSE 
FALSE $univariateNormality
FALSE               Test    Variable Statistic   p value Normality
FALSE 1 Anderson-Darling  flexiones     0.6177    0.0928    YES   
FALSE 2 Anderson-Darling sentadillas    0.7051    0.0553    YES   
FALSE 3 Anderson-Darling   saltos       1.6588    0.0002    NO    
FALSE 
FALSE $Descriptives
FALSE              n   Mean   Std.Dev Median Min Max   25th   75th       Skew
FALSE flexiones   20   9.45  5.286278   11.5   1  17   4.75  13.25 -0.1650396
FALSE sentadillas 20 145.55 62.566575  122.5  50 251 101.00 210.00  0.1912146
FALSE saltos      20  70.30 51.277470   54.0  25 250  39.50  85.25  2.1203234
FALSE              Kurtosis
FALSE flexiones   -1.528716
FALSE sentadillas -1.470311
FALSE saltos       4.726189
FALSE 
FALSE $multivariateOutliers
FALSE NULL

Gráfico de la distribución multivariada para las variables de resultados

set.seed(5433642)
mu <- rep(0, ncol(resultados))
sigma <- cov(scale( resultados))
X <- mvrnorm(1000, mu, sigma)
density <- dmvnorm(X, mean = mu, sigma = sigma)

plot_ly(x=~X[,1], y=~X[,2], z=~density, 
        type = "scatter3d", color=density)
mvn(resultados,subset = NULL,mvn = "mardia", covariance = FALSE,showOutliers = T)
FALSE $multivariateNormality
FALSE              Test        Statistic             p value Result
FALSE 1 Mardia Skewness 29.1162416707605 0.00119317455620527     NO
FALSE 2 Mardia Kurtosis 1.60882520222261   0.107654568489274    YES
FALSE 3             MVN             <NA>                <NA>     NO
FALSE 
FALSE $univariateNormality
FALSE               Test  Variable Statistic   p value Normality
FALSE 1 Anderson-Darling   peso       0.3805    0.3687    YES   
FALSE 2 Anderson-Darling  cintura     0.8399    0.0249    NO    
FALSE 3 Anderson-Darling   pulso      0.4065    0.3183    YES   
FALSE 
FALSE $Descriptives
FALSE          n  Mean   Std.Dev Median Min Max   25th  75th      Skew   Kurtosis
FALSE peso    20 178.6 24.690505    176 138 247 160.75 191.5 0.8292423  0.6971239
FALSE cintura 20  35.4  3.201973     35  31  46  33.00  37.0 1.6006750  3.3686243
FALSE pulso   20  56.1  7.210373     55  46  74  51.50  60.5 0.7234154 -0.1302866
FALSE 
FALSE $multivariateOutliers
FALSE NULL

Gráfico de la distribución multivariada para todas las variabless

set.seed(5632879)
mu <- rep(0, ncol(CA))
sigma <- cov(scale(CA))
X <- mvrnorm(1000, mu, sigma)
density <- dmvnorm(X, mean = mu, sigma = sigma)

plot_ly(x=~X[,1], y=~X[,2], z=~density, 
        type = "scatter3d", color=density)
mvn(CA,subset = NULL,mvn = "mardia", covariance = FALSE,showOutliers = T)
FALSE $multivariateNormality
FALSE              Test          Statistic            p value Result
FALSE 1 Mardia Skewness   69.9769684589944 0.0991664479961755    YES
FALSE 2 Mardia Kurtosis -0.458869864569627  0.646327620484881    YES
FALSE 3             MVN               <NA>               <NA>    YES
FALSE 
FALSE $univariateNormality
FALSE               Test    Variable Statistic   p value Normality
FALSE 1 Anderson-Darling    peso        0.3805    0.3687    YES   
FALSE 2 Anderson-Darling   cintura      0.8399    0.0249    NO    
FALSE 3 Anderson-Darling    pulso       0.4065    0.3183    YES   
FALSE 4 Anderson-Darling  flexiones     0.6177    0.0928    YES   
FALSE 5 Anderson-Darling sentadillas    0.7051    0.0553    YES   
FALSE 6 Anderson-Darling   saltos       1.6588    0.0002    NO    
FALSE 
FALSE $Descriptives
FALSE              n   Mean   Std.Dev Median Min Max   25th   75th       Skew
FALSE peso        20 178.60 24.690505  176.0 138 247 160.75 191.50  0.8292423
FALSE cintura     20  35.40  3.201973   35.0  31  46  33.00  37.00  1.6006750
FALSE pulso       20  56.10  7.210373   55.0  46  74  51.50  60.50  0.7234154
FALSE flexiones   20   9.45  5.286278   11.5   1  17   4.75  13.25 -0.1650396
FALSE sentadillas 20 145.55 62.566575  122.5  50 251 101.00 210.00  0.1912146
FALSE saltos      20  70.30 51.277470   54.0  25 250  39.50  85.25  2.1203234
FALSE               Kurtosis
FALSE peso         0.6971239
FALSE cintura      3.3686243
FALSE pulso       -0.1302866
FALSE flexiones   -1.5287156
FALSE sentadillas -1.4703114
FALSE saltos       4.7261886
FALSE 
FALSE $multivariateOutliers
FALSE NULL

Multicolinealidad

det(cor(CA))
FALSE [1] 0.02079812

Análisis de correlación canónica

# Matriz de correlaciones
library(CCA)
matcor(X = actividades, Y = resultados)
FALSE $Xcor
FALSE             flexiones sentadillas    saltos
FALSE flexiones   1.0000000   0.6957274 0.4957602
FALSE sentadillas 0.6957274   1.0000000 0.6692061
FALSE saltos      0.4957602   0.6692061 1.0000000
FALSE 
FALSE $Ycor
FALSE               peso    cintura      pulso
FALSE peso     1.0000000  0.8702435 -0.3657620
FALSE cintura  0.8702435  1.0000000 -0.3528921
FALSE pulso   -0.3657620 -0.3528921  1.0000000
FALSE 
FALSE $XYcor
FALSE              flexiones sentadillas      saltos       peso    cintura
FALSE flexiones    1.0000000   0.6957274  0.49576018 -0.3896937 -0.5522321
FALSE sentadillas  0.6957274   1.0000000  0.66920608 -0.4930836 -0.6455980
FALSE saltos       0.4957602   0.6692061  1.00000000 -0.2262956 -0.1914994
FALSE peso        -0.3896937  -0.4930836 -0.22629556  1.0000000  0.8702435
FALSE cintura     -0.5522321  -0.6455980 -0.19149937  0.8702435  1.0000000
FALSE pulso        0.1506480   0.2250381  0.03493306 -0.3657620 -0.3528921
FALSE                   pulso
FALSE flexiones    0.15064802
FALSE sentadillas  0.22503808
FALSE saltos       0.03493306
FALSE peso        -0.36576203
FALSE cintura     -0.35289213
FALSE pulso        1.00000000
u1 <- cc(X = actividades, Y = resultados)

names(u1)
FALSE [1] "cor"    "names"  "xcoef"  "ycoef"  "scores"
u1[3:4]
FALSE $xcoef
FALSE                    [,1]         [,2]         [,3]
FALSE flexiones   -0.06611399  0.071041211  0.245275347
FALSE sentadillas -0.01684623 -0.001973745 -0.019767637
FALSE saltos       0.01397157 -0.020714106  0.008167472
FALSE 
FALSE $ycoef
FALSE                 [,1]        [,2]         [,3]
FALSE peso    -0.031404688  0.07631951  0.007735047
FALSE cintura  0.493241676 -0.36872299 -0.158033647
FALSE pulso   -0.008199315  0.03205199 -0.145732242
#correlaciones
u1$cor
FALSE [1] 0.79560815 0.20055604 0.07257029

Cargas canónicas

# Cargas canonicas
v1 <- comput(X = actividades, Y = resultados, res = u1)

names(v1)
FALSE [1] "xscores"        "yscores"        "corr.X.xscores" "corr.Y.xscores"
FALSE [5] "corr.X.yscores" "corr.Y.yscores"
v1[3:6]
FALSE $corr.X.xscores
FALSE                   [,1]       [,2]        [,3]
FALSE flexiones   -0.7276254 -0.2369522  0.64375064
FALSE sentadillas -0.8177285 -0.5730231 -0.05444915
FALSE saltos      -0.1621905 -0.9586280  0.23393722
FALSE 
FALSE $corr.Y.xscores
FALSE               [,1]         [,2]         [,3]
FALSE peso     0.4937881  0.154907853  0.009794003
FALSE cintura  0.7362756  0.075742277  0.002249306
FALSE pulso   -0.2648166 -0.008319907 -0.068366110
FALSE 
FALSE $corr.X.yscores
FALSE                   [,1]       [,2]        [,3]
FALSE flexiones   -0.5789047 -0.0475222  0.04671717
FALSE sentadillas -0.6505914 -0.1149232 -0.00395139
FALSE saltos      -0.1290401 -0.1922586  0.01697689
FALSE 
FALSE $corr.Y.yscores
FALSE               [,1]       [,2]        [,3]
FALSE peso     0.6206424  0.7723919  0.13495886
FALSE cintura  0.9254249  0.3776614  0.03099486
FALSE pulso   -0.3328481 -0.0414842 -0.94206752
plt.cc(u1, d1 = 1, d2 = 2, type = "v", var.label = TRUE)

plt.cc(u1, d1 = 1, d2 = 3, type = "v", var.label = TRUE)

plt.cc(u1, d1 = 2, d2 = 3, type = "v", var.label = TRUE)

Prueba de hipótesis para las dimensiones canónicas

Correlaciones canónicas

#correlaciones
u1$cor
FALSE [1] 0.79560815 0.20055604 0.07257029
library(CCP)

rho <- u1$cor # vector que contiene las correlaciones canónicas
n <- dim(CA)[1] # Número de observaciones para cada variable
p <- length(actividades) # número de variables
q <- length(resultados)  # número de variables

p.asym(rho, n, p, q, tstat = "Hotelling")
FALSE  Hotelling-Lawley Trace, using F-approximation:
FALSE                 stat     approx df1 df2    p.value
FALSE 1 to 3:  1.771941460 2.49384354   9  38 0.02384017
FALSE 2 to 3:  0.047202724 0.17307666   4  44 0.95104071
FALSE 3 to 3:  0.005294329 0.08823881   1  50 0.76765879