TRABAJO FINAL

UNIVERSIDAD NACIONAL AGRARIA LA MOLINA

Departamento acádemico de estadística e informática

Docente:

Jesús Salinas

Tema:

Análisis factorial mixto

Ciclo:

2022-I

Integrantes:

Torres Jorges, David Jesus (20190312@lamolina.edu.pe)
Uriarte Zaga, Aron Salvador (20181161@lamolina.edu.pe)
Vasquez Pelaez, Melannie Geraldine (20190315@lamolina.edu.pe)
Vilca Chávez, Xiomara Coret (20191319@lamolina.edu.pe)

LA MOLINA – LIMA – PERÚ

Caso Práctico

Descripción de la data

Dentro de un caso de estudio, el cual tiene como tema principal los abalone la predicción de la edad del abalón a partir de mediciones físicas de manera que la edad del abalón se determina cortando la concha a través del cono (*parte donde se almacena la glándula a un diente radular en forma de arpón), tiñéndola y contando el número de anillos a través de un microscopio, una tarea muy tediosa donde se requiere de mucho tiempo. Para predecir la edad se utilizan otras mediciones, más accesibles de obtener. Para resolver el problema puede ser necesaria más información, como los patrones climáticos y la ubicación (por tanto, la disponibilidad de alimentos).

De los datos originales se han eliminado los ejemplos con valores perdidos (la mayoría de los cuales carecen del valor predicho), y los rangos de los valores continuos se han escalado para su uso con una RNA (dividiendo por 200).

Librerias

library(pacman)
p_load(FactoMineR,dplyr, funModeling, readr, tidyr, fastDummies,knitr,visdat, naniar,PCAmixdata, ggcorrplot,corrr,psych, 
       factoextra)

Cargando los datos

Los datos fueron extraido de UCI Machine Learning Repository: Base de datos

dt <- read.delim("abalone.data", col.names = c("Sexo","Longitud","Diametro",
                                              "Altura","PesoE","PesoD","PesoV",
                                                "PesoC","Anillos"),sep = ",")

knitr::kable(head(dt))

Sexo	Longitud	Diametro	Altura	PesoE	PesoD	PesoV	PesoC	Anillos
M	0.350	0.265	0.090	0.2255	0.0995	0.0485	0.070	7
F	0.530	0.420	0.135	0.6770	0.2565	0.1415	0.210	9
M	0.440	0.365	0.125	0.5160	0.2155	0.1140	0.155	10
I	0.330	0.255	0.080	0.2050	0.0895	0.0395	0.055	7
I	0.425	0.300	0.095	0.3515	0.1410	0.0775	0.120	8
F	0.530	0.415	0.150	0.7775	0.2370	0.1415	0.330	20

Descripcion de las variables:

Sexo: M, F y I (bebé)
Longitud: Medida de concha más larga (milímetros).
Diámetro: Perpendicular a la longitud en (milímetros).
Altura: Con carne en el caparazón en (milímetros).
Peso_total: Peso (gramos).
Peso_sin_cáscara: Peso de carne (gramos) .
Peso_vísceras: Peso de tripa (después del sangrado) (gramos) .
Peso_de_cáscara: Después de secarse (gramos).
Anillos: +1.5 da la edad (en años).

En este caso particular, al ver que tenemos en la variable anillos, un total de 29 niveles siendo una variable cuantitativa, se decidio categorizar esta variable en 4 nuevos niveles, los cuales son Crias, Joven, Adulto y Longevo, reduciendo asi los niveles que observamos en la presentación del caso.

El criterio de clasificación de la variable anillos, se extrajo del siguiente articulo : Articulo

dt$Division<- factor(dt$Anillos, levels=c(1:3,4:8,9:13,14:28,29), labels = c(rep('cria',3),rep('joven',5),rep('adulto',5),rep('longevo',15),'longevo'))
dt$Sexo <- factor(dt$Sexo)
dt$Division <- factor(dt$Division)
dt <- dt[,-9]

Limpieza de la data:

Valores perdidos

Antes de iniciar con la implementación del algoritmo, se realiza una limpieza de datos, comenzando por encontrar la presencia o ausencia de valores perdidos.

De forma gráfica :

Paquete visdat:

vis_dat(dt, palette = "qual",warn_large_data = TRUE)

Del paquete visdat, con ayuda de la función vis_dat, implementa un gráfico en donde se puede visualizar que nuestro conjunto de datos presenta dos variables factor (División-Sexo) y 7 variables númericas (Longitud, Diametro, Altura, PesoE,PesoD, PesoV,PesoC ), en el cual no encontramos presencia de valores perdidos.

Otra función del mismo paquete es : viss_miss

vis_miss(dt ,sort_miss = TRUE,show_perc=TRUE)

Observamos un gráfico en donde se tiene por filas, la cantidad de datos, en las columnas, las variables con su respectivos porcentaje. El criterio del gráfico es colorear de color negro, en caso se halle un valor perdido, y de color gris, la ausencia de los mismo.

Nota: La función sigue una estetica de ggplot, por lo que se puede modificar de acuerdo a la estica escogida.

Paquete naniar:

dt %>% miss_var_summary()

## # A tibble: 9 × 3
##   variable n_miss pct_miss
##   <chr>     <int>    <dbl>
## 1 Sexo          0        0
## 2 Longitud      0        0
## 3 Diametro      0        0
## 4 Altura        0        0
## 5 PesoE         0        0
## 6 PesoD         0        0
## 7 PesoV         0        0
## 8 PesoC         0        0
## 9 Division      0        0

Otra manera de visualizarlo seria con el paquete naniar, con la función miss_var_summary, en donde nos da como resultado, una tabla con dos columnas que son :

n_miss: Indica la cantidad de valores perdidos por cada variable.
pct_miss: Indica el porcentaje de valores perdidos por cada variable.

Paquete funModeling:

df_status(dt)

##   variable q_zeros p_zeros q_na p_na q_inf p_inf    type unique
## 1     Sexo       0    0.00    0    0     0     0  factor      3
## 2 Longitud       0    0.00    0    0     0     0 numeric    134
## 3 Diametro       0    0.00    0    0     0     0 numeric    111
## 4   Altura       2    0.05    0    0     0     0 numeric     51
## 5    PesoE       0    0.00    0    0     0     0 numeric   2429
## 6    PesoD       0    0.00    0    0     0     0 numeric   1515
## 7    PesoV       0    0.00    0    0     0     0 numeric    880
## 8    PesoC       0    0.00    0    0     0     0 numeric    926
## 9 Division       0    0.00    0    0     0     0  factor      4

La función df_status del paquete funModeling, nos arroja un tabla cuyos indicadores serian :

q_zeros: Cantidad de ceros por cada variable.
p_zeros: Porcentaje de ceros por cada variable.
q_na: Cantidad de valores perdidos por cada variable.
p_na: Porcentaje de valores perdidos por cada variable.
q_inf: Cantidad de valores infinitos por cada variable.
p_inf: Porcentaje de valores infinitos por cada variable.

Podemos ver que hay dos valores de cero para la variable altura, al tener esta variable expresada en centímetros, y ante los resultados observados,existen dos abalones con altura igual a 0. Se analiza la altura de los mismos, se concluye que no pueden existir registros con altura cero. Por tal motivo se excluyen los registros.

dt <- data.frame(dt, N = c(1:nrow(dt)))
ceros <- dt %>% filter(Altura==0)
ceros <- ceros$N
dt <- dt[-ceros,]
dt <- dt[,-10]
head(dt)

##   Sexo Longitud Diametro Altura  PesoE  PesoD  PesoV PesoC Division
## 1    M    0.350    0.265  0.090 0.2255 0.0995 0.0485 0.070    joven
## 2    F    0.530    0.420  0.135 0.6770 0.2565 0.1415 0.210   adulto
## 3    M    0.440    0.365  0.125 0.5160 0.2155 0.1140 0.155   adulto
## 4    I    0.330    0.255  0.080 0.2050 0.0895 0.0395 0.055    joven
## 5    I    0.425    0.300  0.095 0.3515 0.1410 0.0775 0.120    joven
## 6    F    0.530    0.415  0.150 0.7775 0.2370 0.1415 0.330  longevo

Estadisticas Descriptivas

Resumen de los datos

summary(dt)

##  Sexo        Longitud         Diametro         Altura           PesoE       
##  F:1307   Min.   :0.0750   Min.   :0.055   Min.   :0.0100   Min.   :0.0020  
##  I:1340   1st Qu.:0.4500   1st Qu.:0.350   1st Qu.:0.1150   1st Qu.:0.4421  
##  M:1527   Median :0.5450   Median :0.425   Median :0.1400   Median :0.8000  
##           Mean   :0.5241   Mean   :0.408   Mean   :0.1396   Mean   :0.8291  
##           3rd Qu.:0.6150   3rd Qu.:0.480   3rd Qu.:0.1650   3rd Qu.:1.1538  
##           Max.   :0.8150   Max.   :0.650   Max.   :1.1300   Max.   :2.8255  
##      PesoD            PesoV            PesoC           Division   
##  Min.   :0.0010   Min.   :0.0005   Min.   :0.0015   cria   :  17  
##  1st Qu.:0.1861   1st Qu.:0.0935   1st Qu.:0.1300   joven  :1388  
##  Median :0.3360   Median :0.1710   Median :0.2340   adulto :2280  
##  Mean   :0.3595   Mean   :0.1807   Mean   :0.2389   longevo: 489  
##  3rd Qu.:0.5020   3rd Qu.:0.2530   3rd Qu.:0.3289                 
##  Max.   :1.4880   Max.   :0.7600   Max.   :1.0050

Se puede observar que para las variables númericas, se tiene estadisticos de tendencia central, mientras que para las variables cualitativas, se tiene la frecuencia de los datos.

Paquete psych

psych::describe(dt)

##           vars    n mean   sd median trimmed  mad  min  max range  skew
## Sexo*        1 4174 2.05 0.82   2.00    2.07 1.48 1.00 3.00  2.00 -0.10
## Longitud     2 4174 0.52 0.12   0.54    0.53 0.12 0.07 0.81  0.74 -0.64
## Diametro     3 4174 0.41 0.10   0.42    0.41 0.10 0.06 0.65  0.60 -0.61
## Altura       4 4174 0.14 0.04   0.14    0.14 0.04 0.01 1.13  1.12  3.16
## PesoE        5 4174 0.83 0.49   0.80    0.80 0.53 0.00 2.83  2.82  0.53
## PesoD        6 4174 0.36 0.22   0.34    0.34 0.23 0.00 1.49  1.49  0.72
## PesoV        7 4174 0.18 0.11   0.17    0.17 0.12 0.00 0.76  0.76  0.59
## PesoC        8 4174 0.24 0.14   0.23    0.23 0.15 0.00 1.00  1.00  0.62
## Division*    9 4174 2.78 0.65   3.00    2.73 0.00 1.00 4.00  3.00  0.16
##           kurtosis   se
## Sexo*        -1.52 0.01
## Longitud      0.06 0.00
## Diametro     -0.05 0.00
## Altura       76.65 0.00
## PesoE        -0.03 0.01
## PesoD         0.59 0.00
## PesoV         0.08 0.00
## PesoC         0.53 0.00
## Division*    -0.54 0.01

Descripción de las variables numéricas

profiling_num(dt)

##   variable      mean    std_dev variation_coef     p_01     p_05     p_25  p_50
## 1 Longitud 0.5240812 0.12007891      0.2291227 0.195000 0.295000 0.450000 0.545
## 2 Diametro 0.4079504 0.09922953      0.2432392 0.140000 0.220000 0.350000 0.425
## 3   Altura 0.1395939 0.04172470      0.2989006 0.045000 0.075000 0.115000 0.140
## 4    PesoE 0.8290800 0.49038380      0.5914795 0.035730 0.125825 0.442125 0.800
## 5    PesoD 0.3595087 0.22197107      0.6174288 0.013500 0.052325 0.186125 0.336
## 6    PesoV 0.1806718 0.10961163      0.6066893 0.007865 0.027000 0.093500 0.171
## 7    PesoC 0.2388551 0.13922198      0.5828722 0.010365 0.038325 0.130000 0.234
##       p_75     p_95     p_99   skewness  kurtosis      iqr
## 1 0.615000 0.690000 0.735000 -0.6411302  3.066325 0.165000
## 2 0.480000 0.545000 0.580000 -0.6102220  2.955660 0.130000
## 3 0.165000 0.200000 0.220000  3.1656704 79.684026 0.050000
## 4 1.153750 1.695950 2.144660  0.5299749  2.974638 0.711625
## 5 0.502000 0.740350 0.998065  0.7181031  3.592296 0.315875
## 6 0.253000 0.379675 0.476175  0.5908538  3.082210 0.159500
## 7 0.328875 0.480000 0.620000  0.6204775  3.529712 0.198875
##                        range_98                   range_80
## 1                [0.195, 0.735]              [0.355, 0.66]
## 2                  [0.14, 0.58] [0.265, 0.523500000000001]
## 3                 [0.045, 0.22]              [0.09, 0.185]
## 4            [0.03573, 2.14466]         [0.20515, 1.47835]
## 5   [0.0135, 0.998064999999996]            [0.0865, 0.647]
## 6 [0.007865, 0.476174999999999]            [0.0435, 0.326]
## 7              [0.010365, 0.62]              [0.065, 0.42]

Con ayuda del paquete funModeling, se obtiene una tabla de métricas con muchos indicadores para todas las variables numéricas, omitiendo automáticamente las variables no numéricas.

Las métricas actuales son:

Media
std_dev: desviación estándar
Percentiles
Asimetría
Curtosis
Iqr: Rango intercuartil
Variation_coef: la relación de sd/media
Range_98 :es el límite para el que el 98

Análisis de correlación

Politomizando las variables

newdt <- dummy_cols(dt,  select_columns = c("Sexo", "Division")) %>%
  select(-c("Sexo", "Division"))

cor(newdt)

##                    Longitud   Diametro     Altura      PesoE      PesoD
## Longitud          1.0000000  0.9868031  0.8281069  0.9252112  0.8978506
## Diametro          0.9868031  1.0000000  0.8343205  0.9254143  0.8931046
## Altura            0.8281069  0.8343205  1.0000000  0.8198742  0.7756054
## PesoE             0.9252112  0.9254143  0.8198742  1.0000000  0.9693868
## PesoD             0.8978506  0.8931046  0.7756054  0.9693868  1.0000000
## PesoV             0.9029528  0.8996733  0.7988818  0.9663509  0.9319187
## PesoC             0.8984108  0.9060819  0.8195849  0.9559197  0.8831184
## Sexo_F            0.3093625  0.3183553  0.2980553  0.2994356  0.2636902
## Sexo_I           -0.5512536 -0.5641029 -0.5181495 -0.5574398 -0.5216907
## Sexo_M            0.2364599  0.2402560  0.2152594  0.2520141  0.2517800
## Division_cria    -0.1893750 -0.1838876 -0.1544636 -0.1047315 -0.1005009
## Division_joven   -0.5874564 -0.5989268 -0.5416415 -0.5635913 -0.5053972
## Division_adulto   0.4528835  0.4511016  0.3692317  0.3979682  0.4142239
## Division_longevo  0.1969909  0.2154657  0.2524593  0.2302797  0.1190278
##                       PesoV      PesoC      Sexo_F      Sexo_I      Sexo_M
## Longitud          0.9029528  0.8984108  0.30936251 -0.55125358  0.23645986
## Diametro          0.8996733  0.9060819  0.31835525 -0.56410287  0.24025602
## Altura            0.7988818  0.8195849  0.29805530 -0.51814955  0.21525935
## PesoE             0.9663509  0.9559197  0.29943565 -0.55743979  0.25201412
## PesoD             0.9319187  0.8831184  0.26369018 -0.52169072  0.25177999
## PesoV             1.0000000  0.9081762  0.30813102 -0.55594241  0.24219044
## PesoC             0.9081762  1.0000000  0.30631987 -0.54745682  0.23570926
## Sexo_F            0.3081310  0.3063199  1.00000000 -0.46427620 -0.51282182
## Sexo_I           -0.5559424 -0.5474568 -0.46427620  1.00000000 -0.52226993
## Sexo_M            0.2421904  0.2357093 -0.51282182 -0.52226993  1.00000000
## Division_cria    -0.1020385 -0.1059302 -0.04317759  0.06882811 -0.02514151
## Division_joven   -0.5550821 -0.5893687 -0.27261933  0.50147975 -0.22359224
## Division_adulto   0.4109728  0.3609815  0.19514344 -0.37101943  0.17173480
## Division_longevo  0.1971492  0.3255358  0.10582323 -0.17389940  0.06666868
##                  Division_cria Division_joven Division_adulto Division_longevo
## Longitud           -0.18937500    -0.58745639       0.4528835       0.19699086
## Diametro           -0.18388759    -0.59892678       0.4511016       0.21546574
## Altura             -0.15446361    -0.54164150       0.3692317       0.25245926
## PesoE              -0.10473151    -0.56359132       0.3979682       0.23027968
## PesoD              -0.10050095    -0.50539721       0.4142239       0.11902781
## PesoV              -0.10203852    -0.55508207       0.4109728       0.19714923
## PesoC              -0.10593020    -0.58936866       0.3609815       0.32553576
## Sexo_F             -0.04317759    -0.27261933       0.1951434       0.10582323
## Sexo_I              0.06882811     0.50147975      -0.3710194      -0.17389940
## Sexo_M             -0.02514151    -0.22359224       0.1717348       0.06666868
## Division_cria       1.00000000    -0.04513762      -0.0701636      -0.02329540
## Division_joven     -0.04513762     1.00000000      -0.7744290      -0.25712237
## Division_adulto    -0.07016360    -0.77442901       1.0000000      -0.39968065
## Division_longevo   -0.02329540    -0.25712237      -0.3996806       1.00000000

Se hace uso del paquete fastDummies, se hace uso de la función dummy_cols la cual crea columnas ficticias (binarias) a partir de columnas de tipo carácter y factor en los datos introducidos (y columnas numéricas si se especifica.)

Nota: Esta función es útil para el análisis estadístico cuando se desean columnas binarias en lugar de columnas de caracteres.

Prueba estadística:

\[H_0: \rho = 0\]
\[H_1: \rho \neq 0\]

corr.test(newdt)

## Call:corr.test(x = newdt)
## Correlation matrix 
##                  Longitud Diametro Altura PesoE PesoD PesoV PesoC Sexo_F Sexo_I
## Longitud             1.00     0.99   0.83  0.93  0.90  0.90  0.90   0.31  -0.55
## Diametro             0.99     1.00   0.83  0.93  0.89  0.90  0.91   0.32  -0.56
## Altura               0.83     0.83   1.00  0.82  0.78  0.80  0.82   0.30  -0.52
## PesoE                0.93     0.93   0.82  1.00  0.97  0.97  0.96   0.30  -0.56
## PesoD                0.90     0.89   0.78  0.97  1.00  0.93  0.88   0.26  -0.52
## PesoV                0.90     0.90   0.80  0.97  0.93  1.00  0.91   0.31  -0.56
## PesoC                0.90     0.91   0.82  0.96  0.88  0.91  1.00   0.31  -0.55
## Sexo_F               0.31     0.32   0.30  0.30  0.26  0.31  0.31   1.00  -0.46
## Sexo_I              -0.55    -0.56  -0.52 -0.56 -0.52 -0.56 -0.55  -0.46   1.00
## Sexo_M               0.24     0.24   0.22  0.25  0.25  0.24  0.24  -0.51  -0.52
## Division_cria       -0.19    -0.18  -0.15 -0.10 -0.10 -0.10 -0.11  -0.04   0.07
## Division_joven      -0.59    -0.60  -0.54 -0.56 -0.51 -0.56 -0.59  -0.27   0.50
## Division_adulto      0.45     0.45   0.37  0.40  0.41  0.41  0.36   0.20  -0.37
## Division_longevo     0.20     0.22   0.25  0.23  0.12  0.20  0.33   0.11  -0.17
##                  Sexo_M Division_cria Division_joven Division_adulto
## Longitud           0.24         -0.19          -0.59            0.45
## Diametro           0.24         -0.18          -0.60            0.45
## Altura             0.22         -0.15          -0.54            0.37
## PesoE              0.25         -0.10          -0.56            0.40
## PesoD              0.25         -0.10          -0.51            0.41
## PesoV              0.24         -0.10          -0.56            0.41
## PesoC              0.24         -0.11          -0.59            0.36
## Sexo_F            -0.51         -0.04          -0.27            0.20
## Sexo_I            -0.52          0.07           0.50           -0.37
## Sexo_M             1.00         -0.03          -0.22            0.17
## Division_cria     -0.03          1.00          -0.05           -0.07
## Division_joven    -0.22         -0.05           1.00           -0.77
## Division_adulto    0.17         -0.07          -0.77            1.00
## Division_longevo   0.07         -0.02          -0.26           -0.40
##                  Division_longevo
## Longitud                     0.20
## Diametro                     0.22
## Altura                       0.25
## PesoE                        0.23
## PesoD                        0.12
## PesoV                        0.20
## PesoC                        0.33
## Sexo_F                       0.11
## Sexo_I                      -0.17
## Sexo_M                       0.07
## Division_cria               -0.02
## Division_joven              -0.26
## Division_adulto             -0.40
## Division_longevo             1.00
## Sample Size 
## [1] 4174
## Probability values (Entries above the diagonal are adjusted for multiple tests.) 
##                  Longitud Diametro Altura PesoE PesoD PesoV PesoC Sexo_F Sexo_I
## Longitud                0        0      0     0     0     0     0   0.00      0
## Diametro                0        0      0     0     0     0     0   0.00      0
## Altura                  0        0      0     0     0     0     0   0.00      0
## PesoE                   0        0      0     0     0     0     0   0.00      0
## PesoD                   0        0      0     0     0     0     0   0.00      0
## PesoV                   0        0      0     0     0     0     0   0.00      0
## PesoC                   0        0      0     0     0     0     0   0.00      0
## Sexo_F                  0        0      0     0     0     0     0   0.00      0
## Sexo_I                  0        0      0     0     0     0     0   0.00      0
## Sexo_M                  0        0      0     0     0     0     0   0.00      0
## Division_cria           0        0      0     0     0     0     0   0.01      0
## Division_joven          0        0      0     0     0     0     0   0.00      0
## Division_adulto         0        0      0     0     0     0     0   0.00      0
## Division_longevo        0        0      0     0     0     0     0   0.00      0
##                  Sexo_M Division_cria Division_joven Division_adulto
## Longitud            0.0          0.00           0.00               0
## Diametro            0.0          0.00           0.00               0
## Altura              0.0          0.00           0.00               0
## PesoE               0.0          0.00           0.00               0
## PesoD               0.0          0.00           0.00               0
## PesoV               0.0          0.00           0.00               0
## PesoC               0.0          0.00           0.00               0
## Sexo_F              0.0          0.02           0.00               0
## Sexo_I              0.0          0.00           0.00               0
## Sexo_M              0.0          0.21           0.00               0
## Division_cria       0.1          0.00           0.01               0
## Division_joven      0.0          0.00           0.00               0
## Division_adulto     0.0          0.00           0.00               0
## Division_longevo    0.0          0.13           0.00               0
##                  Division_longevo
## Longitud                     0.00
## Diametro                     0.00
## Altura                       0.00
## PesoE                        0.00
## PesoD                        0.00
## PesoV                        0.00
## PesoC                        0.00
## Sexo_F                       0.00
## Sexo_I                       0.00
## Sexo_M                       0.00
## Division_cria                0.21
## Division_joven               0.00
## Division_adulto              0.00
## Division_longevo             0.00
## 
##  To see confidence intervals of the correlations, print with the short=FALSE option

Gráficos de correlación

Paquete psych

cor.plot(cor(newdt),
         main="Mapa de Calor", 
         diag=T,
         show.legend = T,numbers=F,upper=F)

Nos arroja un gráfico de calor, en forma de una matrix triangular inferior, en donde de acuerdo a la intensidad de los colores ubicado en la leyenda, en donde se puede observar la variación de los colores conforme la correlación se encuentra entre \(-1\space y \space1\).

Paquete ggcorrplot

model.matrix(~0+., data=newdt) %>% 
  cor(use="pairwise.complete.obs") %>% 
  ggcorrplot(show.diag = F, type="lower", lab=TRUE, lab_size=2)

De acuerdo a las variables en estudio, podemos observar la alta correlación que presentan alguna variables como :

Diametro y Longitud
Altura y Longitud
PesoE y Longitud
etc.

Ante la presencia de correlación entre multiples variables, se puede implementar un Análisis Factorial Mixto, principalmente por el tipo de dato que presenta nuestro conjunto de datos, tanto variables cualitativas como cuantitativas.

Paquete corrr

cor <- correlate(newdt)
network_plot(cor)

Se puede observar que en las variables cualitativas, al describir estas las dimensiones y caracteristicas fisicas del individuo, poseen correlación altas.

Por medio de los gráficos y la prueba estadistica, se puede verificar que si existe correlación entre las variables, para lo cual procedemos a realizar un analisis factorial mixto, ya que, contamos tanto con variables cuantitativas como cualitativas.

Normalización de los datos

Sexo <- dt$Sexo
Division <- dt$Division
dt <- scale(dt[,-c(1,9)])

dt <- data.frame(Sexo, dt , Division )
head(dt,6)

##   Sexo    Longitud   Diametro     Altura      PesoE      PesoD      PesoV
## 1    M -1.44972355 -1.4406035 -1.1885985 -1.2308319 -1.1713632 -1.2058189
## 2    F  0.04929078  0.1214315 -0.1101006 -0.3101245 -0.4640638 -0.3573688
## 3    M -0.70021638 -0.4328390 -0.3497668 -0.6384387 -0.6487726 -0.6082546
## 4    I -1.61628070 -1.5413800 -1.4282647 -1.2726359 -1.2164141 -1.2879270
## 5    I -0.82513424 -1.0878859 -1.0687654 -0.9738903 -0.9844019 -0.9412484
## 6    F  0.04929078  0.0710433  0.2493987 -0.1051830 -0.5519131 -0.3573688
##        PesoC Division
## 1 -1.2128477    joven
## 2 -0.2072593   adulto
## 3 -0.6023119   adulto
## 4 -1.3205893    joven
## 5 -0.8537090    joven
## 6  0.6546735  longevo

Ante la diferencia de los rangos en todas las variables declaradas dentro de nuestro conjunto de datos, y como requisito del análisis factorial, estandarizamos las variables, cuyo objetivo es estabilizar los pesos de los niveles de cada factor.

Analisis Factorial mixto

Paquete FactoMineR

(res.famd <- FAMD(dt, graph = FALSE))

## *The results are available in the following objects:
## 
##   name          description                             
## 1 "$eig"        "eigenvalues and inertia"               
## 2 "$var"        "Results for the variables"             
## 3 "$ind"        "results for the individuals"           
## 4 "$quali.var"  "Results for the qualitative variables" 
## 5 "$quanti.var" "Results for the quantitative variables"

summary(res.famd)

## 
## Call:
## FAMD(base = dt, graph = FALSE) 
## 
## 
## Eigenvalues
##                       Dim.1  Dim.2  Dim.3  Dim.4  Dim.5
## Variance              7.160  1.032  1.017  0.990  0.725
## % of var.            59.668  8.602  8.475  8.254  6.038
## Cumulative % of var. 59.668 68.270 76.745 84.999 91.036
## 
## Individuals (the 10 first)
##              Dist    Dim.1    ctr   cos2    Dim.2    ctr   cos2    Dim.3    ctr
## 1        |  3.892 | -3.360  0.038  0.745 | -0.438  0.004  0.013 |  0.111  0.000
## 2        |  1.880 | -0.092  0.000  0.002 |  0.027  0.000  0.000 | -0.298  0.002
## 3        |  2.219 | -1.111  0.004  0.251 | -1.139  0.030  0.263 |  0.262  0.002
## 4        |  4.202 | -4.122  0.057  0.962 |  0.262  0.002  0.004 | -0.351  0.003
## 5        |  3.265 | -3.076  0.032  0.888 |  0.283  0.002  0.008 | -0.412  0.004
## 6        |  3.267 |  0.456  0.001  0.020 |  2.864  0.190  0.769 |  0.646  0.010
## 7        |  3.181 |  0.271  0.000  0.007 |  2.750  0.175  0.747 |  0.618  0.009
## 8        |  2.123 | -0.971  0.003  0.209 | -1.139  0.030  0.288 |  0.240  0.001
## 9        |  3.227 |  0.821  0.002  0.065 |  2.819  0.184  0.763 |  0.618  0.009
## 10       |  3.272 | -0.247  0.000  0.006 |  2.787  0.180  0.725 |  0.625  0.009
##            cos2  
## 1         0.001 |
## 2         0.025 |
## 3         0.014 |
## 4         0.007 |
## 5         0.016 |
## 6         0.039 |
## 7         0.038 |
## 8         0.013 |
## 9         0.037 |
## 10        0.036 |
## 
## Continuous variables
##             Dim.1    ctr   cos2    Dim.2    ctr   cos2    Dim.3    ctr   cos2  
## Longitud |  0.962 12.923  0.925 | -0.020  0.038  0.000 | -0.076  0.566  0.006 |
## Diametro |  0.965 13.005  0.931 | -0.006  0.003  0.000 | -0.063  0.392  0.004 |
## Altura   |  0.877 10.752  0.770 |  0.067  0.431  0.004 | -0.029  0.081  0.001 |
## PesoE    |  0.975 13.271  0.950 |  0.001  0.000  0.000 |  0.026  0.065  0.001 |
## PesoD    |  0.937 12.258  0.878 | -0.093  0.844  0.009 | -0.009  0.008  0.000 |
## PesoV    |  0.953 12.688  0.908 | -0.022  0.048  0.000 |  0.017  0.027  0.000 |
## PesoC    |  0.952 12.659  0.906 |  0.095  0.879  0.009 |  0.055  0.301  0.003 |
## 
## Categories
##              Dim.1     ctr    cos2  v.test     Dim.2     ctr    cos2  v.test  
## F        |   1.404   1.205   0.525  22.892 |   0.580   9.888   0.090  24.902 |
## I        |  -2.503   3.924   0.886 -41.557 |   0.129   0.504   0.002   5.654 |
## M        |   0.995   0.706   0.393  18.239 |  -0.610  12.775   0.148 -29.457 |
## cria     |  -6.348   0.320   0.144  -9.800 |  -2.020   1.560   0.015  -8.213 |
## joven    |  -2.497   4.043   0.893 -42.541 |   0.181   1.026   0.005   8.136 |
## adulto   |   1.167   1.450   0.708  30.900 |  -0.575  16.960   0.172 -40.125 |
## longevo  |   1.868   0.797   0.333  16.426 |   2.237  55.043   0.477  51.823 |
##            Dim.3     ctr    cos2  v.test  
## F         -0.189   1.084   0.010  -8.184 |
## I         -0.173   0.931   0.004  -7.630 |
## M          0.314   3.487   0.039  15.275 |
## cria      14.379  81.412   0.741  58.900 |
## joven     -0.329   3.484   0.016 -14.884 |
## adulto    -0.085   0.378   0.004  -5.946 |
## longevo    0.829   7.785   0.066  19.345 |

Se muestra todos las caracteristicas de las dimensiones halladas, mediante ciertos criterios, se hará la elección de las dimensiones óptimas de acuerdo de nuestros criterios de estudio.

Inercia y valores propios (eigenvalues)

Autovalores por componente

res.famd$eig

##        eigenvalue percentage of variance cumulative percentage of variance
## comp 1  7.1601323              59.667769                          59.66777
## comp 2  1.0322221               8.601851                          68.26962
## comp 3  1.0170209               8.475174                          76.74479
## comp 4  0.9904644               8.253870                          84.99866
## comp 5  0.7245357               6.037798                          91.03646

Al observar los resultados, se puede afirmar una posible decisión respecto al número de dimensiones a eligir, según el criterio de eigenvalue, estos tienen que ser mayores a 1 (\(>1\)), descartando asi, 4 y 5 dimensiones.

Grafico de los autovalores

Paquete factoextra

fviz_screeplot(res.famd,barcolor="black",barfill="#EE30A7")

Paquete stats

plot(get_eigenvalue(res.famd)[,1],type="b",pch=20,col="blue",
     main="Gráfico de sedimentación",
     ylab="Autovalores",
     xlab="Número de dimensiones")

Por los gráficos de sedimentación confirmamos que es aceptable trabajar con dos componentes, ya que, despues del segundo componente no suele existir un cambio considerable. Presentandose asi, el punto de inflexión.

Gráfico de las dimensiones y sus contribuciones

Grafico de las variables en las nuevas dimensiones

fviz_famd_var(res.famd, repel = TRUE)

Contribucion de la primera dimension

fviz_contrib(res.famd, "var", axes = 1,fill="#9F79EE",color="black",ggtheme = theme_minimal(),title="Contribuciones de la variables en la Dim1")

Se puede observar que las variables cuantitativas, tiene una mejor representación en la primera dimensión. Siendo las menos explicadas, las varibles cuantitativas.

Contribucion de la segunda dimension

fviz_contrib(res.famd, "var", axes = 2,fill="olivedrab3",color="black",
             ,title="Contribuciones de la variables en la Dim2")

Caso contrario al primer gráfico de contribuciones, se puede observar que las variables cualitativas tienen mejor representación en la segunda dimensión.

Grafica del circulo de correlaciones

Para variables cuantitativas

fviz_famd_var(res.famd, "quanti.var", col.var = "contrib",
             gradient.cols = c("#9A32CD", "white", "#00B2EE"), 
             repel = TRUE)

Para variables cualitativas

fviz_famd_var(res.famd, "quali.var", col.var = "contrib",
             gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"), 
             repel = TRUE)

Gráfica de las observaciones en los dimensiones (\(Cos^2\))

fviz_famd_ind(res.famd, col.ind = "cos2", 
             gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
             repel = TRUE)

Gráfica de las variables cualitativas

fviz_mfa_ind(res.famd, 
             habillage = "Sexo",palette = c( "#EEAD0E", "#B4EEB4", "#9AC0CD"),  repel = TRUE)

fviz_mfa_ind(res.famd, 
             habillage = "Division", palette = c("#B3EE3A", "#00AFBB", "#E7B800", "#FC4E07"), repel = TRUE)

fviz_ellipses(res.famd, c("Sexo", "Division"),  repel = TRUE)

Conclusión:

Por medio del analisis factorial mixto, comprobamos que debemos reducir a dos dimensiones donde las variables: Altura, Peso, Longitud, Diametro,Altura, Peso total, Peso sin cascara, Peso de viceras, Peso de cascara y anillos se encuentran asociadas a la primera dimensión, demostrando su mejor representatividad en la priera dimensión, mientras que las variables: Division y Sexo siendo ambas variables categoricas, se encuentran asociadas a la segunda dimension.

AFDM con el paquete PCAmixdata

FAMD y sus autovalores

Se tiene que separar tanto variables cuantitativas como cualitativas, formando si, dos grupos de variables dentro de nuestro conjunto de datos.

dtsep <- splitmix(dt)

Realizamos el Análisis Factorial mixto con el paquete PCAmix.

(res.pcamix <- PCAmix(X.quanti=dtsep$X.quanti,  
                     X.quali=dtsep$X.quali, 
                     rename.level=TRUE, 
                     graph=FALSE, 
                     ndim=12))

## 
## Call:
## PCAmix(X.quanti = dtsep$X.quanti, X.quali = dtsep$X.quali, ndim = 12,     rename.level = TRUE, graph = FALSE)
## 
## Method = Principal Component of mixed data (PCAmix)
## 
## 
## "name" "description"
## "$eig" "eigenvalues of the principal components (PC) "
## "$ind" "results for the individuals (coord,contrib,cos2)"
## "$quanti" "results for the quantitative variables (coord,contrib,cos2)"
## "$levels" "results for the levels of the qualitative variables (coord,contrib,cos2)"
## "$quali" "results for the qualitative variables (contrib,relative contrib)"
## "$sqload" "squared loadings"
## "$coef" "coef of the linear combinations defining the PC"

(summary(res.pcamix))

## 
## Call:
## PCAmix(X.quanti = dtsep$X.quanti, X.quali = dtsep$X.quali, ndim = 12,     rename.level = TRUE, graph = FALSE)
## 
## Method = Factor Analysis of mixed data (FAmix)
## 
## Data: 
##    number of observations:  4174
##    number of  variables:  9
##         number of numerical variables:  7
##         number of categorical variables:  2
## 
## Squared loadings :
##          dim 1 dim 2 dim 3 dim 4 dim 5 dim 6 dim 7 dim 8 dim 9 dim 10 dim 11
## Longitud  0.93  0.00  0.01  0.00  0.01  0.00  0.00  0.05  0.00   0.00   0.01
## Diametro  0.93  0.00  0.00  0.00  0.00  0.00  0.00  0.05  0.00   0.00   0.01
## Altura    0.77  0.00  0.00  0.00  0.00  0.00  0.21  0.01  0.00   0.00   0.00
## PesoE     0.95  0.00  0.00  0.00  0.02  0.00  0.01  0.01  0.00   0.00   0.00
## PesoD     0.88  0.01  0.00  0.00  0.05  0.01  0.01  0.01  0.02   0.02   0.00
## PesoV     0.91  0.00  0.00  0.00  0.02  0.00  0.01  0.01  0.00   0.04   0.00
## PesoC     0.91  0.01  0.00  0.00  0.01  0.00  0.00  0.00  0.06   0.00   0.00
## Sexo      0.42  0.24  0.06  0.72  0.35  0.22  0.00  0.00  0.00   0.00   0.00
## Division  0.47  0.77  0.95  0.27  0.27  0.26  0.01  0.00  0.00   0.00   0.00
##          dim 12
## Longitud      0
## Diametro      0
## Altura        0
## PesoE         0
## PesoD         0
## PesoV         0
## PesoC         0
## Sexo          0
## Division      0

## NULL

A diferencia del paquete FactoMineR, la función FAMD por default nos arroja 5 dimensiones, en cambio el paquete PCAmix cuya función comparte el nombre del paquete, nos arroja por default 12 dimensiones.

Autovalores

res.pcamix$eig

##         Eigenvalue  Proportion Cumulative
## dim 1  7.160132287 59.66776906   59.66777
## dim 2  1.032222141  8.60185117   68.26962
## dim 3  1.017020910  8.47517425   76.74479
## dim 4  0.990464411  8.25387009   84.99866
## dim 5  0.724535740  6.03779783   91.03646
## dim 6  0.492850103  4.10708419   95.14355
## dim 7  0.259048465  2.15873721   97.30228
## dim 8  0.152767343  1.27306119   98.57535
## dim 9  0.089155850  0.74296542   99.31831
## dim 10 0.062880741  0.52400618   99.84232
## dim 11 0.012576182  0.10480152   99.94712
## dim 12 0.006345825  0.05288188  100.00000

Segun estos resultados la variabilidad que explicariamos si trabajamos con 2 componentes seria de \(68.25\%\) tal como nos dio a saber los resultados anteriores.

Gráfica de autovalores

plot(res.pcamix$eig[,1],type="b",pch=20,col="blue",
     ylab="Autovalores")

eig.val <- res.pcamix$eig

barplot(eig.val[, 2], names.arg=1:nrow(eig.val), 
        main = "Autovalores",
        xlab = "Componentes Principales",
        ylab = "Porcentaje de variancias",
        col ="steelblue")
lines(x = 1:nrow(eig.val), eig.val[, 2], 
      type="b", pch=19, col = "red")

Gráficos de las dimesiones y correlaciones

Individuos en las nuevas dimensiones

plot(res.pcamix,choice="ind",coloring.ind = dtsep$X.quali,cex=0.8,
     posleg="topright",main="Scores")

Cuadrado de las correlaciones

plot(res.pcamix, choice="sqload",main="Squared correlations")

Circulo de correlaciones

plot(res.pcamix, choice="cor",main="Correlation circle")

Conclusion:

Como podemos visualizar obtenemos resultados iguales, es decir, explicamos el 68.25% de la variabilidad de los datos con 2 componentes, además que observamos las variables altura, Peso, Longitud, Diametro,Altura, Peso total, Peso sin cascara,Peso de viceras, Peso de cascara y anillos son explicadas con la primera dimension, mientras que las variables: Division y Sexo son explicadas por la segunda dimension dimensión. Se podría trabajar con 3 dimensiones, pero se tiene en cuenta el gasto computacional que ello implicaria.

Análisis Factorial Mixto

03 Agosto, 2022

TRABAJO FINAL

UNIVERSIDAD NACIONAL AGRARIA LA MOLINA

Docente:

Tema:

Ciclo:

Integrantes:

Caso Práctico

Descripción de la data

Librerias

Cargando los datos

Descripcion de las variables:

Limpieza de la data:

Valores perdidos

Paquete visdat:

Paquete naniar:

Paquete funModeling:

Estadisticas Descriptivas

Resumen de los datos

Paquete psych

Descripción de las variables numéricas

Análisis de correlación

Politomizando las variables

Prueba estadística:

Gráficos de correlación

Paquete psych

Paquete ggcorrplot

Paquete corrr

Normalización de los datos

Analisis Factorial mixto

Paquete FactoMineR

Inercia y valores propios (eigenvalues)

Autovalores por componente

Grafico de los autovalores

Paquete factoextra

Paquete stats

Gráfico de las dimensiones y sus contribuciones

Grafica del circulo de correlaciones

Para variables cuantitativas

Para variables cualitativas

Gráfica de las observaciones en los dimensiones (\(Cos^2\))

Gráfica de las variables cualitativas

AFDM con el paquete PCAmixdata

FAMD y sus autovalores

Autovalores

Gráfica de autovalores

Gráficos de las dimesiones y correlaciones

Individuos en las nuevas dimensiones

Cuadrado de las correlaciones

Circulo de correlaciones