Actividad2_Modelos de Clasificación_A00833113

Introducción

1. ¿Qué es Supervised Machine Learning y cuáles son algunas de sus aplicaciones en análisis de clasificación?
   El aprendizaje supervisado (Supervised Machine Learning) es un tipo de enfoque de aprendizaje donde se entrena un modelo utilizando un conjunto de datos que incluye entradas y las respuestas deseadas asociadas con esas entradas. El objetivo es aprender una función que mapee las entradas a las salidas correctas basadas en ejemplos de entrenamiento etiquetados. Algunas de las aplicaciones comunes del aprendizaje supervisado en análisis de clasificación son:

• Clasificación de correos electrónicos: Identificar si un correo electrónico es spam o no spam.
  
• Detección de fraudes: Reconocer transacciones financieras como legítimas o fraudulentas.
  
• Diagnóstico médico: Clasificar imágenes médicas o datos de pacientes para diagnosticar enfermedades.
  
• Análisis de sentimientos: Clasificar comentarios de redes sociales, reseñas de productos u opiniones de usuarios en positivas, neutrales o negativas.
  
• Reconocimiento de voz: Clasificar grabaciones de voz en diferentes categorías, como comandos de voz o transcripción de texto.

2. ¿Cuáles son los principales algoritmos de Supervised Machine Learning - Classification?
   Los principales algoritmos de aprendizaje supervisado de Clasificación son:

• Regresión Logística: Realiza una clasificación binaria acorde a la regresión ya que, estima las probabilidades de que una instancia pertenezca a una de las dos clases.
  
• K-Nearest Neighbors (KNN): Clasifica una instancia basándose en las clases de sus vecinos más cercanos en el espacio de características, es decir, predice la clasificación de un nuevo punto de muestra en función de las clases de sus vecinos más cercanos. No recomendable para bd con alto número de entradas.
  
• Support Vector Machines (SVM): Busca el hiperplano que mejor separa las clases en el espacio de características con la ayuda de vectores de soporte; efectivo en espacios de características no lineales a través del uso de kernels.
  
• Bayes:
• Árboles de Decisión: Divide repetidamente el espacio de características en subconjuntos cada vez más pequeños basados en la característica que proporciona una mejor estimación de clasificación.
  
• Random Forest: Algoritmo de conjunto que combina más de un algortimo para clasificar objetos, por ende, combina las predicciones de múltiples árboles creados en subconjuntos aleatorios para tomar el promedio de las predicciones y mejorar tanto la precisión como reducir el sobreajuste.

3. Respecto a la selección de los resultados de los modelos de clasificación: ¿Qué es la matriz de confusión? ¿Qué es el estadístico Kappa? ¿Cuál es la relación entre AUC y ROC Curve?
   La selección de los resultados de los modelos de clasificación implica evaluar su desempeño utilizando diversas métricas y herramientas. Las principales son:
   

• Matriz de confusión: Tabla que describe el rendimiento de un modelo de clasificación en términos de los valores reales y predichos de las clases. Se compone de cuatro celdas: verdaderos positivos (TP), falsos positivos (FP), verdaderos negativos (TN) y falsos negativos (FN). Acorde a esto se calculan varias métricas de evaluación como precisión, sensibilidad, especificidad, etc.
• Estadístico Kappa: Medida de la concordancia entre las clasificaciones observadas y las clasificaciones esperadas por azar; permite evaluar la confiabilidad de un modelo de clasificación ajustado, teniendo en cuenta la posibilidad de que las clasificaciones ocurran al azar. Dicho valor varía entre -1 y 1, donde 1 indica una concordancia perfecta, 0 indica concordancia aleatoria y valores negativos indican concordancia inferior a la aleatoria.
• AUC y ROC Curve: La curva ROC (Receiver Operating Characteristic) es una representación gráfica de la relación entre la tasa de verdaderos positivos (sensibilidad) frente a la tasa de falsos positivos (1 - especificidad) en varios umbrales de clasificación. El Área bajo la Curva (AUC) es una métrica de la capacidad discriminativa del modelo que se basa en el área bajo la curva ROC. Por lo tanto: Una curva ROC ideal estaría ubicada en el rincón superior izquierdo del gráfico, lo que indica una alta tasa de verdaderos positivos y una baja tasa de falsos positivos. En este caso, el AUC sería cercano a 1, indicando un modelo muy preciso y efectivo. No obstante, si el clasificador es similar a una estimación aleatoria, la curva ROC sería una línea diagonal desde el punto (0,0) hasta el punto (1,1). En este caso, el AUC sería cercano a 0.5, lo que indica un modelo que no es mejor que el azar en la clasificación.

Acorde a esto, se determina que cuanto mayor sea el AUC, mejor será el rendimiento del modelo en términos de separación entre clases. En consecuencia, la relación entre AUC y la curva ROC es que el AUC es una medida resumida del rendimiento global del modelo, mientras que la curva ROC proporciona información detallada sobre su rendimiento en diferentes umbrales de clasificación.

Base de datos

La base de datos “Bank Application” proporciona información sobre los clientes y las características de los préstamos, lo que permite realizar análisis y modelos de clasificación para determinar la probabilidad de que un cliente tenga dificultades o no para realizar los pagos de un préstamo. A continuación, se muestra una descripción de las variables:
- TARGET (Variable objetivo): 1 - cliente con dificultades de pago: tuvo retrasos en el pago de más de X días en al menos uno de los primeros Y plazos del préstamo en nuestra muestra, 0 - todos los demás casos.
- NAME_CONTRACT_TYPE: Identificación de si el préstamo es al contado o rotatorio.
- FLAG_OWN_CAR: Marca si el cliente es propietario de un coche.
- FLAG_OWN_REALTY: Marca si el cliente es propietario de una casa o un piso.
- CNT_CHILDREN: Número de hijos del cliente.
- AMT_INCOME_TOTAL: Ingresos del cliente.
- AMT_CREDIT: Importe del crédito del préstamo.
- AMT_ANNUITY: Anualidad del préstamo.
- AMT_GOODS_PRICE: Para préstamos al consumo es el precio de los bienes para los que se concede el préstamo.
- NAME_INCOME_TYPE: Tipo de ingresos del cliente (empresario, trabajador, baja por maternidad,…)
- NAME_EDUCATION_TYPE: Nivel de estudios más alto alcanzado por el cliente.
- NAME_FAMILY_STATUS: Situación familiar del cliente.
- NAME_HOUSING_TYPE: Cuál es la situación de vivienda del cliente (alquiler, vive con los padres, …)
- REGION_RATING_CLIENT_W_CITY: Nuestra valoración de la región en la que vive el cliente teniendo en cuenta la ciudad (1,2,3)

Análisis Exploratorio de los Datos (EDA)

Instalación y llamado de ibrerías

library(foreign)        # Read Data Stored by 'Minitab', 'S', 'SAS', 'SPSS', 'Stata', 'Systat', 'Weka', 'dBase'
library(ggplot2)        # It is a system for creating graphics
library(dplyr)          # A fast, consistent tool for working with data frame like objects
library(mapview)        # Quickly and conveniently create interactive visualizations of spatial data with or without background maps
library(naniar)         # Provides data structures and functions that facilitate the plotting of missing values and examination of imputations.
library(tmaptools)       # A collection of functions to create spatial weights matrix objects from polygon 'contiguities', for summarizing these objects, and for permitting their use in spatial data analysis
library(tmap)           # For drawing thematic maps
library(RColorBrewer)   # It offers several color palettes 
library(dlookr)         # A collection of tools that support data diagnosis, exploration, and transformation
library(foreign)
library(modelr)
library(dplyr)
library(tidyverse) 
library(ggplot2)
library(broom)
library(ISLR)          # great textbook to learn, explore, and put in practice data science skills.  
library(readr)
library(caret)
library(e1071)
library(class)
library(ROCR)
library(pROC)
library(lmtest)
library(caTools)
library(rpart)
library(rpart.plot)
library(psych)  
library(ggpubr)
library(reshape)
library(Metrics)
library(mlbench)
library(rsample)
library(cluster)     # clustering algorithms
library(factoextra)  # clustering algorithms & visualization
library(gridExtra)   
library(DataExplorer)

Carga de base de datos “bank_application.csv”

df <- read.csv("C:\\Users\\AVRIL\\Documents\\bank_application2.csv")

Se eliminan duplicados

df <- unique(df)
dim(df)

## [1] 179020     15

Medidas descriptivas

Se determina que no hay missing rows y acorde a los estadísticos descriptivos se determina que: * Las personas con un tipo de contrato “Work” tienen el mayor ingreso total promedio.
* Las personas con un nivel educativo “Higher education” tienen el mayor ingreso total promedio. * Las personas con un estado civil “Married” tienen el mayor ingreso total promedio. * Las mayoría de las personas que vive en una región con calificación de “2”.

A continuación, se genera resumen de cada una de las variables posterior a la identificación y reemplazo de NaN con 0

# Se identifica si hay valores nulos
df[is.na(df)] <- 0

dfn <- is.na(df)
df <- na.omit(df)

plot_missing(df)

Se reemplazan outliers de variables numéricas seleccionadas con mediana

df$NAME_CONTRACT_TYPE <- as.factor(df$NAME_CONTRACT_TYPE)
df$GENDER <- as.factor(df$GENDER)
df$FLAG_OWN_REALTY <- as.factor(df$FLAG_OWN_REALTY)
df$FLAG_OWN_CAR <- as.factor(df$FLAG_OWN_CAR)
df$NAME_INCOME_TYPE <- as.factor(df$NAME_INCOME_TYPE)
df$NAME_EDUCATION_TYPE <- as.factor(df$NAME_EDUCATION_TYPE)
df$NAME_FAMILY_STATUS <- as.factor(df$NAME_FAMILY_STATUS)
df$NAME_HOUSING_TYPE <- as.factor(df$NAME_HOUSING_TYPE)

# Convertir los factores a numéricos
df$GENDER <- as.numeric(df$GENDER)
df$FLAG_OWN_CAR <- as.numeric(df$FLAG_OWN_CAR)
df$FLAG_OWN_REALTY <- as.numeric(df$FLAG_OWN_REALTY)
df$NAME_CONTRACT_TYPE <- as.numeric(df$NAME_CONTRACT_TYPE)
df$NAME_INCOME_TYPE <- as.numeric(df$NAME_INCOME_TYPE)
df$NAME_EDUCATION_TYPE <- as.numeric(df$NAME_EDUCATION_TYPE)
df$NAME_FAMILY_STATUS <- as.numeric(df$NAME_FAMILY_STATUS)
df$NAME_HOUSING_TYPE <- as.numeric(df$NAME_HOUSING_TYPE)
df$NAME_FAMILY_STATUS <- as.numeric(df$NAME_FAMILY_STATUS)
df$NAME_FAMILY_STATUS <- as.numeric(df$NAME_FAMILY_STATUS)


reemplazar_outliers <- function(df, cols) {
  for (col in cols) {
    qnt <- quantile(df[[col]], c(0.25, 0.75))
    iqr <- qnt[2] - qnt[1]
    lower <- qnt[1] - 1.5 * iqr
    upper <- qnt[2] + 1.5 * iqr
    df[[col]][df[[col]] < lower | df[[col]] > upper] <- median(df[[col]], na.rm = TRUE)
  }
  return(df)
}
# Lista de columnas a reemplazar outliers
columnas_a_reemplazar <- c("CNT_CHILDREN", "AMT_INCOME_TOTAL", "DAYS_EMPLOYED", "OWN_CAR_AGE")

# Función para reemplazar outliers
df <- reemplazar_outliers(df, columnas_a_reemplazar)
# Visualización de medidas descriptivas 

summary(df)

##      TARGET        NAME_CONTRACT_TYPE     GENDER       FLAG_OWN_CAR  
##  Min.   :0.00000   Min.   :1.000      Min.   :1.000   Min.   :1.000  
##  1st Qu.:0.00000   1st Qu.:1.000      1st Qu.:1.000   1st Qu.:1.000  
##  Median :0.00000   Median :1.000      Median :1.000   Median :1.000  
##  Mean   :0.08383   Mean   :1.081      Mean   :1.345   Mean   :1.343  
##  3rd Qu.:0.00000   3rd Qu.:1.000      3rd Qu.:2.000   3rd Qu.:2.000  
##  Max.   :1.00000   Max.   :2.000      Max.   :2.000   Max.   :2.000  
##  FLAG_OWN_REALTY  CNT_CHILDREN    AMT_INCOME_TOTAL   AMT_CREDIT     
##  Min.   :1.000   Min.   :0.0000   Min.   : 25650   Min.   :  45000  
##  1st Qu.:1.000   1st Qu.:0.0000   1st Qu.:112500   1st Qu.: 273636  
##  Median :2.000   Median :0.0000   Median :153000   Median : 518562  
##  Mean   :1.687   Mean   :0.3757   Mean   :154921   Mean   : 603622  
##  3rd Qu.:2.000   3rd Qu.:1.0000   3rd Qu.:190350   3rd Qu.: 810000  
##  Max.   :2.000   Max.   :2.0000   Max.   :337500   Max.   :4050000  
##   AMT_ANNUITY     AMT_GOODS_PRICE   NAME_INCOME_TYPE NAME_EDUCATION_TYPE
##  Min.   :     0   Min.   :      0   Min.   :1.000    Min.   :1.000      
##  1st Qu.: 16799   1st Qu.: 238500   1st Qu.:4.000    1st Qu.:3.000      
##  Median : 25128   Median : 450000   Median :8.000    Median :5.000      
##  Mean   : 27358   Mean   : 541663   Mean   :5.652    Mean   :4.175      
##  3rd Qu.: 34911   3rd Qu.: 679500   3rd Qu.:8.000    3rd Qu.:5.000      
##  Max.   :258026   Max.   :4050000   Max.   :8.000    Max.   :5.000      
##  NAME_FAMILY_STATUS NAME_HOUSING_TYPE REGION_RATING_CLIENT_W_CITY
##  Min.   :1.000      Min.   :1.000     Min.   :1.000              
##  1st Qu.:2.000      1st Qu.:2.000     1st Qu.:2.000              
##  Median :2.000      Median :2.000     Median :2.000              
##  Mean   :2.472      Mean   :2.296     Mean   :2.032              
##  3rd Qu.:3.000      3rd Qu.:2.000     3rd Qu.:2.000              
##  Max.   :6.000      Max.   :6.000     Max.   :3.000

Medidas de dispersión

Acorde a las gráficas siguientes se determina que:
- Las variables AMT_ANNUITY, AMT_CREDIT, AMT_GOODS_PRICE y AMT_INCOME_TOTAL tienen un rango similar (40,000).
- La variable AMT_INCOME_TOTAL tiene la mayor desviación estándar y varianza, lo que indica que hay una mayor dispersión en los valores de esta variable.
- La variable CNT_CHILDREN tiene la menor desviación estándar y varianza, lo que indica que hay una menor dispersión en los valores de esta variable.

En este chunk se genera boxplot de cada una de las variabes numéricas del dataframe para identificar outliers

columnas_numericas <- names(df)[sapply(df, is.numeric)]

for (col in columnas_numericas) {
  boxplot(df[[col]], main=col)
}

Identificación de patrones y/o tendencias en los datos mediante el uso de gráficos

Los gráficos posteriores muestran las siguientes tendencias:
* La mayoría de las correlaciones son positivas, lo que indica que las variables tienden a aumentar o disminuir juntas. * Las variables relacionadas con el ingreso (CNT_CHILDREN, AMT_INCOME_TOTAL) y el crédito (AMT_CREDIT, AMT_ANNUITY) tienen las correlaciones más fuertes. * Las variables relacionadas con la ubicación (REGION_RATING_CLIENT) también tienen correlaciones moderadas.

Gráficos de para visualizar distribución de variables

# Descripción introductoria o resumen de df
introduce(df)

##     rows columns discrete_columns continuous_columns all_missing_columns
## 1 179020      15                0                 15                   0
##   total_missing_values complete_rows total_observations memory_usage
## 1                    0        179020            2685300     20054424

plot_intro(df)

# Histograma para cada variable numérica del dataframe df
plot_histogram(df)

# Gráfico de barras para cada variable categórica 
plot_bar(df)

Visualización de distribución normal

plot_normality(df)

Correlación entre variables
Se visualiza que hay una asociación positiva entre expenses y smoker

dev.new(width = 10, height = 8)
correlate(df) %>%  plot()
plot_correlation(df)

Transformación de variables de interés

Acorde a los gráficos de distribución normal, se identificaron las variables que tendrían mejor normalidad al convertirlas a logaritmo para generar el dataframe.

df$log_AMT_CREDIT <- log(df$AMT_CREDIT)
df$log_AMT_ANNUITY <- log(df$AMT_ANNUITY+0.01)
df$log_AMT_GOODS_PRICE <- log(df$AMT_GOODS_PRICE+0.01)

# Genera el nuevo dataframe df1 con las transformaciones
df1 <- data.frame(
  TARGET = df$TARGET,
  log_AMT_CREDIT = df$log_AMT_CREDIT,
  log_AMT_ANNUITY = df$log_AMT_ANNUITY,
  log_AMT_GOODS_PRICE = df$log_AMT_GOODS_PRICE,
  NAME_CONTRACT_TYPE = df$NAME_CONTRACT_TYPE,
  GENDER = df$GENDER,
  FLAG_OWN_CAR = df$FLAG_OWN_CAR,
  FLAG_OWN_REALTY = df$FLAG_OWN_REALTY,
  CNT_CHILDREN = df$CNT_CHILDREN,
  AMT_INCOME_TOTAL = df$AMT_INCOME_TOTAL,
  NAME_INCOME_TYPE = df$NAME_INCOME_TYPE,
  NAME_EDUCATION_TYPE = df$NAME_EDUCATION_TYPE,
  NAME_FAMILY_STATUS = df$NAME_FAMILY_STATUS,
  NAME_HOUSING_TYPE = df$NAME_HOUSING_TYPE,
  REGION_RATING_CLIENT_W_CITY = df$REGION_RATING_CLIENT_W_CITY
)

summary(df1)

##      TARGET        log_AMT_CREDIT  log_AMT_ANNUITY  log_AMT_GOODS_PRICE
##  Min.   :0.00000   Min.   :10.71   Min.   :-4.605   Min.   :-4.605     
##  1st Qu.:0.00000   1st Qu.:12.52   1st Qu.: 9.729   1st Qu.:12.382     
##  Median :0.00000   Median :13.16   Median :10.132   Median :13.017     
##  Mean   :0.08383   Mean   :13.08   Mean   :10.077   Mean   :12.953     
##  3rd Qu.:0.00000   3rd Qu.:13.60   3rd Qu.:10.461   3rd Qu.:13.429     
##  Max.   :1.00000   Max.   :15.21   Max.   :12.461   Max.   :15.214     
##  NAME_CONTRACT_TYPE     GENDER       FLAG_OWN_CAR   FLAG_OWN_REALTY
##  Min.   :1.000      Min.   :1.000   Min.   :1.000   Min.   :1.000  
##  1st Qu.:1.000      1st Qu.:1.000   1st Qu.:1.000   1st Qu.:1.000  
##  Median :1.000      Median :1.000   Median :1.000   Median :2.000  
##  Mean   :1.081      Mean   :1.345   Mean   :1.343   Mean   :1.687  
##  3rd Qu.:1.000      3rd Qu.:2.000   3rd Qu.:2.000   3rd Qu.:2.000  
##  Max.   :2.000      Max.   :2.000   Max.   :2.000   Max.   :2.000  
##   CNT_CHILDREN    AMT_INCOME_TOTAL NAME_INCOME_TYPE NAME_EDUCATION_TYPE
##  Min.   :0.0000   Min.   : 25650   Min.   :1.000    Min.   :1.000      
##  1st Qu.:0.0000   1st Qu.:112500   1st Qu.:4.000    1st Qu.:3.000      
##  Median :0.0000   Median :153000   Median :8.000    Median :5.000      
##  Mean   :0.3757   Mean   :154921   Mean   :5.652    Mean   :4.175      
##  3rd Qu.:1.0000   3rd Qu.:190350   3rd Qu.:8.000    3rd Qu.:5.000      
##  Max.   :2.0000   Max.   :337500   Max.   :8.000    Max.   :5.000      
##  NAME_FAMILY_STATUS NAME_HOUSING_TYPE REGION_RATING_CLIENT_W_CITY
##  Min.   :1.000      Min.   :1.000     Min.   :1.000              
##  1st Qu.:2.000      1st Qu.:2.000     1st Qu.:2.000              
##  Median :2.000      Median :2.000     Median :2.000              
##  Mean   :2.472      Mean   :2.296     Mean   :2.032              
##  3rd Qu.:3.000      3rd Qu.:2.000     3rd Qu.:2.000              
##  Max.   :6.000      Max.   :6.000     Max.   :3.000

Especificación del modelo de regresión lineal a estimar

Se infiere que el impacto de cada una de las variables explicativas sobre la principal variable de estudio, en este caso “TARGET”, sería de esta manera:
- AMT ANNUITY: Se espera que un aumento en la cantidad de la anualidad tenga un impacto positivo en la probabilidad de que un cliente sea bueno.
- AMT CREDIT: Se espera que un aumento en la cantidad del crédito tenga un impacto negativo en la probabilidad de que un cliente sea bueno.
- AMT GOODS PRICE: Se espera que un aumento en la cantidad del precio de los bienes tenga un impacto negativo en la probabilidad de que un cliente sea bueno.
- AMT INCOME TOTAL: Se espera que un aumento en la cantidad del ingreso total tenga un impacto positivo en la probabilidad de que un cliente sea bueno.
- CNT CHILDREN: Se espera que un aumento en el número de hijos tenga un impacto negativo en la probabilidad de que un cliente sea bueno.
- REGION_RATING_CLIENT_W_CITY: Se espera que un aumento en la calificación del cliente con ciudad tenga un impacto positivo en la probabilidad de que un cliente sea bueno.

par(mfrow = c(3, 2))  # Divide el área de la trama en una cuadrícula de 3 filas y 2 columnas

# AMT_CREDIT
boxplot(TARGET ~ AMT_CREDIT, data = df, main = "TARGET vs. AMT_CREDIT", xlab = "AMT_CREDIT", ylab = "TARGET")

# AMT_ANNUITY
boxplot(TARGET ~ AMT_ANNUITY, data = df, main = "TARGET vs. AMT_ANNUITY", xlab = "AMT_ANNUITY", ylab = "TARGET")

# AMT_GOODS_PRICE
boxplot(TARGET ~ AMT_GOODS_PRICE, data = df, main = "TARGET vs. AMT_GOODS_PRICE", xlab = "AMT_GOODS_PRICE", ylab = "TARGET")

Estimación de modelos de Supervised Machine Learning (SML)

Partición de bd

set.seed(123)  
partition <- createDataPartition(y = df1$TARGET, p=0.7, list=F)
train = df1[partition, ]
test  = df1[-partition, ]

Simple Logistic Model

simple_logistic <- glm(TARGET ~ log_AMT_CREDIT, family = "binomial", data = train)
summary(simple_logistic) 

## 
## Call:
## glm(formula = TARGET ~ log_AMT_CREDIT, family = "binomial", data = train)
## 
## Coefficients:
##                Estimate Std. Error z value Pr(>|z|)    
## (Intercept)    -1.55828    0.18480  -8.432  < 2e-16 ***
## log_AMT_CREDIT -0.06341    0.01414  -4.485  7.3e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 72407  on 125313  degrees of freedom
## Residual deviance: 72387  on 125312  degrees of freedom
## AIC: 72391
## 
## Number of Fisher Scoring iterations: 5

exp(coef(simple_logistic))

##    (Intercept) log_AMT_CREDIT 
##      0.2104977      0.9385604

confint(simple_logistic)   ### the estimated coefficients based on the confidence interval 

##                      2.5 %      97.5 %
## (Intercept)    -1.92096520 -1.19655969
## log_AMT_CREDIT -0.09109548 -0.03567187

varImp(simple_logistic)

##                Overall
## log_AMT_CREDIT  4.4847

test_simple_logistic <- predict(simple_logistic, newdata = test, type = "response")
predicted_classes <- ifelse(test_simple_logistic > 0.5, 1, 0)
confusion_matrix <- confusionMatrix(factor(predicted_classes), factor(test$TARGET))
confusion_matrix

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction     0     1
##          0 49250  4456
##          1     0     0
##                                           
##                Accuracy : 0.917           
##                  95% CI : (0.9147, 0.9193)
##     No Information Rate : 0.917           
##     P-Value [Acc > NIR] : 0.504           
##                                           
##                   Kappa : 0               
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 1.000           
##             Specificity : 0.000           
##          Pos Pred Value : 0.917           
##          Neg Pred Value :   NaN           
##              Prevalence : 0.917           
##          Detection Rate : 0.917           
##    Detection Prevalence : 1.000           
##       Balanced Accuracy : 0.500           
##                                           
##        'Positive' Class : 0               
## 

par(mfrow=c(1, 2))

prediction(test_simple_logistic, test$TARGET) %>%
  performance(measure = "tpr", x.measure = "fpr") %>%
  plot()

# AUC - Simple Logistic Regression Model 
auc_simple <- prediction(test_simple_logistic, test$TARGET) %>% performance(measure = "auc") %>% .@y.values
#KAPP
kappa_simple <- confusion_matrix$overall["Kappa"]
kappa_simple

## Kappa 
##     0

Simple Logistic Model Ajusted

Se realiza un Simple Logistic Model Ajustado con el fin de evitar que el desbalanceo de clases afecta las métricas de clasificación del modelo.

class_weights <- ifelse(train$TARGET == 0, mean(train$TARGET == 1), mean(train$TARGET == 0))
simple_logistic_wss <- glm(TARGET ~ log_AMT_CREDIT, family = "binomial", data = train, weights = class_weights)

predictions_simple_wss <- predict(simple_logistic_wss, newdata = test, type = "response")

predicted_simple_wss <- ifelse(predictions_simple_wss > 0.5, 1, 0)

confusion_simple_wss <- confusionMatrix(factor(predicted_simple_wss), factor(test$TARGET))
confusion_simple_wss

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction     0     1
##          0 27314  2326
##          1 21936  2130
##                                          
##                Accuracy : 0.5482         
##                  95% CI : (0.544, 0.5525)
##     No Information Rate : 0.917          
##     P-Value [Acc > NIR] : 1              
##                                          
##                   Kappa : 0.0109         
##                                          
##  Mcnemar's Test P-Value : <2e-16         
##                                          
##             Sensitivity : 0.55460        
##             Specificity : 0.47801        
##          Pos Pred Value : 0.92152        
##          Neg Pred Value : 0.08851        
##              Prevalence : 0.91703        
##          Detection Rate : 0.50858        
##    Detection Prevalence : 0.55189        
##       Balanced Accuracy : 0.51630        
##                                          
##        'Positive' Class : 0              
## 

# AUC - Simple Logistic Regression Model 
auc_simple_wss <- prediction(predictions_simple_wss, test$TARGET) %>% performance(measure = "auc") %>% .@y.values
#KAPP
kappa_simple_wss <- confusion_simple_wss$overall["Kappa"]

Multiple Logistic Model

multiple_logistic <- glm(TARGET ~ ., family = "binomial", data = train)
summary(multiple_logistic)

## 
## Call:
## glm(formula = TARGET ~ ., family = "binomial", data = train)
## 
## Coefficients:
##                               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                 -4.893e+00  2.608e-01 -18.764  < 2e-16 ***
## log_AMT_CREDIT              -6.556e-02  3.059e-02  -2.143 0.032099 *  
## log_AMT_ANNUITY              2.164e-01  3.691e-02   5.864 4.53e-09 ***
## log_AMT_GOODS_PRICE         -5.975e-02  1.590e-02  -3.759 0.000171 ***
## NAME_CONTRACT_TYPE          -1.900e-01  4.417e-02  -4.301 1.70e-05 ***
## GENDER                       4.651e-01  2.268e-02  20.504  < 2e-16 ***
## FLAG_OWN_CAR                -3.364e-01  2.409e-02 -13.965  < 2e-16 ***
## FLAG_OWN_REALTY              4.153e-02  2.270e-02   1.830 0.067304 .  
## CNT_CHILDREN                 8.972e-02  1.581e-02   5.676 1.38e-08 ***
## AMT_INCOME_TOTAL            -3.430e-07  1.921e-07  -1.785 0.074207 .  
## NAME_INCOME_TYPE             5.123e-02  4.235e-03  12.096  < 2e-16 ***
## NAME_EDUCATION_TYPE          1.485e-01  9.046e-03  16.411  < 2e-16 ***
## NAME_FAMILY_STATUS          -2.299e-03  9.205e-03  -0.250 0.802812    
## NAME_HOUSING_TYPE            8.379e-02  9.760e-03   8.584  < 2e-16 ***
## REGION_RATING_CLIENT_W_CITY  3.756e-01  2.063e-02  18.203  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 72407  on 125313  degrees of freedom
## Residual deviance: 70649  on 125299  degrees of freedom
## AIC: 70679
## 
## Number of Fisher Scoring iterations: 5

varImp(multiple_logistic)

##                                Overall
## log_AMT_CREDIT               2.1431741
## log_AMT_ANNUITY              5.8637464
## log_AMT_GOODS_PRICE          3.7587415
## NAME_CONTRACT_TYPE           4.3010208
## GENDER                      20.5040567
## FLAG_OWN_CAR                13.9651679
## FLAG_OWN_REALTY              1.8296379
## CNT_CHILDREN                 5.6758051
## AMT_INCOME_TOTAL             1.7853344
## NAME_INCOME_TYPE            12.0963472
## NAME_EDUCATION_TYPE         16.4113921
## NAME_FAMILY_STATUS           0.2497099
## NAME_HOUSING_TYPE            8.5844808
## REGION_RATING_CLIENT_W_CITY 18.2033900

plot(multiple_logistic, which = 4, id.n = 5)

multiple_logistic_data <- augment(multiple_logistic) %>%  mutate(index = 1:n())
multiple_logistic_data %>% top_n(5, .cooksd)

## # A tibble: 5 × 23
##   .rownames TARGET log_AMT_CREDIT log_AMT_ANNUITY log_AMT_GOODS_PRICE
##   <chr>      <int>          <dbl>           <dbl>               <dbl>
## 1 49926          1           12.5            9.51               -4.61
## 2 55280          1           13.7           10.7                -4.61
## 3 68430          1           12.1            9.10               -4.61
## 4 121951         1           11.8            8.82               -4.61
## 5 149739         1           11.8            8.82               -4.61
## # ℹ 18 more variables: NAME_CONTRACT_TYPE <dbl>, GENDER <dbl>,
## #   FLAG_OWN_CAR <dbl>, FLAG_OWN_REALTY <dbl>, CNT_CHILDREN <dbl>,
## #   AMT_INCOME_TOTAL <dbl>, NAME_INCOME_TYPE <dbl>, NAME_EDUCATION_TYPE <dbl>,
## #   NAME_FAMILY_STATUS <dbl>, NAME_HOUSING_TYPE <dbl>,
## #   REGION_RATING_CLIENT_W_CITY <int>, .fitted <dbl>, .resid <dbl>, .hat <dbl>,
## #   .sigma <dbl>, .cooksd <dbl>, .std.resid <dbl>, index <int>

library(caret)

# Predice las clases en el conjunto de prueba
predictions_multiple <- predict(multiple_logistic, newdata = test, type = "response")

predicted_classes <- ifelse(predictions_multiple > 0.5, 1, 0)

confusion_multiple <- confusionMatrix(factor(predicted_classes), factor(test$TARGET))
confusion_multiple

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction     0     1
##          0 49250  4456
##          1     0     0
##                                           
##                Accuracy : 0.917           
##                  95% CI : (0.9147, 0.9193)
##     No Information Rate : 0.917           
##     P-Value [Acc > NIR] : 0.504           
##                                           
##                   Kappa : 0               
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 1.000           
##             Specificity : 0.000           
##          Pos Pred Value : 0.917           
##          Neg Pred Value :   NaN           
##              Prevalence : 0.917           
##          Detection Rate : 0.917           
##    Detection Prevalence : 1.000           
##       Balanced Accuracy : 0.500           
##                                           
##        'Positive' Class : 0               
## 

par(mfrow=c(1, 2))

prediction(predictions_multiple, test$TARGET) %>%
  performance(measure = "tpr", x.measure = "fpr") %>%
  plot()

# AUC  
auc_multiple <- prediction(predictions_multiple, test$TARGET) %>% performance(measure = "auc") %>% .@y.values
kappa_multiple <- confusion_multiple$overall["Kappa"]
kappa_multiple

## Kappa 
##     0

Multiple Logistic Model Ajusted

Se realiza un Multiple Logistic Model Ajustado con el fin de evitar que el desbalanceo de clases afecta las métricas de clasificación del modelo.

class_weights_multiple <- ifelse(train$TARGET == 0, mean(train$TARGET == 1), mean(train$TARGET == 0))

# Entrenar el modelo de regresión logística con ajuste de pesos de clase
multiple_logistic_weighted <- glm(TARGET ~ ., family = "binomial", data = train, weights = class_weights_multiple)

predictions_wss <- predict(multiple_logistic_weighted, newdata = test, type = "response")

predicted_wss <- ifelse(predictions_wss > 0.5, 1, 0)

confusion_multiple_wss <- confusionMatrix(factor(predicted_wss), factor(test$TARGET))
confusion_multiple_wss

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction     0     1
##          0 28663  1803
##          1 20587  2653
##                                           
##                Accuracy : 0.5831          
##                  95% CI : (0.5789, 0.5873)
##     No Information Rate : 0.917           
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0.0608          
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.5820          
##             Specificity : 0.5954          
##          Pos Pred Value : 0.9408          
##          Neg Pred Value : 0.1142          
##              Prevalence : 0.9170          
##          Detection Rate : 0.5337          
##    Detection Prevalence : 0.5673          
##       Balanced Accuracy : 0.5887          
##                                           
##        'Positive' Class : 0               
## 

auc_multiple_wss <- prediction(predictions_wss, test$TARGET) %>% performance(measure = "auc") %>% .@y.values
kapp_multiple_wss <- confusion_multiple_wss$overall["Kappa"]

Decision Trees

A causa del desbalanceo de clases, el decision tree implica cierto sesgo de clasificación lo que se denota en la matriz de confusión, ya que el modelo no está prediciendo la clase positiva en absoluto y, en cambio, está prediciendo la mayoría de las instancias como negativas.

set.seed(123)
dt.rpart <- rpart((factor(TARGET)) ~ .,data = train, method = "class", control = rpart.control(cp=0.005))
dt.rpart

## n= 125314 
## 
## node), split, n, loss, yval, (yprob)
##       * denotes terminal node
## 
## 1) root 125314 10551 0 (0.9158035 0.0841965) *

prp(dt.rpart, extra = 2) # extra argument includes the proportion of correct predictions (*)

### TESTING PERFORMANCE 
test_ppredict_tree <- predict(object = dt.rpart, newdata = test, type = "class")

# test confusion matrix
confusion_tree <- confusionMatrix(factor(test_ppredict_tree), factor(test$TARGET))
confusion_tree

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction     0     1
##          0 49250  4456
##          1     0     0
##                                           
##                Accuracy : 0.917           
##                  95% CI : (0.9147, 0.9193)
##     No Information Rate : 0.917           
##     P-Value [Acc > NIR] : 0.504           
##                                           
##                   Kappa : 0               
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 1.000           
##             Specificity : 0.000           
##          Pos Pred Value : 0.917           
##          Neg Pred Value :   NaN           
##              Prevalence : 0.917           
##          Detection Rate : 0.917           
##    Detection Prevalence : 1.000           
##       Balanced Accuracy : 0.500           
##                                           
##        'Positive' Class : 0               
## 

kappa_tree <- confusion_tree$overall["Kappa"]
kappa_tree

## Kappa 
##     0

test_pprob_tree <- predict(object = dt.rpart, newdata = test, type = "prob")

roc_obj_tree <- roc(test$TARGET, test_pprob_tree[, 1])  # Assuming first column is positive class probability

# Plotting ROC curve
plot.roc(roc_obj_tree, main = "Curva ROC", col = "blue")

# AUC - Simple Logistic Regression Model 
auc_tree <- roc(test$TARGET, test_pprob_tree[, 1])$auc
auc_tree

## Area under the curve: 0.5

Random Forest

library(randomForest)

train$TARGET <- as.factor(train$TARGET)

set.seed(123)
random_forest <- randomForest(TARGET ~ log_AMT_CREDIT + log_AMT_ANNUITY + log_AMT_GOODS_PRICE + NAME_CONTRACT_TYPE + GENDER + FLAG_OWN_CAR + FLAG_OWN_REALTY + CNT_CHILDREN + AMT_INCOME_TOTAL + NAME_INCOME_TYPE + NAME_EDUCATION_TYPE + NAME_FAMILY_STATUS + NAME_HOUSING_TYPE + REGION_RATING_CLIENT_W_CITY, data=train, ntree=500, mtry=4)
print(random_forest) 

## 
## Call:
##  randomForest(formula = TARGET ~ log_AMT_CREDIT + log_AMT_ANNUITY +      log_AMT_GOODS_PRICE + NAME_CONTRACT_TYPE + GENDER + FLAG_OWN_CAR +      FLAG_OWN_REALTY + CNT_CHILDREN + AMT_INCOME_TOTAL + NAME_INCOME_TYPE +      NAME_EDUCATION_TYPE + NAME_FAMILY_STATUS + NAME_HOUSING_TYPE +      REGION_RATING_CLIENT_W_CITY, data = train, ntree = 500, mtry = 4) 
##                Type of random forest: classification
##                      Number of trees: 500
## No. of variables tried at each split: 4
## 
##         OOB estimate of  error rate: 8.5%
## Confusion matrix:
##        0   1 class.error
## 0 114639 124 0.001080488
## 1  10532  19 0.998199223

varImpPlot(random_forest, n.var = 10, main = "Top 10 - Variable")

importance(random_forest)  

##                             MeanDecreaseGini
## log_AMT_CREDIT                    2912.13155
## log_AMT_ANNUITY                   3939.97160
## log_AMT_GOODS_PRICE               2048.80362
## NAME_CONTRACT_TYPE                  97.77419
## GENDER                             176.42915
## FLAG_OWN_CAR                       335.00925
## FLAG_OWN_REALTY                    526.55972
## CNT_CHILDREN                       648.33952
## AMT_INCOME_TOTAL                  2844.76651
## NAME_INCOME_TYPE                   407.90761
## NAME_EDUCATION_TYPE                348.15858
## NAME_FAMILY_STATUS                 934.95265
## NAME_HOUSING_TYPE                  489.00328
## REGION_RATING_CLIENT_W_CITY        384.45193

predictions_rf <- predict(random_forest, newdata = test)

predictions_rf <- as.factor(predictions_rf)
test$TARGET <- as.factor(test$TARGET)

# Crear la matriz de confusión
confusion_rf <- confusionMatrix(predictions_rf, test$TARGET)
print(confusion_rf)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction     0     1
##          0 49201  4451
##          1    49     5
##                                           
##                Accuracy : 0.9162          
##                  95% CI : (0.9138, 0.9185)
##     No Information Rate : 0.917           
##     P-Value [Acc > NIR] : 0.7572          
##                                           
##                   Kappa : 2e-04           
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.999005        
##             Specificity : 0.001122        
##          Pos Pred Value : 0.917039        
##          Neg Pred Value : 0.092593        
##              Prevalence : 0.917030        
##          Detection Rate : 0.916117        
##    Detection Prevalence : 0.998995        
##       Balanced Accuracy : 0.500064        
##                                           
##        'Positive' Class : 0               
## 

prediccion_prob_rf <- predict(random_forest, test, type = "prob")
prediccion_prob_true_rf <- prediccion_prob_rf[, "1"]

## Generar la curva ROC
roc_obj_rf <- roc(test$TARGET, prediccion_prob_true_rf)

## Dibujar la curva ROC
plot.roc(roc_obj_rf, main="Curva ROC", col="blue")

## Calcular el AUC
library(pROC)
# AUC - Simple Logistic Regression Model 
auc_rf <- roc(test$TARGET, prediccion_prob_rf[, 1])$auc
auc_rf

## Area under the curve: 0.6121

SVM

Se selecciona una sola variable explicativa a causa de la dimnesionalidad de la bd y permite captar una parte significativa del poder predictivo del conjunto de datos a causa de la influencia/importancia de la variable, lo que la convertiría en una buena candidata para un modelo de una sola variable.

svm_model <- svm(TARGET ~ log_AMT_CREDIT, data = train,type = "C-classification", kernel = "linear",scale = FALSE)
svm_model

## 
## Call:
## svm(formula = TARGET ~ log_AMT_CREDIT, data = train, type = "C-classification", 
##     kernel = "linear", scale = FALSE)
## 
## 
## Parameters:
##    SVM-Type:  C-classification 
##  SVM-Kernel:  linear 
##        cost:  1 
## 
## Number of Support Vectors:  21108

predict_svm <- predict(svm_model, newdata = test)
confusion_svm <- confusionMatrix(predict_svm, test$TARGET) 
kappa_svm <- confusion_svm$overall["Kappa"]
kappa_svm

## Kappa 
##     0

# validate our model
predict_svm <- predict(svm_model, newdata = test)
confusion_svm <- confusionMatrix(predict_svm, test$TARGET) 
confusion_svm

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction     0     1
##          0 49250  4456
##          1     0     0
##                                           
##                Accuracy : 0.917           
##                  95% CI : (0.9147, 0.9193)
##     No Information Rate : 0.917           
##     P-Value [Acc > NIR] : 0.504           
##                                           
##                   Kappa : 0               
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 1.000           
##             Specificity : 0.000           
##          Pos Pred Value : 0.917           
##          Neg Pred Value :   NaN           
##              Prevalence : 0.917           
##          Detection Rate : 0.917           
##    Detection Prevalence : 1.000           
##       Balanced Accuracy : 0.500           
##                                           
##        'Positive' Class : 0               
## 

K-MEANS

Cabe destacar que, no se obtuvieron las métricas de AUC, ROC y Matriz de confusión debido a la naturaleza del model. No obstante, se genera la gráfica del codo para determinar el número de clusters adecuados.

set.seed(123)

# Define a function to compute within-cluster sum of squares (WCSS)
wss <- function(k) {
  kmeans(df1, k, nstart = 10)$tot.withinss
}

# Initialize variables for storing WCSS values
wcss_values <- vector()

# Compute WCSS for different values of k (number of clusters)
max_k <- 10  # Reducido el rango a 10
for (k in 1:max_k) {
  wcss_values[k] <- wss(k)
}

# Plot the elbow method to find the optimal number of clusters
plot(1:max_k, wcss_values, type = "b", pch = 19, frame = FALSE, 
     xlab = "Clusters (K)",
     ylab = "WCSS",
     main = "Método del Codo")

# Set seed for reproducibility
set.seed(123)
# Acorde al Método de Codo, se selecciona el número de clusters que en este caso sería 2
k2 <- kmeans(df1, centers = 2, nstart = 25)
str(k2)

## List of 9
##  $ cluster     : int [1:179020] 1 1 2 2 2 2 2 2 1 2 ...
##  $ centers     : num [1:2, 1:15] 0.0784 0.0867 13.3398 12.9426 10.2996 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:2] "1" "2"
##   .. ..$ : chr [1:15] "TARGET" "log_AMT_CREDIT" "log_AMT_ANNUITY" "log_AMT_GOODS_PRICE" ...
##  $ totss       : num 7.06e+14
##  $ withinss    : num [1:2] 1.13e+14 1.22e+14
##  $ tot.withinss: num 2.35e+14
##  $ betweenss   : num 4.7e+14
##  $ size        : int [1:2] 61232 117788
##  $ iter        : int 1
##  $ ifault      : int 0
##  - attr(*, "class")= chr "kmeans"

fviz_cluster(k2, data = df1)

KNN

Cada uno de los modelos siguientes tienen una alta precisión, con valores superiores al 95%. A pesar de esto, se determina que conforme el valor de k disminuye, la precisión del modelo aumenta ligeramente. Esto puede indicar que al considerar menos vecinos cercanos, el modelo tiende a capturar mejor las características locales de los datos. Por lo tanto, el modelo knnn a seleccionar sería knn_model2 con k=1.

library(class)
knn_model <- knn(train = train[, -ncol(train)], test = test[, -ncol(test)], cl = train$TARGET, k = 5)

confusion_knn <- table(Actual = test$TARGET, Predicted = knn_model)
print(confusion_knn)

##       Predicted
## Actual     0     1
##      0 49239    11
##      1  2166  2290

accuracy <- sum(diag(confusion_knn)) / sum(confusion_knn)
print(paste("Accuracy:", accuracy))

## [1] "Accuracy: 0.959464491863107"

knn_model1 <- knn(train = train[, -ncol(train)], test = test[, -ncol(test)], cl = train$TARGET, k = 3)

confusion_knn1 <- table(Actual = test$TARGET, Predicted = knn_model1)
print(confusion_knn1)

##       Predicted
## Actual     0     1
##      0 49216    34
##      1  1833  2623

accuracy1 <- sum(diag(confusion_knn1)) / sum(confusion_knn1)
print(paste("Accuracy:", accuracy1))

## [1] "Accuracy: 0.965236658846311"

knn_model2 <- knn(train = train[, -ncol(train)], test = test[, -ncol(test)], cl = train$TARGET, k = 1)

# Evaluate the model
confusion_knn2 <- table(Actual = test$TARGET, Predicted = knn_model2)
print(confusion_knn2)

##       Predicted
## Actual     0     1
##      0 48992   258
##      1  1394  3062

# Calculate accuracy
accuracyknn <- sum(diag(confusion_knn2)) / sum(confusion_knn2)
print(paste("Accuracy:", accuracyknn))

## [1] "Accuracy: 0.969239935947566"

Naïve Bayes

naive_bayes_model_a   <- naiveBayes(TARGET ~ ., data = train)

### Evaluar resultados de clasificacion 
predicted<-predict(naive_bayes_model_a, as.data.frame(test))
confusionBayes <- confusionMatrix(test$TARGET, predicted)
confusionBayes

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction     0     1
##          0 48037  1213
##          1  4235   221
##                                          
##                Accuracy : 0.8986         
##                  95% CI : (0.896, 0.9011)
##     No Information Rate : 0.9733         
##     P-Value [Acc > NIR] : 1              
##                                          
##                   Kappa : 0.0361         
##                                          
##  Mcnemar's Test P-Value : <2e-16         
##                                          
##             Sensitivity : 0.9190         
##             Specificity : 0.1541         
##          Pos Pred Value : 0.9754         
##          Neg Pred Value : 0.0496         
##              Prevalence : 0.9733         
##          Detection Rate : 0.8944         
##    Detection Prevalence : 0.9170         
##       Balanced Accuracy : 0.5365         
##                                          
##        'Positive' Class : 0              
## 

kappa_Bayes <- confusionBayes$overall["Kappa"]
kappa_Bayes 

##      Kappa 
## 0.03610047

train %>% filter(TARGET == "1") %>% select_if(is.numeric) %>% cor() %>% corrplot::corrplot(type = "upper")

#Se seleccionan variables de importancia acorde a modelos anteriores
train %>% dplyr::select(AMT_INCOME_TOTAL, log_AMT_CREDIT, log_AMT_ANNUITY, log_AMT_GOODS_PRICE, GENDER, NAME_INCOME_TYPE) %>% gather(metric, value) %>% ggplot(aes(value, fill = metric)) + 
  geom_density(show.legend = FALSE) + 
  facet_wrap(~ metric, scales = "free")

predicted_probs <- predict(naive_bayes_model_a, newdata = test, type = "raw")

# Extraer las probabilidades predichas de la clase positiva
positive_probs <- predicted_probs[, "1"]
predictions <- prediction(positive_probs, test$TARGET)

# AUC
auc_bayes <- performance(predictions, "auc")@y.values[[1]]
print(paste("AUC:", auc_bayes))

## [1] "AUC: 0.618200605582856"

# Curva ROC
roc_bayes <- performance(predictions, "tpr", "fpr")
plot(roc_bayes, main = "Curva ROC", col = "blue")
abline(a = 0, b = 1, lty = 2, col = "red")  # Lí

Evaluación y Selección de Modelo de Regresión

Se observan los siguientes hallazgos en relación a la comparativa de los modelos:
1. Los modelos Simple_model y Multiple_model tienen la misma precisión que el KNN, pero tienen un valor Kappa de 0.000000000, lo que indica que no son mejores que el azar. 2. El modelo Random_forest tiene una precisión de 0.9162, pero tiene un valor Kappa de 0.000230883, lo que indica que es un poco mejor que el azar. 3. Los modelos SimpleLogistic, MultipleLogistic, SVM y DecisionTree presentan cieto sesgo en relación a la clasificación de positivos verdaderos debido al desbalance de clases. 4. El modelo K-Means no tiene un valor de precisión, Kappa o AUC, lo que significa que no se puede comparar con los otros modelos. 5. El modelo KNN no tiene un valor de Kappa o AUC, pero tiene un Accuracy de 0.969 lo que significa que es posible que tenga cierto sesgo 6. El modelo Bayes es un buen modelo de clasificación, pero no es el mejor en ninguna de las tres métricas.

Con base en las observaciones comentadas anteriormente, se determina que el modelo Random_forest tiene una alta precisión lo que implica la fracción de predicciones que el modelo realizó correctamente. No obstante, el Multiple_model_wss podría ser preferible debido a su mayor AUC lo que implica que tiene mayor capacidad de discriminación.

accuracysimple <- confusion_matrix$overall["Accuracy"]

accuracysimplewss <- confusion_simple_wss$overall["Accuracy"]

accuracymultiple <- confusion_multiple$overall["Accuracy"]

accuracymultiplewss <- confusion_multiple_wss$overall["Accuracy"]

accuracytree <- confusion_tree$overall["Accuracy"]

accuracyrf <- confusion_rf$overall["Accuracy"]

accuracysvm <- confusion_svm$overall["Accuracy"]

accuracybayes <- confusionBayes$overall["Accuracy"]

resultados <- data.frame(
  "Model" = c("Simple_model", "Simple_model_wss", "Multiple_model", "Multiple_model_wss", 
              "Decision_tree", "Random_forest", "SVM", "Bayes", "KNN", "K-Means"),
  "Accuracy" = c(accuracysimple, accuracysimplewss, accuracymultiple, accuracymultiplewss,
                  accuracytree, accuracyrf, accuracysvm, accuracybayes, accuracyknn, NA),
  "Kappa" = c(kappa_simple, kappa_simple_wss, kappa_multiple, kapp_multiple_wss, 
              kappa_tree, confusion_rf$overall["Kappa"], kappa_svm, kappa_Bayes, NA, NA),  
  "AUC" = c(0.526, 0.526, 0.624, 0.625, auc_tree, auc_rf, NA, auc_bayes, NA, NA)
)

# Ordenar el dataframe por Accuracy
resultados

##                 Model  Accuracy       Kappa       AUC
## 1        Simple_model 0.9170298 0.000000000 0.5260000
## 2    Simple_model_wss 0.5482441 0.010863950 0.5260000
## 3      Multiple_model 0.9170298 0.000000000 0.6240000
## 4  Multiple_model_wss 0.5831006 0.060804144 0.6250000
## 5       Decision_tree 0.9170298 0.000000000 0.5000000
## 6       Random_forest 0.9162105 0.000230883 0.6120832
## 7                 SVM 0.9170298 0.000000000        NA
## 8               Bayes 0.8985588 0.036100468 0.6182006
## 9                 KNN 0.9692399          NA        NA
## 10            K-Means        NA          NA        NA

Hallazgos

EDA

El análisis exploratorio da a conocer que la variable dependiente (TARGET) tiene una fuerte relación lineal segun los coeficientes de correlación con log_AMT_CREDIT, log_AMT_ANNUITY y log_AMT_GOODS_PRICE. Asimismo, se determina que tienen un efecto positivo y significativo sobre la variable objetivo lo que significa que a medida que aumenta el valor de estas variables, también aumenta el valor de y. Según esto, se espera que: * Los clientes con un mayor log_AMT_CREDIT tienen un mayor riesgo de dificultades de pago.
* Los clientes con un log_AMT_ANNUITY elevado tienen más probabilidades de sufrir dificultades de pago, ya que tienen que abonar una cantidad mayor cada año.
* Los clientes que pidieron un préstamo para un alto log_AMT_GOODS_PRICE tienen más probabilidades de tener dificultades de pago debido a que están asumiendo una deuda mayor de la que pueden permitirse

Modelo seleccionado

Con base en lo anterior, se determina que el modelo de Random Forest sería el indicado para predecir a causa de la robustez y eficiencia por el entrenamiento de los árboles de decisión en paralelo. Mientras tanto, el modelo Multiple_model_wss sería ideal para clasificar puesto que, indica una mejor concordancia entre las predicciones del modelo y los valores reales, por ende, mejor discriminación de clases. No obstante, al ser un modelo ajustado es probable que tienda a sobreaprender de los datos o exista algún sesgo.