R Notebook

Análisis Discriminante

Cargar librerías

library(MASS)
library(tidyverse)
library(caret)
theme_set(theme_classic())

#Cargamos base de datos “Dimensionpsico” ## Los datos a analizar corresponden a las mediciones de 4 variables numéricas y una categórica. La variable categórica denominada Etario corresponde a los grupos infancia, adolescencia y juventud. Las variables numéricas contienen las puntuaciones obtenidas por cada paricipante en las dimensiones que les corresponden: Motivación, Expectativas, Cognoscitivos y Cultura.
## Se analiza su distibución y probabilidad de pertenencia a estos grupos según las puntuaciones en las variables. ## La base de datos se dispuso conforme a una de las muestras de un estudio de desempeño de preadolescentes, adolescentes y jóvenes que interactúan en determinada red social.

Dimensionpsico

Prueba y Estandarizar

set.seed(123)
training.samples <- Dimensionpsico$Etario %>%
  createDataPartition(p = 0.8, list = FALSE)
train.data <- Dimensionpsico[training.samples,]
test.data <- Dimensionpsico[-training.samples,]

preproc.param <- train.data %>%
  preProcess(method = c("center", "scale"))

The following pre-processing methods were eliminated: 'center', 'scale'

train.transformed <- preproc.param %>% predict(train.data)
test.transformed <- preproc.param %>% predict(test.data)

model <- lda(Etario~., data = train.transformed)

variables are collinear

predictions <- model %>% predict(test.transformed)
mean(predictions$class==test.transformed$Etario)

[1] 0.375

Calculo de lda

model <- lda(Etario~., data = train.transformed)

variables are collinear

model

Call:
lda(Etario ~ ., data = train.transformed)

Prior probabilities of groups:
adolescencia     infancia     juventud 
   0.2820513    0.2564103    0.4615385 

Group means:
             Motivacion3.50 Motivacion3.55 Motivacion3.60
adolescencia            0.0            0.0            0.0
infancia                0.1            0.1            0.1
juventud                0.0            0.0            0.0
             Motivacion3.70 Motivacion3.95 Motivacion3.98
adolescencia            0.0            0.0            0.0
infancia                0.2            0.1            0.1
juventud                0.0            0.0            0.0
             Motivacion4.00 Motivacion4.05 Motivacion4.10
adolescencia     0.00000000     0.00000000     0.09090909
infancia         0.00000000     0.00000000     0.00000000
juventud         0.05555556     0.05555556     0.00000000
             Motivacion4.15 Motivacion4.25 Motivacion4.35
adolescencia     0.00000000     0.09090909     0.09090909
infancia         0.00000000     0.10000000     0.00000000
juventud         0.05555556     0.00000000     0.00000000
             Motivacion4.40 Motivacion4.45 Motivacion4.60
adolescencia            0.0     0.09090909     0.00000000
infancia                0.1     0.00000000     0.00000000
juventud                0.0     0.00000000     0.05555556
             Motivacion4.65 Motivacion4.70 Motivacion4.75
adolescencia     0.09090909      0.1818182     0.09090909
infancia         0.00000000      0.0000000     0.00000000
juventud         0.11111111      0.0000000     0.05555556
             Motivacion4.80 Motivacion4.90 Motivacion4.95
adolescencia      0.2727273     0.00000000     0.00000000
infancia          0.0000000     0.00000000     0.00000000
juventud          0.0000000     0.05555556     0.05555556
             Motivacion5.00 Motivacion5.10 Motivacion5.20
adolescencia     0.00000000     0.00000000     0.00000000
infancia         0.00000000     0.00000000     0.00000000
juventud         0.05555556     0.05555556     0.05555556
             Motivacion5.30 Motivacion5.40 Motivacion5.50
adolescencia     0.00000000     0.00000000     0.00000000
infancia         0.00000000     0.00000000     0.00000000
juventud         0.05555556     0.05555556     0.05555556
             Motivacion5.65 Motivacion5.70 Motivacion5.95
adolescencia     0.00000000     0.00000000     0.00000000
infancia         0.00000000     0.00000000     0.00000000
juventud         0.05555556     0.05555556     0.05555556
             Expectativas2.45 Expectativas2.50 Expectativas2.60
adolescencia       0.09090909       0.00000000       0.00000000
infancia           0.00000000       0.00000000       0.00000000
juventud           0.00000000       0.05555556       0.05555556
             Expectativas2.65 Expectativas2.70 Expectativas2.75
adolescencia        0.0000000       0.00000000       0.00000000
infancia            0.0000000       0.00000000       0.00000000
juventud            0.1111111       0.05555556       0.05555556
             Expectativas2.90 Expectativas2.95 Expectativas3.00
adolescencia       0.00000000        0.0000000       0.09090909
infancia           0.00000000        0.0000000       0.10000000
juventud           0.05555556        0.1111111       0.11111111
             Expectativas3.05 Expectativas3.10 Expectativas3.15
adolescencia       0.00000000       0.18181818       0.00000000
infancia           0.00000000       0.00000000       0.10000000
juventud           0.05555556       0.05555556       0.05555556
             Expectativas3.20 Expectativas3.25 Expectativas3.30
adolescencia       0.00000000       0.09090909       0.18181818
infancia           0.00000000       0.10000000       0.00000000
juventud           0.05555556       0.00000000       0.05555556
             Expectativas3.35 Expectativas3.40 Expectativas3.50
adolescencia       0.09090909       0.00000000              0.0
infancia           0.00000000       0.10000000              0.1
juventud           0.00000000       0.05555556              0.0
             Expectativas3.55 Expectativas3.60 Expectativas3.65
adolescencia              0.0              0.0       0.09090909
infancia                  0.1              0.1       0.00000000
juventud                  0.0              0.0       0.05555556
             Expectativas3.70 Expectativas3.75
adolescencia       0.09090909       0.09090909
infancia           0.20000000       0.00000000
juventud           0.00000000       0.00000000
             Cognoscitivos1.25 Cognoscitivos1.40
adolescencia               0.0               0.0
infancia                   0.1               0.1
juventud                   0.0               0.0
             Cognoscitivos1.50 Cognoscitivos1.55
adolescencia               0.0               0.0
infancia                   0.1               0.1
juventud                   0.0               0.0
             Cognoscitivos1.70 Cognoscitivos3.10
adolescencia               0.0         0.1818182
infancia                   0.2         0.0000000
juventud                   0.0         0.0000000
             Cognoscitivos3.25 Cognoscitivos3.30
adolescencia        0.09090909         0.2727273
infancia            0.00000000         0.0000000
juventud            0.00000000         0.0000000
             Cognoscitivos3.35 Cognoscitivos3.45
adolescencia        0.09090909        0.09090909
infancia            0.00000000        0.00000000
juventud            0.00000000        0.00000000
             Cognoscitivos3.65 Cognoscitivos3.70
adolescencia        0.09090909        0.09090909
infancia            0.00000000        0.00000000
juventud            0.00000000        0.00000000
             Cognoscitivos3.75 Cognoscitivos3.90
adolescencia        0.09090909        0.00000000
infancia            0.00000000        0.00000000
juventud            0.00000000        0.05555556
             Cognoscitivos3.95 Cognoscitivos4.00
adolescencia        0.00000000         0.0000000
infancia            0.00000000         0.0000000
juventud            0.05555556         0.1111111
             Cognoscitivos4.05 Cognoscitivos4.10
adolescencia         0.0000000        0.00000000
infancia             0.0000000        0.00000000
juventud             0.1111111        0.05555556
             Cognoscitivos4.15 Cognoscitivos4.20
adolescencia        0.00000000        0.00000000
infancia            0.10000000        0.00000000
juventud            0.05555556        0.05555556
             Cognoscitivos4.30 Cognoscitivos4.40
adolescencia        0.00000000        0.00000000
infancia            0.00000000        0.10000000
juventud            0.05555556        0.05555556
             Cognoscitivos4.50 Cognoscitivos4.60
adolescencia        0.00000000        0.00000000
infancia            0.00000000        0.10000000
juventud            0.05555556        0.05555556
             Cognoscitivos4.65 Cognoscitivos4.70
adolescencia         0.0000000        0.00000000
infancia             0.0000000        0.00000000
juventud             0.1111111        0.05555556
             Cognoscitivos4.95 Cultura0.25 Cultura0.26
adolescencia         0.0000000   0.2727273         0.0
infancia             0.0000000   0.5000000         0.1
juventud             0.1111111   0.0000000         0.0
             Cultura0.27 Cultura0.28 Cultura0.29 Cultura0.30
adolescencia  0.09090909  0.00000000  0.00000000   0.4545455
infancia      0.10000000  0.00000000  0.00000000   0.1000000
juventud      0.05555556  0.05555556  0.05555556   0.0000000
             Cultura0.35 Cultura0.40 Cultura0.85 Cultura0.95
adolescencia   0.1818182         0.0  0.00000000  0.00000000
infancia       0.0000000         0.1  0.00000000  0.00000000
juventud       0.0000000         0.0  0.05555556  0.05555556
             Cultura1.00 Cultura1.15 Cultura1.20 Cultura1.30
adolescencia  0.00000000  0.00000000   0.0000000   0.0000000
infancia      0.00000000  0.00000000   0.0000000   0.0000000
juventud      0.05555556  0.05555556   0.1111111   0.1666667
             Cultura1.35 Cultura1.40 Cultura1.45 Cultura1.60
adolescencia  0.00000000   0.0000000  0.00000000  0.00000000
infancia      0.00000000   0.0000000  0.00000000  0.00000000
juventud      0.05555556   0.1111111  0.05555556  0.05555556
             Cultura1.95
adolescencia  0.00000000
infancia      0.00000000
juventud      0.05555556

Coefficients of linear discriminants:
                          LD1          LD2
Motivacion3.50     1.76185883 -0.322499804
Motivacion3.55     1.76185883 -0.322499804
Motivacion3.60     1.10795256 -0.129423954
Motivacion3.70     1.39067971 -0.066643378
Motivacion3.95     1.82424831  0.513345701
Motivacion3.98     3.70622558 -0.298892832
Motivacion4.00     0.47222919 -0.085302339
Motivacion4.05     0.02424666  0.226933929
Motivacion4.10    -0.45920613 -0.180595666
Motivacion4.15    -0.24976779 -0.073241468
Motivacion4.25     0.95814907 -0.443789001
Motivacion4.35    -0.26715259 -0.449195185
Motivacion4.40     1.22601701 -0.115917947
Motivacion4.45     0.15997586 -0.567270951
Motivacion4.60    -0.11716189  0.182663021
Motivacion4.65     0.08491034  0.005453078
Motivacion4.70    -0.78022398 -0.451640466
Motivacion4.75    -0.21764656 -0.274949852
Motivacion4.80     0.94343653  0.646923962
Motivacion4.90     0.01267394  0.205246253
Motivacion4.95     0.06045111  0.117386462
Motivacion5.00    -0.24523535 -0.394340969
Motivacion5.10     0.07040497 -0.138451255
Motivacion5.20     0.01185117  0.205856954
Motivacion5.30     1.89227309  0.124274947
Motivacion5.40    -0.94937559  0.186297269
Motivacion5.50     0.01185117  0.205856954
Motivacion5.65     0.13301338  0.508941149
Motivacion5.70    -0.29048046 -1.154072955
Motivacion5.95    -0.27334375  0.646628287
Expectativas2.45   0.15997586 -0.567270951
Expectativas2.50   0.01185117  0.205856954
Expectativas2.60  -0.11716189  0.182663021
Expectativas2.65  -0.06202578  0.231465455
Expectativas2.70  -0.29048046 -1.154072955
Expectativas2.75  -0.04927814  0.155461735
Expectativas2.90   0.01267394  0.205246253
Expectativas2.95  -0.11309921  0.405882835
Expectativas3.00  -0.10982598  0.821860800
Expectativas3.05   0.02424666  0.226933929
Expectativas3.10  -0.17601315  0.715195475
Expectativas3.15   0.81996421  0.075208892
Expectativas3.20   0.01185117  0.205856954
Expectativas3.25   0.95814907 -0.443789001
Expectativas3.30  -4.02113233 -0.064196651
Expectativas3.35  -0.26715259 -0.449195185
Expectativas3.40   0.11211116  0.038830808
Expectativas3.50   1.76185883 -0.322499804
Expectativas3.55   1.76185883 -0.322499804
Expectativas3.60   1.10795256 -0.129423954
Expectativas3.65   0.14819431 -0.071308738
Expectativas3.70   0.41913468 -1.190230727
Expectativas3.75  -0.30136760 -0.204970439
Cognoscitivos1.25  2.61911832 -1.101615070
Cognoscitivos1.40  1.22601701 -0.115917947
Cognoscitivos1.50  1.76185883 -0.322499804
Cognoscitivos1.55  1.76185883 -0.322499804
Cognoscitivos1.70  1.39067971 -0.066643378
Cognoscitivos3.10 -0.31823595  1.207886643
Cognoscitivos3.25 -0.68621050  0.207458807
Cognoscitivos3.30  0.94343653  0.646923962
Cognoscitivos3.35 -0.26715259 -0.449195185
Cognoscitivos3.45  0.15997586 -0.567270951
Cognoscitivos3.65  0.69411643  0.454908763
Cognoscitivos3.70 -1.29078458 -3.167744461
Cognoscitivos3.75 -0.30136760 -0.204970439
Cognoscitivos3.90  0.01267394  0.205246253
Cognoscitivos3.95  0.06045111  0.117386462
Cognoscitivos4.00  0.12059047 -0.254810508
Cognoscitivos4.05 -0.01329798  0.203147696
Cognoscitivos4.10  0.07040497 -0.138451255
Cognoscitivos4.15  0.76225211  0.212984801
Cognoscitivos4.20  0.01185117  0.205856954
Cognoscitivos4.30  1.89227309  0.124274947
Cognoscitivos4.40  1.32233341 -0.050452118
Cognoscitivos4.50  0.01185117  0.205856954
Cognoscitivos4.60  0.48063492  0.030379618
Cognoscitivos4.65 -0.12977314 -0.036596277
Cognoscitivos4.70 -0.29048046 -1.154072955
Cognoscitivos4.95 -0.21802670  0.161669242
Cultura0.25       -1.24200975 -0.010278601
Cultura0.26        1.10795256 -0.129423954
Cultura0.27        0.89963777  3.580962205
Cultura0.28        0.07040497 -0.138451255
Cultura0.29        0.01267394  0.205246253
Cultura0.30       -0.04472308 -2.908148758
Cultura0.35       -0.31584455 -0.363425347
Cultura0.40        1.22601701 -0.115917947
Cultura0.85       -0.13705946 -0.342309714
Cultura0.95       -0.04927814  0.155461735
Cultura1.00        0.13301338  0.508941149
Cultura1.15       -0.24976779 -0.073241468
Cultura1.20        0.01259187  0.218723013
Cultura1.30        0.51895106  0.142256855
Cultura1.35       -0.37729222 -0.577828259
Cultura1.40       -0.25348403  0.053653557
Cultura1.45        0.02424666  0.226933929
Cultura1.60       -0.11716189  0.182663021
Cultura1.95        0.06045111  0.117386462

Proportion of trace:
  LD1   LD2 
0.827 0.173 

El LDA aporta determina las medias del grupo y realiza el cálculo de la probabilidad de que cada individuo pueda pertenecer a los diferentes grupos.

El individuo se ve afectado por el grupo con la puntuación de probabilidad más alta.

Los resultados deL LDA presentan los siguientes:

_Probabilidades previas de grupos._La proporción de observaciones de entrenamiento en cada grupo. Se evidencia un 28%, 25%, 0.46% en adolescencia, infancia y juventud respectivamente, de las observaciones de entrenamiento en sus grupos.

Grupo significa: centro de gravedad del grupo. Se muestra la media de cada variable en cada grupo.

_Coeficientes de discriminantes lineales._Presenta la combinación lineal de variables predictoras que se utilizan para formar la regla de decisión LDA. Por ejemplo se puede obtener una estimación:

\[ LD1 = 1.76*Motivacion+0.16*Expectativa+ 2.6*Cognoscitivos -1.24*Cultura\].

Graficaremos los discriminates lineales con un plot, calculando LD1 y LD2 para cada una de las observaciones de entrenamiento.

plot(model, main="Gráfico de Discriminantes Lineales")

Claramente se visualiza la agrupación de las variables categóricas, preadolescencia, adolescencia y juventud de acuerdo a su disposición.

Se plantean predicciones:

predictions <- model %>% predict(test.transformed)
names(predictions)

[1] "class"     "posterior" "x"        

Class: clases predichas de observaciones

Posterior: matriz cuyas columnas son los grupos, las filas son los individuos y los valores son la probabilidad posterior de que la observación correspondiente pertenezca a los grupos.

“x” Contiene los discriminantes lineales, descritos anteriormente.

Predicción de clase:

head(predictions$class,6)

[1] juventud     infancia     juventud     juventud    
[5] infancia     adolescencia
Levels: adolescencia infancia juventud

Probabilidades pronosticadas de pertenencia a una clase

head(predictions$posterior, 6)

  adolescencia     infancia     juventud
1 0.1173497532 3.067998e-01 0.5758504017
2 0.0000122673 9.996012e-01 0.0003865531
3 0.0015694183 1.168805e-01 0.8815501205
4 0.2175893851 1.203146e-05 0.7823985834
5 0.0007516415 9.280192e-01 0.0712291330
6 0.9890409281 1.200035e-11 0.0109590719

Discriminante lineal (primeros 10 valores)

head(predictions$x, 10)

         LD1        LD2
1  0.7931506 -0.4210458
2  3.4111155 -0.7407980
3  1.2150008  2.2142375
4 -2.0972311  0.9861087
5  2.1604084  0.6157039
6 -5.6652125 -0.5432174
7  1.2333583  0.7398880
8 -0.7736064  0.5809056

Gráfica de LDA

lda.data <- cbind(train.transformed, predict(model)$x)
ggplot(lda.data, aes(LD1, LD2)) +
  geom_point(aes(color = Etario))+ggtitle("Gráfico LDA")

Precisión del modelo:

mean(predictions$class==test.transformed$Etario)

[1] 0.375

sum(predictions$posterior[,1]) >=0.5

[1] TRUE

Selección de variable.

Los pesos de los discriminadores podrían según ajustes del modelo y de la estandarización que se realice previo al cálculo del LDA según necesidad.