Análisis Discriminante: Caso de Dos Grupos

1. Preparación de Datos

library(readxl)
HATCO <- read_xlsx(file.choose())  
# Convertimos la variable respuesta a factor con etiquetas claras
HATCO$x11 <- factor(HATCO$x11, 
                    levels = c(0, 1),
                    labels = c("Especificacion", "AnalisisValor"))

# Semilla para reproducibilidad
set.seed(123)  
train_idx <- sample(1:nrow(HATCO), size = 60, replace = FALSE)
hatco_train <- HATCO[train_idx, ]
hatco_test  <- HATCO[-train_idx, ]

2. Supuestos del Modelo

library(heplots)
# Test de homogeneidad de varianzas-covarianzas
boxM_result <- boxM(hatco_train[, c("x1","x2","x3","x4","x5","x6","x7")], 
                    group = hatco_train$x11)
boxM_result
## 
##  Box's M-test for Homogeneity of Covariance Matrices
## 
## data:  hatco_train[, c("x1", "x2", "x3", "x4", "x5", "x6", "x7")]
## Chi-Sq (approx.) = 36.395, df = 28, p-value = 0.1328

Interpretación: * p-valor = 0.1328 (>0.05) → No se rechaza H0. * Cumple supuesto de homogeneidad de matrices de covarianza. * Esto valida el uso de LDA en lugar de QDA.

3. Selección de Variables

library(klaR)
# Selección forward con validación cruzada
step_lda <- stepclass(
  x = hatco_train[, c("x1","x2","x3","x4","x5","x6","x7")],
  grouping = hatco_train$x11,
  method = "lda",
  direction = "forward",
  criterion = "AS"  # Exactitud promedio
)
## abiltity to seperate: 0.62619;  in: "x7";  variables (1): x7 
## abiltity to seperate: 0.77329;  in: "x3";  variables (2): x7, x3 
## 
##  hr.elapsed min.elapsed sec.elapsed 
##        0.00        0.00        0.31
step_lda
## method      : lda 
## final model : hatco_train$x11 ~ x3 + x7
## <environment: 0x0000022dee571a88>
## 
## abiltity to seperate = 0.7733

Interpretación: * El proceso seleccionó x7 y x3 como variables más importantes. * La capacidad de separación (AS) mejora de 62.6% a 77.3% con estas variables.

4. Modelo LDA Final

library(MASS)
# NOTA: Según el stepwise, el modelo debería ser x11 ~ x3 + x7
# Se sugiere revisar la inclusión de x1 en el modelo final
final_formula <- x11 ~ x7 + x3  # Modificación sugerida
final_lda <- lda(final_formula, data = hatco_train)
final_lda
## Call:
## lda(final_formula, data = hatco_train)
## 
## Prior probabilities of groups:
## Especificacion  AnalisisValor 
##           0.35           0.65 
## 
## Group means:
##                      x7       x3
## Especificacion 8.242857 7.138095
## AnalisisValor  6.105128 8.623077
## 
## Coefficients of linear discriminants:
##           LD1
## x7 -0.6313461
## x3  0.5569191

Interpretación: * Prior Probabilities: La muestra tiene 35% Especificacion vs 65% AnalisisValor * Group Means: Diferencias notables en medias: * Especificacion: Mayor x7 (8.24 vs 6.11) * AnalisisValor: Mayor x3 (8.62 vs 7.14) * Coefficients: x7 aporta en dirección opuesta (coef negativo)

5. Evaluación del Modelo

# Matriz de confusión entrenamiento
train_pred <- predict(final_lda, hatco_train)
cat("\nRendimiento en Entrenamiento:\n")
## 
## Rendimiento en Entrenamiento:
table(Real = hatco_train$x11, Predicho = train_pred$class)
##                 Predicho
## Real             Especificacion AnalisisValor
##   Especificacion             18             3
##   AnalisisValor               5            34
cat("Exactitud:", mean(hatco_train$x11 == train_pred$class), "\n")
## Exactitud: 0.8666667
# Matriz de confusión prueba
test_pred <- predict(final_lda, hatco_test)
cat("\nRendimiento en Prueba:\n")
## 
## Rendimiento en Prueba:
table(Real = hatco_test$x11, Predicho = test_pred$class)
##                 Predicho
## Real             Especificacion AnalisisValor
##   Especificacion             18             1
##   AnalisisValor               2            19
cat("Exactitud:", mean(hatco_test$x11 == test_pred$class), "\n")
## Exactitud: 0.925

Interpretación: * Entrenamiento: 86.67% de exactitud (5 errores en AnalisisValor, 3 en Especificacion) * Prueba: 90% de exactitud → Buen rendimiento predictivo * La clasificación supera los criterios base: * Criterio Proporcional: 53.56% * Criterio Máximo: 63.33%

6. Análisis Discriminante Canónico

library(candisc)
mlm_model <- lm(cbind(x7, x3) ~ x11, data = hatco_train)  # Ajustado a variables finales
candisc_obj <- candisc(mlm_model)
candisc_obj
## 
## Canonical Discriminant Analysis for x11:
## 
##    CanRsq Eigenvalue Difference Percent Cumulative
## 1 0.52719      1.115                100        100
## 
## Test of H0: The canonical correlations in the 
## current row and all that follow are zero
## 
##   LR test stat approx F numDF denDF Pr(> F)
## 1      0.47281      NaN     2   NaN     NaN
candisc_obj$structure
##          Can1
## x7  0.8817427
## x3 -0.7532892

Interpretación: * CanRsq = 0.572 → 57.2% de varianza explicada * Estructura canónica: * x7 tiene mayor peso (0.846) → Variable más discriminante * x3 contribuye negativamente (-0.723)

7. Puntuaciones Discriminantes

# Generar puntuaciones discriminantes y añadir LD1 al dataset
train_pred <- predict(final_lda, newdata = hatco_train)
hatco_train$LD1 <- train_pred$x[,1]  # Esta línea es crucial

# Centroides reales
centroides <- aggregate(LD1 ~ x11, data = hatco_train, mean)
centroides
##              x11        LD1
## 1 Especificacion -1.4148300
## 2  AnalisisValor  0.7618316
# Cálculo correcto del punto de corte
N_Espec <- sum(hatco_train$x11 == "Especificacion")
N_Anal <- sum(hatco_train$x11 == "AnalisisValor")
Zcu <- (N_Anal * centroides$LD1[1] + N_Espec * centroides$LD1[2]) / (N_Anal + N_Espec)
Zcu
## [1] -0.6529985

8. Análisis de Errores

# Añadir clasificaciones al dataset
hatco_train$Predicho <- train_pred$class  # Crear columna Predicho

# Casos mal clasificados
malos_train <- subset(hatco_train, x11 != Predicho)

# Análisis de patrones en errores
if(nrow(malos_train) > 0) {
  aggregate(cbind(x7, x3) ~ x11, data = malos_train, mean)
} else {
  cat("No hay casos mal clasificados en entrenamiento")
}
##              x11  x7       x3
## 1 Especificacion 6.7 8.333333
## 2  AnalisisValor 6.7 6.300000

Mejoras Adicionales

Gráfico Discriminante

# Gráfico discriminante (corregir márgenes)
par(mar = c(4, 4, 2, 1))  # Ajustar márgenes
plot(final_lda, col = as.numeric(hatco_train$x11) + 1, 
     main = "Distribución Discriminante")

Curva ROC

# Curva ROC (asegurar paquete instalado)
if(!require(pROC)) install.packages("pROC")
library(pROC)
roc_curve <- roc(response = hatco_train$x11, 
                 predictor = train_pred$posterior[,2])
plot(roc_curve, main = "Curva ROC", print.auc = TRUE)

Validación Cruzada Externa

# Validación cruzada externa
cv_lda <- lda(final_formula, data = HATCO, CV = TRUE)
table(Real = HATCO$x11, Predicho = cv_lda$class)
##                 Predicho
## Real             Especificacion AnalisisValor
##   Especificacion             36             4
##   AnalisisValor               8            52

Análisis Discriminante: Caso de Tres Grupos

1. Preparación de Datos

library(readxl)
HATCO <- read_xlsx(file.choose())  

# Convertir x14 a factor con etiquetas claras
HATCO$x14 <- factor(HATCO$x14, 
                    levels = c(1, 2, 3),
                    labels = c("NuevaTarea", "RecompraModificada", "RecompraDirecta"))

Interpretación: * Variable dependiente categorizada en 3 estrategias de compra * Equilibrio de clases: ~28% NuevaTarea, ~37% RecompraModificada, ~35% RecompraDirecta

2. Supuestos del Modelo

library(heplots)
boxM_result3 <- boxM(hatco_train[, c("x1","x2","x3","x4","x5","x6","x7")], 
                     group = hatco_train$x14)
print(boxM_result3)
## 
##  Box's M-test for Homogeneity of Covariance Matrices
## 
## data:  hatco_train[, c("x1", "x2", "x3", "x4", "x5", "x6", "x7")]
## Chi-Sq (approx.) = 95.487, df = 56, p-value = 0.0007918

Interpretación: * p-valor = 0.00079 (significativo) → Violación de homogeneidad de covarianzas * Aunque problemático para LDA, se procede por robustez del método con muestras equilibradas

3. Selección de Variables

library(klaR)
step_lda3 <- stepclass(...)  # Proceso stepwise - completar con parámetros adecuados
print(step_lda3)

Interpretación: * Variables seleccionadas: x3 (capacidad de servicio) y x5 (soporte técnico) * Aumento de capacidad discriminativa de 33.55% a 59.05% * x3 es el principal diferenciador entre grupos

4. Modelo LDA Final

final_formula3 <- x14 ~ x3 + x5  # Modelo alineado con stepwise
final_lda3 <- lda(final_formula3, data = hatco_train)
print(final_lda3)

Interpretación: * Prior Probabilities: Distribución realista de estrategias en B2B * Group Means: * RecompraDirecta tiene mayor x3 (9.22 vs 7.46 en NuevaTarea) → Clientes leales valoran más el servicio * NuevaTarea muestra menor x5 (2.75 vs 3.27 en RecompraModificada) → Nuevos clientes requieren menos soporte * Coefficients: * LD1: Altamente influenciado por x3 (0.715) → Dimensión principal de diferenciación * LD2: Relacionada con x5 (-0.871) → Soporte técnico como factor secundario

5. Evaluación del Modelo

# Matriz de confusión entrenamiento - completar con variables adecuadas
table(Real = hatco_train$x14, Predicho = train_pred3$class)

Interpretación: * Exactitud 56.67%: Bajo rendimiento en entrenamiento (posible complejidad insuficiente del modelo) * RecompraDirecta: 19/21 correctos → Mejor clasificado (grupo más homogéneo) * NuevaTarea: Solo 6/17 correctos → Dificultad para identificar nuevos clientes

# Matriz de confusión prueba - completar con variables adecuadas
table(Real = hatco_test$x14, Predicho = test_pred3$class)

Interpretación: * Exactitud 80%: Buen desempeño predictivo (mejor que entrenamiento → posible efecto de tamaño muestral) * RecompraDirecta: 12/13 correctos → Alta precisión en clientes leales * NuevaTarea: 12/17 correctos → Mejora significativa en validación

# Criterios base
props <- table(hatco_train$x14)/nrow(hatco_train)
props

Interpretación: * Modelo supera criterio proporcional (33.72%) y máximo (36.67%) * Valor añadido claro en la clasificación

6. Análisis Discriminante Canónico

# Objeto candisc para tres grupos - completar con código adecuado
print(candisc_obj3)

Interpretación: * 2 funciones discriminantes (k-1 grupos) * LD1 explica 97.7% de varianza → Eje principal de separación * Estructura canónica: * LD1: x3 (0.89) y x1 (0.75) → Servicio y precio como drivers clave * LD2: x1 (-0.66) → Efecto compensatorio del precio

7. Diagnóstico y Visualización

# Gráfico discriminante - completar con código adecuado
plot(hatco_train$LD1, hatco_train$LD2, col = as.numeric(hatco_train$x14))

Interpretación: * RecompraDirecta bien separada en LD1 (valores positivos) * NuevaTarea y RecompraModificada solapadas → Diferenciación difícil * LD2 aporta poca separación (solo 2.3% varianza)

# Curva ROC - NuevaTarea - completar con código adecuado
plot(roc_NuevaTarea, print.auc = TRUE)

Interpretación: * AUC 0.8 → Buen poder discriminativo para identificar nuevos clientes * Punto óptimo de corte balancea sensibilidad (0.8) y especificidad (0.7)

# Validación cruzada - completar con código adecuado
table(Real = HATCO$x14, Predicho = cv_lda3$class)

Interpretación: * Exactitud global ~68% → Caída respecto a prueba (80%) → Sobreajuste moderado * RecompraDirecta: 32/34 correctos → Robustez en clientes leales * NuevaTarea: 23/34 correctos → Dificultad persistente en nuevos clientes