Considere el conjunto de datos Banco.sav, que consiste en los datos de clientes que han sido clasificados como clientes impagos. El objetivo es explicar y predecir si un cliente tiene un riesgo crediticio bueno o malo (impago)

Realice un Análisis Discriminante Lineal (ADL) y responda a las siguientes preguntas:

  1. Presente la función discriminante.
##Carga de base
library(haven)
## Warning: package 'haven' was built under R version 4.4.3
banco <- read_sav("D:/Usuarios/ir43540452/Desktop/banco.sav")
head(banco)
## # A tibble: 6 × 9
##    edad  educ empleo direccion ingresos deudaingr deudacred deudaotro impago   
##   <dbl> <dbl>  <dbl>     <dbl>    <dbl>     <dbl>     <dbl>     <dbl> <dbl+lbl>
## 1    41    13     17        12   320512     0.093    11.4       5.01  1 [Sí]   
## 2    27     8     10         6   359581     0.173     1.36      4.00  0 [No]   
## 3    40     8     15        14   113872     0.055     0.856     2.17  0 [No]   
## 4    41     8     15        14   235900     0.029     2.66      0.821 0 [No]   
## 5    24    11      2         0   172598     0.173     1.79      3.06  1 [Sí]   
## 6    41    11      5         5   338219     0.102     0.393     2.16  0 [No]

Tenemos correr es la función de ADL

library(MASS)
modelo = lda(impago ~ . , data=banco)
modelo
## Call:
## lda(impago ~ ., data = banco)
## 
## Prior probabilities of groups:
##         0         1 
## 0.7385714 0.2614286 
## 
## Group means:
##       edad     educ   empleo direccion ingresos  deudaingr deudacred deudaotro
## 0 35.51451  9.82205 9.508704  8.945841 216872.6 0.08679304  1.245493  2.773409
## 1 33.01093 10.46448 5.224044  6.393443 213442.7 0.14727869  2.423865  3.862807
## 
## Coefficients of linear discriminants:
##                     LD1
## edad       1.663648e-02
## educ       4.183173e-02
## empleo    -1.182537e-01
## direccion -4.602822e-02
## ingresos  -3.073856e-07
## deudaingr  8.272228e+00
## deudacred  3.074089e-01
## deudaotro -2.794977e-02

D = edad* 1.663648e-02 + educ* 4.183173e-02 + emple-1.182537e-01 + direccion -4.602822e-02 + ingresos * -3.073856e-07 + deudaingr* 8.272228e+00 + deudacred3.074089e-01 deudaotro -2.794977e-02

b.Halle el valor del umbral de la regla

##centroides
modelo$means
##       edad     educ   empleo direccion ingresos  deudaingr deudacred deudaotro
## 0 35.51451  9.82205 9.508704  8.945841 216872.6 0.08679304  1.245493  2.773409
## 1 33.01093 10.46448 5.224044  6.393443 213442.7 0.14727869  2.423865  3.862807
D_o =modelo$means[1,] ##filtrando el atributo 0
D_1=modelo$means[2,] ## filtrando el atributo 1
##guardando los coeficientes en una variable.
##modelo$scaling
coeficiente=modelo$scaling[,1]
#Calculando el umbral
D_I=sum(D_o*coeficiente)
D_II=sum(D_1*coeficiente)

umbral = D_I*modelo$prior[1] + D_II*modelo$prior[2]
umbral
##         0 
## 0.7993085
#manera alternativa de mostrar la cantidad de observaciones.
table(banco$impago)
## 
##   0   1 
## 517 183
  1. Usando la función discriminante, clasifique a un cliente que posee 34 años de edad, 5 años de eduación, 3 años laborando en su empresa, 2 años en su domicilio actual,un ingreso de 345212 ,una tasa de deuda de 0.234, 4.543 de deuda en su tarjeta de crédito y 2.3 de deudas en otros bancos.
# Datos del cliente a clasificar
cliente <- data.frame(
  edad = 34,
  educ = 5,
  empleo = 3,
  direccion = 2,
  ingresos = 345212,
  deudaingr = 0.234,
  deudacred = 4.543,
  deudaotro = 2.3
)

# Mostrar el dataframe
print(cliente)
##   edad educ empleo direccion ingresos deudaingr deudacred deudaotro
## 1   34    5      3         2   345212     0.234     4.543       2.3
# Predecir la clase para el nuevo cliente
prediccion <- predict(modelo, newdata = cliente)
prediccion
## $class
## [1] 1
## Levels: 0 1
## 
## $posterior
##           0         1
## 1 0.0873617 0.9126383
## 
## $x
##        LD1
## 1 2.690535

d.Presente la matriz de confusión e interprete los resultados

predicciones <- predict(modelo, newdata = banco[,-9])
matriz_confusion <- table(Real = banco$impago, Predicho = predicciones$class)
print(matriz_confusion)
##     Predicho
## Real   0   1
##    0 485  32
##    1 100  83
# Calcular precisión
precision <- sum(diag(matriz_confusion)) / sum(matriz_confusion)
cat("\nPrecisión del modelo:", round(precision, 3))
## 
## Precisión del modelo: 0.811

e.Realice la validación del modelo usando el Λ de Wilks y evalúe la calidad de ajuste.

Ho:la función discriminante no posee capacidad discriminante. H1:Las función discriminante permite distinguir las categorias gracias a al menos una variable.

Xm = manova(data=banco,cbind(edad,educ,empleo,direccion,ingresos,deudaingr,deudacred,deudaotro)~impago)
final = summary(Xm,test="Wilks")
final
##            Df   Wilks approx F num Df den Df    Pr(>F)    
## impago      1 0.71278   34.806      8    691 < 2.2e-16 ***
## Residuals 698                                             
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Se rechaza H0, por tanto los grupos son significativamente distintos en las variables independientes.