Capitulo5_an_multivariado

#———————————————————- ##Análisis multivariante Quinta edición #Hair.Anderson.Tatham.Black #———————————————————- ##Ejercicios Capitulo 5 #———————————————————-

#Analisis discriminante de dos grupos: Compradores frente a no compradores

#Resultados de la encuesta HATCO sobre la evaluación de un nuevo producto

HATCO_producto<-data.frame(
  Grupo=c(1,1,1,1,1,2,2,2,2,2),
  Duracion=c(8,6,10,9,4,5,3,4,2,2),
  Funcionamiento=c(9,7,6,4,8,4,7,5,4,2),
  Diseno=c(6,5,3,4,2,7,2,5,3,2)
)

group_means_HATCO<-matrix(NA,ncol=ncol(HATCO_producto),nrow = length(unique(HATCO_producto$Grupo)))

#Medias entre grupos

for (i in seq.default(1,length(unique(HATCO_producto$Grupo)))){
  h<-HATCO_producto %>% filter(Grupo==i)
  cat(i)
  for (j in seq.default(1,ncol(HATCO_producto))){
    group_means_HATCO[i,j]=mean(h[,j],na.rm=TRUE)
    cat(j)
  }
}

## 1123421234

colnames(group_means_HATCO)<-c("Grupo","Duracion_mean","Funcionamiento_mean","Diseño_mean")

#Diferencia de medias

diff_bmeans<-data.frame(
  Duracion=group_means_HATCO[1,2]-group_means_HATCO[2,2],
  Funcionamiento=group_means_HATCO[1,3]-group_means_HATCO[2,3],
  Diseno=group_means_HATCO[1,4]-group_means_HATCO[2,4]
)

cat("Las medias de los grupos conforme a las variables analizadas:")

## Las medias de los grupos conforme a las variables analizadas:

pander(group_means_HATCO)

Grupo	Duracion_mean	Funcionamiento_mean	Diseño_mean
1	7.4	6.8	4
2	3.2	4.4	3.8

cat("Las diferecias entre las medias de los grupos:")

## Las diferecias entre las medias de los grupos:

pander(diff_bmeans)

	Duracion	Funcionamiento	Diseno
Duracion_mean	4.2	2.4	0.2

#Construccion de funciones discriminantes para predecir a los compradores

HATCO_producto<-HATCO_producto %>% mutate(Funcion1=Duracion,Funcion2=Duracion+Funcionamiento,
                                          Funcion3=-4.53+(0.476*Duracion)+(0.359*Funcionamiento))

cat("Puntuaciones Z discriminantes ")

## Puntuaciones Z discriminantes

dplyr::select(HATCO_producto,Grupo,Funcion1,Funcion2,Funcion3)

##    Grupo Funcion1 Funcion2 Funcion3
## 1      1        8       17    2.509
## 2      1        6       13    0.839
## 3      1       10       16    2.384
## 4      1        9       13    1.190
## 5      1        4       12    0.246
## 6      2        5        9   -0.714
## 7      2        3       10   -0.589
## 8      2        4        9   -0.831
## 9      2        2        6   -2.142
## 10     2        2        4   -2.860

Puntuacion_corte<-c(5.5,11,0)

HATCO_producto<-HATCO_producto %>% mutate(Grupo_funcion1=ifelse(Funcion1<Puntuacion_corte[1],2,1),
                                          Grupo_funcion2=ifelse(Funcion2<Puntuacion_corte[2],2,1),
                                          Grupo_funcion3=ifelse(Funcion3<Puntuacion_corte[3],2,1))

HATCO_producto[,8:10]<-lapply(HATCO_producto[,8:10], as.factor)

#Comparacion matrices confusion de las funciones propuestas

cat("Matriz confusion funcion 1:")

## Matriz confusion funcion 1:

confusionMatrix(HATCO_producto$Grupo_funcion1,as.factor(HATCO_producto$Grupo))

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction 1 2
##          1 4 0
##          2 1 5
##                                          
##                Accuracy : 0.9            
##                  95% CI : (0.555, 0.9975)
##     No Information Rate : 0.5            
##     P-Value [Acc > NIR] : 0.01074        
##                                          
##                   Kappa : 0.8            
##                                          
##  Mcnemar's Test P-Value : 1.00000        
##                                          
##             Sensitivity : 0.8000         
##             Specificity : 1.0000         
##          Pos Pred Value : 1.0000         
##          Neg Pred Value : 0.8333         
##              Prevalence : 0.5000         
##          Detection Rate : 0.4000         
##    Detection Prevalence : 0.4000         
##       Balanced Accuracy : 0.9000         
##                                          
##        'Positive' Class : 1              
##

cat("Matriz confusion funcion 2:")

## Matriz confusion funcion 2:

confusionMatrix(HATCO_producto$Grupo_funcion2,as.factor(HATCO_producto$Grupo))

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction 1 2
##          1 5 0
##          2 0 5
##                                      
##                Accuracy : 1          
##                  95% CI : (0.6915, 1)
##     No Information Rate : 0.5        
##     P-Value [Acc > NIR] : 0.0009766  
##                                      
##                   Kappa : 1          
##                                      
##  Mcnemar's Test P-Value : NA         
##                                      
##             Sensitivity : 1.0        
##             Specificity : 1.0        
##          Pos Pred Value : 1.0        
##          Neg Pred Value : 1.0        
##              Prevalence : 0.5        
##          Detection Rate : 0.5        
##    Detection Prevalence : 0.5        
##       Balanced Accuracy : 1.0        
##                                      
##        'Positive' Class : 1          
##

cat("Matriz confusion funcion 3:")

## Matriz confusion funcion 3:

confusionMatrix(HATCO_producto$Grupo_funcion3,as.factor(HATCO_producto$Grupo))

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction 1 2
##          1 5 0
##          2 0 5
##                                      
##                Accuracy : 1          
##                  95% CI : (0.6915, 1)
##     No Information Rate : 0.5        
##     P-Value [Acc > NIR] : 0.0009766  
##                                      
##                   Kappa : 1          
##                                      
##  Mcnemar's Test P-Value : NA         
##                                      
##             Sensitivity : 1.0        
##             Specificity : 1.0        
##          Pos Pred Value : 1.0        
##          Neg Pred Value : 1.0        
##              Prevalence : 0.5        
##          Detection Rate : 0.5        
##    Detection Prevalence : 0.5        
##       Balanced Accuracy : 1.0        
##                                      
##        'Positive' Class : 1          
##

#Construccion de función discriminante para predecir a los compradores a traves de la paqueteria MASS

compradores_lda<-lda(Grupo~Duracion+Funcionamiento+Diseno, data=HATCO_producto)
compradores_lda

## Call:
## lda(Grupo ~ Duracion + Funcionamiento + Diseno, data = HATCO_producto)
## 
## Prior probabilities of groups:
##   1   2 
## 0.5 0.5 
## 
## Group means:
##   Duracion Funcionamiento Diseno
## 1      7.4            6.8    4.0
## 2      3.2            4.4    3.8
## 
## Coefficients of linear discriminants:
##                       LD1
## Duracion       -0.5729478
## Funcionamiento -0.3792257
## Diseno          0.2970406

compradores_lda_pred<-predict(compradores_lda)$class
cat("Los valores predichos para los grupos son:",compradores_lda_pred)

## Los valores predichos para los grupos son: 1 1 1 1 1 2 2 2 2 2

conf_matrix_compradores<-table(Esperado=compradores_lda_pred,Real=HATCO_producto$Grupo)
cat("La matriz de confusion es: ")

## La matriz de confusion es:

pander(conf_matrix_compradores)

1	2
5	0
0	5

#Otra forma de calcular la tabla de confusion es con lapaqueteria 'caret'
HATCO_producto$Grupo<-as.factor(HATCO_producto$Grupo)
confusionMatrix(compradores_lda_pred,HATCO_producto$Grupo)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction 1 2
##          1 5 0
##          2 0 5
##                                      
##                Accuracy : 1          
##                  95% CI : (0.6915, 1)
##     No Information Rate : 0.5        
##     P-Value [Acc > NIR] : 0.0009766  
##                                      
##                   Kappa : 1          
##                                      
##  Mcnemar's Test P-Value : NA         
##                                      
##             Sensitivity : 1.0        
##             Specificity : 1.0        
##          Pos Pred Value : 1.0        
##          Neg Pred Value : 1.0        
##              Prevalence : 0.5        
##          Detection Rate : 0.5        
##    Detection Prevalence : 0.5        
##       Balanced Accuracy : 1.0        
##                                      
##        'Positive' Class : 1          
##

plot(compradores_lda)

#——————————————————– #Un ejemplo de análisis discriminante de tres grupos: Propósitos de cambio #——————————————————–

#Resultados de la encuesta de HATCO sobre las intenciones de cambio de compradores

HATCO_producto_2<-data.frame(
  Grupo=c(1,1,1,1,1,2,2,2,2,2,3,3,3,3,3),
  Competitividad=c(2,1,3,2,2,4,4,5,5,5,2,3,4,5,5),
  Nivel_servicio=c(2,2,2,1,3,2,3,1,2,3,6,6,6,6,7)
)

#Construccion de función discriminante para predecir a los compradores a traves de la paqueteria MASS

compradores_lda_2<-lda(Grupo~Competitividad+Nivel_servicio,data=HATCO_producto_2)
compradores_lda_2

## Call:
## lda(Grupo ~ Competitividad + Nivel_servicio, data = HATCO_producto_2)
## 
## Prior probabilities of groups:
##         1         2         3 
## 0.3333333 0.3333333 0.3333333 
## 
## Group means:
##   Competitividad Nivel_servicio
## 1            2.0            2.0
## 2            4.6            2.2
## 3            3.8            6.2
## 
## Coefficients of linear discriminants:
##                       LD1        LD2
## Competitividad 0.03732692 -1.0983492
## Nivel_servicio 1.45900619  0.1673999
## 
## Proportion of trace:
##    LD1    LD2 
## 0.8577 0.1423

compradores_lda_pred_2<-predict(compradores_lda_2)$class
cat("Los valores predichos para los grupos son:",compradores_lda_pred_2)

## Los valores predichos para los grupos son: 1 1 1 1 1 2 2 2 2 2 3 3 3 3 3

#Matriz de confusion

confusionMatrix(compradores_lda_pred_2,as.factor(HATCO_producto_2$Grupo))

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction 1 2 3
##          1 5 0 0
##          2 0 5 0
##          3 0 0 5
## 
## Overall Statistics
##                                     
##                Accuracy : 1         
##                  95% CI : (0.782, 1)
##     No Information Rate : 0.3333    
##     P-Value [Acc > NIR] : 6.969e-08 
##                                     
##                   Kappa : 1         
##                                     
##  Mcnemar's Test P-Value : NA        
## 
## Statistics by Class:
## 
##                      Class: 1 Class: 2 Class: 3
## Sensitivity            1.0000   1.0000   1.0000
## Specificity            1.0000   1.0000   1.0000
## Pos Pred Value         1.0000   1.0000   1.0000
## Neg Pred Value         1.0000   1.0000   1.0000
## Prevalence             0.3333   0.3333   0.3333
## Detection Rate         0.3333   0.3333   0.3333
## Detection Prevalence   0.3333   0.3333   0.3333
## Balanced Accuracy      1.0000   1.0000   1.0000

Capitulo5_an_multivariado

Alfredo Israel Becerra Ortiz, Hector Monroy,Edgar Gerardo Bustamante Lopez, Iris Pamela Monroy Romero

2025-03-28