Análisis de datos y machine learning con R (caret)
Carlos Hernán Guirao
Rosa Castro Andreu
Gines Torres Almagro
2024-12-12
1 Introducción
El objetivo de esta práctica es crear un modelo de clasificación supervisada que permita predecir la aprobación de solicitudes de crédito para el conjunto de datos “Credit Approval”, empleando para ello técnicas de Machine Learning en R y la librería Caret. Para alcanzar este objetivo, será necesario llevar a cabo una serie de tareas: el análisis exploratorio de datos (AED), el preprocesamiento de datos, el entrenamiento, la comparación de modelos, y la selección y evaluación del modelo final.
2 Análisis Exploratorio (AED) y Preprocesado de Datos
En el Análisis Exploratorio de Datos nos centraremos en explorar el conjunto de datos para entender su estructura, distribuciones, relaciones y patrones. Esto nos va a permitir identificar características importantes y posibles problemas en los datos.
El conjunto de datos utilizado para la realización de la práctica tiene 16 variables, siendo la última de ellas la variable de salida, que inidicará con un “+” si el crédito ha sido aprobado y con un “-” si el crédito ha sido rechazado. A continuación, vamos a ver cuántos predictores numéricos y categóricos posee el conjunto de datos, y qué nombre recibe cada uno.
# Nombres de las columnas según la descripción del conjunto de datos
column_names <- c("A1", "A2", "A3", "A4", "A5",
"A6", "A7", "A8", "A9", "A10",
"A11", "A12", "A13", "A14", "A15", "Class")
# Cargar el conjunto de datos (header = FALSE indica que no se coja la primera línea como cabecera)
credit <- read.csv(file.path("credit+approval", "crx.data"), header = FALSE, col.names = column_names, na.strings = "?")
#División del conjunto de datos en entrenamiento y test
credit.trainIdx<-readRDS(file.path("credit.trainIdx.rds"))
credit.Datos.Train<-credit[credit.trainIdx,]
credit.Datos.Test<-credit[-credit.trainIdx,]
nrow(credit.Datos.Train)## [1] 553## [1] 137El conjunto de datos ha sido dividido en entrenamiento y test. Sin embargo, no se hará uso de ellos hasta el inicio del preprocesado de datos. El Análisis Exploratorio de Datos lo realizaremos sobre el conjunto original.
## A1 A2 A3 A4
## Length:690 Min. :13.75 Min. : 0.000 Length:690
## Class :character 1st Qu.:22.60 1st Qu.: 1.000 Class :character
## Mode :character Median :28.46 Median : 2.750 Mode :character
## Mean :31.57 Mean : 4.759
## 3rd Qu.:38.23 3rd Qu.: 7.207
## Max. :80.25 Max. :28.000
## NA's :12
## A5 A6 A7 A8
## Length:690 Length:690 Length:690 Min. : 0.000
## Class :character Class :character Class :character 1st Qu.: 0.165
## Mode :character Mode :character Mode :character Median : 1.000
## Mean : 2.223
## 3rd Qu.: 2.625
## Max. :28.500
##
## A9 A10 A11 A12
## Length:690 Length:690 Min. : 0.0 Length:690
## Class :character Class :character 1st Qu.: 0.0 Class :character
## Mode :character Mode :character Median : 0.0 Mode :character
## Mean : 2.4
## 3rd Qu.: 3.0
## Max. :67.0
##
## A13 A14 A15 Class
## Length:690 Min. : 0 Min. : 0.0 Length:690
## Class :character 1st Qu.: 75 1st Qu.: 0.0 Class :character
## Mode :character Median : 160 Median : 5.0 Mode :character
## Mean : 184 Mean : 1017.4
## 3rd Qu.: 276 3rd Qu.: 395.5
## Max. :2000 Max. :100000.0
## NA's :13A partir del sumario anterior, identificamos que el conjunto de datos cuenta con seis variables numéricas y nueve variables categóricas, distribuidas de la siguiente manera:
- Variables predictoras numéricas: A2, A3, A8, A11, A14, A15
- Variables predictoras categóricas: A1, A4, A5, A6, A7, A9, A10, A12, A13
- Variable de salida (clase): A16
2.1 Análisis de las variables
A continuación, realizaremos un análisis detallado de las variables predictoras, según sean numéricas o categóricas.
2.1.1 Análisis de los Predictores Numéricos
2.1.1.1 Análisis exploratorio inicial
Una vez identificados los tipos de variables, comenzaremos el análisis con las variables numéricas, proporcionando información sobre el mínimo, el máximo,el primer cuartil (Q1), el tercer cuartil (Q3),la media y la mediana. Finalmente, evaluaremos qué distribución sigue cada una de las seis variables y realizaremos un análisis exhaustivo para las dos variables más interesantes.
# Obtenemos las variables numericas sin modificar el dataset original.
numeric_vars <- c("A2", "A3", "A8", "A11", "A14", "A15")
selected_data <- credit[numeric_vars]
# Eliminamos filas con valores no finitos para evitar warnings al plotear
selected_data <- na.omit(selected_data)
# Convertimos el conjunto a formato largo sin modificar el dataset original
gathered_data <- gather(selected_data, key = "Variable", value = "Value")
# Agrupamos por la columna 'Variable' y calculamos las estadísticas descriptivas
grouped_data <- group_by(gathered_data, Variable)
stats_numeric <- summarise(grouped_data,
Min = min(Value, na.rm = TRUE),
Q1 = quantile(Value, 0.25, na.rm = TRUE),
Median = median(Value, na.rm = TRUE),
Mean = mean(Value, na.rm = TRUE),
Q3 = quantile(Value, 0.75, na.rm = TRUE),
Max = max(Value, na.rm = TRUE))
print(stats_numeric)## # A tibble: 6 × 7
## Variable Min Q1 Median Mean Q3 Max
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 A11 0 0 0 2.46 3 67
## 2 A14 0 75.2 160 182. 271 2000
## 3 A15 0 0 5 999. 399 100000
## 4 A2 13.8 22.6 28.5 31.6 38.2 80.2
## 5 A3 0 1.01 2.75 4.80 7.21 28
## 6 A8 0 0.165 1 2.22 2.58 28.5# Lista para almacenar los histogramas
plots <- list()
# Creamos los histogramas y los agregamos a la lista
for (var in numeric_vars) {
p_hist <- ggplot(selected_data, aes(x = .data[[var]])) +
geom_histogram(bins = 30, fill = "blue", color = "black") +
ggtitle(paste("Histograma de", var)) +
labs(x = var, y = "Frecuencia") +
theme_minimal()
plots[[var]] <- p_hist
}
# Mostrar los histogramas en una cuadrícula
grid.arrange(
grobs = plots, # Los histogramas
ncol = 3, # Número de columnas
nrow = 2 # Número de filas
)
Variable A2. El rango intercuartílico (IQR) es relativamente estrecho [22.60, 38,23], pero el rango completo de los datos va de 13.75 (mínimo) a 80.25 (máximo), lo cual sugiere que los datos tienen una dispersión más concentrada en el rango central, pero con valores extremos que indican una distribución asimétrica. Esto último se ve claramente en el histograma de A2. En él, se muestra una distribución sesgada a la derecha, con la mayoría de los valores concentrados en los primeros intervalos a la izquierda y una disminución progresiva hacia la derecha. Esta distribución indica que los valores bajos son más frecuentes, mientras que los valores altos son menos comunes. Por tanto, la mediana es en este caso una medida de tendencia central más representativa que la media, ya que los valores atípicos desplazan la media hacia los extremos (aunque sus valores respectivos son cercanos). Hay 12 valores para los que no se tiene información, tal y como podemos ver en el primer sumario.Variable A3. El rango intercuartílico (IQR) es relativamente pequeño [1.000, 7.2075], lo cual sugiere una dispersión moderada, pero también que la mayoría de los valores se ubican en un rango bajo (entre 1 y 7 aproximadamente). El rango completo va de un mínimo de 0.000 a un máximo de 28.00, con el máximo notablemente alejado de los valores más comunes. De nuevo, la distribución está sesgada a la derecha, lo cual implica que la mediana puede ser más representativa que la media, debido a los valores extremos.Variable A8. El rango intercuartílico (IQR) es relativamente estrecho [0.1650, 2.6250], lo cual indica que el 50% central de los datos se encuentra en este rango. Aún así, la diferencia entre el mínimo (0) y el máximo (28.500) es amplia, por lo que podemos existe una alta dispersión en los datos, especialmente en los valores más altos, que son menos frecuentes. Esto implica una media poco representativa de los valores centrales, puesto que los valores atípicos de los extremos tirarán de ella. Podemos inferir también que la distribución es altamente asimétrica y sesgada hacia la derecha, con una gran concentración de valores en los primeros intervalos y una frecuencia que disminuye rápidamente a medida que avanzamos hacia la derecha.Variable A11. El rango intercuartílico (IQR) es [0, 3], lo cual sugiere una dispersión muy concentrada en el rango central, pero con valores atípicos muy elevados (min: 0, máx: 67) que generan una distribución asimétrica y sesgada a la derecha. La mediana sería más representativa como medida de tendencia central, debido a que la media se vería afectada por los valores extremos.Variable A14. El rango intercuartílico (IQR) es [75, 276], lo cual muestra una dispersión moderada en el rango central, pero con valores extremos a la derecha que afectan la dispersión general, ya que el valor máximo (2000) se encuentra muy alejado de Q3. Todo esto lleva a una distribución sesgada hacia la derecha. Su media y mediana tiene valores “parecidos” con una diferencia de 20 puntos. Tiene 13 valores desconocidos.Variable A15. El rango intercuartílico (IQR) es [0, 395.5]. Es, sin duda, la que presenta mayor sesgo hacia la derecha, debido a la diferencia abismal que existe entre Q3 y el valor máximo, que es 100000. La diferencia tan amplia entre el IQR y el rango completo es un indicio de que hay outliers en los datos. En este caso, los datos siguen una distribución sesgada a la derecha y la variable que nos dará más información será la mediana.
A continuación, veremos si las variables siguen una distribución normal:
# Inicializamos una lista para almacenar los gráficos
qq_plot_list <- list()
# Ploteamos los gráficos Q-Q
for (var in numeric_vars) {
# Filtramos datos para eliminar valores NA solo en el contexto del gráfico y evitar posibles warnings
filtered_data <- credit %>% filter(!is.na(.data[[var]]))
# Gráfico Q-Q
p_qq <- ggplot(filtered_data, aes(sample = .data[[var]])) +
stat_qq(distribution = qnorm, dparams = list(mean = mean(filtered_data[[var]]), sd = sd(filtered_data[[var]]))) +
stat_qq_line(distribution = qnorm, dparams = list(mean = mean(filtered_data[[var]]), sd = sd(filtered_data[[var]])), color = "red") +
ggtitle(paste("QQ-Plot Normal ", var)) +
theme_minimal() +
labs(x = "Cuantiles teóricos", y = var)
# Agregamos el gráfico a la lista
qq_plot_list[[var]] <- p_qq
}
# Combinamos todos los gráficos Q-Q en una sola ventana para mayor claridad
do.call(grid.arrange, c(qq_plot_list, nrow = 2))
Variable A2. Muestra una desviación leve en los extremos, lo cual sugiere que podría tener una distribución normal con colas moderadamente más pesadas (como una normal contaminada o con ligeras asimetrías). Podemos corroborarlo en su histograma, donde su forma recuerda a una campana de Gauss, y en la diferencia entre la media y mediana, que es pequeña.Variables A3, A8, A11, A14 y A15. Presentan una desviación mucho mayor en los extremos, especialmente en la parte superior. Esto indica colas más gruesas y una fuerte asimetría, por lo que estas variables no siguen una distribución normal. Podemos contrastarlo en sus histogramas, donde la forma que toman se aleja mucho de una campana de Gauss. En cambio, es muy probable que sus distribuciones sean una gamma, una log-normal o una exponencial. Para comprobarlo, vamos a generar los siguientes qq-plot, donde vamos a comparar la distribución de las variables con una distribución gamma y exponencial.
En resumen, la variable A2 está más cerca de la normalidad que el resto de variables numéricas, las cuales tienen distribuciones con colas largas o asimétricas que se alejan de una normal.
2.1.1.2 Análisis monovariable de A11 y A15
En base al análisis inicial, consideramos oportuno realizar un análisis monovariable más exhaustivo para las variables A11 y A15. Las principales razones que nos han llevado a elegir estas variables y no otras son las siguientes:
Variable A11. Esta variable presenta un IQR estrecho [0, 3] que contrasta con el valor máximo (67), por ser significativamente más alto. Esto indica la presencia de outliers. Por tanto, la mezcla de concentración en valores bajos y outliers en la parte superior podría ser interesante para para explorar cómo los valores extremos distorsionan la distribución y afectan a las medidas de tendencia central.Otras variables parecidas que también hemos considerado que podrían ser interesantes han sido A8 y A14. La primera presenta un IQR muy estrecho y la segunda un valor máximo alto en relación a Q3. No obstante, A8 tiene un valor máximo mucho menor que A11, y A14, por su parte, tiene un IQR más amplio que A11, por lo que sus valores están menos concentrados en el rango bajo, y su perfil de concentración no es tan extremo. Por tanto, acabamos descartándolas, puesto que ninguna de ellas presenta un nivel de sesgo ni una concentración en valores bajos tan clara como A11. Además, sendas variables muestran una diferencia menor entre la media y la mediana, por lo que sus outliers no tienen un impacto tan grande en la tendencia central.
Variable A15. La diferencia tan amplia entre el IQR y el rango completo mencionado durante el análisis de esta variable, además del sesgo extremo a la derecha con valores que se alejan significativamente de la línea de la normalidad en el gráfico Q-Q, es la razón que nos ha llevado a elegirla como una candidata interesante para un análisis más exhaustivo. Además, dado que hemos elegido también A11, el análisis de A15 nos permitiría complementar el entendimiento de cómo se distribuyen las variables que presentan extremos de forma similar.
A continuación, mostraremos una versión del histograma de A11 y A15 más enriquecida. En él, vamos a añadir marcas en el eje X para visualizar mejor la dispersión de los datos. Además, agregaremos un poco de ruido aleatorio para que aparezcan como una línea más gruesa los valores repetidos, de manera que podamos ver mejor la densidad de los datos en torno a cada valor.
# Variables elegidas para el análisis monovariable
selected_vars <- c("A11", "A15")
# Generamos los histogramas enriquecidos para A11 y A15
for (var in selected_vars) {
# Filtramos los datos para eliminar los valores NA y no finitos
filtered_data <- credit %>% filter(!is.na(.data[[var]]) & is.finite(.data[[var]]))
# Creamos el histograma enriquecido con rug, jitter y una línea en el contorno superior
p_hist <- ggplot(filtered_data, aes(x = .data[[var]])) +
geom_histogram(bins = 30, fill = "lightblue", color = "black") +
geom_rug() +
geom_jitter(aes(y = 0), width = 0.1, height = 0, alpha = 0.2, color = "darkred") + # Agregamos una línea en el contorno superior
stat_bin(bins = 30, geom = "line", color = "purple", size = 0.75) +
ggtitle(paste("Histograma de", var)) +
labs(x = var, y = "Frecuencia") +
theme_minimal()
# Imprimimos los histogramas enriquecidos
print(p_hist)
}## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Variable A11. Destaca la facilidad con la que podemos observar la alta densidad de datos en torno a los valores más bajos, con una drástica caída en la frecuencia a medida que los valores del eje X aumentan. Este descenso tan pronunciado se vuelve más evidente gracias a la línea lila que sigue el contorno de las barras del histograma. Las marcas en el rug aparecen espaciadas en el eje X, por lo que, en lugar de valores distribuidos continuamente a lo largo de un rango, los puntos parecen alinearse en valores enteros específicos, lo cual podría ser un indicio de que A11 está redondeada o registra eventos discretos.Por tanto, dado el rango de valores que presenta la variable (mínimo 0 y máximo 67), la forma de esos valores (no continuos), la frecuencia de los outliers (únicamente dos puntos en el histograma para valores mayores iguales a 40), el IQR [0-3] y el contexto del dataset (concesión de créditos bancarios), podríamos pensar que la variable A11 puede estar representando el número de años que lleva trabajando el solicitante en la empresa actual.
Aprovechando que los valores de A11 están redondeados, vamos a dividir A11 en cuatro categorías que representen rangos en años que lleva trabajando el solicitante en la empresa actual, y a calcular la tasa de aprobación para cada uno de ellos. De esta forma, podríamos ver si nuestra hipótesis se sostiene, ya que, a mayor estabilidad laboral, mayor debería ser la tasa de aprobación.
# Dividir A11 en rangos
creditP <- credit %>%
mutate(A11_rango = case_when(
A11 < 2 ~ "< 2 años",
A11 >= 2 & A11 < 5 ~ "2-5 años",
A11 >= 5 & A11 < 10 ~ "5-10 años",
A11 >= 10 ~ "10+ años"
))
# Convertir A11_rango a factor y especificar el orden de los niveles
creditP$A11_rango <- factor(creditP$A11_rango, levels = c("< 2 años", "2-5 años", "5-10 años", "10+ años"))
# Calcular la tasa de aprobación por rango de A11
tasas_aprobacion <- creditP %>%
group_by(A11_rango) %>%
summarise(
total_solicitudes = n(),
aprobados = sum(Class == "+"),
tasa_aprobacion = aprobados / total_solicitudes * 100
)
# Mostrar los resultados
print(tasas_aprobacion)## # A tibble: 4 × 4
## A11_rango total_solicitudes aprobados tasa_aprobacion
## <fct> <int> <int> <dbl>
## 1 < 2 años 466 133 28.5
## 2 2-5 años 88 51 58.0
## 3 5-10 años 77 71 92.2
## 4 10+ años 59 52 88.1# Crear el gráfico con el orden especificado
ggplot(tasas_aprobacion, aes(x = A11_rango, y = tasa_aprobacion)) +
geom_bar(stat = "identity", fill = "lightblue") +
labs(
title = "Tasa de aprobación por rango de años en el empleo",
x = "Rango de años en el empleo (A11)",
y = "Tasa de aprobación (%)"
) +
theme_minimal()
A bote pronto, si observamos el gráfico, podríamos decir que hay indicios que respaldan nuestra hipótesis: a medida que aumenta el número de años trabajados, mayor es la tasa de aprobación. Además, el número de solicitudes sigue una tendencia opuesta, lo cual tiene sentido, puesto que la mayoría de las personas no permanecen tantos años en una misma empresa, y quienes sí lo hacen suelen ser personas con un rango de edad mayor que, por lo general, presentan una menor inclinación a la solicitud de créditos. Por tanto, A11 puede ser una variable útil y valiosa para nuestro modelo. Además, si utilizamos modelos como la regresión logística ordinal, Random Forest o modelos bayesianos para datos ordinales, podríamos capturar mejor las relaciones entre los niveles ordenados de A11, obteniendo un análisis y predicciones más precisas.
Variable A15. El aspecto del histograma es muy similar al de A11. Existe una alta densidad de datos en torno a los valores más bajos, con una drástica caída en la frecuencia a medida que los valores del eje X aumentan. Los valores 50000 y 100000 sobresalen por estar muy alejados del resto, actuando como outliers extremos que son poco representativos del patrón general. Al ser valores tan extremadamente altos y dispersos, pueden provocarnos problemas en el modelado, por lo que es probable que más adelante sea necesario considerar alguna estrategia para tratarlos. Sin embargo, también pueden darnos información útil sobre el significado de esta variable, ya que valores tan altos se relacionan normalmente con el dinero y, quizá, estén ahí por una razón. Por lo que es necesario analizar estos valores extremos e intentar entendee qué significan y por qué están ahí, de manera que podamos decir qué hacer con ellos.
Hasta ahora solo hemos mencionado que ambas variables presentan outliers, pero no nos hemos detenido a analizar cuáles son esos posibles valores atípicos. Con el histograma y haciendo uso de jitter, comentamos la frecuencia de los valores en intervalos específicos. Y con en el gráfico Q-Q, mostramos la relación de los datos con una distribución teórica, tratando de averiguar si se ajusta o no a una normal. Por tanto, creemos conveniente que el último paso de nuestro análisis monovariable sea un diagrama de caja, ya que este gráfico nos va a ayudar visualmente a localizar la tendencia central (representada por la mediana, que es la línea dentro de la caja) y la variabilidad de los datos alrededor de ella. Además, el boxplot resalta de manera explícita los outliers (serán los valores fuera de los bigotes), lo que nos va a permitir identificar qué datos se alejan significativamente del rango intercuartílico (representado por la caja) y qué datos se concentran en el rango central.
Para ello, vamos a generar dos tipos de diagramas de caja. Por un lado, crearemos un diagrama Box-Whisker combinado con jitter para visualizar más fácilmente la distribución de los datos, ya que ambas variables presentan distribuciones asimétricas y no usarlo podría dar lugar a una interpretación engañosa e incompleta. Y, por otro lado, generaremos otro diagrama de caja, pero en esta ocasión mostraremos únicamente los outliers. Esto nos permitirá visualizar únicamente los valores extremos, destacando aquellos que se alejen significativamente del rango intercuartílico.
# Filtrar datos y eliminar valores NA solo en el contexto del gráfico
filtered_data_A11 <- credit %>% filter(!is.na(A11) & is.finite(A11))
filtered_data_A15 <- credit %>% filter(!is.na(A15) & is.finite(A15))
# Calcular límites de los bigotes (IQR) para A11 y A15
q1_A11 <- quantile(credit$A11, 0.25, na.rm = TRUE)
q3_A11 <- quantile(credit$A11, 0.75, na.rm = TRUE)
iqr_A11 <- IQR(credit$A11, na.rm = TRUE)
lower_A11 <- q1_A11 - 1.5 * iqr_A11
upper_A11 <- q3_A11 + 1.5 * iqr_A11
q1_A15 <- quantile(credit$A15, 0.25, na.rm = TRUE)
q3_A15 <- quantile(credit$A15, 0.75, na.rm = TRUE)
iqr_A15 <- IQR(credit$A15, na.rm = TRUE)
lower_A15 <- q1_A15 - 1.5 * iqr_A15
upper_A15 <- q3_A15 + 1.5 * iqr_A15
# Filtrado temporal para eliminar NA en A11 y A15
credit_temp <- credit %>% filter(!is.na(A11) & !is.na(A15))
# Filtrar outliers para A11 y A15
outliers_A11 <- credit_temp %>% filter(A11 < lower_A11 | A11 > upper_A11)
outliers_A15 <- credit_temp %>% filter(A15 < lower_A15 | A15 > upper_A15)
# Filtrar datos en el rango para A15 para mejor visualización
filtered_credit_A15 <- credit_temp %>% filter(A15 <= 20000)
filtered_outliers_A15 <- outliers_A15 %>% filter(A15 <= 20000)
# Generar boxplot y jitter para A11
p_A11 <- ggplot(filtered_data_A11, aes(x = "", y = A11, fill = "A11", color = "A11")) +
geom_boxplot(alpha = 0.6) +
geom_jitter(color = "black", width = 0.15) +
scale_fill_discrete(name = "Variable") +
scale_color_discrete(name = "Variable") +
ylab("Valores de A11") +
xlab("Variable A11") +
theme_minimal() +
ggtitle("Boxplot para A11") +
coord_cartesian(ylim = c(0, max(filtered_data_A11$A11, na.rm = TRUE)))
# Generar boxplot para los outliers de A11
p_outliers_A11 <- ggplot(outliers_A11, aes(x = factor("A11"), y = A11)) +
geom_boxplot(data = credit_temp, aes(x = factor("A11"), y = A11), alpha = 0.6, fill = "lightblue", color = "darkblue") +
geom_jitter(color = "red", width = 0.1) +
ylab("Valores de A11") +
xlab("Variable A11") +
theme_minimal() +
ggtitle("Outliers para A11")
# Generar boxplot y jitter para A15
p_A15 <- ggplot(filtered_data_A15, aes(x = "", y = A15, fill = "A15", color = "A15")) +
geom_boxplot(alpha = 0.6) +
geom_jitter(color = "black", width = 0.15) +
scale_fill_discrete(name = "Variable") +
scale_color_discrete(name = "Variable") +
ylab("Valores de A15") +
xlab("Variable A15") +
theme_minimal() +
ggtitle("Boxplot para A15") +
coord_cartesian(ylim = c(0, max(filtered_data_A15$A15, na.rm = TRUE)))
# Generar boxplot para los outliers de A15 con un límite en el eje Y para mayor claridad
p_outliers_A15 <- ggplot(filtered_outliers_A15, aes(x = factor("A15"), y = A15)) +
geom_boxplot(data = filtered_credit_A15, aes(x = factor("A15"), y = A15), alpha = 0.6, fill = "lightblue", color = "darkblue") +
geom_jitter(color = "red", width = 0.1) +
scale_y_continuous(limits = c(0, 20000)) + # Límite del eje Y
ylab("Valores de A15") +
xlab("Variable A15") +
theme_minimal() +
ggtitle("Outliers para A15 (Valores <= 20,000)")
# Organizar gráficos en filas de dos columnas
print(p_A11)
Analizaremos simultáneamente ambos tipos de diagrama de caja para sendas variables:
Variable A11. Los outliers (por encima de 20 y hasta 67) tienen una proporción mucho menor en relación con el total de los datos. Su presencia puede afectar considerablemente a la media y generar un sesgo en los modelos que asumen normalidad o poca varianza. Por tanto, podría ser más útil en modelos como Árboles de decisión, Random Forest o modelos probabilísitcos, tal y como mencionamos antes. Esto se debe a que este tipo de modelos no necesitan que la relación entre A11 y la clase objetivo sea lineal, son capaces de capturar interacciones entre A11 y otras variables, y manejan los valores discretizados mejor que un modelo lineal. Sin embargo, también pueden introducir ruido si no existe una alta correlación con la clase objetivo. Por esta razón, es importante considerar distintos tratamientos para los outliers dependiendo del modelo que se vaya a utilizar.Variable A15. En este caso, a medida que los valores se alejan del IQR, parecen dispersarse más, sin seguir una tendencia específica. Esto sugiere que los outliers no son ruido uniforme, sino que podría reflejar subgrupos de la población, como solicitantes con diferentes propósitos o niveles de solvencia financiera.De cara al tratamiento de outliers de esta variable, tenemos varias opciones interesantes. Por un lado, podríamos aplicar a la variable una transformación logarítmica o raíz cuadrada para reducir el impacto de los valores extremos y mejorar la normalidad. Por otro lado, podríamos dividir los valores en grupos, lo que permitiría realizar un análisis más robusto y evitar el sesgo causado por los outliers. Además, también podríamos realizar un análisis específico de los outliers, ya que podrían contener información valiosa de las características específicas de esos solicitantes.
Es importante destacar también que los valores extremos podrían afectar negativamente al ajuste de modelos lineales al sesgar los coeficientes. Por ello, modelos no lineales como los árboles de decisión o modelos basados en distancias podrían manejar mejor la relación no lineal de A15 con el resto de las variables.
Con el propósito de realizar un análisis detallado del comportamiento de A15, hemos decidido segmentarla en deciles para observar mejor la distribución de la clase objetivo en diferentes rangos de valores. Este enfoque resulta especialmente valioso, dado que A15 es una variable con alta dispersión y un notable sesgo. La segmentación en deciles facilita identificar diferencias significativas entre los rangos, permitiendo determinar cuáles tienen mayor relevancia en la predicción de la clase objetivo. Al analizar estos segmentos, es posible identificar patrones consistentes o comportamientos atípicos en las tasas de aprobación y rechazo.
Este análisis también proporciona una base sólida para evaluar si los outliers tienen un impacto significativo en la variable, como venimos sospechando en análisis previos. Al observar cómo se comporta la clases objetivo en cada decil, es posible confirmar o descartar la influencia de estos valores extremos, guiando las decisiones sobre su tratamiento y asegurando un enfoque más robusto.
# Filtramos los valores que están fuera del rango intercuartílico (outliers) credit_temp1 <- credit # Cálculo del IQR de A15 q1_A15 <- quantile(credit_temp1$A15, 0.25, na.rm = TRUE) q3_A15 <- quantile(credit_temp1$A15, 0.75, na.rm = TRUE) iqr_A15 <- IQR(credit_temp1$A15, na.rm = TRUE) # Identificar outliers lower_limit_A15 <- q1_A15 - 1.5 * iqr_A15 upper_limit_A15 <- q3_A15 + 1.5 * iqr_A15 outliers_A15 <- credit_temp1 %>% filter(A15 > upper_limit_A15) # Crear la columna A15_deciles credit_temp1 <- credit_temp1 %>% mutate(A15_deciles = ntile(A15, 10)) # Calcular tabla de frecuencias por deciles y clase objetivo subgroup_analysis_class <- credit_temp1 %>% group_by(A15_deciles) %>% mutate(total = n()) %>% # Total de observaciones por decil ungroup() %>% group_by(A15_deciles, Class) %>% summarise( n = n(), # Conteo de observaciones por clase y decil total = first(total), # Total de observaciones por decil tasa = n / total * 100 # Proporción de cada clase dentro del decil ) %>% ungroup()## `summarise()` has grouped output by 'A15_deciles'. You can override using the ## `.groups` argument.# Crear el gráfico con porcentajes ggplot(subgroup_analysis_class, aes(x = factor(A15_deciles), y = tasa, fill = factor(Class))) + geom_bar(stat = "identity", position = "stack") + labs( title = "Distribución porcentual de la clase objetivo por deciles de A15", x = "Deciles de A15", y = "Porcentaje (%)", fill = "Clase" ) + theme_minimal()
Hay una variación significativa en la proporción de “+” y “-” a lo largo de los deciles. En general, los primeros deciles están dominados por la clase “-” (a excepción del primer y segundo decil), y en los deciles superiores (8-10) la proporción de “+” aumenta considerablemente.
Podemos observar ciertos patrones interesantes en el gráfico. El decil 3 presenta una proporción anómala, casi exclusivamente la clase “-”, lo que podría indicar una subpoblación con características específicas en este rango. En los deciles superiores (8-10), el predominio de “+” sugiere que los valores altos de A15 están fuertemente asociados con la aprobación, posiblemente están relacionados con mayores capacidades financieras o ingresos.
Dada la alta concentración de la clase “+” en los valores extremos de A15, podríamos concluir que los outliers no son ruido aleatorio, sino que representan un subgrupo importante que tienen alta probabilidad de aprobación. Por otro lado, los valores bajos parecen estar más relacionados con la clase “-” (a excepción del primer y segundo decil). Además, la irregularidad de la distribución porcentual de la clase objetivo por deciles podría indicar que A15 tiene una influencia relevante en la clase objetivo, aunque limitada a ciertos rangos.
2.1.2 Análisis de los predictores categóricos
2.1.2.1 Análisis exploratorio inicial
Antes de nada, convertimos los valores categóricos a factores:
# Lista de variables categóricas
categorical_vars <- c("A1", "A4", "A5", "A6", "A7", "A9", "A10", "A12", "A13", "Class")
# Convertir las variables categóricas en factores
credit <- credit %>%
mutate(across(all_of(categorical_vars), as.factor))
credit.Datos.Train <- credit.Datos.Train %>%
mutate(across(all_of(categorical_vars), as.factor))
credit.Datos.Test <- credit.Datos.Test %>%
mutate(across(all_of(categorical_vars), as.factor))
summary(credit)## A1 A2 A3 A4 A5
## a :210 Min. :13.75 Min. : 0.000 l : 2 g :519
## b :468 1st Qu.:22.60 1st Qu.: 1.000 u :519 gg : 2
## NA's: 12 Median :28.46 Median : 2.750 y :163 p :163
## Mean :31.57 Mean : 4.759 NA's: 6 NA's: 6
## 3rd Qu.:38.23 3rd Qu.: 7.207
## Max. :80.25 Max. :28.000
## NA's :12
## A6 A7 A8 A9 A10 A11
## c :137 v :399 Min. : 0.000 f:329 f:395 Min. : 0.0
## q : 78 h :138 1st Qu.: 0.165 t:361 t:295 1st Qu.: 0.0
## w : 64 bb : 59 Median : 1.000 Median : 0.0
## i : 59 ff : 57 Mean : 2.223 Mean : 2.4
## aa : 54 j : 8 3rd Qu.: 2.625 3rd Qu.: 3.0
## (Other):289 (Other): 20 Max. :28.500 Max. :67.0
## NA's : 9 NA's : 9
## A12 A13 A14 A15 Class
## f:374 g:625 Min. : 0 Min. : 0.0 -:383
## t:316 p: 8 1st Qu.: 75 1st Qu.: 0.0 +:307
## s: 57 Median : 160 Median : 5.0
## Mean : 184 Mean : 1017.4
## 3rd Qu.: 276 3rd Qu.: 395.5
## Max. :2000 Max. :100000.0
## NA's :13Primero vamos a ver como se distribuyen los datos en cada variable. En concreto, nos centraremos en el número de ocurrencias que hay de cada valor y en sus porcentajes dentro de la variable. Además, mostraremos un diagrama para cada variable categórica.
# Definir las variables categóricas
categorical_vars <- c("A1", "A4", "A5", "A6", "A7", "A9", "A10", "A12", "A13")
# Lista para almacenar gráficos de barras
bar_plot_list <- list()
# Generar tablas y gráficos de barras para cada variable categórica
for (var in categorical_vars) {
# Calcular la distribución de frecuencias
freq_table <- table(credit[[var]])
porcent <- prop.table(freq_table) * 100
# Mostrar la tabla de frecuencias en la consola
print(paste("Distribución de la variable", var))
print(cbind(total = freq_table, porcentaje = porcent))
# Crear un gráfico de barras para visualizar la distribución
plot <- ggplot(data = as.data.frame(freq_table), aes(x = Var1, y = Freq)) +
geom_bar(stat = "identity", fill = "steelblue") +
labs(title = paste("Distribución de", var), x = var, y = "Frecuencia") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# Agregar el gráfico a la lista
bar_plot_list[[var]] <- plot
}## [1] "Distribución de la variable A1"
## total porcentaje
## a 210 30.97345
## b 468 69.02655
## [1] "Distribución de la variable A4"
## total porcentaje
## l 2 0.2923977
## u 519 75.8771930
## y 163 23.8304094
## [1] "Distribución de la variable A5"
## total porcentaje
## g 519 75.8771930
## gg 2 0.2923977
## p 163 23.8304094
## [1] "Distribución de la variable A6"
## total porcentaje
## aa 54 7.9295154
## c 137 20.1174743
## cc 41 6.0205580
## d 30 4.4052863
## e 25 3.6710720
## ff 53 7.7826725
## i 59 8.6637298
## j 10 1.4684288
## k 51 7.4889868
## m 38 5.5800294
## q 78 11.4537445
## r 3 0.4405286
## w 64 9.3979442
## x 38 5.5800294
## [1] "Distribución de la variable A7"
## total porcentaje
## bb 59 8.6637298
## dd 6 0.8810573
## ff 57 8.3700441
## h 138 20.2643172
## j 8 1.1747430
## n 4 0.5873715
## o 2 0.2936858
## v 399 58.5903084
## z 8 1.1747430
## [1] "Distribución de la variable A9"
## total porcentaje
## f 329 47.68116
## t 361 52.31884
## [1] "Distribución de la variable A10"
## total porcentaje
## f 395 57.24638
## t 295 42.75362
## [1] "Distribución de la variable A12"
## total porcentaje
## f 374 54.2029
## t 316 45.7971
## [1] "Distribución de la variable A13"
## total porcentaje
## g 625 90.57971
## p 8 1.15942
## s 57 8.26087
Observando los datos y los gráficos anteriores, podemos decir lo siguiente:
Variable A1. La distribución está fuertemente inclinada hacia b con un 69.0265%, por lo que existe una clara desproporción entre ambas categorías.Variable A4. Con un 75.88%, u destaca sobre el resto de categorías. Además, hay una representación muy baja de l (0.29%), por lo que podríamos considerar aplicarle algún tipo de tratamiento.Variable A5. Es idéntica a A4, ya que los porcentajes para cada categoría son exactamente iguales. En este caso, la categoría dominante sería g y la categoría más irrelevante a priori sería gg.Variable A6. Esta variable es la que presenta una distribución más diversa y un mayor número de categorías. Aunque c (20.11%) y q (11.45%) sobresalen del resto, hay otras categorías que también tienen cierta presencia. Aún así, r (0.44%)y j (1.47%)parecen casi irrelevantes.Variable A7. Es la variable con más categorías por detrás de A6 y muestra una distribución más dispar que esta última. La categoría v destaca sobre el resto con un 58.59%. Estas otras categorías aparecen menos, aunque h (20.26%) también parece sobresalir frente a la poca presencia del resto.Variable A9. La distribución es bastante equilibrada, por lo que es muy probable que no haga falta ningún ajuste adicional.Variable A10. Aunque f (57.24%) es aquí algo más frecuente que en A9 (52.31%), esta variable también está bien proporcionada. Por ello, igual que antes, es muy probable que no haya que aplicarle ningún tratamiento adicional.Variable A12. Muy similar a A9 y A10, pero en este caso f aparace un 54.20% de las veces.Variable A13. La categoría g (90.58%) es casi exclusiva, frente a una s (8.26%) poco relevante y una p (1.16%) prácticamente inexistente. En un escenario como este, podría ser útil aplicar algún tratamiento para agrupar o descartar categorías.
2.1.2.2 Análisis monovariable de A7
Basándonos en el análisis exploratorio inicial, hemos considerado realizar un análisis monovariable más exhaustivo para la variable A7. Las razones que nos han llevado a elegirla sobre el resto de variables han sido las siguientes:
Las
variables A1, A9, A10 y A12tienen una buena distribución de frecuencias. Esto las convierte en variables potencialmente útiles de cara al modelo final sin necesidad de ajustes adicionales. Por tanto, sabiendo que por el momento no vamos a tratarlas, las descartamos.Las
variables A4, A5 y A13muestran desbalances significativos muy similares. Sin embargo, todas ellas mantienen al menos dos categorías con una frecuencia razonable. Así, cualquiera de ellas podría ser candidata para un análisis más detallado, dado que todas podrían necesitar alguna simplificación en sus categorías menos frecuentes. No obstante, hay otras variables aún más problemáticas que estasLas
variables A6 y A7son las más problemáticas, ya que ambas presentan una gran cantidad de categorías con frecuencias muy dispares. Por tanto, es muy probable haya que aplicar algún tipo de transformación previa a sendas variables, reagrupando o eliminando categorías poco frecuentes. No obstante, dado que se observa un desequilibrio mayor en A7, hemos decidido analizarla de manera más exhaustiva.
Para dar una visión más general de la proporción de cada categoría en relación al total, hemos considerado oportuno incluir un gráfico circular.
library(RColorBrewer)
# Filtrar los datos para eliminar los NA en la columna A7
credit_filtered <- credit %>% filter(!is.na(A7))
# Crear el gráfico de pastel con colores personalizados
ggplot(credit_filtered, aes(x = "", fill = factor(A7))) +
geom_bar(width = 1) +
coord_polar(theta = "y") +
labs(title = "Distribución de A7", fill = "A7") +
theme_void() +
scale_fill_brewer(palette = "Set3")
Como ya dijimos en el análisis inicial, la categoría v destaca sobre el resto con un 58.59%. El resto de categorías, exceptuando h (20.26%), ff (8.37%) y bb (8.66%), tienen frecuencias muy baja, no alcanza ninguna el 2%. Esto indica que son poco representativas y, posiblemente, ruidosas. Por lo tanto, podríamos considerar los valores de esas categorías (dd, j, n, o y z) como outliers y buscar la mejor estrategia para tratarlos.
Una opción viable sería agrupar las categorías menos frecuentes en una nueva categoría, lo que ayudaría a reducir la dimensionalidad de la variable sin perder completamente la información que aportan. Además, si el análisis de la relación con la variable de clase muestra una correlación baja o nula, podría considerarse incluso la eliminación de alguna categoría. Finalmente, cabe destacar que la presencia de una categoría dominante implica que el modelo podría sobreajustarse a ella si no se realiza alguna modificación. Para evitar que esta variable introduzca sesgo, se podrían agrupar categorías que tengan una distribución por clase similar, reduciendo así las diferencias existentes y evitando el sobreajuste.
2.1.3 Distribución por clase de los predictores
Con el fin de entender cómo se distribuyen las variables predictoras en función de la variable de clase, es necesario realizar un análisis de la distribución de sus valores en función de la clase (variable A16). Este análisis es clave para detectar patrones y relaciones potenciales entre los predictores y la variable de clase, lo cual puede ser útil para comprender cómo influyen las diferentes variables en la clasificación. Para ello, mostraremos una serie de gráficos y los comentaremos.
Por último, destacar que en este apartado usaremos el conjunto de entrenamiento para evitar introducir información del conjunto de test en el análisis, pudiendo generar un sesgo y comprometer la evaluación futura del modelo.
2.1.3.1 Predictores categóricos
En el caso de los predictores categóricos, vamos a mostrar dos diagramas de barras para cada uno de ellos. El primero relaciona la variable con la categoría “-” de la clase y está asociado al color rojo, mientras que el segundo lo relaciona con la categoría “+” de la clase y está ligado al color turquesa. Para complementar las conclusiones visuales obtenidas a partir de estos gráficos, realizaremos un análisis estadístico mediante pruebas como Chi-cuadrado, Fisher exacto y Monte Carlo, con el objetivo de determinar si existe una asociación significativa entre los predictores categóricos y la variable de clase.
# Gráfico de barras para las variables categóricas
categorical_vars <- c("A1", "A4", "A5", "A6", "A7", "A9", "A10", "A12", "A13")
for (var in categorical_vars) {
p <- ggplot(credit.Datos.Train, aes(x = .data[[var]], fill = Class)) +
geom_bar(position = "dodge") +
facet_wrap(~ Class) +
labs(title = paste("Distribución de", var, "por Clase"), x = var, y = "Frecuencia") +
theme_minimal() +
theme(legend.position = "bottom") +
scale_fill_manual(values = c("red2", "turquoise3"))
print(p)
}
[A1, A4, A5, A12 y A13]. Este conjunto de variables presenta un mismo patrón. Las dos categorías más frecuentes hacen que la variable de clase tome el valor “-” un mayor número de veces. Pese a esa tendencia, la frecuencia de “-” no es muy diferente a la de “+”. Es decir, independientemente del valor que tomen estas variables, el resultado para la variable de clase está muy equilibrado. Por tanto, podemos suponer que ninguna de estas variables supone un gran impacto en el resultado de la variable de clase de manera individual.[A6]. En esta variable destacan únicamente las categorías i, ff y k por afectar significativamente a la variable de clase, provocando que casi siempre tome el valor “-”, así como las categorías q y x por lo contrario, por hacer que la variable de clase tome la gran mayoría de las veces el valor “+”. El resto de categorías de la variable está muy equilibrada, puesto que no parece afectar al resultado de la clase. Esto puede significar que la variable A6 influye de alguna manera en el resultado de la variable de clase, por lo que puede tener cierta utilidad individualmente de cara al modelo final. Además, dado que hay ciertas categorías que no afectan al resultado de la clase, podríamos considerar agruparlas.[A7]. En este caso, la categoría más común para esta variable afecta a la clase, provocando que la mayoría de las veces tome el valor “-”. Ocurre lo mismo para la categoría ff. Sin embargo, la categoría h tiende a hacer que la clase resulte en “+”. El resto de categorías están muy equilibradas respecto al resultado de la clase. Al igual que A6, esta variable podría ser útil de alguna forma para el modelo final. No obstante, podríamos aprovechar las categorías similares y sin efecto alguno en la clase para agruparlas o eliminarlas.[A9 y A10]. Ambas variables tienen un efecto importante en el resultado de la clase, ya que presentan un desbalance de clase muy pronunciado. Siguen una tendencia clara: el valor f en esta variable supone en la inmensa mayoría de los casos que la clase sea “-”, mientras que t consigue el efecto contrario, que la gran mayoría de veces la clase sea “+”. Si bien es cierto que este patrón está presente en ambas variables, es mucho más pronunciado en A9. Esta disparidad tan evidente pone de manifiesto la utilidad de estas variables para el modelado. Sin embargo, debemos tener cuidado, especialmente con A9, puesto que el efecto de esta variable puede opacar al resto, dificultando la interpretación de la incidencia de otros predictores en el modelo.
Continuamos nuestro análisis, pero ahora comprobaremos si existe una asociación significativa entre las variables categóricas y la variable de clase, utilizando para ello pruebas estadísticas como Chi-cuadrado, Fisher exacto y Monte Carlo.
El test de Chi-cuadrado se aplica cuando las frecuencias esperadas en las tablas de contingencia son suficientemente altas (mayores o iguales a 5), mientras que la prueba exacta de Fisher se usa en tablas pequeñas o con frecuencias bajas, ya que proporciona resultados más precisos. En casos donde Fisher no es viable, recurrimos a la simulación Monte Carlo, que estima p-valores confiables mediante permutaciones.
El objetivo es identificar qué variables categóricas tienen un impacto significativo en la clasificación de créditos, medir la fuerza de esa relación (con el coeficiente de Cramer, en caso de Chi-cuadrado) y priorizar las variables más relevantes para construir un modelo predictivo robusto. Este enfoque asegura un análisis estadísticamente válido que nos va a evitar introducir sesgos.
categorical_vars <- c("A1", "A4", "A5", "A6", "A7", "A9", "A10", "A12", "A13")
for (var in categorical_vars) {
print(paste("Variable:", var))
# Crear tabla de contingencia
contingency_table <- table(credit.Datos.Train[[var]], credit.Datos.Train$Class)
# Calcular frecuencias esperadas manualmente
row_totals <- rowSums(contingency_table)
col_totals <- colSums(contingency_table)
total <- sum(contingency_table)
expected_frequencies <- outer(row_totals, col_totals) / total
# Verificar si alguna frecuencia esperada es menor a 5
low_expected <- any(expected_frequencies < 5)
if (low_expected) {
print("Advertencia: Frecuencias bajas. Usando prueba exacta de Fisher o simulación.")
# Intentar Fisher con mayor espacio de trabajo
tryCatch({
fisher_test <- fisher.test(contingency_table, workspace = 2e7)
print("Prueba exacta de Fisher:")
print(fisher_test)
}, error = function(e) {
# Si falla, usar simulación en Fisher
print("Fisher con simulación Monte Carlo debido al tamaño de la tabla.")
fisher_test <- fisher.test(contingency_table, simulate.p.value = TRUE, B = 10000)
print(fisher_test)
})
} else {
# Usar Chi-cuadrado
chi_test <- chisq.test(contingency_table)
print("Chi-cuadrado:")
print(chi_test)
# Calcular Coeficiente de Cramer
print("Coeficiente de Cramer:")
print(CramerV(contingency_table))
}
}## [1] "Variable: A1"
## [1] "Chi-cuadrado:"
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: contingency_table
## X-squared = 1.0548, df = 1, p-value = 0.3044
##
## [1] "Coeficiente de Cramer:"
## [1] 0.04817699
## [1] "Variable: A4"
## [1] "Advertencia: Frecuencias bajas. Usando prueba exacta de Fisher o simulación."
## [1] "Prueba exacta de Fisher:"
##
## Fisher's Exact Test for Count Data
##
## data: contingency_table
## p-value = 1.243e-05
## alternative hypothesis: two.sided
##
## [1] "Variable: A5"
## [1] "Advertencia: Frecuencias bajas. Usando prueba exacta de Fisher o simulación."
## [1] "Prueba exacta de Fisher:"
##
## Fisher's Exact Test for Count Data
##
## data: contingency_table
## p-value = 1.243e-05
## alternative hypothesis: two.sided
##
## [1] "Variable: A6"
## [1] "Advertencia: Frecuencias bajas. Usando prueba exacta de Fisher o simulación."
## [1] "Fisher con simulación Monte Carlo debido al tamaño de la tabla."
##
## Fisher's Exact Test for Count Data with simulated p-value (based on
## 10000 replicates)
##
## data: contingency_table
## p-value = 9.999e-05
## alternative hypothesis: two.sided
##
## [1] "Variable: A7"
## [1] "Advertencia: Frecuencias bajas. Usando prueba exacta de Fisher o simulación."
## [1] "Prueba exacta de Fisher:"
##
## Fisher's Exact Test for Count Data
##
## data: contingency_table
## p-value = 7.153e-07
## alternative hypothesis: two.sided
##
## [1] "Variable: A9"
## [1] "Chi-cuadrado:"
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: contingency_table
## X-squared = 288.23, df = 1, p-value < 2.2e-16
##
## [1] "Coeficiente de Cramer:"
## [1] 0.7255876
## [1] "Variable: A10"
## [1] "Chi-cuadrado:"
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: contingency_table
## X-squared = 109.46, df = 1, p-value < 2.2e-16
##
## [1] "Coeficiente de Cramer:"
## [1] 0.4485852
## [1] "Variable: A12"
## [1] "Chi-cuadrado:"
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: contingency_table
## X-squared = 0.89485, df = 1, p-value = 0.3442
##
## [1] "Coeficiente de Cramer:"
## [1] 0.04387743
## [1] "Variable: A13"
## [1] "Advertencia: Frecuencias bajas. Usando prueba exacta de Fisher o simulación."
## [1] "Prueba exacta de Fisher:"
##
## Fisher's Exact Test for Count Data
##
## data: contingency_table
## p-value = 0.006493
## alternative hypothesis: two.sidedA continuación, analizaremos los resultados obtenidos:
Variable [A1 y A12]. Ambas variables presentan p-valores altos (>0.05), puesto que el p-valorA1 = 0.0482 y el p-valorA12 = 0.0439. Esto indica que no hay una asociación estadísticamente significativa con la variable de clase. Además, los coeficientes de Cramer también son bajos (<0.1), por lo que la relación es débil o nula. Por tanto, estas variables tienen poca o ninguna influencia en la clasificación y podrían ser descartadas en análisis posteriores.Variable [A4, A5, A6, A7 y A13]. Este grupo muestra asociaciones estadísticamente significativas con la variable de clase (p-valor < 0.05), dado que:A4, A5: p-valor = 1.243e-05 (Fisher Exacto).
A6: p-valor = 9.999e-05 (Fisher Monte Carlo, 10,000 simulaciones).
A7: p-valor = 7.153e-07 (Fisher Exacto).
A13: p-valor = 0.006493 (Fisher Exacto).
Aunque las pruebas detectan asociación, no disponemos del coeficiente de Cramer debido al uso de Fisher. Por lo tanto, sabemos que sendas variables tienen un impacto moderado en la clasificación y podrían complementar al modelo predictivo, pero requieren un análisis adicional para determinar su relevancia práctica.
Para determinar la importancia relativa del grupo de variables A4, A5, A6, A7 y A13, vamos a realizar un análisis adicional utilizando un modelo de árbol de decisión. Este enfoque permite identificar cómo las variables categóricas segmentan los datos en función de la clase objetivo, proporcionando una medida directa de su impacto en la clasificación. Además, calculamos también la importancia relativa de las variables según su capacidad para reducir la incertidumbre (impureza) en las divisiones del árbol.
## Warning: package 'rpart.plot' was built under R version 4.4.2# Modelo de árbol tree_model <- rpart(Class ~ A4 + A5 + A6 + A7 + A13, data = credit.Datos.Train, method = "class") rpart.plot(tree_model, main = "Árbol de Decisión")
## A6 A7 A4 A5 ## 39.38279147 17.48364931 0.06992398 0.06992398A partir de los resultados obtenidos, podemos concluir que:
Variable [A6]. Es la variable más relevante (con una importancia relativa de 39.38). Aparece en el nodo raíz, dividiendo los datos en dos grupos claramente diferenciados. Esta segmentación inicial genera nodos con probabilidades sustancialmente distintas para las clases “+” y “-” (por ejemplo, nodos con probabilidades de 0.44 y 0.58, respectivamente). Por lo tanto, A6 es útil para el modelo y debería ser priorizada en el análisis y diseño del sistema predictivo.Variable [A7]. Aparece como la segunda variable más importante (importancia relativa de 17.48), dentro de una rama ya segmentada por A6. Sus categorías (dd, n y v) contribuyen a un mayor refinamiento de la clasificación, aumentando la probabilidad de “+” en un subgrupo. Por lo tanto, podemos concluir que proporciona una diferenciación adicional en nodos ya segmentados, complementando la discriminación iniciada por A6.Variable [A4, A5 y A13]. Las variables A4 y A5 tienen ambas una importancia relativa muy baja (0.07 cada una). No aparecen en las divisiones del árbol, por lo que su capacidad para discriminar es mínima. En el caso de A13, aunque está estadísticamente asociada con la clase, no fue seleccionada en el árbol, por lo que tiene poca utilidad para la clasificación. Debido a su distribución uniforme, tampoco tiene un importancia relativa. En este caso, la exclusión de A13 del modelo no afectaría a su capacidad predictiva.
En conclusión, A6 y A7 son las variables clave en este grupo, por lo que deben ser priorizadas en el modelo predictivo, ya que su impacto en la clasificación es significativo y están directamente relacionadas con la discriminación entre las clases.
Variable [A9 y A10]. Este grupo presenta asociaciones altamente significativas con la clase, con p-valores extremadamente bajos (< 2.2e-16), por lo que existe una fuerte relación con la variable de respuesta, tal y como pudimos comprobar antes gráficamente. Los coeficientes de Cramer refuerzan esta relevancia, mostrando una asociación fuerte para A9 (Cramer = 0.7256) y moderadamente fuerte para A10 (Cramer = 0.4486). Este grupo de variables son esenciales por su capacidad de discriminación entre clases, por lo que ambas deben ser priorizadas en el modelo predictivo.
En conclusión, podemos afirmar que A9 y A10 destacan como los predictores categóricos con mayor capacidad discriminativa entre las clases, seguidos por A6 y A7, que también muestran un impacto relevante en el modelo. Las demás variables aportan información complementaria que, aunque significativa en menor medida, puede contribuir al análisis y soporte del modelo predictivo.
2.1.3.2 Predictores numéricos
En el caso de los predictores numéricos, vamos a mostrar un gráfico de densidad y un diagrama de cajas para cada uno de ellos. El primero muestra la distribución de cada variable numérica según la variable categórica de clase, con valores “-” (rojo) y “+” (turquesa). Por su parte, el segundo muestra, además de la distribución, la variabilidad de los datos entre diferentes categorías. Cabe destacar que, para la variable A15, ha sido necesario realizar de manera temporal una transformación de raíz cuadrada para poder visualizar correctamente los diagramas, dado que de otra forma era imposible (es decir, sin aplicar ningún tipo de transformación).
# Defininimos las variables numéricas y de clase
numeric_vars <- c("A2", "A3", "A8", "A11", "A14", "A15")
class_var <- "Class"
for (var in numeric_vars) {
# Filtramos las filas con valores finitos en la variable actual
filtered_data <- credit.Datos.Train[is.finite(credit.Datos.Train[[var]]), ]
# Si la variable es A15, aplicar la transformación de raíz cuadrada temporal (mejor visualización)
if (var == "A15") {
filtered_data <- filtered_data %>% mutate(temp_var = sqrt(.data[[var]])) # Nueva columna con raíz cuadrada temporal
x_label <- "sqrt(A15)"
y_label <- "sqrt(A15)"
title_suffix <- " (raíz cuadrada)"
} else {
filtered_data <- filtered_data %>%
mutate(temp_var = .data[[var]]) # Mantener el valor original
x_label <- var
y_label <- var
title_suffix <- ""
}
# Creamos el gráfico de densidad con clases superpuestas para facilitar la comapración
p_density <- ggplot(filtered_data, aes(x = temp_var, fill = Class)) +
geom_density(alpha = 0.5) +
labs(title = paste("Distribución de", var, "por Clase", title_suffix), x = x_label, y = "Densidad") +
theme_minimal() +
scale_fill_manual(values = c("red2", "turquoise3")) +
(if (var == "A2") scale_x_continuous(limits = c(0, max(filtered_data$temp_var, na.rm = TRUE))) else NULL) +
theme(aspect.ratio = 0.5) # Ajustamos aspecto
# Creamos el boxplot para la variable según la clase
p_box <- ggplot(filtered_data, aes(x = .data[[class_var]], y = temp_var, fill = .data[[class_var]])) +
geom_boxplot(alpha = 0.6, outlier.color = "red2") +
labs(title = paste("Boxplot de", var, "por Clase", title_suffix), x = "Clase", y = y_label) +
scale_y_continuous(limits = c(0, NA)) +
theme_minimal() +
theme(legend.position = "none", aspect.ratio = 0.5) # Ajustamos aspecto
# Combinamos los gráficos de densidad y boxplot en una cuadrícula de 1 columna y 2 filas
gridExtra::grid.arrange(p_density, p_box, ncol = 1)
}
[A2]. El gráfico de densidad muestra como la categoría “-” presenta una distribución unimodal con un pico pronunciado en el intervalo [20-30]. En cambio, la clase “+” expone una distribución ligeramente desplazada hacia valores más altos en comparación con “-”. Además, existe cierta superposición entre ambas categorías en el rango [20-40]. Todo esto deriva en una alta concentración de la categoría “-” en el rango más bajo, mientras que la clase “+” tiene una mayor dispersión hacia valores más altos (a partir de 40). Esto queda respaldado por el diagrama de caja, donde la mediana de la clase “+” es ligeramente superior y su IQR abarca valores más altos. Por tanto, podemos decir que A2 por sí sola no es suficiente para separar las categorías de forma clara.[A3]. En este caso, el gráfico de densidad muestra que ambas clases (“+” y “-”) presentan una alta concentración de valores cercanos a 0. Sin embargo, la clase “-” tiene una densidad mucho mayor cerca del valor 0, mientras que la clase “+” tiene una distribución un poco más dispersa hacia valores más altos. Esto explica por qué la mediana de “+” es superior y el IQR abarca valores más altos (caja más grande y más alta). Todo esto justifica la superposición existente en ambas variables. Además, si tenemos en cuenta también que ambas clases presentan outliers, especialmente “-” (más variabilidad), hace que sea más difícil confiar en A3 como predictor efectivo de manera aislada.[A8, A11 y A15]. En esta ocasión, el gráfico de densidad muestra que estas tres variables comparten una estructura de distribución sesgada hacia valores bajos, donde solo unos pocos casos alcanzan valores mayores. Estos casos más altos se dan sobre todo en la clase “+”, dado que en todos los predictores que estamos analizando se cumple que la mediana de “+” es superior y que el IQR abarca valores más elevados. Sin embargo, esta extensión de “+” hacia valores más altos no es lo suficientemente fuerte como para que cada una de estas variables sea completamente discriminativa individualmente. Esto se debe a la considerable superposición existente entre categorías.[A14]. En este predictor ambas clases se concentran en valores bajos (entre 0 y 500), por lo que la mayor parte las observaciones presentan valores bajos independientemente de la clase a la que pertenezcan. Esta similitud está presente también en las medianas de sendas clases, situándose ambas en un rango bajo. Además, existe una considerable superposición entre las dos clases, que puede apreciarse también en el tamaño de las cajas, que es muy parecido. Por lo tanto, esta varible por sí sola no ofrece ningún tipo de información que ayude a diferenciar entre “+” y “-”.
A continuación, evaluaremos la relación de asociación entre las variables predictoras numéricas y la variable de clase. Este análisis tiene como objetivo determinar si existe una asociación significativa entre cada predictor numérico y la variable de clase. Esta información nos servirá para complementar la información obtenida a partir de la visualización de gráficos, y nos ayudará a identificar correctamente las variables más relevantes para el modelo predictivo, puesto que no hemos podido identificar claramente qué predictor o predictores son más significativos para la discriminación de clases usando los diagramas.
Para ello, existen dos pruebas estadísticas complementarias: ANOVA (Análisis de Varianza) y Prueba de Kruskal-Wallis. Sin embargo, no vamos a emplear ANOVA porque las distribuciones de los datos presentan una asimetría significativa, tal y como hemos comentado en el análisis de variables. Esto supone una violación de los supuestos fundamentales de este método, ya que ANOVA asume que las distribuciones dentro de cada grupo son normales y que existe homogeneidad de varianzas, condiciones que no se cumplen en nuestro conjunto de datos.
En su lugar, usaremos la prueba de Kruskal-Wallis, que es una alternativa no paramétrica a ANOVA. Esto significa que no es necesario que los datos sigan una distribución normal. Tampoco asume igualdad de varianzas, lo que lo hace que este método sea más robusto y adecuado para datos con distribuciones asimétricas como las de nuestro análisis.
# Para ANOVA y Kruskal-Wallis en cada variable numérica:
numeric_vars <- c("A2", "A3", "A8", "A11", "A14", "A15")
for (var in numeric_vars) {
print(paste("Variable:", var))
print("Kruskal-Wallis:")
print(kruskal.test(credit.Datos.Train[[var]] ~ credit.Datos.Train$Class))
}## [1] "Variable: A2"
## [1] "Kruskal-Wallis:"
##
## Kruskal-Wallis rank sum test
##
## data: credit.Datos.Train[[var]] by credit.Datos.Train$Class
## Kruskal-Wallis chi-squared = 11.074, df = 1, p-value = 0.0008754
##
## [1] "Variable: A3"
## [1] "Kruskal-Wallis:"
##
## Kruskal-Wallis rank sum test
##
## data: credit.Datos.Train[[var]] by credit.Datos.Train$Class
## Kruskal-Wallis chi-squared = 20.829, df = 1, p-value = 5.022e-06
##
## [1] "Variable: A8"
## [1] "Kruskal-Wallis:"
##
## Kruskal-Wallis rank sum test
##
## data: credit.Datos.Train[[var]] by credit.Datos.Train$Class
## Kruskal-Wallis chi-squared = 76.997, df = 1, p-value < 2.2e-16
##
## [1] "Variable: A11"
## [1] "Kruskal-Wallis:"
##
## Kruskal-Wallis rank sum test
##
## data: credit.Datos.Train[[var]] by credit.Datos.Train$Class
## Kruskal-Wallis chi-squared = 136.44, df = 1, p-value < 2.2e-16
##
## [1] "Variable: A14"
## [1] "Kruskal-Wallis:"
##
## Kruskal-Wallis rank sum test
##
## data: credit.Datos.Train[[var]] by credit.Datos.Train$Class
## Kruskal-Wallis chi-squared = 9.2828, df = 1, p-value = 0.002313
##
## [1] "Variable: A15"
## [1] "Kruskal-Wallis:"
##
## Kruskal-Wallis rank sum test
##
## data: credit.Datos.Train[[var]] by credit.Datos.Train$Class
## Kruskal-Wallis chi-squared = 41.198, df = 1, p-value = 1.376e-10Con los resultados del análisis, podemos concluir lo siguiente:
Variable [A2, A3 y A15]. Estas variables presentan un p-valor menor a 0.001 (p-valorA2 = 0.0008754, p-valorA3 = 5.022e-06 y p-valorA15 = 1.376e-10), lo cual indica una asociación significativa con la variable de clase. Aunque su impacto individual no es tan fuerte como el de otros grupos, estas variables muestran diferencias claras en sus distribuciones entre las clases (“+” y “-”). Por lo tanto, podrían ser relevantes para la clasificación cuando se utilizan de forma complementaria, contribuyendo al modelo como indicadores secundarios.Variable [A8 y A11]. Este grupo contiene las variables con la asociación más fuerte con la variable de clase. Los valores extremadamente bajos de los p-valores indican que estas variables tienen un impacto determinante en la clasificación (p-valorA8 y p-valorA11 < 2.2e-16). Las diferencias en sus distribuciones entre las clases son tan marcadas que probablemente sean los principales predictores numéricos del modelo. Por lo tanto, estos predictores deben ser priorizados en la construcción de cualquier modelo predictivo, ya que sus valores son críticos para discriminar entre las clases.Variable [A14]. Esta variable, aunque significativa, tiene una asociación moderada con la variable de clase en comparación con los otros grupos (p-valorA14 = 0.002313). Por tanto, su influencia en la clasificación es menor. Así, A14 podría ser incluida como una variable de soporte en el modelo para agregar un contexto adicional.
En conclusión, A8 y A11 destacan como los predictores más importantes, con asociaciones extremadamente significativas y diferencias marcadas entre las clases, lo que los convierte en piezas clave para cualquier modelo predictivo. Por otro lado, A2, A3 y A15, aunque tienen una asociación significativa, su impacto individual es menor, siendo útiles como variables complementarias que refuercen la capacidad predictiva del modelo. Finalmente, A14, con una asociación moderada, puede actuar como un predictor de soporte, aportando valor adicional en un análisis multivariable sin ser determinante por sí misma.
2.1.4 Análisis multivariable
Hasta ahora hemos tratado cada una de las variables de manera independiente. Por ello, ahora vamos a relacionarlas para comprobar si hay relación entre ellas.
# Filtrar el dataset para quitar filas con valores nulos en las variables seleccionadas
credit_filtered <- na.omit(credit[, c(numeric_vars, class_var)])
# Aplicar transformación de raíz cuadrada a las variables A14 y A15 temporalmente para una mejor visualización
credit_filtered$A14 <- sqrt(credit_filtered$A14)
credit_filtered$A15 <- sqrt(credit_filtered$A15)
ggpairs(
credit_filtered,
columns = 1:6, # Selección de columnas numéricas
aes(color = Class), # Color basado en la variable de clase
upper = list(continuous = wrap("cor", size = 3)), # Correlación en la parte superior
lower = list(continuous = wrap("points", alpha = 0.7)), # Puntos en la parte inferior
diag = list(continuous = wrap("densityDiag")) # Densidad en la diagonal
) +
ggtitle("Análisis multivariable del Dataset Credit")
En el gráfico, podemos observar como ninguna de las variables numéricas presenta una correlación suficiente como para que sea tomada en cuenta. La más alta es la existente entre A8 y A2 para la clase “+”, pero su valor en conjunto 0.405 no es suficiente para tenerla en cuenta. Por este motivo, exploraremos ahora la relación entre las variables categóricas y las númericas, buscando aquellas dos variables que de manera conjunta influyan más en la variable de clase.
# Definir las variables categóricas y numéricas
categorical_vars <- c("A1", "A4", "A5", "A6", "A7", "A9", "A10", "A12", "A13")
datos_multivariable <- credit.Datos.Train
datos_multivariable$A15 <- pmin(datos_multivariable$A15, 5000) # Para ver mejor el gráfico
# Iterar sobre cada variable categórica
for (cat_var in categorical_vars) {
# Seleccionar las variables numéricas y la variable categórica actual
selected_data <- datos_multivariable[, c(numeric_vars, cat_var)]
# Eliminar filas con valores NA solo para el gráfico
selected_data <- na.omit(selected_data)
# Convertir los datos a formato largo para usar ggplot2
data_long <- pivot_longer(selected_data, cols = all_of(numeric_vars),
names_to = "Variable", values_to = "Value")
# Crear el strip plot con jitter
p <- ggplot(data_long, aes(x = .data[[cat_var]], y = Value, color = .data[[cat_var]])) +
geom_jitter(width = 0.2, alpha = 0.5) +
facet_wrap(~ Variable, scales = "free_y") +
labs(title = paste("Distribución de variables numéricas por categoría de", cat_var),
x = paste("Categoría de", cat_var),
y = "Valores de los predictores") +
theme_minimal()
# Mostrar el gráfico
print(p)
}
Variable A1. En general, la categoría b de está asociada con una mayor dispersión en las variables numéricas, incluyendo un rango más amplio de comportamientos y valores extremos. La categoría a, por otro lado, presenta una concentración mayor en valores más bajos y un rango más limitado. En general, la distribución está muy igualada para todas las variables numéricas, a excepción de A8. En este gráfico, se ve una ligera cola de b hacia valores más altos. A1 podría tener cierta relevancia para el análisis multivariable y la construcción de nuestro futuro modelo, pues los valores más altos de A8 estaban ligados a la clase “+”.Variable A4. La distribución de las variables numéricas según las categorías de A4 es muy similar a la de A1. En este caso, la categoría u podemos asociarla con una mayor dispersión en todas las variables numéricas. Por su parte, las categorías l e y presentan valores más concentrados y rangos más estrechos. Además, un análisis más detallado de los valores extremos en A8 y A15 para la categoría u podrían sernos de utilidad para verificar si existe una relación entre A4 y alguna de estas dos variables, dado que los valores altos de ambas están asociados a “+”.Variable A5. En este caso, hemos detectado que A5 sigue un patrón casi idéntico al de A4. Por tanto, las conclusiones son las mismas, ya que parecen ser la misma variable.Variable A6. Esta variable presenta varios subgrupos con comportamientos numéricos notablemente diferentes.[aa, d, i, j y k]. Este conjunto de categorías muestra características similares: valores numéricos concentrados en rangos bajos, mínima dispersión y ausencia de outliers. No muestran ningún interés en el análisis multivariable.
[c y q]. Aunque estas categorías presentan valores predominantemente bajos en las variables numéricas, su dispersión es mayor que la del grupo anterior, especialmente en el caso de q. Sin embargo, no destacan en ninguna variable numérica, por lo que no presentan interés.
[e, m y w]. Este grupo de variables muestra una dispersión importante en las variables numéricas y están asociadas a valores extremos. Podrían corresponder a subgrupos menos típicos, con un comportamiento menos predecible y más diverso que otras categorías. Aún así, no presenta ninguna un comportamiento que valga la pena analizar.
[x y ff]. Aunque estas dos categorías no encajan en ningún grupo, x muestra valores extremos y una amplia dispersión, y ff se comporta de manera poco consistente. Por tanto, al igual que las otras categorías, no merece la pena un anális multivariable más exhaustivo.
En conclusión, la heterogeneidad de esta variable hace que sea complicado identificar posibles relaciones con otras variables, por lo que preferimos centrarnos en otros predictores.
Variable A7. En esta variable ocurre algo parecido a A6, pero con una peculiaridad, tiene una categoría dominante, v, que provoca que el resto tengan poca representación. Esto dificulta la identificación de relaciones con otros predictores. Por este motivo, no seguiremos analizándola, ya que en análisis posteriores comprobaremos si existe correlación con otras variables.Variable A9. La categoría t de esta variable está asociada sistemáticamente con valores más altos (outliers) y mayor dispersión en todas las variables numéricas, especialmente en A11, A15 y A8. Esto es importante porque, si recordamos de análisis anteriores, t está asociada la mayoría de veces a la clase “+”. Esto podría explicar el alto valor predictivo de A9, tal y como se evidenció en su coeficiente de Cramer, que fue el más alto de todas las variables categóricas. Como consecuencia, A9 se confirma como uno de los predictores más importantes, no solo por su relación directa con la clase objetivo, sino también por su influencia en las distribuciones de las variables numéricas. Por tanto, sus relaciones con A8, A11 y A15 son candidatas a ser analizadas más exhaustivamente.Variable A10. La variable A10 muestra un comportamiento similar al de A9, con la categoría t asociada a valores más altos y una mayor dispersión en las variables numéricas. De nuevo, estas características predominan en las variables A15, A11 y A8. Además, en análisis anteriores vimos como esta categoría también está asociada en su mayoría a la clase “+”. Por lo que también sería interesante su análisis con A15, A11 y A8.Variable A12. Observando el gráfico para esta variable, podemos ver que no existe ningún patrón entre las categorías de A12 y los valores de las variables numéricas. Ambas categorías tienen una dispersión y rango similares, lo que indica que no hay una relación clara entre las categorías de A12 y las variables numéricas. Por tanto, no muestra ningún interés para nuestro análisis.Variable A13. La variable A13 no muestra ninguna relación importante con las variables numéricas. Esto se debe a que la categoría g predomina con una frecuencia del 90,57 %, lo que limita la variabilidad de la variable, mientras que las categorías restantes (p y s) no presentan patrones interesantes en su relación con las variables numéricas.
En resumen, las relaciones más interesantes a analizar son A1:A8, A4:A8, A4:15, A9:A8, A9:A11, A9:A15, A10:A8, A10:A11 y A10:A15. Utilizando un modelo de regresión lineal (glm), vamos a tratar de identificar si estas relaciones son útiles para nuestro modelo. Además, analizaremos la más prometedora de manera más exhaustiva.
# Variables categóricas
categoricas <- c("A1", "A4", "A9", "A10")
# Variables numéricas
numericas <- c("A8", "A11", "A15")
credit_filtered <- na.omit(credit.Datos.Train[, c(categoricas, numericas, class_var)])
credit_filtered$A15 <- sqrt(credit_filtered$A15)
credit_filtered$A1 <- as.factor(credit_filtered$A1)
credit_filtered$A4 <- as.factor(credit_filtered$A4)
credit_filtered$A9 <- as.factor(credit_filtered$A9)
credit_filtered$A10 <- as.factor(credit_filtered$A10)
# Crear un dataframe para almacenar resultados
resultados <- data.frame(
Categorica = character(),
Numerica = character(),
AIC = numeric(),
P_Interaccion = numeric(),
stringsAsFactors = FALSE
)
# Iterar sobre todas las combinaciones de variables categóricas y numéricas
for (cat_var in categoricas) {
for (num_var in numericas) {
# Crear el modelo con interacción
formula <- as.formula(paste("Class ~", cat_var, "*", num_var))
modelo <- tryCatch(
glm(formula, data = credit_filtered, family = binomial),
error = function(e) {
cat("Error al ajustar el modelo para", cat_var, "y", num_var, ":", e$message, "\n")
return(NULL)
}
)
# Verificar si el modelo se ajustó correctamente
if (is.null(modelo)) next
# Obtener métricas del modelo
aic <- AIC(modelo)
# Inspeccionar los nombres de los coeficientes
terminos <- rownames(summary(modelo)$coefficients)
# Detectar términos de interacción que incluyan ambas variables
interaccion_term <- terminos[grepl(cat_var, terminos) & grepl(num_var, terminos)]
if (length(interaccion_term) > 0) {
# Si se encuentra interacción, calcular el p-valor
p_interaccion <- summary(modelo)$coefficients[interaccion_term[1], "Pr(>|z|)"]
} else {
p_interaccion <- NA
}
# Guardar los resultados
resultados <- rbind(resultados, data.frame(
Categorica = cat_var,
Numerica = num_var,
AIC = aic,
P_Interaccion = p_interaccion
))
}
}
# Ordenar los resultados por AIC (menor es mejor) o P_Interaccion (menor es más significativo)
resultados <- resultados[order(resultados$AIC), ]
# Mostrar los mejores resultados
if (nrow(resultados) > 0) {
print(head(resultados))
}## Categorica Numerica AIC P_Interaccion
## 9 A9 A15 364.7240 0.0005691471
## 8 A9 A11 374.6257 0.1352904363
## 7 A9 A8 397.6690 0.4092987193
## 10 A10 A8 584.7349 0.1215192463
## 12 A10 A15 589.9761 0.0642584764
## 11 A10 A11 597.9922 NAEn la tabla podemos ver claramente que la relación más relevante es A9:A15. Esto es así por varios motivos:
Un valor de AIC más bajo (364.724), indicando un mejor ajuste del modelo.
Un p-valor de interacción (P_Interaccion = 0.000569) muy significativo, sugiriendo que la interacción entre A9 y A15 tiene un efecto estadísticamente significativo en la variable dependiente de clase.
A continuación, obtendremos el resto de medidas para esta relación.
# Inspeccionar los coeficientes del modelo para A9 y A15
modelo_prueba <- glm(Class ~ A9 * A15, data = credit_filtered, family = binomial)
summary(modelo_prueba)$coefficients## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.89976197 0.285224355 -10.166600 2.794945e-24
## A9t 3.51884645 0.336617742 10.453538 1.411585e-25
## A15 0.01114019 0.006388721 1.743728 8.120646e-02
## A9t:A15 0.05666917 0.016445358 3.445907 5.691471e-04El coeficiente de la interacción A9:A15 (0.0566) es positivo y altamente significativo (p = 0.0005). Esto implica que cuando A9 y A15 interactúan, tienen un efecto combinado positivo significativo en la predicción de la variable de clase. Para poder interpretar mejor la interacción de ambas variables, mostraremos el siguiente gráfico:
# Ajustar el modelo con interacción
modelo <- glm(Class ~ A9 * A15, data = credit_filtered, family = binomial)
# Crear un rango de valores para A15_sqrt y predicciones para los niveles de A9
a15_values <- seq(min(credit_filtered$A15), max(credit_filtered$A15), length.out = 100)
predicted_data <- expand.grid(
A15 = a15_values,
A9 = unique(credit_filtered$A9)
)
predicted_data$Predicted <- predict(modelo, newdata = predicted_data, type = "response")
# Graficar con ggplot2
ggplot(predicted_data, aes(x = A15, y = Predicted, color = A9)) +
geom_line(size = 1) +
labs(
title = "Interacción entre A9 y A15_sqrt",
x = "A15 (sqrt-transformada)",
y = "Probabilidad predicha de Class = +",
color = "Nivel de A9"
) +
theme_minimal() +
theme(
legend.position = "top",
plot.title = element_text(hjust = 0.5)
)
# Predicciones probabilísticas
predicciones <- predict(modelo, newdata = credit_filtered, type = "response")
# Curva ROC y cálculo de AUC
roc_obj <- roc(credit_filtered$Class, predicciones)## Setting levels: control = -, case = +## Setting direction: controls < cases
## Area under the curve: 0.9073Por un lado, en el gráfico de interacción, podemos ver como para el nivel A9 = t la probabilidad de que la clase sea “+” es alta (cercana a 1) y parece estabilizarse rápidamente a medida que A15 aumenta. Por contra, para el el nivel A9 = f, la probabilidad de “+” aumenta más lentamente y de manera más lineal, por lo que existe una interacción más dependiente. Por tanto, A9 tiene un impacto dominante en la predicción de la clase, y dependiendo de su nivel se modula el efecto de A15 sobre el resultado de la clase. De tal manera que cuando A9 = f, A15 cobra un papel más relevante, ya que su aumento incrementa las probabilidades de que la clase sea “+”.
Por otro lado, la curva ROC muestra una buena capacidad de discriminación del modelo, ya que se encuentra alejada de la diagonal (línea gris) que representa el azar y obtiene un valor AUC = 0.9. El modelo parece tener un buen balance entre sensibilidad (tasa de verdaderos positivos) y especificidad (tasa de verdaderos negativos). Por tanto, podemos confirmar que la interacción de estas dos variables será fundamental en los modelos que entrenemos en pasos posteriores. De manera que, la eliminación de una de estas variables en el preprocesado es muy poco recomendable.
2.2 Preprocesado de valores nulos
2.2.1 Análisis de los valores nulos
En este apartado, analizaremos las posibles estrategias para tratar los valores nulos y los outliers. Posteriormente, en el tratamiento de datos nulos, se realizará la transformación de estos datos según lo dispuesto en este apartado. A partir de este momento, utilizaremos siempre el conjunto de entrenamiento.
# Número total de filas
total_rows <- nrow(credit.Datos.Train)
# Recuento de NA con porcentaje
na_summary <- data.frame(
Variable = names(credit.Datos.Train),
NA_Count = colSums(is.na(credit.Datos.Train)),
NA_Percentage = colSums(is.na(credit.Datos.Train)) / total_rows * 100
)
# Mostrar la tabla resumen
print(na_summary)## Variable NA_Count NA_Percentage
## A1 A1 12 2.169982
## A2 A2 12 2.169982
## A3 A3 0 0.000000
## A4 A4 6 1.084991
## A5 A5 6 1.084991
## A6 A6 9 1.627486
## A7 A7 9 1.627486
## A8 A8 0 0.000000
## A9 A9 0 0.000000
## A10 A10 0 0.000000
## A11 A11 0 0.000000
## A12 A12 0 0.000000
## A13 A13 0 0.000000
## A14 A14 13 2.350814
## A15 A15 0 0.000000
## Class Class 0 0.000000Como podemos ver en el tribble, el conjunto de datos presenta valores nulos en algunas de sus columnas para determinadas observaciones (37 observaciones (5%)). En concreto, destacan las variables A1, A2 y A14 por tener un mayor porcentaje de valores nulos que el resto de variables. No obstante, estos porcentajes son muy bajos en comparación con el número total de observaciones, por lo que no es motivo de alarma. Por otra parte, el resto de variables no presentan valores nulos o tienen un porcentaje muy bajo de estos.
A continuación, buscaremos las mejores estrategias para tratar los valores nulos:
- En el conjunto de datos vemos 6 observaciones (159, 212, 262, 368, 480 y 503) con un gran porcentaje de variables nulas y que tienen la misma estructura. En concreto, faltan datos para las variables A4-A7 y A14. Además, en esta situación, las variables A3, A8, A11 y A15 siempre tienen el valor 0, mientras que el resto de las variables, excepto A1 y A2, tienen el mismo valor en todas las observaciones. Por lo tanto, sería una buena estrategia eliminar estas observaciones del conjunto de datos, ya que contienen muchos valores nulos y 0 en la mayoría de las variables, lo cual indica que no serán relevantes de cara al modelo final.
En cuanto a las observaciones con variables numéricas nulas, comprobaremos antes de todo la correlación entre ellas. Con esto, pretendemos descubrir de qué forma podríamos aprovechar las relaciones entre variables a la hora de decidir qué técnica aplicar. Para ello, generaremos una representación simbólica de la matriz de correlación con dichas variables.
## A2 A3 A8 A11 A14 A15
## A2 1
## A3 1
## A8 . . 1
## A11 . 1
## A14 1
## A15 1
## attr(,"legend")
## [1] 0 ' ' 0.3 '.' 0.6 ',' 0.8 '+' 0.9 '*' 0.95 'B' 1Como podemos observar en la matriz, los únicos pares de variables que presentan correlación son (A8,A2), (A8,A3) y (A11,A8). Sin embargo, el valor de correlación en todas ellas es de 0.3, indicando una correlación débil. En este sentido, no combiene tratar los valores nulos de forma conjunta. Por tanto, será necesario tratar cada variable por separado.
Para la
variable A2, aprovecharemos el análisis realizado en apartados anteriores, donde pudimos ver como esta variable presenta una distribución moderadamente sesgada a la derecha. Por este motivo, sería mas acertado usar la mediana para rellenar los valores nulos de esta variable.Para la
variable A14, aprovecharemos también el mismo análisis, donde pudimos comprobar como la variable presenta un fuerte sesgo hacia la derecha. Por ello, vuelve a ser mejor opción aplicar la mediana a los valores nulos de esta variable.Por último, solo queda tratar los valores nulos en las
variables categóricas A1, A6 y A7. Observando el análisis realizado anteriormente sobre las variables categóricas, se puede ver cómo en A1 la categoría “b” predomina sobre “a”, y en A7 cómo la categoría “v” predomina sobre las demás. Esto se puede solucionar imputando los valores nulos con la moda (“b” y “v” respectivamente), manteniendo la distribución original. Por otra parte, la variable A6 presenta una distribución mucho más dispersa, por lo que crear una nueva categoría llamada “Desconocido” es una mejor opción. Esto es así, porque imputar con una categoría específica podría distorsionar la diversidad.
2.2.2 Tratamiento de los valores nulos
Una vez seleccionada la estrategia más adecuada para tratar los valores nulos, es necesario aplicarla específicamente al conjunto de entrenamiento. No obstante, para preservar el conjunto original sin alteraciones, ya que algunos modelos pueden manejar valores nulos de forma nativa, emplearemos variables temporales para realizar las transformaciones necesarias. Esto nos permitirá experimentar y ajustar la estrategia sin comprometer la integridad de los datos originales, manteniendo la flexibilidad para diferentes enfoques durante el análisis y modelado.
# Eliminamos las observaciones
credit.fix1.delUselessNull <- credit.Datos.Train[-c(159,212,262,368,480,503),]# Mostramos el conjunto fix1 resultante
tibble::rowid_to_column(credit.fix1.delUselessNull)[!complete.cases(credit.fix1.delUselessNull),]# Número total de filas en el conjunto de datos
total_rows <- nrow(credit.fix1.delUselessNull)
# Crear tabla de conteo y porcentaje de valores nulos
null_summary <- data.frame(
Variable = names(credit.fix1.delUselessNull),
Nulos = colSums(is.na(credit.fix1.delUselessNull)),
Porcentaje = (colSums(is.na(credit.fix1.delUselessNull)) / total_rows) * 100
)
# Mostrar la tabla de resumen
print(null_summary)## Variable Nulos Porcentaje
## A1 A1 12 2.1937843
## A2 A2 12 2.1937843
## A3 A3 0 0.0000000
## A4 A4 0 0.0000000
## A5 A5 0 0.0000000
## A6 A6 3 0.5484461
## A7 A7 3 0.5484461
## A8 A8 0 0.0000000
## A9 A9 0 0.0000000
## A10 A10 0 0.0000000
## A11 A11 0 0.0000000
## A12 A12 0 0.0000000
## A13 A13 0 0.0000000
## A14 A14 7 1.2797075
## A15 A15 0 0.0000000
## Class Class 0 0.0000000Al aplicar la estrategia de eliminación de observaciones con excesivas apariciones de valores nulos, podemos observar cómo ha descendido el número de valores nulos para las variables A6, A7 y A14. Además, hemos conseguido eliminar por completo los valores nulos de las variables A4 y A5. Sin embargo, las variables A1 y A2 no se han visto afectadas tras la aplicación de esta estrategia.
A continuación, aplicamos el resto de estrategias a las variables que aún poseen valores nulos. Empezaremos aplicando la mediana a los valores nulos de A2 y A14.
# Guardamos la modificación anterior
credit.fix2.Median <- credit.fix1.delUselessNull
# Realizamos la imputación en credit.fix2.Median de A2 y A14 mediana
credit.fix2.Median$A2[is.na(credit.fix2.Median$A2)] <- median(credit.fix1.delUselessNull$A2, na.rm = TRUE)
credit.fix2.Median$A14[is.na(credit.fix2.Median$A14)] <- median(credit.fix1.delUselessNull$A14, na.rm = TRUE)
# Mostramos el conjunto fix2.Median resultante
tibble::rowid_to_column(credit.fix2.Median)[!complete.cases(credit.fix2.Median),]# Número total de filas en el conjunto de datos
total_rows <- nrow(credit.fix2.Median)
# Crear tabla de conteo y porcentaje de valores nulos
null_summary <- data.frame(
Variable = names(credit.fix2.Median),
Nulos = colSums(is.na(credit.fix2.Median)),
Porcentaje = (colSums(is.na(credit.fix2.Median)) / total_rows) * 100
)
# Mostrar la tabla de resumen
print(null_summary)## Variable Nulos Porcentaje
## A1 A1 12 2.1937843
## A2 A2 0 0.0000000
## A3 A3 0 0.0000000
## A4 A4 0 0.0000000
## A5 A5 0 0.0000000
## A6 A6 3 0.5484461
## A7 A7 3 0.5484461
## A8 A8 0 0.0000000
## A9 A9 0 0.0000000
## A10 A10 0 0.0000000
## A11 A11 0 0.0000000
## A12 A12 0 0.0000000
## A13 A13 0 0.0000000
## A14 A14 0 0.0000000
## A15 A15 0 0.0000000
## Class Class 0 0.0000000Al aplicar esta estrategia, hemos conseguido eliminar completamente los valores nulos para las variables A2 y A14. Por último, aplicaremos la moda a los valores nulos de A7 y crearemos una nueva categoría “Desconocido” para A6.
# Guardamos la modificación anterior
credit.fix3.categoricalFix <- credit.fix2.Median
# Realizamos la imputación en credit.fix3.categoricalFix de A1 y A7 por la moda
credit.fix3.categoricalFix$A1[is.na(credit.fix3.categoricalFix$A1)] <- "b"
credit.fix3.categoricalFix$A7[is.na(credit.fix3.categoricalFix$A7)] <- "v"
# Agregar "Desconocido" a los niveles del factor A6
levels(credit.fix3.categoricalFix$A6) <- c(levels(credit.fix3.categoricalFix$A6), "Desconocido")
# Realizamos la imputación en credit.fix3.categoricalFix de A6 por "Desconocido"
credit.fix3.categoricalFix$A6[is.na(credit.fix3.categoricalFix$A6)] <- "Desconocido"
# Convertir de nuevo a factor A6
credit.fix3.categoricalFix$A6 <- as.factor(credit.fix3.categoricalFix$A6)
# Número total de filas en el conjunto de datos
total_rows <- nrow(credit.fix3.categoricalFix)
# Crear tabla de conteo y porcentaje de valores nulos
null_summary <- data.frame(
Variable = names(credit.fix3.categoricalFix),
Nulos = colSums(is.na(credit.fix3.categoricalFix)),
Porcentaje = (colSums(is.na(credit.fix3.categoricalFix)) / total_rows) * 100
)
# Mostrar la tabla de resumen
print(null_summary)## Variable Nulos Porcentaje
## A1 A1 0 0
## A2 A2 0 0
## A3 A3 0 0
## A4 A4 0 0
## A5 A5 0 0
## A6 A6 0 0
## A7 A7 0 0
## A8 A8 0 0
## A9 A9 0 0
## A10 A10 0 0
## A11 A11 0 0
## A12 A12 0 0
## A13 A13 0 0
## A14 A14 0 0
## A15 A15 0 0
## Class Class 0 0#Creamos la variable temporal para almacenar el conjunto de entrenamiento sin valores nulos
temporal_train <- credit.fix3.categoricalFixComo se observa en la tabla, hemos logrado eliminar los valores nulos de todas las variables, minimizando en la medida de lo posible cualquier distorsión en el conjunto de datos. Sin embargo, este tratamiento se ha llevado a cabo de manera exploratoria, sin considerar aún el modelo específico al que se aplicará el conjunto de datos de entrenamiento. Por lo tanto, es probable que sea necesario realizar un preprocesado adicional o diferente para adaptar los datos a los requisitos específicos de ciertos modelos.
2.2.3 Evaluación del impacto del tratamiento de los valores nulos
Antes de evaluar el imapacto, creemos conveniente hacer una recapitulación del tratamiento aplicado a los valores nulos, con el fin de garantizar la claridad en el proceso y asegurar que no se pierden de vista los detalles de los cambios realizados:
Eliminación de observaciones con un gran número de nulos.
Imputación en las variables numéricas A2 y A14 con la mediana.
Imputación en las variables categóricas A1 y A7 con la moda.
Creación de una nueva categoría llamada “Desconocido” en A6.
Una vez tratados los valores nulos, es fundamental evaluar si los cambios introducidos han afectado negativamente a nuestro conjunto de datos en términos de rendimiento para los modelos predictivos. Para comprobarlo, utilizamos un modelo rápido como el Random Forest (ranger) al tener varias optimizaciones implementadas en su diseño como ser más ligero en memoria, optimizaciones de cálculos, o que su implementación está en C++. Nos permite obtener resultados fiables en un tiempo razonable.
A continuación, usamos caret para inspeccionar los hiperparámetros disponibles en el modelo Random Forest:
Observamos que el único parámetro explícito listado es mtry, que indica el número de predictores seleccionados aleatoriamente en cada división del árbol para ser evaluados como posibles divisores. Sin embargo, sabemos que también tiene el hiperparámetro de splitrule (pureza), que define el criterio para dividir los nodos, y min.node.size, que especifica el número mínimo de observaciones en un nodo para que el árbol pueda dividirlo.
Antes de llevar a cabo la comprobación usando Random Forest, es necesario realizar una búsqueda de hiperparámetros que garantice que las configuraciones utilizadas son las óptimas para nuestro conjunto de datos. Dado el tamaño mediano de nuestro dataset, vamos a realizar una búsqueda exhaustiva (grid search) de hiperparámetros con validación cruzada para garantizar que la combinación seleccionada sea robusta y óptima. Por tanto, para llevar a cabo el proceso completo de comprobación, hemos seguido los siguientes pasos:
Definición de una cuadrícula con combinaciones específicas de valores para los hiperparámetros relevantes: Para mtry dejamos los valores por defecto que tiene en el grid, garantizando una evaluación equilibrada de los predictores en cada división. En el caso de splitrule, el criterio Gini es apropiado para medir la pureza de las divisiones en problemas de clasificación, como es nuestro caso. Por último, en min.node.size el número de observaciones será (1, 5, 10), dado que estos valores cubren diferentes niveles de granularidad y son estándar en muchas implementaciones por ser buenos puntos de partida cuando no se tiene un conocimiento específico del conjunto de datos, como es nuestro caso.
Validación Cruzada (trainControl): Definine cómo se validará cada combinación de hiperparámetros. Usaremos method = “cv” para una validación cruzada, number = 3 para establecer un número de pliegues que sea rápido para nuestro problema, y search = “grid” para especificar que se probarán todas las combinaciones de la cuadrícula.
Entrenamiento y evaluación del modelo (train): Implementa todo el proceso de búsqueda, entrenando y evaluando el modelo con cada combinación de hiperparámetros en la cuadrícula.
Evaluación de las combinaciones y selección de la mejor combinación: Se evalúan las 9 combinaciones de hiperparámetros definidas en grid_modificado. Para cada una de ellas, el modelo se entrena y evalúa en los 3 pliegues, obteniendo una métrica promedio (en este caso, accuracy, ya que consideramos que las clases están mayormente balanceadas). Después, el modelo guarda la mejor combinación encontrada durante el proceso de búsqueda.
Entrenamiento del modelo final: Entrenamos dos modelos de Random Forest con los mejores hiperparámetros: el dataset original (credit.Datos.Train) y el dataset procesado sin valores nulos (temporal_train).
set.seed(125)
# Configuración de control para el entrenamiento
control <- trainControl(
method = "cv", # Validación cruzada
number = 3, # Número de folds
search = "grid", # Búsqueda por cuadrícula
)
set.seed(125)
# Definir un grid personalizado
grid_modificado <- expand.grid(
mtry = c(2, 8, 15),
splitrule = "gini",
min.node.size = c(1, 5, 10)
)
# Función para entrenar y evaluar el modelo
train_evaluate_model <- function(dataset, target_column) {
# Separar predictores y variable objetivo
predictors <- dataset[, !names(dataset) %in% target_column]
target <- dataset[[target_column]]
set.seed(125)
# Entrenar modelo con caret
model <- train(
x = predictors,
y = target,
method = "ranger", # Implementación rápida de Random Forest
trControl = control,
tuneGrid = grid_modificado
)
return(model)
}
# Entrenar modelos en ambos datasets
set.seed(125)
model_credit <- train_evaluate_model(credit.Datos.Train, "Class")
set.seed(125)
model_temporal <- train_evaluate_model(temporal_train, "Class")
# Comparar precisión
comparison <- data.frame(
Dataset = c("Datos en crudo", "Datos sin nulos"),
Accuracy = c(
max(model_credit$results$Accuracy),
max(model_temporal$results$Accuracy)
)
)
print(comparison)## Dataset Accuracy
## 1 Datos en crudo 0.8824912
## 2 Datos sin nulos 0.8921416Podemos ver como los datos sin valores nulos no solo no afectan negativamente el rendimiento del modelo, sino que incluso muestran una ligera mejora en la métrica de precisión (accuracy). Por tanto, los datos procesados no introducen sesgos significativos y son adecuados para ser utilizados en modelos predictivos futuros.
2.3 Tratamiento de predictores correlados o asociados
En esta sección, llevaremos a cabo un análisis de correlación y asociación entre los distintos predictores. Para evaluar el impacto de los outliers en estas relaciones, el estudio se realizará en dos fases: primero, analizaremos los datos originales sin tratar los outliers; posteriormente, repetiremos el análisis utilizando los datos ajustados tras su tratamiento. Este enfoque nos permitirá identificar posibles diferencias y comprender mejor cómo los outliers pueden influir en la relación entre las variables.
2.3.1 Sin tratamiento de outliers
2.3.1.1 Eliminación de variables numéricas con poca varianza
En esta sección evaluamos las variables numéricas con el propósito de identificar aquellas con poca varianza. Este análisis es esencial porque las variables con una variabilidad muy baja no aportan información significativa al modelo de clasificación, ya que no ayudan a distinguir entre las clases objetivo. Además, estas variables pueden introducir ruido y complicar innecesariamente el proceso de modelado, afectando tanto el tiempo de procesamiento como la precisión del modelo.
Para realizar este análisis, utilizamos la función nearZeroVar() del paquete Caret, diseñada específicamente para detectar variables con baja variabilidad.
## character(0)Tras aplicar la función, observamos que no existen variables numéricas en nuestro conjunto de datos que cumplan los criterios de baja varianza. Por tanto, no es necesario realizar ninguna eliminación en esta etapa. Esto indica que todas las variables numéricas tienen suficiente variabilidad como para potencialmente contribuir al modelo de clasificación.
2.3.1.2 Eliminación de variables numéricas correladas
La correlación entre predictores numéricos puede ser problemática en el modelado, especialmente en algoritmos sensibles a la multicolinealidad, como la regresión logística o los modelos lineales. Variables altamente correladas tienden a contener información redundante, lo que puede influir negativamente en la estabilidad del modelo, aumentar el tiempo de procesamiento y dificultar la interpretación de los coeficientes.
## A2 A3 A8 A11 A14 A15
## A2 1
## A3 1
## A8 . . 1
## A11 . 1
## A14 1
## A15 1
## attr(,"legend")
## [1] 0 ' ' 0.3 '.' 0.6 ',' 0.8 '+' 0.9 '*' 0.95 'B' 1Como ya comentamos cuando analizamos las estrategias para el tratamiento de los valores nulos, no existen correlaciones relevantes entre los predictores numéricos, por lo que no es necesario eliminar ninguna variable basada en este criterio.
2.3.1.3 Eliminación de variables categóricas con poca varianza (Dummy variables)
En este apartado nos centramos en identificar y tratar variables
categóricas que, al ser transformadas en dummies (para poder aplicarles
el mismo análisis que a las variables numéricas), presentan una baja
varianza y, por tanto, no aportan información significativa al
modelo.
Para realizar este análisis, es necesario transformar las variables
categóricas en su equivalente dummy. Hemos utilizado el argumento
fullRank = TRUE al crear las dummies, generando
n-1 columnas para evitar la multicolinealidad
perfecta y la conocida “trampa de la variable
dummy”.
data <- temporal_train
# Lista de variables categóricas y numéricas
categorical_vars <- c("A1", "A4", "A5", "A6", "A7", "A9", "A10", "A12", "A13", "Class")
numeric_vars <- c("A2", "A3", "A8", "A11", "A14", "A15")
# variable de salida
target_var <- "Class"
# Variables de entrada
input_vars <- setdiff(names(data), target_var)
# Crear variables dummy para todas las variables categóricas (fullRank = TRUE)
cols_categorical <- NULL
if (length(categorical_vars) > 0) {
dummy_categorical <- dummyVars(
paste("~", paste(categorical_vars, collapse = " + ")),
data = data, fullRank = TRUE
)
cols_categorical <- data.frame(predict(dummy_categorical, newdata = data))
}
# Combinar variables categóricas dummy con las numéricas
temporal_train_dummy <- cbind(cols_categorical, data[, numeric_vars], data[, target_var, drop = FALSE])
# Verificar el nuevo conjunto de datos
str(temporal_train_dummy)## 'data.frame': 547 obs. of 40 variables:
## $ A1.b : num 1 1 1 1 1 0 1 1 0 1 ...
## $ A4.u : num 1 1 1 1 1 1 0 0 1 0 ...
## $ A4.y : num 0 0 0 0 0 0 1 1 0 1 ...
## $ A5.gg : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A5.p : num 0 0 0 0 0 0 1 1 0 1 ...
## $ A6.c : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A6.cc : num 0 0 0 0 0 1 0 0 0 0 ...
## $ A6.d : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A6.e : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A6.ff : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A6.i : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A6.j : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A6.k : num 0 0 0 0 0 0 1 0 1 1 ...
## $ A6.m : num 0 0 0 1 0 0 0 0 0 0 ...
## $ A6.q : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A6.r : num 0 0 0 0 1 0 0 0 0 0 ...
## $ A6.w : num 1 1 1 0 0 0 0 1 0 0 ...
## $ A6.x : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A6.Desconocido: num 0 0 0 0 0 0 0 0 0 0 ...
## $ A7.dd : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A7.ff : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A7.h : num 0 0 0 0 1 0 1 0 0 0 ...
## $ A7.j : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A7.n : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A7.o : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A7.v : num 1 1 1 1 0 1 0 1 1 1 ...
## $ A7.z : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A9.t : num 1 1 1 1 1 1 1 1 1 1 ...
## $ A10.t : num 1 1 0 0 0 0 0 0 0 1 ...
## $ A12.t : num 0 1 0 1 1 0 0 1 1 1 ...
## $ A13.p : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A13.s : num 0 0 1 0 0 0 0 0 0 0 ...
## $ Class.. : num 1 1 1 1 1 1 1 1 1 1 ...
## $ A2 : num 30.8 27.8 20.2 32.1 33.2 ...
## $ A3 : num 0 1.54 5.62 4 1.04 ...
## $ A8 : num 1.25 3.75 1.71 2.5 6.5 ...
## $ A11 : int 1 5 0 0 0 0 0 0 0 10 ...
## $ A14 : num 202 100 120 360 164 80 180 52 0 320 ...
## $ A15 : int 0 3 0 0 31285 1349 314 1442 0 0 ...
## $ Class : Factor w/ 2 levels "-","+": 2 2 2 2 2 2 2 2 2 2 ...Posteriormente, se aplicó la función nearZeroVar() sobre las variables dummy para identificar aquellas con baja varianza.
Podemos identificar varias variables que cumplen con esta condición al tener el valor TRUE en nzv:
Variables categóricas binarias: A4l, A5gg.
Variables categóricas con más niveles: A6d, A6Desconocido, A6e, A6j, A6m, A6r, A7dd, A7j, A7n, A7o, A7z, A13p.
Para cada variable categórica identificada, tenemos dos formas de actuar: eliminar directamente las categorías con poca representación, o agregarlas con categorías más frecuentes. Sin embargo, en ocasiones es interesante no eliminar o agrupar esas categorías si alguno de los valores está especialmente relacionado con una de las clases (gráficos mostrados en el análisis de datos categóricos). Para decidir qué vamos a hacer, es necesario realizar un análisis variable a variable:
Variable A4 [l]. La categoría l aparece 2 veces (0.29% < 1%) y su distribución con la variable de clase es siempre la misma, ya que para cada aparición la clase es “+”. Al haber tanto equilibrio entre las clases, decidimos agruparla en u para no perder información.Variable A5 [gg]. La categoría gg aparece 2 veces (0.29% < 1%) y su distribución con la variable de clase es siempre la misma, ya que para cada aparición la clase es “+”. Al haber tanto equilibrio entre las clases, decidimos agruparla en g para no perder información.Variable A6 [d]. Cuando la salida es positiva “+”, A6 suele tener la mitad de las veces el valor d en comparación a cuando es negativa “-” (en función solo de la categoría d), luego podría ser significativa para la distinción entre clases. Se mantiene como categoría independiente.Variable A6 [Desconocido, r y j]. Las categorías j y r aparecen 10 veces (1.47% > 1%) y 3 veces (0.44% < 1%) respectivamente. Respecto a sus distribuciones con la variable de clase, para la primera, j, la variable de clase es “-” la mayoría de las veces, pero en la segunda, r, ocurre justo lo contrario, predomina “+”. En ambos casos, no hay un gran desbalance entre clases. Además, podemos encontrar distribuciones similares para sendas variables en otras categorías de la variable. Por este motivo, decidimos agrupar j en m, y r en e. Además, agrupamos Desconocido en c por ser la categoría más frecuente. Así, evitamos la pérdida de información, dado que en análisis anteriores detectamos que A6 se trata de una variable con gran valor predictivo.Variable A6 [m, e]: Suus distribuciones por clases no son importantes, pero su frecuencia de aparición no es tan baja como para considerar agruparla o eliminarla. Se mantienen tal y como están.Variable A7 [dd, j, n, o y z]: Como ya vimos anteriormente, aquí encontramos una gran cantidad de variables con una frecuencia muy baja de aparición: dd (6 veces - 0.88% < 1%), j (8 veces - 1.17% > 1%), n (4 veces - 0.59% < 1%), o (2 veces - 0.29%) y z (8 veces - 1.17% > 1%). Respecto a sus distribuciones por clase: en dd predomina “-” sobre “+”, en j la clase “-” supera a “+”, en z “+” destaca sobre “-”, mientras que en n y o están equilibradas ambas clases. En todos los casos donde una clase predomina sobre otra, lo hace por muy poco. Además, podemos comprobar que en bb la clase “-” supera a “+” por muy poco. Por otro lado, la categoría h presenta una distribución por clase similar a la de z. Por estas razones, decidimos agrupar dd, j, n y o en bb, mientras que z la agrupamos con h. En el caso de n y o, aunque no muestran una tendencia por ninguna de las dos clases al estar tan equilibradas, dicidimos agruparlas con bb por estar esta categoría también muy balanceada.Variable A13 [p]: En este caso, la variable p aparece 8 veces (1.16% > 1%) y en su distribución por clase, predomina por muy poca diferencia la clase “+” sobre “-”. Al haber tanto equilibrio entre las clases, decidimos agruparla en g para no perder información.
A continuación, realizaremos los cambios que hemos comentado en los datos de entrenamiento sin variables dummys:
credit.fix4.categorias <- temporal_train
# Cambiar valores de A4
credit.fix4.categorias$A4 <- as.character(credit.fix4.categorias$A4)
credit.fix4.categorias$A4 <- ifelse(credit.fix4.categorias$A4 == "l", "u", credit.fix4.categorias$A4)
credit.fix4.categorias$A4 <- factor(credit.fix4.categorias$A4)
# Cambiar valores de A5
credit.fix4.categorias$A5 <- as.character(credit.fix4.categorias$A5)
credit.fix4.categorias$A5 <- ifelse(credit.fix4.categorias$A5 == "gg", "g", credit.fix4.categorias$A5)
credit.fix4.categorias$A5 <- factor(credit.fix4.categorias$A5)
# Agrupar valores de A6 según las nuevas reglas
credit.fix4.categorias$A6 <- as.character(credit.fix4.categorias$A6)
credit.fix4.categorias$A6 <- ifelse(credit.fix4.categorias$A6 == "r", "e",
ifelse(credit.fix4.categorias$A6 == "j", "m",
ifelse(credit.fix4.categorias$A6 == "Desconocido", "c", credit.fix4.categorias$A6)))
credit.fix4.categorias$A6 <- factor(credit.fix4.categorias$A6)
# Agrupar valores de A7 según las nuevas reglas
credit.fix4.categorias$A7 <- as.character(credit.fix4.categorias$A7)
credit.fix4.categorias$A7 <- ifelse(credit.fix4.categorias$A7 %in% c("dd", "j", "n", "o"), "bb",
ifelse(credit.fix4.categorias$A7 == "z", "h", credit.fix4.categorias$A7))
credit.fix4.categorias$A7 <- factor(credit.fix4.categorias$A7)
# Cambiar valores de A13
credit.fix4.categorias$A13 <- as.character(credit.fix4.categorias$A13)
credit.fix4.categorias$A13 <- ifelse(credit.fix4.categorias$A13 == "p", "g", credit.fix4.categorias$A13)
credit.fix4.categorias$A13 <- factor(credit.fix4.categorias$A13)
temporal_train_cat_modified <- credit.fix4.categoriasEste análisis garantiza que las variables categóricas mantengan un equilibrio entre relevancia y simplicidad, reduciendo el ruido y mejorando la eficiencia del modelo. Al agrupar categorías poco representativas, evitamos la introducción de redundancia y potenciales problemas de overfitting, mientras que preservamos aquellas categorías que podrían tener relevancia para la predicción de la clase objetivo.
2.3.1.3.1 Evaluación del tratamiento de variables dummies con poca varianza
Al igual que hicimos para el tratamiento de valores nulos, es necesario evaluar si los cambios aplicados a las variables dummies no incluyen demasido sesgo. Para llevar a cabo la comprobación, usaremos la misma función train_evaluate_model que usamos antes para los nulos, pero aplicándolo en esta ocasión al conjunto de datos que contiene las modificaciones y al conjunto de datos que contenía los valores nulos tratados.
set.seed(125)
model_modified <- train_evaluate_model(temporal_train_cat_modified, "Class")
set.seed(125)
model_temporal <- train_evaluate_model(temporal_train, "Class")
comparison <- data.frame(
Dataset = c("Datos modificados", "Datos de entrenamiento actuales"),
Accuracy = c(
max(model_modified$results$Accuracy),
max(model_temporal$results$Accuracy)
)
)
print(comparison)## Dataset Accuracy
## 1 Datos modificados 0.8903301
## 2 Datos de entrenamiento actuales 0.8921416Corroboramos que los cambios realizados no afectan negativamente al rendimiento, sino que incluso sufren una ligera mejora. Por lo que actualizamos la variable que contiene los datos de entrenamiento (con los nulos tratados) con los nuevos cambios.
2.3.1.4 Eliminación de variables categóricas correladas (Dummy variables)
Antes de continuar con el análisis, es necesario actualizar el conjunto de datos con los nuevos cambios:
data <- temporal_train
# Lista de variables categóricas y numéricas
categorical_vars <- c("A1", "A4", "A5", "A6", "A7", "A9", "A10", "A12", "A13")
numeric_vars <- c("A2", "A3", "A8", "A11", "A14", "A15")
# variable de salida
target_var <- "Class"
# Variables de entrada
input_vars <- setdiff(names(data), target_var)
# Crear variables dummy para todas las variables categóricas (fullRank = TRUE)
cols_categorical <- NULL
if (length(categorical_vars) > 0) {
dummy_categorical <- dummyVars(
paste("~", paste(categorical_vars, collapse = " + ")),
data = data, fullRank = TRUE
)
cols_categorical <- data.frame(predict(dummy_categorical, newdata = data))
}
# Combinar variables categóricas dummy con las numéricas
temporal_train_dummy_aux <- cbind(cols_categorical, data[, numeric_vars], data[, target_var, drop = FALSE])
# Verificar el nuevo conjunto de datos
str(temporal_train_dummy_aux)## 'data.frame': 547 obs. of 28 variables:
## $ A1.b : num 1 1 1 1 1 0 1 1 0 1 ...
## $ A4.y : num 0 0 0 0 0 0 1 1 0 1 ...
## $ A5.p : num 0 0 0 0 0 0 1 1 0 1 ...
## $ A6.c : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A6.cc: num 0 0 0 0 0 1 0 0 0 0 ...
## $ A6.d : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A6.e : num 0 0 0 0 1 0 0 0 0 0 ...
## $ A6.ff: num 0 0 0 0 0 0 0 0 0 0 ...
## $ A6.i : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A6.k : num 0 0 0 0 0 0 1 0 1 1 ...
## $ A6.m : num 0 0 0 1 0 0 0 0 0 0 ...
## $ A6.q : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A6.w : num 1 1 1 0 0 0 0 1 0 0 ...
## $ A6.x : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A7.ff: num 0 0 0 0 0 0 0 0 0 0 ...
## $ A7.h : num 0 0 0 0 1 0 1 0 0 0 ...
## $ A7.v : num 1 1 1 1 0 1 0 1 1 1 ...
## $ A9.t : num 1 1 1 1 1 1 1 1 1 1 ...
## $ A10.t: num 1 1 0 0 0 0 0 0 0 1 ...
## $ A12.t: num 0 1 0 1 1 0 0 1 1 1 ...
## $ A13.s: num 0 0 1 0 0 0 0 0 0 0 ...
## $ A2 : num 30.8 27.8 20.2 32.1 33.2 ...
## $ A3 : num 0 1.54 5.62 4 1.04 ...
## $ A8 : num 1.25 3.75 1.71 2.5 6.5 ...
## $ A11 : int 1 5 0 0 0 0 0 0 0 10 ...
## $ A14 : num 202 100 120 360 164 80 180 52 0 320 ...
## $ A15 : int 0 3 0 0 31285 1349 314 1442 0 0 ...
## $ Class: Factor w/ 2 levels "-","+": 2 2 2 2 2 2 2 2 2 2 ...Una vez actualizado, comprobamos si hay variables correladas con las nuevas variables dummies:
# Juntamos los datos numericos y los datos dummys
dfdate <- cbind(cols_categorical, data[, numeric_vars])
cor_matrix <- cor(dfdate)
# Generar la matriz de correlación simbólica
symnum(cor_matrix)## A1. A4 A5 A6.c A6.cc A6.d A6.e A6.f A6.i A6.k A6.m A6.q A6.w A6.x A7.f
## A1.b 1
## A4.y 1
## A5.p 1 1
## A6.c 1
## A6.cc 1
## A6.d 1
## A6.e 1
## A6.ff 1
## A6.i 1
## A6.k 1
## A6.m 1
## A6.q 1
## A6.w 1
## A6.x 1
## A7.ff B 1
## A7.h
## A7.v . .
## A9.t
## A10.t
## A12.t
## A13.s
## A2
## A3
## A8
## A11
## A14
## A15
## A7.h A7.v A9 A10 A12 A13 A2 A3 A8 A11 A14 A15
## A1.b
## A4.y
## A5.p
## A6.c
## A6.cc
## A6.d
## A6.e
## A6.ff
## A6.i
## A6.k
## A6.m
## A6.q
## A6.w
## A6.x
## A7.ff
## A7.h 1
## A7.v . 1
## A9.t 1
## A10.t . 1
## A12.t 1
## A13.s 1
## A2 1
## A3 1
## A8 . . . 1
## A11 . . . 1
## A14 1
## A15 1
## attr(,"legend")
## [1] 0 ' ' 0.3 '.' 0.6 ',' 0.8 '+' 0.9 '*' 0.95 'B' 1Corroboramos la información de la matriz con la función “findCorrelation”:
cutoff <- 0.85
# Obtener los índices de las columnas a eliminar
highCorr <- findCorrelation(cor_matrix, cutoff = cutoff)
# Obtener los nombres de las columnas a eliminar
colsToRemove <- names(dfdate)[highCorr]
# Mostrar las columnas que se eliminarán
print("Variables a eliminar debido a alta correlación:")## [1] "Variables a eliminar debido a alta correlación:"## [1] "A6.ff" "A4.y"Podemos comprobar que la variable A4 [y] esta correlacionada con la variable A5 [p], luego podemos eliminarla ya que representan la misma información. Además podemos ver otra correlación con la variable A6 y A7 con el valor ff ambos respectivamente. Entonces, al igual que antes podemos eliminar una de ellas, por ejemplo A6 [ff]. Sin embargo existe otra correlación no muy fuerte entre la variable A7 [v] y A7 [h], pero es de 0.6, no lo suficiente para tomar la decisión de eliminar una de las dos.
Procedemos a la eliminación de la variable A4 [y] y A6 [ff].
temporal_train_dummy_modified <- temporal_train_dummy_aux
temporal_train_dummy_modified <- temporal_train_dummy_modified[, !names(temporal_train_dummy_modified) %in% "A4.y"]
temporal_train_dummy_modified <- temporal_train_dummy_modified[, !names(temporal_train_dummy_modified) %in% "A6.ff"]
names (temporal_train_dummy_modified)## [1] "A1.b" "A5.p" "A6.c" "A6.cc" "A6.d" "A6.e" "A6.i" "A6.k" "A6.m"
## [10] "A6.q" "A6.w" "A6.x" "A7.ff" "A7.h" "A7.v" "A9.t" "A10.t" "A12.t"
## [19] "A13.s" "A2" "A3" "A8" "A11" "A14" "A15" "Class"2.3.1.4.1 Evaluación del tratamiento de variables dummies correladas
Al igual que hicimos para las anteriores modificaciones, evaluamos que las eliminaciones realizadas en la variable A4 [y] y A6 [ff] no introducen sesgo en comparación con las últimas modificaciones (agregaciones de variables):
set.seed(125)
# Definir un grid personalizado
grid_modificado_dummy <- expand.grid(
mtry = c(2, 15, 27),
splitrule = "gini",
min.node.size = c(1, 5, 10)
)
set.seed(125)
# Definir un grid personalizado
grid_modificado_dummy1 <- expand.grid(
mtry = c(2, 14, 25),
splitrule = "gini",
min.node.size = c(1, 5, 10)
)
# Función para entrenar y evaluar el modelo
train_evaluate_model_dummy <- function(dataset, target_column) {
# Separar predictores y variable objetivo
predictors <- dataset[, !names(dataset) %in% target_column]
target <- dataset[[target_column]]
set.seed(125)
# Entrenar modelo con caret
model <- train(
x = predictors,
y = target,
method = "ranger", # Implementación rápida de Random Forest
trControl = control,
tuneGrid = grid_modificado_dummy
)
return(model)
}
# Función para entrenar y evaluar el modelo
train_evaluate_model_dummy1 <- function(dataset, target_column) {
# Separar predictores y variable objetivo
predictors <- dataset[, !names(dataset) %in% target_column]
target <- dataset[[target_column]]
set.seed(125)
# Entrenar modelo con caret
model <- train(
x = predictors,
y = target,
method = "ranger", # Implementación rápida de Random Forest
trControl = control,
tuneGrid = grid_modificado_dummy1
)
return(model)
}
set.seed(125)
model_modified <- train_evaluate_model_dummy1(temporal_train_dummy_modified, "Class")
set.seed(125)
model_temporal <- train_evaluate_model_dummy(temporal_train_dummy_aux, "Class")
comparison <- data.frame(
Dataset = c("Datos con dummy", "Datos modificados con dummy"),
Accuracy = c(
max(model_temporal$results$Accuracy),
max(model_modified$results$Accuracy)
)
)
print(comparison)## Dataset Accuracy
## 1 Datos con dummy 0.8903401
## 2 Datos modificados con dummy 0.8885186Observamos que las modificaciones no afectan al rendimiento, por lo que procedemos a realizarlo:
2.3.1.5 Eliminación de variables categóricas en función de su asociación
En este caso, vamos a analizar la asociación existente entre las variables categóricas sin convertirlas a variables dummy.
# Filtrar solo las variables categóricas en el dataset
categorical_vars <- names(credit)[sapply(credit, is.factor) | sapply(credit, is.character)]
categorical_vars <- categorical_vars[1:9] # Excluir la variable de clase
categorical_data <- credit[, categorical_vars]
# Crear una matriz vacía para almacenar los resultados de V de Cramer entre las variables categóricas
n <- length(categorical_vars)
cramer_matrix <- matrix(NA, nrow = n, ncol = n, dimnames = list(categorical_vars, categorical_vars))
# Calcular V de Cramer para cada par de variables categóricas
for (i in 1:(n-1)) {
for (j in (i+1):n) {
cramer_matrix[i, j] <- CramerV(table(categorical_data[[i]], categorical_data[[j]]))
}
}
# Visualizar la matriz de V de Cramer
cramer_matrix## A1 A4 A5 A6 A7 A9 A10
## A1 NA 0.07270823 0.07270823 0.3586536 0.2148438 0.01792815 0.07445207
## A4 NA NA 1.00000000 0.1600990 0.3656891 0.15713918 0.18298710
## A5 NA NA NA 0.1600990 0.3656891 0.15713918 0.18298710
## A6 NA NA NA NA 0.5896455 0.32720977 0.28238417
## A7 NA NA NA NA NA 0.27071106 0.12708591
## A9 NA NA NA NA NA NA 0.43203236
## A10 NA NA NA NA NA NA NA
## A12 NA NA NA NA NA NA NA
## A13 NA NA NA NA NA NA NA
## A12 A13
## A1 0.05330833 0.08389595
## A4 0.05843995 0.35856203
## A5 0.05843995 0.35856203
## A6 0.18472904 0.20544130
## A7 0.15529192 0.36152246
## A9 0.09127576 0.14908560
## A10 0.01704281 0.24884032
## A12 NA 0.07451145
## A13 NA NALo único destacable en la matriz es la observación realizada en el apartado anterior. Las variables A4 y A5 tienen una dependencia total entre ellas, por lo que el valor de una de ellas determina completamente el valor de la otra.
# Gráfico de barras para las variables categóricas
categorical_vars <- c("A4", "A5")
plots <- list() # Lista para almacenar los gráficos
for (var in categorical_vars) {
p <- ggplot( temporal_train
, aes(x = .data[[var]], fill = Class)) +
geom_bar(position = "dodge") +
facet_wrap(~ Class) +
labs(title = paste("Distribución de", var, "por Clase"), x = var, y = "Frecuencia") +
theme_minimal() +
theme(legend.position = "bottom") +
scale_fill_manual(values = c("red2", "turquoise3"))
plots[[var]] <- p # Agregar cada gráfico a la lista
}
# Mostrar los gráficos al mismo tiempo
grid.arrange(grobs = plots, ncol = 2) # Organizar en 2 columnas
Además, si observando el gráfico anterior, podemos ver que los valores de u e y de la variable A4 están asociados totalmente con los valores g y p de la variable A5, respectivamente. Por este motivo, concluimos que lo mejor es eliminar una de estas variables del conjunto de datos. Así, llevamos a cabo la eliminación de A4.
credit.fix5.del <- temporal_train[, !names(temporal_train) %in% "A4"]
temporal_train_modified <- credit.fix5.del2.3.1.5.1 Evaluación del tratamiento de variables categóricas asociadas
Volvemos a aplicar Random Forest a dos conjuntos de datos para evaluar el impacto de los cambios realizados. En este caso, se aplica al conjunto de datos de entrenamiento que contiene ambas variables (A4 y A5) y al conjunto de datos de entrenamiento modificado con la eliminación de A4.
set.seed(125)
# Definir un grid personalizado
grid_modificado2 <- expand.grid(
mtry = c(2, 8, 14), # Modificamos el maximo a 14 ya que hemos eliminado una variable
splitrule = "gini",
min.node.size = c(1, 5, 10)
)
# Función para entrenar y evaluar el modelo
train_evaluate_model2 <- function(dataset, target_column) {
# Separar predictores y variable objetivo
predictors <- dataset[, !names(dataset) %in% target_column]
target <- dataset[[target_column]]
set.seed(125)
# Entrenar modelo con caret
model <- train(
x = predictors,
y = target,
method = "ranger", # Implementación rápida de Random Forest
trControl = control,
tuneGrid = grid_modificado2
)
return(model)
}
set.seed(125)
model_modified <- train_evaluate_model2(temporal_train_modified, "Class")
model_temporal <- train_evaluate_model(temporal_train, "Class")
comparison <- data.frame(
Dataset = c("Datos actuales", "Datos modificados (sin A4)"),
Accuracy = c(
max(model_temporal$results$Accuracy),
max(model_modified$results$Accuracy)
)
)
print(comparison)## Dataset Accuracy
## 1 Datos actuales 0.8903301
## 2 Datos modificados (sin A4) 0.8958246Podemos observar que no introducen sesgo dañino para el modelo. Por lo tanto, confirmamos las modificaciones.
2.3.2 Con tratamiento de outliers
El efecto de los outliers en las variables numéricas de nuestro conjunto de datos es considerable, tanto que la mediana es la medida de tendencia central para todas ellas.
A continuación, procedemos a eliminar todos aquellos valores que sobrepasen 3/2 la distancia intercuartil y a almacenar el número de outliers eliminados por cada predictor numérico:
### SIN OUTLIERS
cleaned_data <- temporal_train
# Crear un vector para almacenar el número de outliers eliminados
outliers_removed <- c()
# Iterar sobre cada variable numérica para eliminar outliers y contar cuántos se eliminan
for (var in numeric_vars) {
# Obtener los datos de la variable
data <- cleaned_data[[var]]
# Calcular los valores de los cuartiles y el rango intercuartílico (IQR)
Q1 <- quantile(data, 0.25, na.rm = TRUE)
Q3 <- quantile(data, 0.75, na.rm = TRUE)
IQR <- Q3 - Q1
# Determinar límites inferior y superior para outliers
lower_bound <- Q1 - 1.5 * IQR
upper_bound <- Q3 + 1.5 * IQR
# Identificar los índices de los outliers
outlier_indices <- which(data < lower_bound | data > upper_bound)
# Contar el número de outliers
num_outliers <- length(outlier_indices)
outliers_removed[var] <- num_outliers
# Eliminar los outliers del dataset
temporal_train_no_outliers <- cleaned_data[-outlier_indices, ]
}
# Mostrar el número de outliers eliminados para cada variable
print(outliers_removed)## A2 A3 A8 A11 A14 A15
## 20 15 50 63 10 75Podemos observar aquí como la variable A15 y A11 son las que mayor número de valores atípicos tienen, mientras que A14 y A13 son las que menos. Para comprobar si es mejor eliminar los outliers o tratarlos, hemos considerado oportuno aplicar la técnica de winsorización, que consiste en limitar los valores extremos (outliers) en un conjunto de datos reemplazándolos por percentiles específicos, como el 5% y 95%, y comprobar qué es mejor.
### WINSORAZED
# Crear una copia del dataset original
temporal_train_winsorized <- temporal_train
# Crear un vector para almacenar el número de outliers identificados
outliers_removed <- c()
# Iterar sobre cada variable numérica para aplicar Winsorización
for (var in numeric_vars) {
# Obtener los datos de la variable
data <- temporal_train[[var]]
# Calcular los valores de los cuartiles y el rango intercuartílico (IQR)
Q1 <- quantile(data, 0.25, na.rm = TRUE)
Q3 <- quantile(data, 0.75, na.rm = TRUE)
IQR <- Q3 - Q1
# Determinar límites inferior y superior para outliers
lower_bound <- Q1 - 1.5 * IQR
upper_bound <- Q3 + 1.5 * IQR
# Reemplazar valores fuera de los límites con los límites
data_winsorized <- data
data_winsorized[data < lower_bound] <- lower_bound
data_winsorized[data > upper_bound] <- upper_bound
# Actualizar el dataset con los valores tratados
temporal_train_winsorized[[var]] <- data_winsorized
}
# Resumen del dataset Winsorizado
summary(temporal_train_winsorized)## A1 A2 A3 A5 A6 A7
## a:165 Min. :13.75 Min. : 0.000 g:421 c :106 bb: 67
## b:382 1st Qu.:22.50 1st Qu.: 1.000 p:126 q : 58 ff: 48
## Median :27.83 Median : 2.750 i : 53 h :108
## Mean :30.91 Mean : 4.733 w : 48 v :324
## 3rd Qu.:36.71 3rd Qu.: 7.543 ff : 46
## Max. :58.02 Max. :17.356 aa : 43
## (Other):193
## A8 A9 A10 A11 A12 A13
## Min. :0.000 f:263 f:313 Min. :0.000 f:293 g:504
## 1st Qu.:0.165 t:284 t:234 1st Qu.:0.000 t:254 s: 43
## Median :1.000 Median :0.000
## Mean :1.738 Mean :1.825
## 3rd Qu.:2.500 3rd Qu.:3.000
## Max. :6.003 Max. :7.500
##
## A14 A15 Class
## Min. : 0.0 Min. : 0.0 -:305
## 1st Qu.: 80.0 1st Qu.: 0.0 +:242
## Median :160.0 Median : 6.0
## Mean :177.5 Mean : 271.7
## 3rd Qu.:273.0 3rd Qu.: 450.0
## Max. :562.5 Max. :1125.0
## Aquí, podemos ver como los valores máximos se han visto reducidos con winsorización. Por ejemplo, el máximo de A15 era 100000, y ahora es de 1125.
Cabe destacar que, en este momento, disponemos de dos dataset de entrenamiento: el primero, sin dummies y con outliers (temporal_train), y el segundo, con dummies y con outliers (temporal_train_dummy). Por tanto, debemos tratar los outliers en el segundo dataset igual que hemos hecho con el primero. Además, habíamos encontrado en pasos previos del análisis que los outliers de la variable A15 podían representar un subgrupo importante, debido a su alta aprobación. Por esta razón, es necesario crear otro dataset con la eliminación de los outliers, a excepción de los de la variable A15, y otro con winsorización.
# Crear copias de los datasets
dataset_dummy <- temporal_train_dummy
dataset_special_A15 <- temporal_train
dataset_dummy_special_A15 <- temporal_train_dummy
# Función para calcular límites y eliminar outliers
remove_outliers <- function(data, variable, keep_outliers = FALSE) {
# Calcular cuartiles e IQR
Q1 <- quantile(data[[variable]], 0.25, na.rm = TRUE)
Q3 <- quantile(data[[variable]], 0.75, na.rm = TRUE)
IQR <- Q3 - Q1
lower_bound <- Q1 - 1.5 * IQR
upper_bound <- Q3 + 1.5 * IQR
if (keep_outliers && variable == "A15") {
# Si estamos manteniendo los outliers de A15, no filtramos esta variable
return(data)
} else {
# Eliminar outliers
return(data[data[[variable]] >= lower_bound & data[[variable]] <= upper_bound | is.na(data[[variable]]), ])
}
}
for (var in numeric_vars) {
# Eliminar todos los outliers para el dataset con dummies
temporal_train_dummy_modified_no_outliers <- remove_outliers(dataset_dummy, var)
# Eliminar outliers excepto los de A15
temporal_train_no_outliers_si_A15 <- remove_outliers(dataset_special_A15, var, keep_outliers = TRUE)
# Eliminar outliers excepto los de A15 con dummies
temporal_train_dummy_modified_no_outliers_si_A15 <- remove_outliers(dataset_dummy_special_A15, var, keep_outliers = TRUE)
}# Crear una copia del dataset original para Winsorización
temporal_train_winsorized_dummy <- temporal_train_dummy
# Función para aplicar Winsorización
winsorize_variable <- function(data, variable) {
# Calcular cuartiles e IQR
Q1 <- quantile(data[[variable]], 0.25, na.rm = TRUE)
Q3 <- quantile(data[[variable]], 0.75, na.rm = TRUE)
IQR <- Q3 - Q1
lower_bound <- Q1 - 1.5 * IQR
upper_bound <- Q3 + 1.5 * IQR
# Reemplazar valores fuera de los límites con los límites
data[[variable]][data[[variable]] < lower_bound] <- lower_bound
data[[variable]][data[[variable]] > upper_bound] <- upper_bound
return(data)
}
# Aplicar Winsorización sobre cada variable numérica en temporal_train_winsorized_dummy
for (var in numeric_vars) {
temporal_train_winsorized_dummy <- winsorize_variable(temporal_train_winsorized_dummy, var)
}A continuación, vamos a realizar un nuevo análisis de la varianza y la correlación de las variables numéricas para los distintos conjuntos de datos. Por un lado, el conjunto de datos con modificaciones y sin outliers, y por otro lado, el conjunto de datos con modificaciones y sin outliers, a excepción de A15. De esta forma, vamos a comprobar si los outliers estaban influyendo en el análisis.
Primero, comprobamos si las variables tienen poca varianza:
## character(0)## character(0)## character(0)Para todos los conjuntos, obtenemos los mismos resultados que antes de la eliminación de outliers. En segundo lugar, calculamos la correlación existente entre las variables numéricas:
## A2 A3 A8 A11 A14 A15
## A2 1
## A3 1
## A8 . . 1
## A11 . 1
## A14 1
## A15 1
## attr(,"legend")
## [1] 0 ' ' 0.3 '.' 0.6 ',' 0.8 '+' 0.9 '*' 0.95 'B' 1## A2 A3 A8 A11 A14 A15
## A2 1
## A3 1
## A8 . 1
## A11 . 1
## A14 1
## A15 . 1
## attr(,"legend")
## [1] 0 ' ' 0.3 '.' 0.6 ',' 0.8 '+' 0.9 '*' 0.95 'B' 1## A2 A3 A8 A11 A14 A15
## A2 1
## A3 1
## A8 . . 1
## A11 . 1
## A14 1
## A15 1
## attr(,"legend")
## [1] 0 ' ' 0.3 '.' 0.6 ',' 0.8 '+' 0.9 '*' 0.95 'B' 1De nuevo, volvemos a observar los mismos resultados que obtuvimos antes de la eliminación de outliers. Por tanto, podemos concluir que no existe ninguna correlación importante entre las variables numéricas. Por último, podemos afirmar también que la eliminación de outliers y winsorización no ha influido en el análisis de eliminación de variables numéricas por poca varianza o alta correlación, puesto que en todos los casos los resultados son los mismos.
2.3.2.0.1 Evaluación del tratamiento de outliers en predictores numéricos
Ahora, evaluamos si la eliminación de outliers ha sido perjudicial. Para ello, vamos a comparar el conjunto de datos de entrenamiento del que disponemos (temporal_train), con los distintos conjuntos de datos para los cuales hemos tratado los outliers.
set.seed(125)
model_temporal <- train_evaluate_model2(temporal_train, "Class")
model_modified <- train_evaluate_model2(temporal_train_no_outliers, "Class")
model_modified2 <- train_evaluate_model2(temporal_train_winsorized, "Class")
model_modified3 <- train_evaluate_model2(temporal_train_no_outliers_si_A15, "Class")
comparison <- data.frame(
Dataset = c("Datos actuales", "Datos sin outliers", "Datos winsorizados", "Datos sin outliers excepto A15"),
Accuracy = c(
max(model_temporal$results$Accuracy),
max(model_modified$results$Accuracy),
max(model_modified2$results$Accuracy),
max(model_modified3$results$Accuracy)
)
)
print(comparison)## Dataset Accuracy
## 1 Datos actuales 0.8958246
## 2 Datos sin outliers 0.8686071
## 3 Datos winsorizados 0.8903301
## 4 Datos sin outliers excepto A15 0.8958246Podemos observar que la eliminación de todos los outliers provoca un deterioramiento en la clasificación. Sin embargo, al aplicar winsorización o al eliminar todos los outliers excepto los de lavariable A15, podemos ver como se obtiene el mismo valor que los datos actuales. Esto verifica en cierta manera la hipótesis que teníamos sobre los outliers de la variable A15. Habíamos dicho que podrían representar una subpoblación distinta al haber tantos datos en la misma situación, por lo que quizás eran importantes para la clasificación. Por lo que, al eliminarlos, perderíamos información y obtendríamos una peor clasificación, tal y como ha ocurrido cuando los hemos eliminado. Para evitar esta situación, trataremos los outliers sin aplicar una eliminación generalizada.
Ahora, tenemos dos opciones, eliminar todos los outliers que no sean los de A15 o aplicar winsorización. La primera opción supone perder mucha información, ya que todas las observaciones con outliers quedarían eliminadas del conjunto. En nuestro caso, esto no es una buena opción, ya que el dataset del que disponemos para realizar la práctica no tiene demasiadas observaciones, por lo que no podemos permitirnos perder más información. Por este motivo, la segunda opción es la más acertada, ya que no eliminamos observaciones y los valores de A15 quedan limitados en cierta manera, evitando que en el futuro, cuando entrenemos los modelos, haya que tratar esos valores extremos para que no empeoren el rendimiento de los modelos. Por tanto, vamos a actualizar el conjunto de datos de entrenamiento con los datos winsorizados.
A continuación hacemos los mismo con los data set de las variables dummy (temporal_train_dummy):
set.seed(125)
model_temporal <- train_evaluate_model_dummy1(temporal_train_dummy, "Class")
set.seed(125)
model_modified <- train_evaluate_model_dummy1(temporal_train_dummy_modified_no_outliers, "Class")
set.seed(125)
model_modified2 <- train_evaluate_model_dummy1 (temporal_train_dummy_modified_no_outliers_si_A15, "Class")
set.seed(125)
model_modified3 <- train_evaluate_model_dummy1 (temporal_train_winsorized_dummy, "Class")
comparison <- data.frame(
Dataset = c("Datos dummy actuales", "Datos dummy sin outliers", "Datos dummy sin outliers excepto A15", "Datos winsorizados dummy"),
Accuracy = c(
max(model_temporal$results$Accuracy),
max(model_modified$results$Accuracy),
max(model_modified2$results$Accuracy),
max(model_modified3$results$Accuracy)
)
)
print(comparison)## Dataset Accuracy
## 1 Datos dummy actuales 0.8885186
## 2 Datos dummy sin outliers 0.8601548
## 3 Datos dummy sin outliers excepto A15 0.8885186
## 4 Datos winsorizados dummy 0.8885186En este caso, winsorización obtiene un resultado ligeramente peor al de eliminar todos los outliers menos los de A15. Sin embargo, el empeoramiento es muy leve, y a cambio no perdemos información. Por tanto, actualizamos la información de temporal_train_dummy con temporal_train_winsorized_dummy:
2.3.2.0.2 Resumen de los distintos conjuntos de entrenamiento
Hasta el momento, tenemos dos conjuntos de datos, los cuales vamos a mostrar y explicar en la siguiente tabla:
# Crear un data frame con la información de los datasets
datasets_info <- data.frame(
Dataset = c(
"temporal_train",
"temporal_train_dummy"
),
Descripción = c(
"Datos sin valores nulos, etiquetas variables categóricas modificadas, eliminación A4 y outliers winsorizados",
"Datos dummy sin valores nulos, etiquetas variables categóricas modificadas, eliminación A4 [y] y A6 [ff] y outliers winsorizados"
)
)
datasets_info %>%
kable("html", col.names = c("Dataset", "Descripción"), align = "l") %>%
kable_styling(
full_width = FALSE, # Ajustar el ancho de la tabla
bootstrap_options = c("striped", "hover", "condensed", "responsive"),
font_size = 14 # Ajustar el tamaño de la fuente
) %>%
column_spec(1, bold = TRUE, color = "white", background = "#0073C2") %>%
column_spec(2, width = "70%") %>% # Ajustar el ancho de la columna de descripción
row_spec(0, bold = TRUE, color = "white", background = "#005F8C") # Dar formato al encabezado| Dataset | Descripción |
|---|---|
| temporal_train | Datos sin valores nulos, etiquetas variables categóricas modificadas, eliminación A4 y outliers winsorizados |
| temporal_train_dummy | Datos dummy sin valores nulos, etiquetas variables categóricas modificadas, eliminación A4 [y] y A6 [ff] y outliers winsorizados |
2.4 Transformación de los datos
2.4.1 Preprocesado para el Análisis de Componentes principales. Escalado
A continuación, vamos a realizar un escalado de las variables numéricas en función de su distribución. Este escalado es un paso esencial en la preparación del conjunto de datos para la realización del análisis PCA, ya que centrar y estandarizar los datos numéricos es un requisito previo fundamental para poder aplicar esta técnica. Existen diferentes métodos de escalado; en nuestro caso, emplearemos dos: scale y range. El método scale se utilizará para variables con distribuciones normales, mientras que el método range se aplicará a aquellas con distribuciones no normales.
Como ya comentamos en el apartado “Análisis exploratorio inicial”, la variable A2 podría estar más cerca de una distribución normal, mientras que A3, A8, A11, A14 y A15 seguían claramente una distribución no normal. Luego vamos a aplicar scale y range a los conjuntos de datos de entrenamiento temporal_train y temporal_train_dummy respectivamente.
Estas transformaciones se realizarán únicamente a las variables numéricas del conjunto de datos, ya que posteriormente serán utilizadas para realizar el PCA. Nuestro objetivo es analizar las diferencias en el PCA al usar o no variables dummy. No consideramos las variables categóricas, ya que dichas variables no se ven afectadas por las transformaciones, por lo que no son relevantes para este análisis.
# Variables categorizadas como Gaussianas y no Gaussianas
gaussians <- c("A2") # Solo una variable
no_gaussians <- c("A3", "A14", "A8", "A11", "A15")
# Identificar las variables categóricas
categorical_vars <- setdiff(names(temporal_train), c(gaussians, no_gaussians))
#######################################################
# 1. Escalado para el conjunto original temporal_train
# Escalar variables Gaussianas (centrado y escalado)
gaussians_df <- temporal_train[, gaussians, drop = FALSE] # Asegurarse de que sea un data frame
escalado1 <- preProcess(gaussians_df, method = c("center", "scale"))
transformed_gaussians1 <- predict(escalado1, gaussians_df)
# Normalizar variables no Gaussianas
no_gaussians_df <- temporal_train[, no_gaussians, drop = FALSE] # Asegurarse de que sea un data frame
pre_process_model1 <- preProcess(no_gaussians_df, method = "range")
transformed_no_gaussians1 <- predict(pre_process_model1, no_gaussians_df)
# Añadir variables categóricas y salida
categorical1 <- temporal_train[, c(categorical_vars), drop = FALSE]
# Combinar los datos transformados
temporal_train_escalados <- cbind(transformed_gaussians1, transformed_no_gaussians1, categorical1)
#######################################################
# 2. Escalado para temporal_train_dummy
# Escalar variables Gaussianas (centrado y escalado)
gaussians_df2 <- temporal_train_dummy[, gaussians, drop = FALSE] # Asegurarse de que sea un data frame
escalado2 <- preProcess(gaussians_df2, method = c("center", "scale"))
transformed_gaussians2 <- predict(escalado2, gaussians_df2)
# Normalizar variables no Gaussianas
no_gaussians_df2 <- temporal_train_dummy[, no_gaussians, drop = FALSE] # Asegurarse de que sea un data frame
pre_process_model2 <- preProcess(no_gaussians_df2, method = "range")
transformed_no_gaussians2 <- predict(pre_process_model2, no_gaussians_df2)
# Añadir variables categóricas
categorical2 <- temporal_train_dummy[, setdiff(names(temporal_train_dummy), c(gaussians, no_gaussians)), drop = FALSE]
# Combinar los datos transformados
temporal_train_dummy_escalados <- cbind(transformed_gaussians2, transformed_no_gaussians2, categorical2)2.4.2 Análisis de Componentes Principales
Vamos a proceder a realizar un análisis para identificar cuáles son los principales variables que determinan la clasificación. Para ello vamos a usar datasets sin outliers, centrados y escalados, ya que PCA es muy sensible a estos factores.
Realizaremos este análisis sobre el dataset temporal_train y temporal_train_dummy, de nuevo nos centramos solo en las variables numéricas y queremos ver la diferencia entre el uso de variables dummy y no.
Hemos pensado en no usar la función de caret y hacerlo a mano para poder personalizar como escalar las variables en función de su distribución. Y no aplicarles a todas es escalado “center-scale”.
# Realizar PCA
pca <- prcomp(temporal_train_escalados[, numeric_vars], scale = FALSE)
# Obtención de la Proporción de Varianza Explicada
VE <- pca$sdev^2
PVE <- VE / sum(VE)
# Crear el Scree Plot acumulado con ggplot
cumPVE <- data.frame(
Component = 1:length(PVE),
CumulativeVariance = cumsum(PVE)
)
scree_plot <- ggplot(cumPVE, aes(x = Component, y = CumulativeVariance)) +
geom_line() +
geom_point() +
geom_hline(yintercept = 0.95, color = "red", linetype = "dashed") + # Línea roja en 0.97
scale_y_continuous(limits = c(0, 1)) + # Limitar eje Y entre 0 y 1
xlab("Principal Component") +
ylab("Cumulative Proportion of Variance Explained") +
ggtitle("Cumulative Scree Plot") +
theme_minimal()
# Mostrar la gráfica
print(scree_plot)
Podemos observar que las cuatro primeras componentes suponen el 0.95% de la varianza explicada. Luego podríamos deshacernos del resto reduciendo la dimensionalidad de 6 variables numéricas a 4, lo que supone una reducción del 33.33% del total. La pérdida de información sería mínima, del 5% únicamente. Realizamos los cambios creando un nuevo data set:
pca_data <- as.data.frame(pca$x[, 1:4]) # Extrae las 3 primeras PC
# Renombrar las componentes principales
colnames(pca_data) <- c("PC1", "PC2", "PC3", "PC4")
# Añadir las variables categóricas al nuevo dataset
categorical_data <- temporal_train_escalados[, categorical_vars]
# Combinar todo en un único dataset
temporal_train_escalados_pca <- cbind(pca_data, categorical_data)
names (temporal_train_escalados_pca)## [1] "PC1" "PC2" "PC3" "PC4" "A1" "A5" "A6" "A7" "A9"
## [10] "A10" "A12" "A13" "Class"Vamos a comprobar si tras aplicar el PCA se ha conseguido una distinción más clara entre clases según los principales componentes.
scatter_matrix <- ggpairs(temporal_train_escalados_pca,
columns = 1:4, # Seleccionar las PCs
mapping = aes(color = Class, alpha = 0.7),
diag = list(continuous = "densityDiag"),
title = "Scatter Plot Matrix")
print(scatter_matrix)
Observamos que ninguna de las componentes principales permite realizar una separación clara entre clases, lo que podría indicar que las variables originales no tienen suficiente información discriminativa entre clases. Con el PCA hemos reducido la dimensionalidad, pero el objetivo del PCA es maximizar la varianza total del conjunto de datos y no necesariamente busca separar las clases. Podemos hacer una comparación rápida de resultados entre los datos con PCA y los datos de entrenamiento que tenemos por el momento:
set.seed(125)
# Definir un grid personalizado
grid_modificado3 <- expand.grid(
mtry = c(2, 6, 11), # Modificamos el maximo a 11 ya que hemos reducido dimensiones
splitrule = "gini",
min.node.size = c(1, 5, 10)
)
# Función para entrenar y evaluar el modelo
train_evaluate_model3 <- function(dataset, target_column) {
# Separar predictores y variable objetivo
predictors <- dataset[, !names(dataset) %in% target_column]
target <- dataset[[target_column]]
set.seed(125)
# Entrenar modelo con caret
model <- train(
x = predictors,
y = target,
method = "ranger", # Implementación rápida de Random Forest
trControl = control,
tuneGrid = grid_modificado3
)
return(model)
}
set.seed(125)
model_temporal <- train_evaluate_model2(temporal_train, "Class")
model_modified <- train_evaluate_model3(temporal_train_escalados_pca, "Class")
comparison <- data.frame(
Dataset = c("Datos actuales", "Datos escalados con pca"),
Accuracy = c(
max(model_temporal$results$Accuracy),
max(model_modified$results$Accuracy)
)
)
print(comparison)## Dataset Accuracy
## 1 Datos actuales 0.8903301
## 2 Datos escalados con pca 0.8811425Comprobamos que el uso del pca maximizando la varianza total de las variables numéricas contribuye negativamente a la clasificación de los datos. A pesar de ello, sigue mostrando un resultado aceptable.
2.4.3 Análisis de Componentes Principales para data set con variables Dummy
A continuación realizamos la misma operación pero para el dataset con variables dummy:
pca_dummy <- prcomp(temporal_train_dummy_escalados[, !colnames(temporal_train_dummy_escalados) %in% "Class"], scale = FALSE)
#Obtención de la Proporción de Varianza Explicada
VE <- pca_dummy$sdev^2
PVE <- VE / sum(VE)
PVE_rounded <- round(PVE, 2)
print(PVE_rounded)## [1] 0.27 0.12 0.09 0.07 0.05 0.04 0.04 0.04 0.03 0.03 0.02 0.02 0.02 0.02 0.02
## [16] 0.02 0.02 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.00cumPVE <- qplot(c(1:length(PVE)), cumsum(PVE), geom = "line") +
geom_point() +
xlab("Principal Component") +
ylab("Cumulative Proportion of Variance Explained") +
ggtitle("Cumulative Scree Plot") +
ylim(0, 1.00001) +
geom_hline(yintercept = 0.95, color = "red", linetype = "dashed", size = 1)## Warning: `qplot()` was deprecated in ggplot2 3.4.0.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Como era de esperar la variabilidad ha estado más repartida con la mayor con 0.27 seguida del 0.12 y 0.09. Podemos observar que al alcanzar la varianza el valor 0.95, se quedan fuera las 6 últimas componentes principales, aquellas que tienen el valor 0.1 e igual a 0.0. De esta forma pasamos de 25 variables numéricas a 19, reduciando un 32,14% la dimensionalidad total. Descartamos las variables que consideramos poco importantes:
pca_data_dummy <- as.data.frame(pca_dummy$x[, 1:19])
pcs <- paste0("PC", 1:19)
# Renombrar las componentes principales
colnames(pca_data_dummy) <- pcs
# Añadir la variable de clase al nuevo dataset
class_data <- temporal_train_dummy_escalados[, "Class", drop = FALSE]
# Combinar todo en un único dataset
temporal_train_dummy_escalados_pca <- cbind(pca_data_dummy, class_data)Visualizamos los gráficos para ver si se ha conseguido una separación más clara entre clases con las primeras componentes principales:
scatter_matrix <- ggpairs(temporal_train_dummy_escalados_pca,
columns = 1:5, # Seleccionar las PCs
mapping = aes(color = Class, alpha = 0.7),
diag = list(continuous = "densityDiag"),
title = "Scatter Plot Matrix")
print(scatter_matrix)
Vemos que se puede hacer una mayor distinción de clases con los componentes PC1:PC2, PC3:PC2, PC2:PC4, y P2:PC5. Por tanto, el componente PC2 ayuda claramente a dividir las clases negativas de las positvivas. Estas últimas están inclinadas hacia la izquierda, y las negativas a la derecha. Por lo que, no solo hemos reducido variables, sino que además puede que nos ayude a una mejor distintición en la clasificación.
Hacemos de nuevo una comparación rápida de resultados entre los datos con PCA y los datos de entrenamiento que tenemos por el momento:
set.seed(125)
# Definir un grid personalizado
grid_modificado_dummy2 <- expand.grid(
mtry = c(2, 11, 18), # Modificamos el maximo a 19 ya que hemos reducido dimensiones
splitrule = "gini",
min.node.size = c(1, 5, 10)
)
# Función para entrenar y evaluar el modelo
train_evaluate_model_dummy2 <- function(dataset, target_column) {
# Separar predictores y variable objetivo
predictors <- dataset[, !names(dataset) %in% target_column]
target <- dataset[[target_column]]
set.seed(125)
# Entrenar modelo con caret
model <- train(
x = predictors,
y = target,
method = "ranger", # Implementación rápida de Random Forest
trControl = control,
tuneGrid = grid_modificado_dummy2
)
return(model)
}
set.seed(125)
model_temporal <- train_evaluate_model_dummy1(temporal_train_dummy, "Class")
set.seed(125)
model_modified <- train_evaluate_model_dummy2(temporal_train_dummy_escalados_pca, "Class")
comparison <- data.frame(
Dataset = c("Datos actuales", "Datos escalados con pca"),
Accuracy = c(
max(model_temporal$results$Accuracy),
max(model_modified$results$Accuracy)
)
)
print(comparison)## Dataset Accuracy
## 1 Datos actuales 0.8885186
## 2 Datos escalados con pca 0.8793311Vemos que realizar el PCA sobre el data set dummy ha disminuido ligeramente la predicción final. A pesar de esto, consideramos este data set válido para poder aplicarlo a algún modelo que necesite las variables dumizadas, posiblemente para el modelo de redes neuronales, por ser una reducción leve y todavía aceptable.
2.4.3.0.1 Resumen data set
Para aclararnos con los nuevos data sets, exponemos los que tenemos de momento:
# Crear un data frame con la información de los datasets
datasets_info <- data.frame(
Dataset = c(
"temporal_train",
"temporal_train_escalados_pca",
"temporal_train_dummy",
"temporal_train_dummy_escalados_pca"
),
Descripción = c(
"Datos sin valores nulos, etiquetas variables categóricas modificadas, eliminación A4 y outliers winsorizados",
"Igual que temporal_train con datos escalados y aplicado el PCA",
"Datos dummy sin valores nulos, etiquetas variables categóricas modificadas, eliminación A4 [y] y A6 [ff] y outliers winsorizados",
"Igual que temporal_train_dummy con datos escalados y aplicado el PCA"
)
)
datasets_info %>%
kable("html", col.names = c("Dataset", "Descripción"), align = "l") %>%
kable_styling(
full_width = FALSE, # Ajustar el ancho de la tabla
bootstrap_options = c("striped", "hover", "condensed", "responsive"),
font_size = 14 # Ajustar el tamaño de la fuente
) %>%
column_spec(1, bold = TRUE, color = "white", background = "#0073C2") %>%
column_spec(2, width = "70%") %>% # Ajustar el ancho de la columna de descripción
row_spec(0, bold = TRUE, color = "white", background = "#005F8C") # Dar formato al encabezado| Dataset | Descripción |
|---|---|
| temporal_train | Datos sin valores nulos, etiquetas variables categóricas modificadas, eliminación A4 y outliers winsorizados |
| temporal_train_escalados_pca | Igual que temporal_train con datos escalados y aplicado el PCA |
| temporal_train_dummy | Datos dummy sin valores nulos, etiquetas variables categóricas modificadas, eliminación A4 [y] y A6 [ff] y outliers winsorizados |
| temporal_train_dummy_escalados_pca | Igual que temporal_train_dummy con datos escalados y aplicado el PCA |
Estos conjuntos de datos van a ser usados para entrenar los distintos modelos, aunque dependiendo de cúal usemos puede ser necesario realizar alguna modificación para adaptarnos a las necesidades específicas de cada modelo.
if (!require(here)) install.packages("here", dependencies = TRUE)
if (!require(dplyr)) install.packages("dplyr", dependencies = TRUE)
if (!require(caret)) install.packages("caret", dependencies = TRUE)
if (!require(rpart)) install.packages("rpart", dependencies = TRUE)
if (!require(rpart.plot)) install.packages("rpart.plot", dependencies = TRUE)
if (!require(pROC)) install.packages("pROC", dependencies = TRUE)
if (!require(MASS)) install.packages("MASS", dependencies = TRUE)## Cargando paquete requerido: MASS##
## Adjuntando el paquete: 'MASS'## The following object is masked from 'package:dplyr':
##
## select3 Regresión Logística Bayesiana
3.1 Justificación del modelo elegido
Como modelo simple, hemos elegido regresión logística bayesiana por ser un modelo robusto que no requiere ajuste de hiperparámetros, ya que aplica regularización implícita a través de priors bayesianos predeterminados. Además, es particularmente eficiente para problemas de clasificación binaria y se adapta perfectamente a la naturaleza híbrida de nuestros datos.
Un aspecto clave de la regresión logística bayesiana es su robustez frente a características no ideales en los datos. No necesita que los predictores sigan una distribución normal, lo cual en nuestro caso es una ventaja, ya que hay varios predictores numéricos en nuestro conjunto de datos que no se adaptan a una distribución normal. Otro atributo importante es su capacidad para manejar variables categóricas de forma automática mediante la creación de variables dummy. Sin embargo, este modelo no es capaz de manejar los datos nulos y la alta colinealidad (correlación cercana o igual a 1). Por lo que, para un primer entrenamiento, aprovecharemos el preprocesado realizado anteriormente, tanto para los valores nulos como para las variables altamente correladas.
Por último, este modelo relaciona de manera clara los predictores con la variable objetivo mediante coeficientes estimados que son intuitivos y directamente utilizables. De esta forma, será más fácil conocer los predictores que afectan al resultado y mejorar el preprocesado. En resumen, la combinación de robustez, simplicidad, interpretabilidad y capacidad para manejar predictores mixtos hace que la Regresión Logística Bayesiana sea una buena elección de modelo simple para el conjunto de datos que tenemos y el tipo de problema al que nos enfrentamos.
3.2 Preprocesado de datos
El preprocesamiento es crucial para mejorar la calidad y el rendimiento del modelo. Aunque en apartados anteriores ya hemos tratado ciertos problemas que este modelo no es capaz de manejar, como los datos nulos, las variables con alta colinealidad y variables sin escalar, todavía es necesario realizar un preprocesado previo antes de comenzar con el entrenamiento del modelo.
3.2.1 Entrenamiento del modelo con el preprocesado inicial
Con el fin de comprobar el valor predictivo de cada variable en nuestro modelo de Regresión Logística Bayesiana (bayesglm), vamos a realizar un primer entrenamiento con el conjunto de datos de entrenamiento que obtuvimos del preprocesado inicial. Dadas las características de este modelo, explicadas en el apartado anterior, usaremos como conjunto de datos temporal_train_dummy_escalados, que contiene el conjunto de datos con todas las variables, excepto A4, convertidas a dummy y escaladas. Además, en él ya se han tratado los valores nulos y los outliers.
### Modelo realizado con preprocesado inicial
# Configurar validación cruzada
control <- trainControl(
method = "repeatedcv", # Validación cruzada
number = 10,
repeats = 3
)
# Entrenar el modelo
set.seed(125)
model_bayesglm_sin_nada <- train(
Class ~ ., # Fórmula
data = temporal_train_dummy_escalados, # Todo el dataset
method = "bayesglm", # Método
trControl = control, # Configuración de validación
metric = "Accuracy" # Métrica objetivo
)
# Evaluar el modelo
print(model_bayesglm_sin_nada)## Bayesian Generalized Linear Model
##
## 547 samples
## 25 predictor
## 2 classes: '-', '+'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 493, 493, 492, 492, 492, 492, ...
## Resampling results:
##
## Accuracy Kappa
## 0.8622611 0.7219077##
## Call:
## NULL
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.89248 0.71787 -4.029 5.6e-05 ***
## A2 -0.13526 0.16081 -0.841 0.400265
## A3 0.13352 0.57286 0.233 0.815702
## A14 -0.79144 0.62846 -1.259 0.207908
## A8 1.05814 0.50682 2.088 0.036818 *
## A11 1.01082 0.69861 1.447 0.147922
## A15 1.60296 0.47201 3.396 0.000684 ***
## A1.b -0.04409 0.32986 -0.134 0.893663
## A5.p -0.54822 0.35497 -1.544 0.122492
## A6.c 0.31595 0.46766 0.676 0.499296
## A6.cc 1.96774 0.73144 2.690 0.007140 **
## A6.d 0.06253 0.73045 0.086 0.931785
## A6.e 0.36745 0.75426 0.487 0.626138
## A6.i -0.38279 0.63066 -0.607 0.543870
## A6.k -0.38186 0.61201 -0.624 0.532665
## A6.m 0.32164 0.59495 0.541 0.588768
## A6.q 0.64063 0.54892 1.167 0.243181
## A6.w 0.81001 0.57158 1.417 0.156442
## A6.x 2.40981 0.86837 2.775 0.005518 **
## A7.ff -1.11665 0.75590 -1.477 0.139612
## A7.h -0.03840 0.54072 -0.071 0.943389
## A7.v -0.56599 0.46962 -1.205 0.228118
## A9.t 3.38577 0.33960 9.970 < 2e-16 ***
## A10.t 0.42369 0.45932 0.922 0.356307
## A12.t -0.14676 0.30207 -0.486 0.627081
## A13.s 0.21321 0.52571 0.406 0.685054
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 751.03 on 546 degrees of freedom
## Residual deviance: 315.71 on 521 degrees of freedom
## AIC: 367.71
##
## Number of Fisher Scoring iterations: 10Por un lado, podemos observar que las variables con mayor coeficiente y alta significancia estadística (mayor número de *) son:
A8. Coeficiente alto (1.058) y una alta significancia (*).
A15. Coeficiente alto (1.602) y una gran significancia estadística (***).
A6.cc. Coeficiente alto (1.967) y significancia estadística alta (**).
A6.x. Coeficiente alto (2.409) y significancia estadística elevada (**).
A9.t. Es el predictor más relevante identificado, con mayor coeficiente (3.385) y mayor significancia estadística (***).
De manera conjunta, un alto coeficiente y una alta significancia señala que el predictor tiene un fuerte efecto causal en la variable dependiente (clase). Por tanto, son esenciales para el modelo, ya que predice y afecta directamente el resultado, permitiendo entender las relaciones causales.
# Salida de importancia relativa
variable_importance <- varImp(model_bayesglm_sin_nada)
print(variable_importance)## ROC curve variable importance
##
## only 20 most important variables shown (out of 25)
##
## Importance
## A9.t 100.000
## A11 71.067
## A10.t 61.070
## A8 60.338
## A15 42.142
## A3 31.996
## A7.h 21.763
## A2 21.229
## A5.p 20.286
## A14 19.956
## A7.ff 13.769
## A6.x 12.259
## A6.q 10.870
## A6.cc 10.487
## A6.i 9.976
## A6.k 8.666
## A13.s 8.550
## A7.v 7.868
## A12.t 6.151
## A1.b 5.525
Por otro lado, los predictores con mayor importancia relativa son: A9 (A9.t), A11, A10 (A10.t), A8, A15 y A3. El resto de variables tienen un valor más bajo. Un predictor con alta importancia relativa refleja su utilidad para el rendimiento predictivo, independientemente de su significancia estadística. Puede ocurrir que un predictor tenga alta importancia relativa, pero no ser estadísticamente significativo, como ocurre con A1, A3 y A5.
Por todo esto, decidimos comprobar la importancia de A3, A5, A6, A7, A8, A9, A10, A11 y A15 no eliminándolas en un primer procesado. Por contra, A1, A2, A12 y A13, sí que serán eliminadas.
3.2.2 Análisis para el preprocesado de datos del modelo
Por un lado, realizaremos un entrenamiento para uno de los conjuntos de datos que obtuvimos en los primeros pasos del preprocesado inicial, credit.fix3.categorical (distinto de temporal_train_dummy_escalados del apartado anterior). De esta manera, comprobaremos si es realmente necesario la eliminación de outliers para este modelo u obtiene un mejor redimiento cuando no son tratados, ya que en este conjunto solo están tratados los valores nulos. Para este conjunto será necesario únicamente eliminar la variable A4, que presentaba colinealidad perfecta (1) con A5, y el escalado de los predictores numéricos.
Por otro lado, para el resto de preprocesados, trataremos de la manera que más convenga las categorías que aparezcan muy poco en las observaciones del conjunto de datos. Pues, aunque este modelo es capaz de estabilizar los coeficientes, no elimina completamente el problema, especialmente cuando una categoría tiene muy pocos datos. Para ello, analizaremos las categorías poco frecuentes de todas las variables categóricas, decidiendo si eliminarlas o agruparlas. Además, utilizaremos parte de la información obtenida en el análisis de predictores categóricos previamente realizado.
# Por análisis anteriores, sabemos que estas son las variables que presentan categorías poco frecuentes
categorical <- c("A6", "A7", "A13")
# Generar tablas para cada variable categórica
for (var in categorical) {
freq_table <- table(temporal_train[[var]])
porcent <- prop.table(freq_table) * 100
cat("\nDistribución de la variable:", var, "\n")
print(cbind(total = as.numeric(freq_table), porcentaje = round(porcent, 2)))
}##
## Distribución de la variable: A6
## total porcentaje
## aa 43 7.86
## c 106 19.38
## cc 34 6.22
## d 26 4.75
## e 27 4.94
## ff 46 8.41
## i 53 9.69
## k 41 7.50
## m 35 6.40
## q 58 10.60
## w 48 8.78
## x 30 5.48
##
## Distribución de la variable: A7
## total porcentaje
## bb 67 12.25
## ff 48 8.78
## h 108 19.74
## v 324 59.23
##
## Distribución de la variable: A13
## total porcentaje
## g 504 92.14
## s 43 7.86Variable A6. Las categorías d (4,75 <= 5%), e (4.94% <= 5%) y x (5.48% <= 5%) tienen frecuencias muy bajas. No obstante, tienen distribuciones por clase muy diferentes entre ellas, puesto que en d predomina “-”, en e está muy equilibrado aunque “+” supera a “-”, y en x hay un dominio muy marcado de “+” sobre “-”. Por tanto, decidimos no agruparlas entre ellas. Sin embargo, al tener tener distribuciones por clase similares a las de otras categorías, decidimos apgrupar x en cc, d en i, y e en w.
Variable A7. Aunque hay una categoría claramente dominante, v, con un 59.23%, el resto de categorías (bb, ff y h) tienen frecuencias razonables (> 5%). Por tanto, no es necesario agregar ni eliminar categorías.
Variable A13. En este caso, la variable s aparece más del 5% de las veces. No obstante, si observamos su distribución por clase, podemos comprobar que es exactamente igual a la de g. Por este motivo, en lugar de agregar s a g, puesto que sabemos por análisis previos que esta variable no tiene valor predictivo significativo, decidimos eliminarla.
Otra decisión que hemos tomado, es la eliminación de la variable A1. Su eliminación como predictor queda justificada en apartados anteriores (distribución por clase muy equilibrada sin diferencias significativas en sus categorías y coeficiente de Cramer bajo, 0.048 < 0.1). Además, hemos comprobado que no tiene un coeficiente alto ni una alta importancia relativa. Lo mismo ocurre para A12, cuyo análisis era exactamente igual (Cramer = 0.043 < 0.1; bajo coeficiente y significancia). Por lo que decidimos eliminar también esta variable.
En apartados previos pertenecientes al AED, sospechabamos que A2 y A3 podían no tener sufiente valor predictivo como para ser incluidas. En el apartado anterior, hemos comprobado, por un lado, que A2 no tiene ninguna relevancia en este modelo, ya que presenta bajo coeficiente y baja relevancia, y lo mismo ocurre para su importancia relativa, así que la eliminamos. Por otro lado, aunque A3 tampoco presenta un alto coeficiente y significancia, si presenta una alta importancia relativa, por lo que decidimos dejarla.
Podríamos eliminar también la variable A5 por presentar una importancia relativa media (20). No obstante, en este caso, el gráfico de la distribución por clases de sus categorías no está tan equilibrado como A1 o A12, por lo que decidimos dejarla. Por último, ocurre que al realizar cambios en las variables numéricas (A2) es necesario volver a realizar el escalado.
En conclusión, realizaremos tres preprocesados distintos:
Un primer preprocesado sin nulos, con outliers y sin agrupación de categorías poco frecuentes. Solo eliminamos A4.
Un segundo preprocesado sin las variables A1, A2, A12 y A13 y con agrupación de categorías poco frecuentes en A6.
Un tercer preprocesado sin todas las variables anteriormente eliminadas y sin A3, A5 y A14. Dada la alta impotancia relativa de A11, este predictor no lo eliminaremos.De esta forma, comprobaremos si realmente A3, A5 y A14 tienen un valor predictivo significativo. Además, agruparemos ciertas categorías poco frecuentes de A6.
3.2.3 Realización del preprocesado ajustado al modelo
A continuación, aplicaremos todos los cambios expuestos en el análisis previo:
Agrupación de categorías en la variable A6.
temporal_train_regression <- temporal_train # Agrupar valores de A6 temporal_train_regression$A6 <- as.character(temporal_train_regression$A6) temporal_train_regression$A6 <- ifelse(temporal_train_regression$A6 == "x", "cc", ifelse(temporal_train_regression$A6 == "d", "i", ifelse(temporal_train_regression$A6 == "e", "w", temporal_train_regression$A6))) temporal_train_regression$A6 <- factor(temporal_train_regression$A6) # Mostrar las categorías resultantes levels(temporal_train_regression$A6)## [1] "aa" "c" "cc" "ff" "i" "k" "m" "q" "w"De esta manera, queda reducido el número de categorías de A6 a 9.
Eliminación de variables:
#Eliminación de variables temporal_train_regression_outliers <- credit.fix3.categoricalFix temporal_train_regression_outliers <- temporal_train_regression_outliers %>% dplyr::select(-A4) temporal_train_regression_simple <- temporal_train_regression %>% dplyr::select(-A1, -A2, -A12, -A13) temporal_train_regression <- temporal_train_regression_simple %>% dplyr::select(-A3, -A5, -A14) # Verificar que las columnas han sido eliminadas print("Predictores de temporal_train_regresion_outliers:")## [1] "Predictores de temporal_train_regresion_outliers:"## [1] "A1" "A2" "A3" "A5" "A6" "A7" "A8" "A9" "A10" ## [10] "A11" "A12" "A13" "A14" "A15" "Class"## [1] "Predictores de temporal_train_regresion_simple:"## [1] "A3" "A5" "A6" "A7" "A8" "A9" "A10" "A11" "A14" ## [10] "A15" "Class"## [1] "Predictores de temporal_train_regresion:"## [1] "A6" "A7" "A8" "A9" "A10" "A11" "A15" "Class"Aplicación del escalado.
# Variable categorizada como Gaussiana y no Gaussianas gaussian_only <- c("A2") no_gaussians <- c("A3", "A14", "A8", "A11", "A15") # Identificar las variables categóricas y la variable de salida categorical_regression_outliers <- setdiff(names(temporal_train_regression_outliers), c(gaussian_only, no_gaussians)) # Escalar únicamente la variable Gaussiana (A2) con centrado y escalado escalado_regression_outliers <- preProcess(temporal_train_regression_outliers[, gaussian_only, drop = FALSE], method = c("center", "scale")) transformed_gaussian <- predict(escalado_regression_outliers, temporal_train_regression_outliers[, gaussian_only, drop = FALSE]) # Normalizar las variables no Gaussianas pre_process_model_regression_outliers <- preProcess(temporal_train_regression_outliers[, no_gaussians, drop = FALSE], method = "range") transformed_no_gaussians <- predict(pre_process_model_regression_outliers, temporal_train_regression_outliers[, no_gaussians, drop = FALSE]) # Añadir variables categóricas y salida categorical1_regression_outliers <- temporal_train_regression_outliers[, categorical_regression_outliers, drop = FALSE] # Combinar los datos transformados temporal_train_regression_outliers_escalados <- cbind(transformed_gaussian, transformed_no_gaussians, categorical1_regression_outliers) # Ver la estructura de los datos transformados str(temporal_train_regression_outliers_escalados)## 'data.frame': 547 obs. of 15 variables: ## $ A2 : num -0.0305 -0.2829 -0.9274 0.0746 0.1663 ... ## $ A3 : num 0 0.055 0.2009 0.1429 0.0371 ... ## $ A14 : num 0.101 0.05 0.06 0.18 0.082 0.04 0.09 0.026 0 0.16 ... ## $ A8 : num 0.0439 0.1316 0.06 0.0877 0.2281 ... ## $ A11 : num 0.0149 0.0746 0 0 0 ... ## $ A15 : num 0 0.00003 0 0 0.31285 ... ## $ A1 : Factor w/ 2 levels "a","b": 2 2 2 2 2 1 2 2 1 2 ... ## $ A5 : Factor w/ 3 levels "g","gg","p": 1 1 1 1 1 1 3 3 1 3 ... ## $ A6 : Factor w/ 15 levels "aa","c","cc",..: 13 13 13 10 12 3 9 13 9 9 ... ## $ A7 : Factor w/ 9 levels "bb","dd","ff",..: 8 8 8 8 4 8 4 8 8 8 ... ## $ A9 : Factor w/ 2 levels "f","t": 2 2 2 2 2 2 2 2 2 2 ... ## $ A10 : Factor w/ 2 levels "f","t": 2 2 1 1 1 1 1 1 1 2 ... ## $ A12 : Factor w/ 2 levels "f","t": 1 2 1 2 2 1 1 2 2 2 ... ## $ A13 : Factor w/ 3 levels "g","p","s": 1 1 3 1 1 1 1 1 1 1 ... ## $ Class: Factor w/ 2 levels "-","+": 2 2 2 2 2 2 2 2 2 2 ...### Escalado para temporal_train_regression # Variables categorizadas como Gaussianas y no Gaussianas no_gaussians_regression <- c("A8", "A11", "A15") # Identificar las variables categóricas y la variable de salida categorical_regression <- setdiff(names(temporal_train_regression), no_gaussians_regression) # Normalizar variables no Gaussianas pre_process_model_regression <- preProcess(temporal_train_regression[, no_gaussians_regression, drop = FALSE], method = "range") transformed_no_gaussians_regression <- predict(pre_process_model_regression, temporal_train_regression[, no_gaussians_regression, drop = FALSE]) # Mantener las variables categóricas y la salida sin cambios categorical_vars_regression <- temporal_train_regression[, categorical_regression, drop = FALSE] # Combinar los datos transformados temporal_train_regression_escalados <- cbind(transformed_no_gaussians_regression, categorical_vars_regression) # Verificar el resultado str(temporal_train_regression_escalados)## 'data.frame': 547 obs. of 8 variables: ## $ A8 : num 0.208 0.625 0.285 0.416 1 ... ## $ A11 : num 0.133 0.667 0 0 0 ... ## $ A15 : num 0 0.00267 0 0 1 ... ## $ A6 : Factor w/ 9 levels "aa","c","cc",..: 9 9 9 7 9 3 6 9 6 6 ... ## $ A7 : Factor w/ 4 levels "bb","ff","h",..: 4 4 4 4 3 4 3 4 4 4 ... ## $ A9 : Factor w/ 2 levels "f","t": 2 2 2 2 2 2 2 2 2 2 ... ## $ A10 : Factor w/ 2 levels "f","t": 2 2 1 1 1 1 1 1 1 2 ... ## $ Class: Factor w/ 2 levels "-","+": 2 2 2 2 2 2 2 2 2 2 ...# Variables categorizadas como no Gaussianas no_gaussians_regression_simple <- c("A3", "A14", "A8", "A11", "A15") # Identificar las variables categóricas y la variable de salida categorical_regression_simple <- setdiff(names(temporal_train_regression_simple), no_gaussians_regression_simple) # Escalado para todas las variables no Gaussianas (rango [0, 1]) pre_process_model_regression_simple <- preProcess(temporal_train_regression_simple[, no_gaussians_regression_simple, drop = FALSE], method = "range") transformed_no_gaussians_regression_simple <- predict(pre_process_model_regression_simple, temporal_train_regression_simple[, no_gaussians_regression_simple, drop = FALSE]) # Añadir variables categóricas y salida categorical1_regression_simple <- temporal_train_regression_simple[, categorical_regression_simple, drop = FALSE] # Combinar los datos transformados temporal_train_regression_simple_escalados <- cbind(transformed_no_gaussians_regression_simple, categorical1_regression_simple) # Ver la estructura del data frame resultante str(temporal_train_regression_simple_escalados)## 'data.frame': 547 obs. of 11 variables: ## $ A3 : num 0 0.0887 0.3241 0.2305 0.0599 ... ## $ A14 : num 0.359 0.178 0.213 0.64 0.292 ... ## $ A8 : num 0.208 0.625 0.285 0.416 1 ... ## $ A11 : num 0.133 0.667 0 0 0 ... ## $ A15 : num 0 0.00267 0 0 1 ... ## $ A5 : Factor w/ 2 levels "g","p": 1 1 1 1 1 1 2 2 1 2 ... ## $ A6 : Factor w/ 9 levels "aa","c","cc",..: 9 9 9 7 9 3 6 9 6 6 ... ## $ A7 : Factor w/ 4 levels "bb","ff","h",..: 4 4 4 4 3 4 3 4 4 4 ... ## $ A9 : Factor w/ 2 levels "f","t": 2 2 2 2 2 2 2 2 2 2 ... ## $ A10 : Factor w/ 2 levels "f","t": 2 2 1 1 1 1 1 1 1 2 ... ## $ Class: Factor w/ 2 levels "-","+": 2 2 2 2 2 2 2 2 2 2 ...Vemos como, efectivamente, los valores numéricos han sido escalados
3.3 Entrenamiento del modelo
3.3.1 Entrenamiento del modelo usando crosvalidación
El objetivo de probar diferentes preprocesamientos es mejorar la calidad del modelo al reducir el ruido presente en los datos, facilitando así el aprendizaje de patrones útiles. Además, buscamos adaptarnos a los requisitos específicos de cada modelo y prevenir el sobreajuste, eliminando características redundantes que podrían causar que el modelo se ajustase al ruido.
Al principio de la sección, realizamos el entrenamiento utilizando el conjunto de datos temporal_train_dummy_escalados, que corresponde al obtenido tras aplicar el preprocesamiento inicial. Este conjunto de datos fue preparado de la siguiente manera. Ahora, procederemos a entrenar tres modelos bayesglm más utilizando los siguientes conjuntos de datos:
temporal_train_regression_outliers_escalado. Sin nulos, con outliers, sin A4, sin agrupación de categorías y escalado.
temporal_train_regression_simple_escalados. Igual que temporal_train_dummy_escalados, pero sin conversión de variables categóricas a dummy, con la categoría ff de A6, con nuevas agrupaciones para A6 (x en cc, d en i, y e en w), eliminación de los predictores A1, A2, A12 y A13, y el escalado aplicado.
temporal_train_regression_escalados. Igual que temporal_train_regression_simple_escalados, pero eliminando A1, A2, A3, A5, A12, A13 y A14.
Para el entrenamiento del modelo bayesglm usaremos validación cruzada repetida (method = “repeatedcv”), que evalúa el modelo varias veces (repeats = 3) con diferentes particiones (number = 10) de los datos. Esto reduce el sesgo y la varianza de las métricas de evaluación, dando una visión más confiable del rendimiento esperado del modelo en datos nuevos. Como métrica, utilizaremos Accuracy (clases balanceadas).
# Configurar validación cruzada
control <- trainControl(
method = "repeatedcv", # Validación cruzada
number = 10,
repeats = 3
)
# Entrenar el modelo
set.seed(125)
model_bayesglm_outliers <- train(
Class ~ ., # Fórmula
data = temporal_train_regression_outliers_escalados, # Todo el dataset
method = "bayesglm", # Método
trControl = control, # Configuración de validación
metric = "Accuracy" # Métrica objetivo
)## Warning: fitted probabilities numerically 0 or 1 occurred
## Warning: fitted probabilities numerically 0 or 1 occurred## Bayesian Generalized Linear Model
##
## 547 samples
## 14 predictor
## 2 classes: '-', '+'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 493, 493, 492, 492, 492, 492, ...
## Resampling results:
##
## Accuracy Kappa
## 0.8708241 0.7397593# Configurar validación cruzada
control <- trainControl(
method = "repeatedcv", # Validación cruzada
number = 10,
repeats = 3
)
# Entrenar el modelo
set.seed(125)
model_bayesglm_simple <- train(
Class ~ ., # Fórmula
data = temporal_train_regression_simple_escalados, # Todo el dataset
method = "bayesglm", # Método
trControl = control, # Configuración de validación
metric = "Accuracy" # Métrica objetivo
)
# Evaluar el modelo
print(model_bayesglm_simple)## Bayesian Generalized Linear Model
##
## 547 samples
## 10 predictor
## 2 classes: '-', '+'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 493, 493, 492, 492, 492, 492, ...
## Resampling results:
##
## Accuracy Kappa
## 0.8731714 0.7440067# Configurar validación cruzada
control <- trainControl(
method = "repeatedcv", # Validación cruzada
number = 10,
repeats = 3
)
# Entrenar el modelo
set.seed(125)
model_bayesglm <- train(
Class ~ ., # Fórmula
data = temporal_train_regression_escalados, # Todo el dataset
method = "bayesglm", # Método
trControl = control, # Configuración de validación
metric = "Accuracy" # Métrica objetivo
)
# Evaluar el modelo
print(model_bayesglm)## Bayesian Generalized Linear Model
##
## 547 samples
## 7 predictor
## 2 classes: '-', '+'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 493, 493, 492, 492, 492, 492, ...
## Resampling results:
##
## Accuracy Kappa
## 0.8726102 0.7432206# Crear un data frame para almacenar las métricas
comparison <- data.frame(
Dataset = character(),
Accuracy = numeric(),
Kappa = numeric(),
stringsAsFactors = FALSE
)
models <- list()
models[["temporal_train_regression_sin_nada"]] <- model_bayesglm_sin_nada
models[["temporal_train_regression_otliers"]] <- model_bayesglm_outliers
models[["temporal_train_regression_simple"]] <- model_bayesglm_simple
models[["temporal_train_regression"]] <- model_bayesglm
# Iterar sobre los modelos
for (name in names(models)) {
model <- models[[name]]
best_accuracy <- max(model$results$Accuracy) # Mejor precisión
best_kappa <- model$results$Kappa[which.max(model$results$Accuracy)] # Kappa asociado
comparison <- rbind(
comparison,
data.frame(
Dataset = name,
Accuracy = best_accuracy,
Kappa = best_kappa
)
)
}
# Mostrar la tabla comparativa
print(comparison)## Dataset Accuracy Kappa
## 1 temporal_train_regression_sin_nada 0.8622611 0.7219077
## 2 temporal_train_regression_otliers 0.8708241 0.7397593
## 3 temporal_train_regression_simple 0.8731714 0.7440067
## 4 temporal_train_regression 0.8726102 0.7432206En la tabla comparativa podemos observar que model_bayesglm_simple es el que mayor desempeño consigue, dado que obtiene un 0.8731 de accuracy. No obstante, model_bayesglm, obtiene un desempeño casi idéntico, 0.8726, con un menor número de predictores. En el caso del modelo entrenado con el conjunto obtenido del preprocesado incial, se consigue un desempeño claramente peor. Además, model_bayesglm_outliers presenta una ligera disminución de accuracy, por lo que tratar los outliers y eliminar variables, tal y como hemos hecho en model_bayesglm_simple y model_bayesglm, no nos va a perjudicar en demasía.
Si comparamos los dos moelos que mayor accuracy obtienen, model_bayesglm es preferible debido a su simplicidad y al buen resultado obtenido en Accuracy. Si bien es cierto que este modelo elimina más predictores, lo que puede suponer la pérdida de variables potencialmente informativas, podemos comprobar comparando el resultado de ambos modelos que dicha pérdida es mínima.
3.3.2 Entrenamiento del modelo con el conjunto de entrenamiento completo
Antes de evaluar el desempeño del modelo, es necesario reentrenar el modelo con el conjunto de datos de entrenamiento completo.
# No hacemos crossvalidación
control <- trainControl(
method = "none"
)
# Reentrenar el modelo
set.seed(125)
model_bayesglm <- train(
Class ~ ., # Fórmula
data = temporal_train_regression_escalados, # Todo el dataset
method = "bayesglm", # Método
trControl = control, # Configuración de validación
metric = "Accuracy" # Métrica objetivo
)
# Vemos que se ha reentrenado
print(model_bayesglm)## Bayesian Generalized Linear Model
##
## 547 samples
## 7 predictor
## 2 classes: '-', '+'
##
## No pre-processing
## Resampling: NoneA diferencia de lo observado en el apartado anterior, aquí no se obtienen métricas de rendimiento para los modelos entrenados. Esto se debe a que el modelo no ha sido evaluado con un conjunto de validación, como sí ocurrió en el apartado anterior al aplicar validación cruzada.
3.4 Evaluación del modelo seleccionado
En este apartado, pasaremos el conjunto de test al modelo para obtener una estimación del desempeño real. Sin embargo, antes de hacerlo, debemos aplicar las mismas transformaciones al conjunto de test que se realizaron en el conjunto de entrenamiento, asegurando así la coherencia y validez de la evaluación:
Eliminación de las variables A1, A2, A3, A4, A5, A12, A13 y A14.
Agrupación de categorías en variables categóricas.
Escalado de variables numéricas.
# Creamos una variable con el conjunto de test de nuestro modelo
test_regression <- credit.Datos.Test
# Eliminamos las variables
test_regression <- test_regression %>%
dplyr::select(-A1, -A2, -A3, -A4, -A5, -A12, -A13, -A14)
# Agrupar valores de A6
test_regression$A6 <- as.character(test_regression$A6)
test_regression$A6 <- ifelse(test_regression$A6 == "r", "e",
ifelse(test_regression$A6 == "j", "m",
ifelse(test_regression$A6 == "Desconocido", "c", test_regression$A6)))
test_regression$A6 <- ifelse(test_regression$A6 == "x", "cc", ifelse(test_regression$A6 == "d", "i", ifelse(test_regression$A6 == "e", "w", test_regression$A6)))
test_regression$A6 <- factor(test_regression$A6)
# Agrupar valores de A7
test_regression$A7 <- as.character(test_regression$A7)
test_regression$A7 <- ifelse(test_regression$A7 %in% c("dd", "j", "n", "o"), "bb",
ifelse(test_regression$A7 == "z", "h", test_regression$A7))
test_regression$A7 <- factor(test_regression$A7)
## Escalado
# Normalizar variables no Gaussianas
transformed_no_gaussians_test_regression <- predict(pre_process_model_regression, test_regression[, no_gaussians_regression])
# Añadir variables categóricas y salida
categorical_test_regression <- test_regression[, c(categorical_regression), drop = FALSE]
# Combinar los datos transformados
test_regression <- cbind(transformed_no_gaussians_test_regression, categorical_test_regression)
# Verificar el nuevo conjunto de datos
str(test_regression)## 'data.frame': 137 obs. of 8 variables:
## $ A8 : num 0.50646 0.2499 0.36068 0.7222 0.00666 ...
## $ A11 : num 0.8 0 0 0 0 ...
## $ A15 : num 0.498 0.732 0 0.178 2.391 ...
## $ A6 : Factor w/ 9 levels "aa","c","cc",..: 8 8 2 2 6 8 8 2 2 8 ...
## $ A7 : Factor w/ 4 levels "bb","ff","h",..: 3 3 3 3 4 4 4 4 4 4 ...
## $ A9 : Factor w/ 2 levels "f","t": 2 2 1 2 1 2 2 2 2 2 ...
## $ A10 : Factor w/ 2 levels "f","t": 2 1 1 1 1 2 2 2 1 2 ...
## $ Class: Factor w/ 2 levels "-","+": 2 2 2 2 2 2 2 2 2 2 ...Podemos comprobar que se han realizado todos los cambios, por lo que el conjunto de test ya está listo para pasarselo al modelo model_bayesglm.
# Preparar predictores
train_predictors_regression <- temporal_train_regression_escalados[, setdiff(names(temporal_train_regression_escalados), "Class")]
# Generar predicciones para calcular el error de entrenamiento
predictions_regression <- predict(model_bayesglm, newdata = train_predictors_regression)
# Calcular la matriz de confusión y métricas
conf_matrix <- confusionMatrix(predictions_regression, temporal_train_regression_escalados$Class, positive = "+")
print(conf_matrix$table)## Reference
## Prediction - +
## - 267 28
## + 38 214accuracy <- conf_matrix$overall["Accuracy"]
train_error_regression <- 1 - accuracy
# Reordenar columnas del conjunto de prueba según el entrenamiento
test_regression <- test_regression[, colnames(temporal_train_regression_escalados)]
# Preparar predictores (excluyendo la clase objetivo)
test_predictors_regression <- test_regression[, setdiff(names(test_regression), "Class")]
# Generar predicciones directamente como etiquetas con threshold 0.5
predictions_regression <- predict(model_bayesglm, newdata = test_predictors_regression)
# Calcular la matriz de confusión y métricas
conf_matrix <- confusionMatrix(predictions_regression, test_regression$Class, positive = "+")
print(conf_matrix$table)## Reference
## Prediction - +
## - 60 5
## + 16 56accuracy <- conf_matrix$overall["Accuracy"]
test_error_regression <- 1 - accuracy
# Generar probabilidades y calcular AUC
predictions_prob_regression <- predict(model_bayesglm, newdata = test_predictors_regression, type = "prob")
roc_reg_log <- roc(test_regression$Class, predictions_prob_regression[, 2], levels = rev(levels(test_regression$Class)))## Setting direction: controls > cases## AUC: 0.9296808## Accuracy: 0.8467153## Error de test: 0.1532847## Error de entrenamiento: 0.1206581A continuación, evaluaremos los resultados obtenidos al aplicar el conjunto de test a nuestro modelo:
Podemos observar en la matriz de confusión que hay un total de 60 verdaderos negativos (TN), 56 verdaderos positivos (TP), 16 falsos positivos (FP) y 5 falsos negativos (FN). El número de falsos positivos no es relativamente alto, pero deberíamos intentar mejorarlo dado el contexto de nuestro problema, donde hay mayor riesgo asociado a los FP que a los FN.
El AUC evalua el desempeño de modelos de clasificación binaria. Mide la capacidad del modelo para distinguir entre las dos clases en todas las configuraciones de threshold posibles. Aunque el modelo no sea perfecto, un AUC alto indica que, en la mayoría de los casos, asignará probabilidades adecuadas. Es decir, será bueno discriminando entre las clases. En nuestro caso, el valor AUC es igual a 0.929, lo que significa que el modelo puede asignar puntuaciones de probabilidad correctamente en la mayoría de los casos, separando los positivos de los negativos con alta precisión.
El Accuracy del conjunto de prueba es del 84.67%, lo que significa que el modelo clasifica correctamente la mayoría de las observaciones. En nuestro caso, sabemos que las clases están balanceadas, por lo que es una métrica fiable.
El error de entrenamiento de 12% indica un ajuste razonablemente bueno del modelo a los datos de entrenamiento, sin llegar al sobreajuste. Un error bajo en el entrenamiento combinado con un error bajo en el test (15.3%) es un buen indicador de generalización. La diferencia con el error de test (0.1532 - 0.1206 = 0.0326 ó 3.26%) es pequeña, lo que sugiere que el modelo no está sobreajustado y tiene un buen equilibrio entre aprendizaje y generalización.
No obstante, nos planteamos si podríamos mejorar estos resultados ajustando diferentes threshold. Dado el contexto de nuestro problema, la concesión de créditos bancarios, queremos asegurarnos de que el modelo conceda créditos solamente a solicitantes que realmente puedan devolver el dinero. Por este motivo, debemos evitar un gran número de falsos positivos, para reducir el riesgo de otorgar un crédito y que este no sea devuelto. Sin embargo, debemos ser cuidadosos y no ser excesivamente estrictos, evitando rechazar a demasiados buenos candidatos, aumentando mucho los FN. Para conseguirlo, será necesario ajustar el threshold de nuestro modelo.
En nuestro modelo, el umbral por defecto para clasificar es 0.5. De tal manera que, si la probabilidad estimada de que un individuo puede pagar el crédito es mayor a 0.5, se clasifica como “+”. Si es menor o igual, se clasifica como “-”. Para ajustar correctamente el threshold, seguiremos los siguientes pasos:
Evaluaremos la curva ROC para ver cómo varían la sensibilidad (verdaderos positivos) y la especificidad (verdaderos negativos) a medida que se ajusta el threshold. Dado que nuestra prioridad es minimizar los falsos positivos, buscaremos un punto donde la especificidad sea alta (es decir, pocos negativos clasificados erróneamente como positivos), pero no en exceso.
Consideraremos otras métricas, como F1-Score para encontrar un punto de equilibrio razonable entre ambas.
# Generar probabilidades de predicción con el modelo entrenado
predictions_regression <- predict(model_bayesglm, newdata = test_predictors_regression, type = "prob")
# Crear la curva ROC
roc_reg_log <- roc(test_regression$Class, predictions_regression[, 2], levels = rev(c('+','-')))## Setting direction: controls < cases# Visualizar la curva ROC
plot(roc_reg_log, col = "blue", lwd = 2, main = "Curva ROC")
abline(a = 0, b = 1, col = "gray", lty = 2) # Línea diagonal (azar)
# Definir los thresholds a probar
thresholds <- seq(0.5, 0.9, by = 0.1)
# Crear un data frame vacío para almacenar los resultados
results <- data.frame(
Threshold = numeric(),
Accuracy = numeric(),
FP = numeric(),
FN = numeric(),
Sensitivity = numeric(),
Specificity = numeric(),
F1 = numeric()
)
# Probar cada threshold
for (threshold in thresholds) {
# Ajustar las predicciones según el threshold
predictions_regression_custom <- ifelse(predictions_regression[, 2] > threshold, "+", "-")
predictions_regression_custom <- factor(predictions_regression_custom, levels = levels(test_regression$Class))
# Generar la matriz de confusión
conf_matrix <- confusionMatrix(predictions_regression_custom, test_regression$Class, positive = '+')
print(paste("Threshold:",threshold))
print(conf_matrix$table)
FN <- conf_matrix$table["-", "+"]
FP <- conf_matrix$table["+", "-"]
# Calcular métricas
accuracy <- conf_matrix$overall["Accuracy"]
sensitivity <- conf_matrix$byClass["Sensitivity"]
specificity <- conf_matrix$byClass["Specificity"]
precision <- conf_matrix$byClass["Pos Pred Value"]
recall <- conf_matrix$byClass["Recall"]
f1 <- conf_matrix$byClass["F1"]
# Almacenar los resultados
results <- rbind(results, data.frame(
Threshold = threshold,
Accuracy = accuracy,
FP = FP,
FN = FN,
Sensitivity = sensitivity,
Specificity = specificity,
F1 = f1
))
}## [1] "Threshold: 0.5"
## Reference
## Prediction - +
## - 60 5
## + 16 56
## [1] "Threshold: 0.6"
## Reference
## Prediction - +
## - 63 8
## + 13 53
## [1] "Threshold: 0.7"
## Reference
## Prediction - +
## - 66 9
## + 10 52
## [1] "Threshold: 0.8"
## Reference
## Prediction - +
## - 70 17
## + 6 44
## [1] "Threshold: 0.9"
## Reference
## Prediction - +
## - 74 23
## + 2 38## Threshold Accuracy FP FN Sensitivity Specificity F1
## Accuracy 0.5 0.8467153 16 5 0.9180328 0.7894737 0.8421053
## Accuracy1 0.6 0.8467153 13 8 0.8688525 0.8289474 0.8346457
## Accuracy2 0.7 0.8613139 10 9 0.8524590 0.8684211 0.8455285
## Accuracy3 0.8 0.8321168 6 17 0.7213115 0.9210526 0.7927928
## Accuracy4 0.9 0.8175182 2 23 0.6229508 0.9736842 0.7524752# Añadir la información de la curva ROC al data frame
roc_data <- data.frame(
Threshold = coords(roc_reg_log, seq(0, 1, by = 0.01), ret = "threshold"),
Sensitivity = coords(roc_reg_log, seq(0, 1, by = 0.01), ret = "sensitivity"),
Specificity = coords(roc_reg_log, seq(0, 1, by = 0.01), ret = "specificity")
)El gráfico muestra una curva ROC que está bien alejada de la diagonal (línea gris). Esto significa que nuestro modelo tiene buena capacidad discriminativa. El área bajo la curva (AUC) es alta, como ya vimos antes, lo cual respalda esta afirmación.
Si observamos la tabla, podemos ver que el mejor thereshold es el de 0.7, ya que la especificidad es ligeramente mayor que la sensibilidad. Esto provoca que el número de FP se reduzca de 16 (0.5) a 10. Además, podemos ver que ambos valores están bastante equilibrados, por lo que al mismo tiempo que evitamos conceder créditos a gente que no puede devolverlos, también estamos evitando ser demasiado estrictos con aquellos que sí pueden hacerle frente, no aumentando en exceso el número de FN (9). De hecho, en este caso este número es incluso menor. Asimismo, con este umbral mejora también el accuracy. Por tanto, este umbral mejora claramente el modelo y obtiene un buen equilibrio entre sensibilidad y especificidad, tal y como podemos ver en el valor de F1 (0.845).
# Resultados de accuracy para diferentes thresholds
thresholds <- c(0.5, 0.6, 0.7, 0.8, 0.9) # Valores de threshold
test_accuracy_regression <- c(results$Accuracy) # Accuracy para cada threshold
test_error_regression <- 1 - test_accuracy_regression # Cálculo del error de test
# Crear el dataframe
error_df <- data.frame(
Threshold = thresholds,
Train_Error = rep(train_error_regression, length(thresholds)), # Mismo error para cada threshold
Test_Accuracy = test_accuracy_regression,
Test_Error = test_error_regression
)
# Mostrar el dataframe
print(error_df)## Threshold Train_Error Test_Accuracy Test_Error
## 1 0.5 0.1206581 0.8467153 0.1532847
## 2 0.6 0.1206581 0.8467153 0.1532847
## 3 0.7 0.1206581 0.8613139 0.1386861
## 4 0.8 0.1206581 0.8321168 0.1678832
## 5 0.9 0.1206581 0.8175182 0.1824818Por último, el error de entrenamiento (12%) es ligeramente superior al de test en el threshold 0.7 (13.8%), tal y como se espera de un modelo con buena capacidad de generalización. En concreto, dicha diferencia es de 0.018%, por lo que al no ser excesivamente amplia podemos concluir que el modelo no está sufriendo overfitting. En cuanto a la decisión de qué umbral es mejor, intentaremos confirmar nuestra teoría creando una población y obteniendo el intervalo de confianza.
3.4.1 Creación de una población y obtención del Intervalo de Confianza
Para la creación de una población, es necesario entrenar de nuevo el modelo elegido con distintas semillas. Sin embargo, dado que bayesglm es un modelo determinista, siempre producirá el mismo resultado dado el mismo conjunto de datos de entrenamiento, incluso si usamos diferentes semillas. Esto sucede porque no hay componentes aleatorios en el modelo. Esto es un problema, ya que para la creación de una población utilizando diferentes semillas, necesitamos variabilidad en los resultados. Para solucionar esta limitación, se ha utilizado la técnica de bootstraping, que introduce variabilidad al generar muestras aleatorias con reemplazo del conjunto de datos.
# Crear un dataframe para almacenar resultados
results_regression <- data.frame(Iteración = integer(), Accuracy = numeric())
results_regression_0.7 <- results_regression
accuracy_values <- c()
accuracy_values_0.7 <- c()
# Número de iteraciones de bootstrap
n_bootstrap <- 30
for (i in 1:n_bootstrap) {
# Muestreo bootstrap con reemplazo
set.seed(120 + i) # Para reproducibilidad
bootstrap_index <- sample(1:nrow(temporal_train_regression_escalados), replace = TRUE)
bootstrap_data <- temporal_train_regression_escalados[bootstrap_index, ]
# Entrenar el modelo
model_bayesglm_boot <- train(
Class ~ .,
data = bootstrap_data,
method = "bayesglm",
trControl = trainControl(method = "none"),
metric = "Accuracy"
)
# Generar probabilidades
predictions_prob <- predict(model_bayesglm_boot, newdata = test_predictors_regression, type = "prob")
predictions_prob_0.5 <- predictions_prob
predictions_prob_0.5 <- ifelse(predictions_prob_0.5[, 2] > 0.5, levels(test_regression$Class)[2], levels(test_regression$Class)[1])
predictions_prob_0.5 <- factor(predictions_prob_0.5, levels = levels(test_regression$Class)) # Ajustar niveles
# Generar predicciones como etiquetas con threshold 0.7
predictions <- ifelse(predictions_prob[, 2] > 0.7, levels(test_regression$Class)[2], levels(test_regression$Class)[1])
predictions <- factor(predictions, levels = levels(test_regression$Class)) # Ajustar niveles
# Calcular la matriz de confusión y métricas
conf_matrix_0.5 <- confusionMatrix(predictions_prob_0.5, test_regression$Class)
accuracy <- conf_matrix_0.5$overall["Accuracy"]
accuracy_values <- c(accuracy_values , accuracy)
# Calcular la matriz de confusión y métricas
conf_matrix_0.7 <- confusionMatrix(predictions, test_regression$Class)
accuracy_0.7 <- conf_matrix_0.7$overall["Accuracy"]
accuracy_values_0.7 <- c(accuracy_values_0.7, accuracy_0.7)
# Guardar los resultados
results_regression <- rbind(results_regression, data.frame(Iteración = i, Accuracy = accuracy))
# Guardar los resultados de 0.7
results_regression_0.7 <- rbind(results_regression_0.7, data.frame(Iteración = i, Accuracy = accuracy_0.7))
}
# Mostrar resultados
print(results_regression)## Iteración Accuracy
## Accuracy 1 0.8540146
## Accuracy1 2 0.8248175
## Accuracy2 3 0.8467153
## Accuracy3 4 0.8394161
## Accuracy4 5 0.8175182
## Accuracy5 6 0.8613139
## Accuracy6 7 0.8394161
## Accuracy7 8 0.8394161
## Accuracy8 9 0.8540146
## Accuracy9 10 0.8248175
## Accuracy10 11 0.8467153
## Accuracy11 12 0.8175182
## Accuracy12 13 0.8467153
## Accuracy13 14 0.8467153
## Accuracy14 15 0.8467153
## Accuracy15 16 0.8321168
## Accuracy16 17 0.8540146
## Accuracy17 18 0.8321168
## Accuracy18 19 0.8321168
## Accuracy19 20 0.8540146
## Accuracy20 21 0.8248175
## Accuracy21 22 0.8613139
## Accuracy22 23 0.8394161
## Accuracy23 24 0.8394161
## Accuracy24 25 0.8394161
## Accuracy25 26 0.8540146
## Accuracy26 27 0.8467153
## Accuracy27 28 0.8394161
## Accuracy28 29 0.8540146
## Accuracy29 30 0.8467153## Iteración Accuracy
## Accuracy 1 0.8467153
## Accuracy1 2 0.8467153
## Accuracy2 3 0.8686131
## Accuracy3 4 0.8102190
## Accuracy4 5 0.8394161
## Accuracy5 6 0.8321168
## Accuracy6 7 0.8394161
## Accuracy7 8 0.8102190
## Accuracy8 9 0.8321168
## Accuracy9 10 0.8248175
## Accuracy10 11 0.8613139
## Accuracy11 12 0.8248175
## Accuracy12 13 0.8394161
## Accuracy13 14 0.8467153
## Accuracy14 15 0.8467153
## Accuracy15 16 0.8540146
## Accuracy16 17 0.8540146
## Accuracy17 18 0.8540146
## Accuracy18 19 0.8613139
## Accuracy19 20 0.8467153
## Accuracy20 21 0.8321168
## Accuracy21 22 0.8686131
## Accuracy22 23 0.8759124
## Accuracy23 24 0.8321168
## Accuracy24 25 0.8467153
## Accuracy25 26 0.8686131
## Accuracy26 27 0.8540146
## Accuracy27 28 0.8175182
## Accuracy28 29 0.8540146
## Accuracy29 30 0.8394161# Calcular el intervalo de confianza
mean_acc <- mean(accuracy_values)
std_error <- sd(accuracy_values) / sqrt(length(accuracy_values))
ci_lower <- mean_acc - qt(0.975, df = length(accuracy_values) - 1) * std_error
ci_upper <- mean_acc + qt(0.975, df = length(accuracy_values) - 1) * std_error
cat("Precisión promedio:", mean_acc, "\n")## Precisión promedio: 0.8418491## Intervalo de confianza al 95%: [ 0.8373601 , 0.8463382 ]# Con threshold a 0.7
mean_acc_0.7 <- mean(accuracy_values_0.7)
std_error_0.7 <- sd(accuracy_values_0.7) / sqrt(length(accuracy_values_0.7))
ci_lower_0.7 <- mean_acc_0.7 - qt(0.975, df = length(accuracy_values_0.7) - 1) * std_error_0.7
ci_upper_0.7 <- mean_acc_0.7 + qt(0.975, df = length(accuracy_values_0.7) - 1) * std_error_0.7
cat("Precisión promedio 0.7:", mean_acc_0.7, "\n")## Precisión promedio 0.7: 0.8442822## Intervalo de confianza al 95%: [ 0.8379472 , 0.8506173 ]Podemos comprobar en la tabla que, efectivamente, el modelo ha sido entrenado correctamente con distintas semillas, ya que la métrica accuracy es distinta para cada uno de ellos (tanto para 0.5 como para 0.7). Respecto al intervalo de confianza, podemos observar que:
Para el umbral 0.5 el intervalo de confianza se encuentra entre 83.736% y 84.633%.
Para el umbral 0.7, el rango se encuentra entre 83.79% y 85.061%.
El intervalo es muy parecido para ambos umbrales, pero el del segundo es algo mejor, ya que tanto los límites inferior y superior son más altos. Por tanto, nos quedamos con el segundo, el modelo con el umbral 0.7, pues también ofrece un mejor accuracy promedio (0.8418491 < 0.8442822). De tal forma que, podemos afirmar que el accuracy del modelo se encuentra entre esos intervalos con un 95% de confianza.
3.5 Conclusión del modelo Regresión Logística Bayesiana
En conclusión, el modelo de Regresión Logística Bayesiana alcanza un accuracy promedio de 0.844 al establecer el threshold en 0.7 y aplicar un preprocesado adaptado a las características de los datos y las necesidades del modelo. Este ajuste del umbral permite reducir el número de falsos positivos en comparación con otros umbrales más bajos, lo que mejora significativamente la fiabilidad del modelo de cara al futuro. Además, la diferencia tan estrecha entre el error de entrenamiento y de test, siendo el primero ligeramente superior al segundo, sugiere que el modelo no está sobreajustado y tiene un buen equilibrio entre aprendizaje y generalización.
4 Implementación del Modelo XGBoost
4.1 Objetivo
El propósito de este script es desarrollar, evaluar y optimizar un modelo de clasificación binaria basado en XGBoost, utilizando el enfoque xgbLinear, sobre el conjunto de datos credit_approval. Este modelo tiene como objetivo predecir con alta precisión y mantener un balance adecuado entre sensibilidad y especificidad, priorizando la minimización de falsos positivos, ya que, en el contexto del otorgamiento de créditos, estos errores pueden ser críticos. Para la optimización del modelo, se empleará el uso del parámetro tuneGrid, explorando combinaciones de hiperparámetros para encontrar el mejor ajuste.
4.2 Justificación del modelo elegido
Hemos optado por implementar XGBoost, específicamente el modelo xgbLinear, debido a las características particulares del conjunto de datos. Este conjunto incluye tanto variables numéricas como categóricas (convertidas en dummies durante el preprocesado), con algunas relaciones lineales, presencia de colinealidad en algunas características y variables con contribuciones marginales.
El modelo xgbLinear es especialmente adecuado para este escenario, ya que:
Utiliza regularización avanzada a través de los parámetros lambda y alpha, reduciendo el impacto negativo de las características redundantes en el rendimiento del modelo (Manejo de colinealidad).
El escalado y normalización de las variables numéricas elimina la dependencia de las escalas entre características, potenciando la eficacia del modelo (Preprocesamiento óptimo).
La estructura lineal del modelo, combinada con regularización, garantiza que sea interpretable y eficiente, especialmente en un conjunto de datos con relaciones claras y donde algunas variables tienen mayor peso que otras (Simplicidad e interpretabilidad).
Esta elección asegura que el modelo no solo sea robusto frente a problemas comunes como la colinealidad, sino también interpretable, lo cual es crucial en un proyecto donde entender la contribución de las variables es tan importante como alcanzar un alto rendimiento predictivo.
4.3 Entrenamiento Inicial
4.3.1 Preprocesado específico del modelo
Como ya hemos comentado, realizaremos un entrenamiento inicial
utilizando el conjunto temporal_train_dummy_escalados
obtenido durante el preprocesamiento original. Esto nos permitirá
identificar posibles variables que no contribuyan significativamente al
modelo, con el objetivo de reducir la dimensionalidad del conjunto de
datos y optimizar el rendimiento del modelo.
A este conjunto se le han tratado los nulos y los outliers. Además, las variables categóricas estan dummyficadas y, las numéricas, escaladas.
4.3.2 Configuración del Control de Entrenamiento
Para el entrenamiento del modelo, es fundamental definir cómo la función encargada del entrenamiento dividirá los datos y evaluará el rendimiento durante el ajuste y selección de hiperparámetros.
En este caso, se implementará una validación cruzada de 10 pliegues repetida 3 veces, lo que garantiza una evaluación más robusta y menos dependiente de una única partición aleatoria. Este enfoque permite que cada observación en el conjunto de entrenamiento sea utilizada tanto para entrenamiento como para validación en diferentes iteraciones, maximizando la representatividad de los resultados.
Adicionalmente, se utilizará una búsqueda en cuadrícula (grid search) para explorar exhaustivamente todas las combinaciones posibles de los hiperparámetros definidos, con el objetivo de encontrar la configuración óptima para el modelo.
4.3.3 Búsqueda de Hiperparámetros
Con el fin de realizar una búsqueda exhaustiva sobre los valores de los hiperparámetros más relevantes, se define una parrilla con las combinaciones a probar durante el entrenamiento. Por ello, hemos decidido usar las siguientes combinaciones de hiperparámetros, teniendo en cuenta el tamaño de nuestro conjunto de entrenamiento:
(nrounds): Este hiperparámetro controla el número de iteraciones durante el entrenamiento. Más iteraciones pueden mejorar el rendimiento del modelo, pero también incrementan el riesgo de sobreajuste (overfitting). Por esta razón, hemos seleccionado valores pequeños, dado que al tratarse de un conjunto de datos relativamente simple, queremos encontrar un equilibrio entre subentrenamiento y sobreentrenamiento.
(eta): Este hiperparámetro controla el tamaño del paso en cada iteración. Una tasa más baja se traduce en un aprendizaje más lento y preciso. Por el contrario, una tasa alta permite un entrenamiento más rápido, aunque con mayor riesgo de saltar puntos óptimos. Estos valores permitirán pequeños ajustes en cada iteración para evitar convergencia prematura.
(lambda): Este hiperparámetro controla la penalización de los coeficientes para reducir el impacto de las características colineales o irrelevantes, evitando el sobreajuste (overfitting). Valores más bajos otorgan mayor flexibilidad al modelo, lo cual no nos interesa.
(alpha): Este hiperparámetro controla la penalización de los coeficientes utilizando regularización L1 (penalización de valores absolutos), lo que puede hacer que los coeficientes de algunas variables se reduzcan exactamente a cero. Por esta razón, valores como 2.5, 3 o 3.5 ofrecen una regularización moderada. En caso de que necesitemos una regularización más agresiva se ajustarán estos valores.
4.3.4 Entrenamiento del Modelo
# Separar predictores (todas las columnas menos la última)
train1_x <- train1_xgboost[, -ncol(train1_xgboost)]
# Separar la clase (última columna)
train1_y <- train1_xgboost[, ncol(train1_xgboost)]
# Verificar niveles de la clase
levels(train1_y)## [1] "-" "+"4.3.5 Resultados del entrenamiento
# Extraer la precisión asociada a los mejores parámetros
print(xgbModel$results[which.max(xgbModel$results$Accuracy), ])## nrounds eta lambda alpha Accuracy Kappa AccuracySD KappaSD
## 31 75 0.15 9 2.5 0.8877846 0.7729204 0.02656168 0.05264822
En cuanto a los mejores hiperparámetros obtenidos:
(nrounds = 75) El modelo alcanzó su mejor rendimiento con un número reducido de iteraciones, lo que sugiere que no es necesario un entrenamiento prolongado para ajustar los datos.
(eta = 0.15) La tasa de aprendizaje baja permitió un entrenamiento más lento y preciso, reduciendo el riesgo de sobreajuste.
(lambda = 9) Este valor elevado de regularización L2 ayudó a manejar la colinealidad y las características redundantes, estabilizando el modelo.
(alpha = 2.5) Una regularización L1 moderada eliminó características con poco impacto, haciendo el modelo más interpretable.
En cuanto a las métricas, el modelo muestra un buen desempeño general en la validación cruzada, obteniendo un accuracy de 0.8877. Además, el nivel de acuerdo entre las predicciones del modelo y los valores reales, considerando la distribución de las clases, es moderado, como lo indica el kappa de 0.7729. No obstante, el rendimiento real se observará al aplicar el modelo al conjunto de test, donde se verá cómo generaliza el modelo a datos nuevos y no vistos.
Finalmente, en cuanto a la importancia de las variables, encontramos
que A9.t, A14, A3,
A15, A11 y A8 son las variables
que más contribuyen al modelo, siendo A9.t la que destaca
por encima de las demás con diferencia. Esto se debe a la fuerte
correlación de esta última con la variable de clase, tal y como vimos en
el preprocesado, haciendo que el modelo la priorize en las decisiones de
predicción. Por otro lado, variables como A6,
A10, A12 y A13 muestran un
impacto marginal en todas sus categorías, indicando que su contribución
al modelo es muy baja.
Dado el impacto limitado de A6, se realizará una
primera optimización eliminándola del conjunto de datos.
Además, se procederá a buscar nuevamente los hiperparámetros óptimos con
el mismo grid, ya que al modificar la estructura del dataset, estos
pueden variar. Este enfoque permitirá evaluar si la eliminación de A6
mejora el rendimiento general y la interpretabilidad del modelo.
4.4 Primera Optimización de Entrenamiento
4.4.1 Preprocesado específico del modelo
En esta primera optimización, procederemos a evaluar el impacto que
tiene en el modelo final la eliminación de la variable A6.
Para ello, partiremos del conjunto de entrenamiento básico, dado que
necesitamos eliminar la variable del conjunto original sin modificar.
Tras eliminar la variable, crearemos las variables dummy y escalaremos
las variables numéricas, distinguiendo entre variables gaussianas y no
gaussianas.
# Variables usadas->
categorical_vars_train2 <- c("A1", "A5", "A7", "A9", "A12", "A13", "A10")
numeric_vars_train2 <- c("A2", "A3", "A8", "A11", "A14", "A15")
target_var_train <- "Class"# Crear variables dummys para todas las variables categóricas ->
cols_categorical_train2 <- NULL
if (length(categorical_vars_train2) > 0) {
dummy_categorical_train2 <- dummyVars(paste("~", paste(categorical_vars_train2, collapse = " + ")), data = train2_xgboost, fullRank = TRUE)
cols_categorical_train2 <- data.frame(predict(dummy_categorical_train2, newdata = train2_xgboost))
}
# Combinar variables categóricas dummy con las numéricas
train2_xgboost <- cbind(cols_categorical_train2, train2_xgboost[, numeric_vars_train2], train2_xgboost[, target_var_train, drop = FALSE])
train2_xgboost <- train2_xgboost[, !names(train2_xgboost) %in% "A6.ff"]# Escalar las variables numéricas
# Identificar las variables categóricas
categorical_train2 <- setdiff(names(train2_xgboost), c(gaussians, no_gaussians))
# Escalar variables Gaussianas (centrado y escalado)
escalado_train2 <- preProcess(train2_xgboost[, gaussians, drop = FALSE], method = c("center", "scale"))
transformed_gaussians_train2 <- predict(escalado_train2, train2_xgboost[, gaussians, drop = FALSE])
# Normalizar variables no Gaussianas
pre_process_model_train2 <- preProcess(train2_xgboost[, no_gaussians, drop = FALSE], method = "range")
transformed_no_gaussians_train2 <- predict(pre_process_model_train2, train2_xgboost[, no_gaussians, drop = FALSE])
# Añadir variables categóricas y salida
categorical_train2 <- train2_xgboost[, c(categorical_train2), drop = FALSE]
# Combinar los datos transformados
train2_xgboost <- cbind(transformed_gaussians_train2, transformed_no_gaussians_train2, categorical_train2)
# Verificar el nuevo conjunto de datos
str(train2_xgboost)## 'data.frame': 547 obs. of 16 variables:
## $ A2 : num -0.00766 -0.27857 -0.97029 0.10522 0.20365 ...
## $ A3 : num 0 0.0887 0.3241 0.2305 0.0599 ...
## $ A14 : num 0.359 0.178 0.213 0.64 0.292 ...
## $ A8 : num 0.208 0.625 0.285 0.416 1 ...
## $ A11 : num 0.133 0.667 0 0 0 ...
## $ A15 : num 0 0.00267 0 0 1 ...
## $ A1.b : num 1 1 1 1 1 0 1 1 0 1 ...
## $ A5.p : num 0 0 0 0 0 0 1 1 0 1 ...
## $ A7.ff: num 0 0 0 0 0 0 0 0 0 0 ...
## $ A7.h : num 0 0 0 0 1 0 1 0 0 0 ...
## $ A7.v : num 1 1 1 1 0 1 0 1 1 1 ...
## $ A9.t : num 1 1 1 1 1 1 1 1 1 1 ...
## $ A12.t: num 0 1 0 1 1 0 0 1 1 1 ...
## $ A13.s: num 0 0 1 0 0 0 0 0 0 0 ...
## $ A10.t: num 1 1 0 0 0 0 0 0 0 1 ...
## $ Class: Factor w/ 2 levels "-","+": 2 2 2 2 2 2 2 2 2 2 ...4.4.2 Entrenamiento del Modelo
Como ya hemos comentado, para este entrenamiento usaremos el mismo control y el mismo grid. Esto asegura que no se pierdan posibles combinaciones óptimas debido a un grid reducido prematuramente. Si los hiperparámetros óptimos cambian se puede considerar reajustar el grid.
# Separar predictores (todas las columnas menos la última)
train2_x <- train2_xgboost[, -ncol(train2_xgboost)]
# Separar la clase (última columna)
train2_y <- train2_xgboost[, ncol(train2_xgboost)]
# Verificar niveles de la clase
levels(train2_y)## [1] "-" "+"4.4.3 Resultados del entrenamiento
# Extraer la precisión asociada a los mejores parámetros
print(xgbModel2$results[which.max(xgbModel2$results$Accuracy), ])## nrounds eta lambda alpha Accuracy Kappa AccuracySD KappaSD
## 7 50 0.15 10 2.5 0.8871453 0.771852 0.03083766 0.06149521
Con esta primera optimización se han obtenido una combinación de
hiperparámetros similar a la versión anterior del modelo, a excepción
del valor nrounds (de 75 a 50) y de lambda (de 9 a
10). Este cambio indica que el modelo ahora requiere menos iteraciones y
más regularización L2 para optimizar su rendimiento. Esto puede deberse
a que, al eliminar A6 y obtener un conjunto mas pequeño, el
riesgo de aprender patrones específicos del entrenamiento es mayor.
En cuanto a la precisión, el modelo se mantuvo prácticamente igual
(88.71%) en comparación con resultados anteriores
(88.77%). Esto indica que la variable no tenía impacto significativo en
el rendimiento del modelo. El kappa también se mantiene
constante, lo que confirma que el modelo sigue capturando la relación
entre las clases y las predicciones de manera consistente incluso sin
A6.
Por otra parte, eliminando A6 hemos conseguido una
reducción del conjunto de datos bastante importante, pasando de 26
variables a 16. Esto hace que se obtenga un modelo más simple y con
menor necesidad de regularización.
Por todo esto, esta optimización es una gran candidata a ser elegida como modelo final, debido a su simplicidad con respecto a la versión anterior y su excelente rendimiento.
Observando el gráfico de contribución de cada variable al modelo,
vemos como siguen habiendo variables que, aparentemente, no contribuyen
en la predicción y, por tanto, se puede reducir aún más la
dimensionalidad del conjunto. En consecuencia, se elaborará una
segunda optimización eliminando A1, A10,
A12 y A13 del conjunto de datos, partiendo de
esta optimización y usando el mismo control y el mismo
grid.
4.5 Segunda Optimización de Entrenamiento
4.5.1 Preprocesado específico del modelo
En esta segunda optimización, procederemos a evaluar el impacto que
tiene en el modelo final la eliminación de la variable A6,
A1, A10, A12 y A13.
Para ello, partiremos del conjunto de entrenamiento obtenido en la
iteración anterior, dado que necesitamos eliminar las nuevas variables
del conjunto. Tras eliminar la variable, crearemos las variables dummy y
escalaremos las variables numéricas, distinguiendo entre variables
gaussianas y no gaussianas.
# Variables usadas->
categorical_vars_train3 <- c("A5", "A7", "A9")
numeric_vars_train3 <- c("A2", "A3", "A8", "A11", "A14", "A15")
target_var_train <- "Class"# Crear variables dummys para todas las variables categóricas ->
cols_categorical_train3 <- NULL
if (length(categorical_vars_train3) > 0) {
dummy_categorical_train3 <- dummyVars(paste("~", paste(categorical_vars_train3, collapse = " + ")), data = train3_xgboost, fullRank = TRUE)
cols_categorical_train3 <- data.frame(predict(dummy_categorical_train3, newdata = train3_xgboost))
}
# Combinar variables categóricas dummy con las numéricas
train3_xgboost <- cbind(cols_categorical_train3, train3_xgboost[, numeric_vars_train3], train3_xgboost[, target_var_train, drop = FALSE])
train3_xgboost <- train3_xgboost[, !names(train3_xgboost) %in% "A6.ff"]# Escalar las variables numéricas
# Identificar las variables categóricas y la variable de salida
categorical_train3 <- setdiff(names(train3_xgboost), c(gaussians, no_gaussians))
# Escalar variables Gaussianas (centrado y escalado)
escalado_train3 <- preProcess(train3_xgboost[, gaussians, drop = FALSE], method = c("center", "scale"))
transformed_gaussians_train3 <- predict(escalado_train3, train3_xgboost[, gaussians, drop = FALSE])
# Normalizar variables no Gaussianas
pre_process_model_train3 <- preProcess(train3_xgboost[, no_gaussians, drop = FALSE], method = "range")
transformed_no_gaussians_train3 <- predict(pre_process_model_train3, train3_xgboost[, no_gaussians, drop = FALSE])
# Añadir variables categóricas y salida
categorical_train3 <- train3_xgboost[, c(categorical_train3), drop = FALSE]
# Combinar los datos transformados
train3_xgboost <- cbind(transformed_gaussians_train3, transformed_no_gaussians_train3, categorical_train3)
# Verificar el nuevo conjunto de datos
str(train3_xgboost)## 'data.frame': 547 obs. of 12 variables:
## $ A2 : num -0.00766 -0.27857 -0.97029 0.10522 0.20365 ...
## $ A3 : num 0 0.0887 0.3241 0.2305 0.0599 ...
## $ A14 : num 0.359 0.178 0.213 0.64 0.292 ...
## $ A8 : num 0.208 0.625 0.285 0.416 1 ...
## $ A11 : num 0.133 0.667 0 0 0 ...
## $ A15 : num 0 0.00267 0 0 1 ...
## $ A5.p : num 0 0 0 0 0 0 1 1 0 1 ...
## $ A7.ff: num 0 0 0 0 0 0 0 0 0 0 ...
## $ A7.h : num 0 0 0 0 1 0 1 0 0 0 ...
## $ A7.v : num 1 1 1 1 0 1 0 1 1 1 ...
## $ A9.t : num 1 1 1 1 1 1 1 1 1 1 ...
## $ Class: Factor w/ 2 levels "-","+": 2 2 2 2 2 2 2 2 2 2 ...4.5.2 Entrenamiento del Modelo
Como en la anterior optimización, usaremos el mismo control y el mismo grid.
# Separar predictores (todas las columnas menos la última)
train3_x <- train3_xgboost[, -ncol(train3_xgboost)]
# Separar la clase (última columna)
train3_y <- train3_xgboost[, ncol(train3_xgboost)]
# Verificar niveles de la clase
levels(train3_y)## [1] "-" "+"4.5.3 Resultados del entrenamiento
# Extraer la precisión asociada a los mejores parámetros
print(xgbModel3$results[which.max(xgbModel3$results$Accuracy), ])## nrounds eta lambda alpha Accuracy Kappa AccuracySD KappaSD
## 28 75 0.15 8 2.5 0.8871681 0.7718 0.02873782 0.05724922
Vemos que eliminando A6, A1,
A10, A12 y A13 obtenemos un
accuracy y un kappa levemente inferior que en el
entrenamiento original. Esto sugiere que la eliminación de estas
variables en conjunto no aportan mucho al modelo. Por otro lado, el
valor de lambda baja a 8, lo que indica que ya no necesita
regularizar tanto.
En definitiva, hemos conseguido un modelo mucho más simple que el original, reduciendo el conjunto de datos a 12 variables y con un rendimiento constante y bastante aceptable. No obstante, es necesario evaluar el modelo con el conjunto de test para ver su capacidad de generalizar y evaluar realmente su rendimiento.
Por último, en cuanto a los hiperparámetros obtenidos, se han mantenido cerca a lo largo de todas las optimizaciones. Además, en su mayoría se han posicionado en los límites izquierdos del grid definido. Por ello, realizaremos una última optimización en la que ya no eliminaremos variables, sino que probaremos una nueva parrilla de hiperparámetros explorando alrededor de los valores obtenidos.
# Grid de hiperparámetros
xgbGrid_test2 <- expand.grid(
nrounds = c(30, 40, 50),
eta = c(0.05, 0.10, 0.15),
lambda = c(8, 9, 10),
alpha = c(2.5, 3, 3.5)
)
# Entrenar el modelo
set.seed(123)
xgbModel4 <- train(
x = train3_x,
y = train3_y,
method = "xgbLinear",
trControl = fitControl,
tuneGrid = xgbGrid_test2,
metric = "Accuracy", # Métrica objetivo
verbosity = 0
)
# Extraer la precisión asociada a los mejores parámetros
best_row_train4 <- xgbModel4$results[which.max(xgbModel4$results$Accuracy), ]
print(best_row_train4)## nrounds eta lambda alpha Accuracy Kappa AccuracySD KappaSD
## 31 40 0.05 9 2.5 0.8883802 0.7743115 0.03369299 0.06741731
Ajustanto el rango de hiperparámetros conseguimos una leve mejora en cuanto a rendimiento y precisión. Vemos como ahora solo necesita 40 iteraciones para entrenar el modelo. Además, reduce el ratio de aprendizaje, haciendo que este sea más lento pero más preciso. Por último, la regularización L1 se mantiene, pero el modelo ahora requiere mas regularización L2.
En definitiva, además de mejorar el rendimiento con un modelo mas simple, hemos conseguido subirlo levemente ajustando mejor los hiperparámetros.
4.6 Comparación de modelos
Tras haber comentado los rasgos más importantes de cada modelo desarrollado, es hora de compararlos, teniendo en cuenta las métricas obtenidas, la simplicidad del modelo y los hiperparámetros buscados.
# Extraer la mejor fila de resultados de cada modelo
best_xgbModel <- xgbModel$results[which.max(xgbModel$results$Accuracy), ]
best_xgbModel2 <- xgbModel2$results[which.max(xgbModel2$results$Accuracy), ]
best_xgbModel3 <- xgbModel3$results[which.max(xgbModel3$results$Accuracy), ]
best_xgbModel4 <- xgbModel4$results[which.max(xgbModel4$results$Accuracy), ]
# Crear una tabla comparativa
comparacion <- data.frame(
Modelo = c("xgbModel", "xgbModel2", "xgbModel3", "xgbModel4"),
Cambios = c("Sin cambios", "Eliminada A6", "Eliminadas A6, A1, A10, A12 y A13", "Eliminadas A6, A1, A10, A12 y A13. Hiperpraámetros modificados"),
Variables = c(26,16,12,12),
Accuracy = c(best_xgbModel$Accuracy, best_xgbModel2$Accuracy, best_xgbModel3$Accuracy, best_xgbModel4$Accuracy),
Kappa = c(best_xgbModel$Kappa, best_xgbModel2$Kappa, best_xgbModel3$Kappa, best_xgbModel4$Kappa),
Lambda = c(best_xgbModel$lambda, best_xgbModel2$lambda, best_xgbModel3$lambda, best_xgbModel4$lambda),
Eta = c(best_xgbModel$eta, best_xgbModel2$eta, best_xgbModel3$eta, best_xgbModel4$eta),
Nrounds = c(best_xgbModel$nrounds, best_xgbModel2$nrounds, best_xgbModel3$nrounds, best_xgbModel4$nrounds),
Alpha = c(best_xgbModel$alpha, best_xgbModel2$alpha, best_xgbModel3$alpha, best_xgbModel4$alpha)
)
# Mostrar la tabla
comparacionAl evaluar los resultados de los tres modelos, podemos identificar diferencias significativas en términos de rendimiento y simplicidad.
xgbModel, que incluye todas las variables, obtiene un
accuracy de 0.8877 y un kappa de 0.7729. Debido a su
mayor complejidad, este modelo requiere un mayor número de iteraciones
con una alta regularización. Aunque su rendimiento es competitivo, la
presencia de todas las variables lo convierte en el modelo más complejo
(26 variables), dificultando la interpretabilidad y aumentando la
probabilidad de sobreajuste.
xgbModel2, que elimina la variable A6, reduce
ligeramente la complejidad sin afectar significativamente el
rendimiento. Este modelo obtiene un accuracy de 0.8871 y un
kappa de 0.7718, valores apenas inferiores al primer modelo. La
regularización L2 se mantiene pero con un menor número de iteraciones
necesarias, lo que indica que el modelo requiere menos ajustes para
manejar redundancias tras la eliminación de A6. Este modelo es más
simple que el primero (16 variables), pero no logra superar su
rendimiento.
xgbModel3, que elimina las variables A6, A1, A10, A12 y
A13, se posiciona como la mejor opción hasta el momento. Este modelo
mantiene un accuracy similar a la anterior optimización
(0.8871). Por el contrario, es el más simple, ya que
utiliza solo 12 variables en lugar de las 26 originales. En su lugar, el
número de iteraciones vuelve a aumentar pero con una menor
regularización L2, lo que indica que ha necesitado mas iteraciones para
captar mejor las relaciones del conjunto pero requiere de menos
ajustes.
xgbModel4 que, además de eliminar las variables A6, A1,
A10, A12 y A13, se ajusta la parrilla de hiperparámetros usada para
entrenar el modelo. Como ya se dijo anteriormente, esto se hizo para
comprobar si el modelo cambia sus hiperparámetros óptimos buscando
alrededor de los valores obtenidos. Este modelo obtiene un
rendimiento levemente superior que la versión anterior,
con la misma dimensionalidad. En cuanto a los hiperparámetros obtenidos,
el modelo necesita menos rondas con un menor ratio de aprendizaje. Esto
es coherente ya que, al simplificar el modelo, se necesita menos tiempo
para aprender relaciones entre las variables, compensandose con un
aprendizaje mas lento y preciso.
En definitiva, el modelo final basado en xgbLinear a usar
será xgbModel4, debido a su rendimiento y
simplicidad con respecto a otros modelos. No obstante, en apartados
posteriores comprobaremos la capacidad de generalización del modelo
(rendimiento real) al presentarle datos nunca vistos y una vez entrenado
con el conjunto de entrenamiento completo.
4.7 Entrenamiento y Evaluación del Modelo Final
Una vez realizada la búsqueda del mejor modelo y de sus hiperparámetros óptimos usando crossvalidación repetida, realizaremos un entrenamiento final del modelo usando todo el conjunto de entrenamiento. Esto nos permitirá aportarle al modelo toda la información posible con el fin de realizar mejores predicciones futuras.
Este modelo se entrenará con los hiperparámetros seleccionados anteriormente por el mejor modelo obtenido. No obstante, hemos decidido reajustar el valor del hiperparámetro alpha a 3, con el fin de realizar una regularización mas agresiva y que el modelo se sobreajuste lo menos posible sin sacrificar el rendimiento.
# Ajustar trainControl para no usar validación cruzada
fitControl_final <- trainControl(
method = "none" # No se utiliza validación cruzada
)
xgbGrid_final <- data.frame(
nrounds = 40,
eta = 0.05,
lambda = 9,
alpha = 3
)
# Entrenar el modelo final
set.seed(123)
xgbModel_final <- train(
x = train3_x,
y = train3_y,
method = "xgbLinear",
trControl = fitControl_final,
tuneGrid = xgbGrid_final,
metric = "Accuracy",
verbosity = 0
)
p <- predict(xgbModel_final, newdata = train3_x)
confusionMatrix(p, train3_y, positive="+")## Confusion Matrix and Statistics
##
## Reference
## Prediction - +
## - 291 19
## + 14 223
##
## Accuracy : 0.9397
## 95% CI : (0.9163, 0.9581)
## No Information Rate : 0.5576
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.8775
##
## Mcnemar's Test P-Value : 0.4862
##
## Sensitivity : 0.9215
## Specificity : 0.9541
## Pos Pred Value : 0.9409
## Neg Pred Value : 0.9387
## Prevalence : 0.4424
## Detection Rate : 0.4077
## Detection Prevalence : 0.4333
## Balanced Accuracy : 0.9378
##
## 'Positive' Class : +
## Tras haber entrenado el modelo final, procederemos a evaluarlo con el conjunto de test obtenido al principio de esta práctica. Para ello, realizaremos un preprocesado previo al conjunto, siendo este el mismo preprocesado aplicado en el conjunto de entrenamiento usado.
# Modificar variables del conjunto original ->
# Conjunto de test 1
test1_xgboost <- credit.Datos.Test
# Cambiar valores de A5
test1_xgboost$A5 <- as.character(test1_xgboost$A5)
test1_xgboost$A5 <- ifelse(test1_xgboost$A5 == "gg", "g", test1_xgboost$A5)
test1_xgboost$A5 <- factor(test1_xgboost$A5)
# Agrupar valores de A6 según el preprocesado
test1_xgboost$A6 <- as.character(test1_xgboost$A6)
test1_xgboost$A6 <- ifelse(test1_xgboost$A6 == "r", "e",
ifelse(test1_xgboost$A6 == "j", "m",
ifelse(test1_xgboost$A6 == "Desconocido", "c", test1_xgboost$A6)))
test1_xgboost$A6 <- factor(test1_xgboost$A6)
# Agrupar valores de A7 según el preprocesado
test1_xgboost$A7 <- as.character(test1_xgboost$A7)
test1_xgboost$A7 <- ifelse(test1_xgboost$A7 %in% c("dd", "j", "n", "o"), "bb",
ifelse(test1_xgboost$A7 == "z", "h", test1_xgboost$A7))
test1_xgboost$A7 <- factor(test1_xgboost$A7)
# Cambiar valores de A13
test1_xgboost$A13 <- as.character(test1_xgboost$A13)
test1_xgboost$A13 <- ifelse(test1_xgboost$A13 == "p", "g", test1_xgboost$A13)
test1_xgboost$A13 <- factor(test1_xgboost$A13)
# Variables usadas
categorical_vars_test1 <- c("A5", "A7", "A9")
numeric_vars_test1 <- c("A2", "A3", "A8", "A11", "A14", "A15")
target_var_test <- "Class"# Crear variables dummys para todas las variables categóricas ->
cols_categorical_test1 <- NULL
if (length(categorical_vars_test1) > 0) {
dummy_categorical_test1 <- dummyVars(paste("~", paste(categorical_vars_test1, collapse = " + ")), data = test1_xgboost, fullRank = TRUE)
cols_categorical_test1 <- data.frame(predict(dummy_categorical_test1, newdata = test1_xgboost))
}
# Combinar variables categóricas dummy con las numéricas
test1_xgboost <- cbind(cols_categorical_test1, test1_xgboost[, numeric_vars_test1], test1_xgboost[, target_var_test, drop = FALSE])
# Eliminar A6.ff
test1_xgboost <- test1_xgboost[, !names(test1_xgboost) %in% "A6.ff"]# Escalar las variables numéricas, usando los escalados para variables gausianas y no gausianas del entrenamiento ->
# Variables categóricas
categorical_test1 <- setdiff(names(test1_xgboost), c(gaussians, no_gaussians))
# Escalar variables Gaussianas y no Gaussianas
transformed_gaussians_test1 <- predict(escalado_train3, test1_xgboost[, gaussians, drop = FALSE])
transformed_no_gaussians_test1 <- predict(pre_process_model_train3, test1_xgboost[, no_gaussians, drop = FALSE])
# Añadir variables categóricas y salida
categorical_test1 <- test1_xgboost[, c(categorical_test1), drop = FALSE]
# Combinar los datos transformados
test1_xgboost <- cbind(transformed_gaussians_test1, transformed_no_gaussians_test1, categorical_test1)
# Verificar el nuevo conjunto de datos
str(test1_xgboost)## 'data.frame': 137 obs. of 12 variables:
## $ A2 : num 2.5064 -0.5793 -0.7978 -0.0898 1.5501 ...
## $ A3 : num 0.257 0.0288 0.0478 0.1057 0.348 ...
## $ A14 : num 0.0764 0.4978 0.2276 0.4622 0 ...
## $ A8 : num 0.50646 0.2499 0.36068 0.7222 0.00666 ...
## $ A11 : num 0.8 0 0 0 0 ...
## $ A15 : num 0.498 0.732 0 0.178 2.391 ...
## $ A5.p : num 0 0 0 0 0 0 0 0 0 0 ...
## $ A7.ff: num 0 0 0 0 0 0 0 0 0 0 ...
## $ A7.h : num 1 1 1 1 0 0 0 0 0 0 ...
## $ A7.v : num 0 0 0 0 1 1 1 1 1 1 ...
## $ A9.t : num 1 1 0 1 0 1 1 1 1 1 ...
## $ Class: Factor w/ 2 levels "-","+": 2 2 2 2 2 2 2 2 2 2 ...# Reordenar columnas
test1_xgboost <- test1_xgboost[, colnames(train3_xgboost)]
# Separar predictores (todas las columnas menos la última)
test_x <- test1_xgboost[, -ncol(test1_xgboost)]
# Separar la clase (última columna)
test_y <- test1_xgboost[, ncol(test1_xgboost)]
# Evaluar el modelo en el conjunto de prueba
p <- predict(xgbModel_final, newdata = test_x)
predictions <- predict(xgbModel_final, newdata = test_x, type = "prob")
# Calcular y mostrar la matriz de confusión
cf <- confusionMatrix(p, test_y, positive="+")
print(cf)## Confusion Matrix and Statistics
##
## Reference
## Prediction - +
## - 65 6
## + 11 55
##
## Accuracy : 0.8759
## 95% CI : (0.8088, 0.926)
## No Information Rate : 0.5547
## P-Value [Acc > NIR] : 5.29e-16
##
## Kappa : 0.7508
##
## Mcnemar's Test P-Value : 0.332
##
## Sensitivity : 0.9016
## Specificity : 0.8553
## Pos Pred Value : 0.8333
## Neg Pred Value : 0.9155
## Prevalence : 0.4453
## Detection Rate : 0.4015
## Detection Prevalence : 0.4818
## Balanced Accuracy : 0.8785
##
## 'Positive' Class : +
## 
Los resultados muestran un accuracy de 0.8759, lo que indica que el modelo clasifica correctamente el 87.59% de las observaciones. Este resultado es consistente con las métricas obtenidas durante la validación cruzada y el entrenamiento completo:
Accuracy de validación (0.8883): Rendimiento obtenido durante el proceso de validación cruzada del modelo
xgbModel4. Representa un promedio en varias particiones del conjunto de datos, lo cual lo hace robusto frente a variaciones en los datos.Accuracy en entrenamiento completo (0.9397): Es más alto que el de validación y test, lo cual es normal porque el modelo tiene acceso a todos los datos durante el entrenamiento, maximizando su capacidad de ajuste.
Accuracy en test (0.8759): Es razonablemente cercano al de validación, lo que indica que el modelo generaliza bien a datos no vistos, sin un signo evidente de sobreajuste.
El Kappa de 0.7508 refleja un nivel de acuerdo sustancial entre las predicciones del modelo y los valores reales, lo que refuerza la confianza en su rendimiento.
Fortalezas del modelo
El modelo presenta una sensibilidad de 90.16% y una especificidad de 85.53%, lo que significa que tiene una buena capacidad para identificar correctamente tanto las observaciones positivas (clase -) como las negativas (clase +). Esto es importante, ya que asegura un balance razonable entre evitar rechazar casos que realmente deberían ser aprobados y minimizar errores en la asignación de créditos. Además, el valor predictivo positivo (PPV) de 83.33% indica que cuando el modelo predice la clase positiva (no aprobar el crédito), la predicción es correcta en la mayoría de los casos. Este porcentaje puede ser mejorado ajustando el threshold, tal y como se hará posteriormente.
Debilidades del modelo
Sin embargo, el modelo tiene un 11% de falsos positivos y un 6% de falsos negativos. Dado que una de nuestras prioridades es minimizar los falsos positivos (no conceder créditos erróneamente), este porcentaje de falsos positivos puede ser motivo de preocupación. Aun así, el porcentaje está dentro de límites aceptables considerando la complejidad del problema y la naturaleza de los datos.
Capacidades del modelo
El modelo muestra una balanced accuracy de 87.85%, lo que confirma que tiene un buen equilibrio en el manejo de clases desbalanceadas. Esto asegura que el modelo no favorece injustamente a ninguna clase, lo que es crucial en problemas donde ambas clases tienen implicaciones críticas. El bajo valor del p-valor de McNemar indica que no hay una diferencia significativa en la tasa de errores entre las clases, lo que sugiere que el modelo está bien calibrado.
En conclusión, aunque el modelo tiene un porcentaje razonable de falsos positivos y falsos negativos, sus fortalezas radican en su capacidad para manejar ambas clases de manera equilibrada. Esto lo hace adecuado para aplicaciones donde la aprobación incorrecta de créditos debe evitarse, sin comprometer en exceso las oportunidades para quienes realmente califican.
4.8 Mejora del rendimiento modificando el threshold
Con el fin de aumentar el rendimiento del modelo, ajustaremos el threshold a valores superiores a 0.5. Esto nos permitirá reducir aún más los casos de falso positivo, priorizando el no conceder el crédito ante la duda. Para ello, necesitamos un threshold que incline el balance hacia un aumento en la sensibilidad, pero sin sacrificar demasiado la sensibilidad.
# Definir los thresholds a probar
thresholds <- seq(0.5, 0.9, by = 0.1)
# Crear un data frame vacío para almacenar los resultados
results <- data.frame(
Threshold = numeric(),
Accuracy = numeric(),
FP = numeric(),
FN = numeric(),
Sensitivity = numeric(),
Specificity = numeric(),
Precision = numeric()
)
# Probar cada threshold
for (threshold in thresholds) {
# Ajustar las predicciones según el threshold
predictions_custom <- ifelse(predictions[, 2] > threshold, "+", "-")
predictions_custom <- factor(predictions_custom, levels = levels(test1_xgboost$Class))
# Generar la matriz de confusión
conf_matrix <- confusionMatrix(predictions_custom, test1_xgboost$Class, positive="+")
cm_table <- conf_matrix$table
FN <- cm_table["-", "+"]
FP <- cm_table["+", "-"]
# Calcular métricas
accuracy <- conf_matrix$overall["Accuracy"]
test_error <- 1 - as.numeric(accuracy) # Calcular el error de test
sensitivity <- conf_matrix$byClass["Sensitivity"]
specificity <- conf_matrix$byClass["Specificity"]
precision <- conf_matrix$byClass["Pos Pred Value"]
# Almacenar los resultados
results <- rbind(results, data.frame(
Threshold = threshold,
Accuracy = accuracy,
FP = FP,
FN = FN,
Sensitivity = sensitivity,
Specificity = specificity,
Precision = precision
))
}
# Mostrar los resultados
print(results)## Threshold Accuracy FP FN Sensitivity Specificity Precision
## Accuracy 0.5 0.8759124 11 6 0.9016393 0.8552632 0.8333333
## Accuracy1 0.6 0.8759124 9 8 0.8688525 0.8815789 0.8548387
## Accuracy2 0.7 0.8905109 5 10 0.8360656 0.9342105 0.9107143
## Accuracy3 0.8 0.8613139 5 14 0.7704918 0.9342105 0.9038462
## Accuracy4 0.9 0.8029197 0 27 0.5573770 1.0000000 1.0000000En el caso del threshold 0.5 (Threshold por defecto) y 0.6, el modelo logra un accuracy de 87.59%, igual al obtenido durante el entrenamiento. Este caso ya fue comentado antes.
El threshold 0.7 ofrece aparentemente el mejor balance general. Con un accuracy de 89.05%, este es el valor más alto entre los thresholds evaluados. Se observa una disminución drástica de los falsos positivos, consiguiendo pasar el de falsos negativos. Además, la sensibilidad y la especificidad muestran un buen rendimiento en la clasificación de ambas clases, inclinandose a la especificidad. Este threshold es particularmente adecuado para el problema, ya que minimiza los errores críticos relacionados con los falsos positivos y mantiene un buen rendimiento general.
Con los thresholds 0.8 y 0.9, los falsos negativos se disparan, mientras que los falsos positivos disminuyen llegando a 0. Aunque la especificidad alcanza valores perfectos, la sensibilidad disminuye significativamente, lo que significa que el modelo rechaza erróneamente más casos. Por esto, estos thresholds son casos extremos y no deseables ya que, ademas de degradar el rendimiento general, hace que la no concesión de créditos sea excesivo.
En cuanto a la coherencia entre el conjunto de entrenamiento, validación y de prueba, el accuracy de test es consistente y se mantiene en ratios normales. Esto demuestra que el modelo no está sobreajustado y generaliza bien a datos no vistos. Las pequeñas variaciones en el rendimiento son esperables debido a diferencias en la distribución y dificultad de los datos de prueba.
En conclusión, el threshold óptimo es 0.7, ya que proporciona el mejor balance entre rendimiento general y minimización de falsos positivos. Este threshold asegura que el modelo sea efectivo al evitar la aprobación de créditos incorrectos, sin comprometer en exceso la sensibilidad del modelo.
No obstante, para ver mejor la capacidad del modelo para distinguir entre clases positivas y negativas a diferentes umbrales de decisión usaremos la curva ROG. En ella podremos evaluar qué tan bien el modelo equilibra la capacidad y la sensibilidad. Por otra parte, usaremos el índice de Youden para obtener exactamente el mejor threshold. Este valor indica el punto de la curva ROG donde el modelo logra mejor balance.
# Crear la curva ROC
roc_xgb <- roc(test1_xgboost$Class, predictions[, 2], levels = rev(c('+','-')))## Setting direction: controls < cases# Visualizar la curva ROC
plot(roc_xgb, col = "blue", lwd = 2, main = "Curva ROC")
abline(a = 0, b = 1, col = "gray", lty = 2) # Línea diagonal (azar)
## El valor de AUC es: 0.9500647# Añadir la información de la curva ROC al data frame
roc_data <- data.frame(
Threshold = coords(roc_xgb, seq(0, 1, by = 0.01), ret = "threshold"),
Sensitivity = coords(roc_xgb, seq(0, 1, by = 0.01), ret = "sensitivity"),
Specificity = coords(roc_xgb, seq(0, 1, by = 0.01), ret = "specificity")
)
# Threshold óptimo según el índice de Youden
optimal_metrics <- coords(roc_xgb, "best", ret = c("threshold", "sensitivity", "specificity"), best.method = "youden")
# Crear una tabla con los resultados
optimal_results <- data.frame(
Threshold = optimal_metrics["threshold"],
Sensitivity = optimal_metrics["sensitivity"],
Specificity = optimal_metrics["specificity"]
)
# Mostrar la tabla
print(optimal_results)## threshold sensitivity specificity
## 1 0.6585378 0.8688525 0.9210526En este caso, la curva muestra un buen rendimiento, ya que se acerca significativamente al punto superior izquierdo (0,1), donde se logra máxima sensibilidad y especificidad. Esto sugiere que el modelo tiene una alta capacidad para distinguir entre clases positivas y negativas a través de distintos thresholds.
El valor del Área Bajo la Curva (AUC) es 0.95, lo cual indica un rendimiento bastante bueno. Valores de AUC cercanos a 1 representan modelos con una gran capacidad de discriminación; es decir, el modelo tiene un 95% de probabilidad de clasificar correctamente una instancia positiva y una negativa al azar. Esto valida la eficacia del modelo en el problema.
El threshold óptimo determinado por el índice de Youden es cercano a 0.7, lo que implica que este valor proporciona el mejor balance entre sensibilidad y especificidad y corrobora lo dicho anteriormente. Con este valor conseguimos disminuir levemente los falsos positivos mejorando el rendimiento al máximo.
4.9 Obtención del intervalo de confianza
A diferencia de otros enfoques, como los árboles de decisión, el
modelo xgbLinear es menos sensible a las semillas debido a su enfoque
determinista y lineal. Esto significa que no depende de decisiones
estocásticas como particiones aleatorias o procesos internos de
construcción de árboles. Por lo tanto, aunque se cambie la semilla, los
pesos ajustados por el modelo y el proceso de entrenamiento seguirán
siendo consistentes, siempre que el conjunto de datos y los
hiperparámetros permanezcan invariables. Debido a esta
deterministicidad, no es posible generar un intervalo de confianza
basado en la variabilidad de las semillas, ya que todas las ejecuciones
producirán los mismos resultados.
Para solucionar esto, se ha utilizado la técnica de bootstraping, que introduce variabilidad al generar muestras aleatorias con reemplazo del conjunto de datos.
# Crear un dataframe para almacenar resultados
results_xgboost <- data.frame(Iteración = integer(), Accuracy = numeric())
accuracy_values <- c()
# Número de iteraciones de bootstrap
n_bootstrap <- 30
for (i in 1:n_bootstrap) {
# Muestreo bootstrap con reemplazo
set.seed(120 + i) # Para reproducibilidad
bootstrap_index <- sample(1:nrow(train3_x), replace = TRUE)
bootstrap_x <- train3_x[bootstrap_index, ]
bootstrap_y <- train3_y[bootstrap_index]
# Entrenar el modelo con los datos bootstrap
model_xgboost_boot <- train(
x = bootstrap_x,
y = bootstrap_y,
method = "xgbLinear",
trControl = trainControl(method = "none"), # Sin validación cruzada
tuneGrid = xgbGrid_final,
metric = "Accuracy",
verbosity = 0
)
# Generar probabilidades
predictions_prob <- predict(model_xgboost_boot, newdata = test_x, type = "prob")
# Generar predicciones como etiquetas con threshold 0.7
predictions <- ifelse(predictions_prob[, 2] > 0.7, levels(test_y)[2], levels(test_y)[1])
predictions <- factor(predictions, levels = levels(test_y)) # Ajustar niveles
# Calcular la matriz de confusión y métricas
conf_matrix <- confusionMatrix(predictions, test_y, positive="+")
accuracy <- conf_matrix$overall["Accuracy"]
accuracy_values <- c(accuracy_values, accuracy)
# Guardar los resultados
results_xgboost <- rbind(results_xgboost, data.frame(Iteración = i, Accuracy = accuracy))
}
# Mostrar resultados
print(results_xgboost)## Iteración Accuracy
## Accuracy 1 0.8613139
## Accuracy1 2 0.8613139
## Accuracy2 3 0.8613139
## Accuracy3 4 0.8686131
## Accuracy4 5 0.8613139
## Accuracy5 6 0.8540146
## Accuracy6 7 0.8686131
## Accuracy7 8 0.8832117
## Accuracy8 9 0.8613139
## Accuracy9 10 0.8467153
## Accuracy10 11 0.8686131
## Accuracy11 12 0.8540146
## Accuracy12 13 0.8540146
## Accuracy13 14 0.8613139
## Accuracy14 15 0.8686131
## Accuracy15 16 0.8686131
## Accuracy16 17 0.8686131
## Accuracy17 18 0.8613139
## Accuracy18 19 0.8686131
## Accuracy19 20 0.8686131
## Accuracy20 21 0.8905109
## Accuracy21 22 0.8613139
## Accuracy22 23 0.8686131
## Accuracy23 24 0.8759124
## Accuracy24 25 0.8467153
## Accuracy25 26 0.8759124
## Accuracy26 27 0.8686131
## Accuracy27 28 0.8832117
## Accuracy28 29 0.8905109
## Accuracy29 30 0.8540146# Calcular el intervalo de confianza
mean_acc <- mean(accuracy_values)
std_error <- sd(accuracy_values) / sqrt(length(accuracy_values))
ci_lower <- mean_acc - qt(0.975, df = length(accuracy_values) - 1) * std_error
ci_upper <- mean_acc + qt(0.975, df = length(accuracy_values) - 1) * std_error
cat("Precisión promedio:", mean_acc, "\n")## Precisión promedio: 0.86618## Intervalo de confianza al 95%: [ 0.8620475 , 0.8703126 ]Como vemos, realizando bootstraping obtenemos un accuracy promedio mas bajo (0.866) que el de test básico (0.87) y que el de test con el threshold de 0.7 (0.89). Esto es normal, ya que bootstraping evalúa diferentes modelos entrenados con subconjuntos de los datos, lo que lo hace mas conservador. Es más, un threshold de 0.5 puede que funcione mejor en promedio, ya que es mas flexible y menos restrictivo que 0.7, especialmente en datos con variabilidad.
En cuanto al intervalo de confianza, este es bastante estrecho, lo que sugiere que el modelo es bastante estable y no tiene alta variabilidad entre las iteraciones. Además, el valor de precisión promedio está cercano al límite superior del intervalo (0.8703) del conjunto de prueba estándar (0.87). Esto confirma que no hay signos de sobreajuste significativo.
En general, podemos decir que este modelo tiene un rendimiento promedio de 0.866. Este valor refleja el comportamiento del modelo en datos futuros. Por otra parte, en cuanto a la optimización especifica de este conjunto de datos, es una mejor opción el threshold de 0.7, llegando a obtener un rendimiento de 0.89 aproximadamente.
if (!require(tidyverse)) install.packages("tidyverse", dependencies = TRUE)
if (!require(ggplot2)) install.packages("ggplot2", dependencies = TRUE)
if (!require(dplyr)) install.packages("dplyr", dependencies = TRUE)
if (!require(gridExtra)) install.packages("gridExtra", dependencies = TRUE)
if (!require(tidyr)) install.packages("tidyr", dependencies = TRUE)
if (!require(caret)) install.packages("caret", dependencies = TRUE)
if (!require(lattice)) install.packages("lattice", dependencies = TRUE)
if (!require(reshape2)) install.packages("reshape2", dependencies = TRUE)
if (!require(DescTools)) install.packages("DescTools", dependencies = TRUE)
if (!require(kableExtra)) install.packages("kableExtra", dependencies = TRUE)
if (!require(randomForest)) install.packages("randomForest", dependencies = TRUE)
if (!require(GGally)) install.packages("GGally", dependencies = TRUE)
if (!require(here)) install.packages("here", dependencies = TRUE)
if (!require(pROC)) install.packages("pROC", dependencies = TRUE)
# Cargar las librerías
library(tidyverse)
library(ggplot2)
library(dplyr)
library(gridExtra)
library(tidyr)
library(caret)
library(lattice)
library(reshape2)
library(DescTools)
library(kableExtra)
library(randomForest)
library(GGally)
library(here)
library(pROC)5 Random Forest
5.1 Justificación del modelo elegido
Hemos decidido utilizar el modelo de Random Forest debido a su robustez y eficacia en tareas de clasificación binaria, así como su capacidad para manejar tanto variables numéricas como categóricas de manera eficiente. Random Forest es un algoritmo de aprendizaje de conjunto que construye múltiples árboles de decisión y combina sus resultados para obtener una predicción más precisa y generalizable.
Una de las ventajas clave de Random Forest es su capacidad para manejar datos con relaciones complejas y no lineales entre las variables predictoras y la clase objetivo, lo que lo convierte en una elección sólida para conjuntos de datos mixtos.
Por último, el modelo de Random Forest no requiere suposiciones específicas sobre la distribución de los datos, lo que lo hace ideal para conjuntos de datos donde las variables no siguen distribuciones normales o tienen distribuciones heterogéneas. Esta flexibilidad, junto con su alta precisión y capacidad para generalizar, lo convierte en una opción adecuada para resolver problemas de clasificación binaria.
5.2 Análisis para el preprocesado de datos
Probaremos distintos preprocesados de datos, que pensamos que pueden dar buenos resultados, y encontraremos sus óptimos hiper-parámetros para cada uno usando este algoritmo de random forest. Posteriormente se eligirá el mejor modelo y se le aplicará el test. Los preprocesados candidatos son:
Usar los datos inicales sin nulos y eliminando la variabla A4.
Usar los datos que no tienen nulos, eliminando la variable A4, outliers winsorizados y variables categóricas modificadas.
Los preprocesados son llamados credit.fix3.categoricalFix y temporal_train.
Usamos estos datos de entrenamiento para comprobar cómo actúa random forest con el conjunto de datos casi sin tocar, y luego con un preprocesado más exhaustivo.
Como el random forest trabaja con los puntos de corte basados en los valores de las variables y no calcula las distancias, suponemos que escalar los datos no servirá de nada. No usaremos las variables dummy ya que este modelo funciona bien con las variables categóricas.
5.3 Análisis para la búsqueda de hiper-parámetros del modelo random forest
Averiguemos cuántos parámetros tiene este modelo:
Solo tiene uno visible, mtree, que representa el número de variables seleccionadas aleatoriamente como candidatas en cada división de un árbol. A menor valor de mtry introduce más aleatoriedad en el modelo, pero puede hacer que sean menos precisos debido a la consideración de variables menos informativas en las divisiones. Por otro lado, un valor más alto de mtry puede aumentar el Accuracy individual de los árboles, pero puede reducir la diversidad del bosque (overfitting).
Investigando el modelo descubrimos que tiene además dos más que son importantes:
ntree: representa la cantidad de árboles de decisión que se construirán en el Random Forest.
nodesize: define cuántos datos como mínimo deben estar presentes en un nodo para que pueda dividirse.
Estos datos son importantes tanto para el coste de computación (ntree) como para eludir el overfitting (nodesize). Como son parámetros ocultos tendremos que crear una función para que caret los tome como hiperparámetros posibles y encuentre la mejor combinación de ellos. Se usará una búsqueda de tipo aleatorio, es decir, buscará una combinación aleatoria entre un rango de los valores descritos en la función.
Cabe destacar que por defecto mtry no puede tomar un valor superior al número de predictores, luego su rango esta acotado. Ntree tiene por defecto 500, y nodesize 5, probaremos distintos valores alrededor de estos con un amplio rango. Nodesize tendrá como mínimo un valor de 5, ya que con menos crearía overfitting.
Creamos una función auxiliar para poder incluir ntree y nodesize como hiper-parámetros a probar(se ha usado como referencia la función que aparece en caret.pdf referenciada en la memoria):
RF3param <- list(
type = "Classification",
library = "randomForest",
loop = NULL,
parameters = data.frame(
parameter = c("mtry", "ntree", "nodesize"),
class = rep("numeric", 3),
label = c("mtry", "ntree", "nodesize")
),
grid = function(x, y, len = NULL, search = "grid") {
if (search == "grid") {
} else {
data.frame(
mtry = sample(1:ncol(x), size = len, replace = TRUE),
ntree = sample(seq(50, 600, by = 10), size = len, replace = TRUE),
nodesize = sample(5:30, size = len, replace = TRUE)
)
}
},
fit = function(x, y, wts, param, lev, last, weights, classProbs, ...) {
require(randomForest)
model <- randomForest(
x, y,
mtry = param$mtry,
ntree = param$ntree,
nodesize = param$nodesize,
probability = TRUE
)
model$classes <- lev # Garantizamos que tenga acceso a las clases
model
},
predict = function(modelFit, newdata, submodels = NULL) {
predict(modelFit, newdata, type = "response")
},
prob = function(modelFit, newdata, submodels = NULL) {
predict(modelFit, newdata, type = "prob")
},
varImp = function(object, ...) {
importance(object, ...)
},
sort = function(x) {
x[order(x$ntree, x$mtry, x$nodesize), ]
},
levels = function(x) x$classes,
label = "Random Forest with 3 Parameters"
)Para poder realizar un remuestreo más profundo utilizamos la cosvalidación cruzada de k pliegues (3 pliegues y 10 repeticiones). Usamos la busquedad random comentada anteriormente. Usamos el método de entrenamiento de rf para clasificación y regresión de random forest. Usamos la métrica de accuracy para observar los resultados al tener las clases balanceadas (44% - 56%):
# Tabular las frecuencias
frecuencias <- table(temporal_train$Class)
porcentajes <- prop.table(frecuencias) * 100
print(porcentajes)##
## - +
## 55.75868 44.24132El proceso que vamos a seguir será el siguiente, primero realizaremos un RFE como método de eliminación de variables. En función de esa información iremos obteniendo los mejores hiper-parámetros para modelos con distinto número de variables del mismo preprocesado. Después eligiremos al que tenga mayor accuracy, o en caso de parecerse el más simple.
5.4 Primer preprocesado
El primer conjunto de datos a probar es el que no tiene nulos ni la variable A4. Creamos el trainControl que usaremos para entrenar:
- Usaremos como método la crossvalidación adaptative para que ajuste dinámicamente el proceso de ajuste de hiperparámetros durante la validación cruzada. Se realizarán 10 repeticiones y se usará la búsqueda aleatoria de valores. Eligiremos la función del mejor modelo como best, queremos el que obtenga mejor accuracy, ya que queremos optimizar el modelo:
# Configuración de control para el entrenamiento
control <- trainControl(method = 'adaptive_cv',
adaptive = list(min =8, alpha = 0.05, method ="gls", complete=TRUE),
number = 10,
search = 'random',
returnResamp = 'all',
savePredictions = 'final',
verbose = FALSE,
selectionFunction = 'best')Vemos cuales son el subconjunto de variables que mejora el rendimiento y eficiencia del modelo:
# Preparar los datos
data <- credit.fix3.categoricalFix %>% dplyr::select(-A4)
# Dividir en variables predictoras y objetivo
predictors <- data %>% dplyr::select(-Class)
target <- data$Class
# Definir el control para RFE
rfe_control <- rfeControl(
functions = treebagFuncs, # Utilizar treebagFuncs para una ejecución rápida
method = "repeatedcv",
number = 10,
repeats = 3,
verbose = FALSE
)
# Definir el rango de variables a evaluar
subset_sizes <- 1:14
# Ejecutar RFE
set.seed(125)
rfe_result <- rfe(
x = predictors,
y = target,
sizes = subset_sizes,
rfeControl = rfe_control
)
print(rfe_result)##
## Recursive feature selection
##
## Outer resampling method: Cross-Validated (10 fold, repeated 3 times)
##
## Resampling performance over subset size:
##
## Variables Accuracy Kappa AccuracySD KappaSD Selected
## 1 0.8647 0.7306 0.03589 0.07137
## 2 0.8622 0.7256 0.03560 0.07080
## 3 0.8306 0.6576 0.03617 0.07467
## 4 0.8349 0.6654 0.04478 0.09124
## 5 0.8440 0.6840 0.04853 0.09903
## 6 0.8501 0.6971 0.03785 0.07627
## 7 0.8544 0.7062 0.03826 0.07720
## 8 0.8532 0.7035 0.03919 0.07977
## 9 0.8593 0.7162 0.04253 0.08522
## 10 0.8647 0.7267 0.04245 0.08570
## 11 0.8641 0.7256 0.04209 0.08475
## 12 0.8672 0.7319 0.03676 0.07378
## 13 0.8672 0.7319 0.04188 0.08411
## 14 0.8684 0.7346 0.03937 0.07918 *
##
## The top 5 variables (out of 14):
## A9, A11, A8, A10, A15## [1] "A9" "A11" "A8" "A10" "A15" "A6" "A3" "A14" "A2" "A7" "A5" "A13"
## [13] "A1" "A12"
Vemos que las principales variables son A9, A11, A8, A10 y A15. Se ve como con una y dos variables el modelo es capaz de alcanzar un accuracy por encima del 86%. No confiamos en reducir tanto las variables porque pensamos que puede reducir demasiado el modelo y no generalizar correctamente. Pero a partir de 10 variables si se obtiene un accuracy interesante y reducimos la posibilidad de que este sobre-ajustado. Luego vamos a probar a tener 10, 11, 12, 13 y 14 variables y obtener los mejores hiper-parámetros para ellos. Después lo compararemos entre ellos, y nos quedaremos con el mejor.
Para 10 variables, probamos 100 combinaciones distintas para distintos valores de mtry, nTree y Nodesize:
variables_deseadas <- c("A9", "A11", "A8", "A10", "A15", "A6", "A3", "A14", "A2", "A7", "Class")
# Filtrar el dataset para que contenga solo estas variables
data <- credit.fix3.categoricalFix %>% dplyr::select(all_of(variables_deseadas))
predictors <- data[, !names(data) %in% 'Class']
target <- data[['Class']]
set.seed(125)
model_no_nulos <- train(
x = predictors,
y = target,
method=RF3param,
tuneLength = 100,
trControl=control,
metric = 'Accuracy'
)
model_no_nulos_10 <- model_no_nulos
print(model_no_nulos_10$bestTune)## mtry ntree nodesize
## 77 7 480 6Para 11 variables:
variables_deseadas <- c("A9", "A11", "A8", "A10", "A15", "A6", "A3", "A14", "A2", "A7", "A5", "Class")
# Filtrar el dataset para que contenga solo estas variables
data <- credit.fix3.categoricalFix %>% dplyr::select(all_of(variables_deseadas))
predictors <- data[, !names(data) %in% 'Class']
target <- data[['Class']]
set.seed(125)
model_no_nulos <- train(
x = predictors,
y = target,
method=RF3param,
tuneLength = 100,
trControl=control,
metric = 'Accuracy'
)
model_no_nulos_11 <- model_no_nulos
print(model_no_nulos_11$bestTune)## mtry ntree nodesize
## 76 7 280 6Para 12 variables:
variables_deseadas <- c("A9", "A11", "A8", "A10", "A15", "A6", "A3", "A14", "A2", "A7", "A5", "A13", "Class")
# Filtrar el dataset para que contenga solo estas variables
data <- credit.fix3.categoricalFix %>% dplyr::select(all_of(variables_deseadas))
predictors <- data[, !names(data) %in% 'Class']
target <- data[['Class']]
set.seed(125)
model_no_nulos <- train(
x = predictors,
y = target,
method=RF3param,
tuneLength = 100,
trControl=control,
metric = 'Accuracy'
)
model_no_nulos_12 <- model_no_nulos
print(model_no_nulos_12$bestTune)## mtry ntree nodesize
## 78 7 270 5Para 13 variables:
variables_deseadas <- c("A9", "A11", "A8", "A10", "A15", "A6", "A3", "A14", "A2", "A7", "A5", "A13", "A1", "Class")
# Filtrar el dataset para que contenga solo estas variables
data <- credit.fix3.categoricalFix %>% dplyr::select(all_of(variables_deseadas))
predictors <- data[, !names(data) %in% 'Class']
target <- data[['Class']]
set.seed(125)
model_no_nulos <- train(
x = predictors,
y = target,
method=RF3param,
tuneLength = 100,
trControl=control,
metric = 'Accuracy'
)
model_no_nulos_13 <- model_no_nulos
print(model_no_nulos_13$bestTune)## mtry ntree nodesize
## 61 4 450 6Para 14 variables:
variables_deseadas <- c("A9", "A11", "A8", "A10", "A15", "A6", "A3", "A14", "A2", "A7", "A5", "A13", "A1", "A12", "Class")
# Filtrar el dataset para que contenga solo estas variables
data <- credit.fix3.categoricalFix %>% dplyr::select(all_of(variables_deseadas))
predictors <- data[, !names(data) %in% 'Class']
target <- data[['Class']]
set.seed(125)
model_no_nulos <- train(
x = predictors,
y = target,
method=RF3param,
tuneLength = 100,
trControl=control,
metric = 'Accuracy'
)
model_no_nulos_14 <- model_no_nulos
print(model_no_nulos_14$bestTune)## mtry ntree nodesize
## 18 11 130 12Vemos que los 5 modelos tienen accuracy muy similares que se diferencian en las centésimas, como mucho en 0.004. Luego vamos a comparar los modelos para elegir el modelo más adecuado basado en el rendimiento y la variabilidad del accuracy:
modelList_nulos<-list(
model_no_nulos_10
,model_no_nulos_11
,model_no_nulos_12
,model_no_nulos_13
,model_no_nulos_14
)
model_nulos_final<-resamples(modelList_nulos)## Warning in resamples.default(modelList_nulos): 'Model1' did not have
## 'returnResamp="final"; the optimal tuning parameters are used## Warning in resamples.default(modelList_nulos): 'Model2' did not have
## 'returnResamp="final"; the optimal tuning parameters are used## Warning in resamples.default(modelList_nulos): 'Model3' did not have
## 'returnResamp="final"; the optimal tuning parameters are used## Warning in resamples.default(modelList_nulos): 'Model4' did not have
## 'returnResamp="final"; the optimal tuning parameters are used## Warning in resamples.default(modelList_nulos): 'Model5' did not have
## 'returnResamp="final"; the optimal tuning parameters are useddensityplot(model_nulos_final,
scales =list(x = list(relation = "free"),
y = list(relation = "free")),
auto.key = list(columns = 4),
pch = "|")
La mayoría de los modelos tienen sus valores de Accuracy alrededor de (0.87 - 0.93), lo que indica que son bastante similares en términos de precisión general. El modelo 3 tiene una mayor densidad respecto a los demás modelos, es decir, es más consistente, y además esta centrado en el intervalo dicho (un buen valor de accuracy). Elegimos el modelo 3 porque entre los modelos hay apenas diferencia en el accuracy, luego elegimos por el modelo más consistente en este caso el 3:
- mtry = 7
- ntree = 270
- nodesize = 5
5.5 Segundo preprocesado
Usamos los datos que no tienen nulos, eliminando la variable A4, outliers winsorizados y variables categóricas modificadas. De la misma forma que el preprocesado anterior vamos a ver cuales son las principales variables aplicando el RFE:
# Dividir en variables predictoras y objetivo
predictors <- temporal_train %>% dplyr::select(-Class)
target <- temporal_train$Class
# Definir el control para RFE
rfe_control <- rfeControl(
functions = treebagFuncs, # Utilizar treebagFuncs para una ejecución rápida
method = "repeatedcv",
number = 10,
repeats = 3,
verbose = FALSE
)
# Definir el rango de variables a evaluar
subset_sizes <- 1:14
# Ejecutar RFE
set.seed(125)
rfe_result <- rfe(
x = predictors,
y = target,
sizes = subset_sizes,
rfeControl = rfe_control
)
print(rfe_result)##
## Recursive feature selection
##
## Outer resampling method: Cross-Validated (10 fold, repeated 3 times)
##
## Resampling performance over subset size:
##
## Variables Accuracy Kappa AccuracySD KappaSD Selected
## 1 0.8647 0.7306 0.03589 0.07137
## 2 0.8641 0.7293 0.03622 0.07208
## 3 0.8392 0.6753 0.03477 0.07088
## 4 0.8354 0.6667 0.04917 0.09949
## 5 0.8440 0.6845 0.04853 0.09820
## 6 0.8483 0.6933 0.03787 0.07601
## 7 0.8630 0.7235 0.03965 0.07984
## 8 0.8539 0.7052 0.03852 0.07765
## 9 0.8654 0.7285 0.04363 0.08763
## 10 0.8654 0.7281 0.03882 0.07795
## 11 0.8654 0.7281 0.04292 0.08692
## 12 0.8618 0.7211 0.04306 0.08679
## 13 0.8636 0.7247 0.03844 0.07715
## 14 0.8666 0.7308 0.04046 0.08132 *
##
## The top 5 variables (out of 14):
## A9, A11, A8, A10, A15## [1] "A9" "A11" "A8" "A10" "A15" "A6" "A14" "A3" "A2" "A7" "A13" "A1"
## [13] "A5" "A12"
Observamos que a partir de 9 variables se obtiene un valor por encima de 0.865 excepto con 12 y 13 variables. Vamos a buscar de nuevo los mejores hiper-parámetros desde 9 variables hasta 14.
Para 9 variables, probamos 100 combinaciones distintas para distintos valores de mtry, nTree y Nodesize:
variables_deseadas <- c("A9", "A11", "A8", "A10", "A15", "A6", "A3", "A14", "A2", "Class")
# Filtrar el dataset para que contenga solo estas variables
data <- temporal_train %>% dplyr::select(all_of(variables_deseadas))
predictors <- data[, !names(data) %in% 'Class']
target <- data[['Class']]
set.seed(125)
model <- train(
x = predictors,
y = target,
method=RF3param,
tuneLength = 100,
trControl=control,
metric = 'Accuracy'
)
model_temporal_9 <- model
print(model_temporal_9$bestTune)## mtry ntree nodesize
## 23 3 200 6Para 10 variables:
variables_deseadas <- c("A9", "A11", "A8", "A10", "A15", "A6", "A14", "A3", "A2", "A7", "Class")
# Filtrar el dataset para que contenga solo estas variables
data <- temporal_train %>% dplyr::select(all_of(variables_deseadas))
predictors <- data[, !names(data) %in% 'Class']
target <- data[['Class']]
set.seed(125)
model <- train(
x = predictors,
y = target,
method=RF3param,
tuneLength = 100,
trControl=control,
metric = 'Accuracy'
)
model_temporal_10 <- model
print(model_temporal_10$bestTune)## mtry ntree nodesize
## 99 9 500 11Para 11 variables:
variables_deseadas <- c("A9", "A11", "A8", "A10", "A15", "A6", "A3", "A14", "A2", "A7", "A1", "Class")
# Filtrar el dataset para que contenga solo estas variables
data <- temporal_train %>% dplyr::select(all_of(variables_deseadas))
predictors <- data[, !names(data) %in% 'Class']
target <- data[['Class']]
set.seed(125)
model <- train(
x = predictors,
y = target,
method=RF3param,
tuneLength = 100,
trControl=control,
metric = 'Accuracy'
)
model_temporal_11 <- model
print(model_temporal_11$bestTune)## mtry ntree nodesize
## 50 4 480 27Para 12 variables:
variables_deseadas <- c("A9", "A11", "A8", "A10", "A15", "A6", "A3", "A14", "A2", "A7", "A12", "A1", "Class")
# Filtrar el dataset para que contenga solo estas variables
data <- temporal_train %>% dplyr::select(all_of(variables_deseadas))
predictors <- data[, !names(data) %in% 'Class']
target <- data[['Class']]
set.seed(125)
model <- train(
x = predictors,
y = target,
method=RF3param,
tuneLength = 100,
trControl=control,
metric = 'Accuracy'
)
model_temporal_12 <- model
print(model_temporal_12$bestTune)## mtry ntree nodesize
## 76 7 230 5Para 13 variables:
variables_deseadas <- c("A9", "A11", "A8", "A10", "A15", "A6", "A3", "A14", "A2", "A7", "A12", "A1", "A13", "Class")
# Filtrar el dataset para que contenga solo estas variables
data <- temporal_train %>% dplyr::select(all_of(variables_deseadas))
predictors <- data[, !names(data) %in% 'Class']
target <- data[['Class']]
set.seed(125)
model <- train(
x = predictors,
y = target,
method=RF3param,
tuneLength = 100,
trControl=control,
metric = 'Accuracy'
)
model_temporal_13 <- model
print(model_temporal_13$bestTune)## mtry ntree nodesize
## 63 5 230 18Para 14 variables:
variables_deseadas <- c("A9", "A11", "A8", "A10", "A15", "A6", "A3", "A14", "A2", "A7", "A5", "A13", "A1", "A12", "Class")
# Filtrar el dataset para que contenga solo estas variables
data <- temporal_train %>% dplyr::select(all_of(variables_deseadas))
predictors <- data[, !names(data) %in% 'Class']
target <- data[['Class']]
set.seed(125)
model <- train(
x = predictors,
y = target,
method=RF3param,
tuneLength = 100,
trControl=control,
metric = 'Accuracy'
)
model_temporal_14 <- model
print(model_temporal_14$bestTune)## mtry ntree nodesize
## 78 7 380 11De nuevo las diferencias entre los accuracy son pequeños, luego usamos una gráfica de densidad para decidir sobre el mejor modelo:
modelList_temporal <-list(
model_temporal_9
,model_temporal_10
,model_temporal_11
,model_temporal_12
,model_temporal_13
,model_temporal_14
)
model_temporal_final<-resamples(modelList_temporal)## Warning in resamples.default(modelList_temporal): 'Model1' did not have
## 'returnResamp="final"; the optimal tuning parameters are used## Warning in resamples.default(modelList_temporal): 'Model2' did not have
## 'returnResamp="final"; the optimal tuning parameters are used## Warning in resamples.default(modelList_temporal): 'Model3' did not have
## 'returnResamp="final"; the optimal tuning parameters are used## Warning in resamples.default(modelList_temporal): 'Model4' did not have
## 'returnResamp="final"; the optimal tuning parameters are used## Warning in resamples.default(modelList_temporal): 'Model5' did not have
## 'returnResamp="final"; the optimal tuning parameters are used## Warning in resamples.default(modelList_temporal): 'Model6' did not have
## 'returnResamp="final"; the optimal tuning parameters are used##
## Call:
## summary.resamples(object = model_temporal_final)
##
## Models: Model1, Model2, Model3, Model4, Model5, Model6
## Number of resamples: 10
##
## Accuracy
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## Model1 0.8000000 0.8727273 0.8909091 0.8867003 0.9212963 0.9272727 0
## Model2 0.7818182 0.8755051 0.8991582 0.8867003 0.9086700 0.9272727 0
## Model3 0.7818182 0.8727273 0.8900673 0.8848822 0.9086700 0.9272727 0
## Model4 0.8000000 0.8727273 0.8808081 0.8848485 0.9086700 0.9272727 0
## Model5 0.7818182 0.8727273 0.8898990 0.8866667 0.9086700 0.9454545 0
## Model6 0.8000000 0.8767677 0.8898990 0.8866330 0.9045455 0.9272727 0
##
## Kappa
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## Model1 0.5953177 0.7387885 0.7761194 0.7705636 0.8417493 0.8543046 0
## Model2 0.5564516 0.7511727 0.7957519 0.7706163 0.8146898 0.8543046 0
## Model3 0.5564516 0.7406491 0.7780676 0.7668832 0.8166605 0.8533333 0
## Model4 0.5953177 0.7406491 0.7607728 0.7673140 0.8140555 0.8543046 0
## Model5 0.5564516 0.7407447 0.7784572 0.7706086 0.8140555 0.8903654 0
## Model6 0.5953177 0.7508929 0.7771726 0.7706692 0.8054081 0.8543046 0densityplot(model_temporal_final,
scales =list(x = list(relation = "free"),
y = list(relation = "free")),
auto.key = list(columns = 4),
pch = "|")
Se puede observar como todos los modelos estan en el rango de 0.85 y 0.95. De nuevo resalta el modelo que está más centrado de los demás en 0.9, y además tiene mayor densidad (más consistente). Los demás modelos varían de inclinación, pero son menos consistentes. Siguiendo la misma regla de elección del modelo, elegimos el modelo 6:
- mtry = 7
- ntree = 380
- nodesize = 11
5.6 Comparación de modelos
Comparamos las mejores configuraciones de los preprocesados obtenidos con su determinada reducción de variables:
# Preprocesado sin nulos y sin A4
rf2parGrid<-expand.grid(
mtry = 7,
ntree = 270,
nodesize = 5
)
variables_deseadas <- c("A9", "A11", "A8", "A10", "A15", "A6", "A3", "A14", "A2", "A7", "A5", "A13", "Class")
# Filtrar el dataset para que contenga solo estas variables
data <- credit.fix3.categoricalFix %>% dplyr::select(all_of(variables_deseadas))
predictors <- data[, !names(data) %in% "Class"]
target <- data[["Class"]]
# Configuración de control para el entrenamiento
control_aux <- trainControl(method = 'cv',
number = 10,
search = 'grid',
verbose = FALSE,)
set.seed(125)
model_nulos <- train(
x = predictors,
y = target,
method=RF3param,
tuneGrid = rf2parGrid,
trControl=control_aux
)
# Preprocesado temporal_train
rf2parGrid<-expand.grid(
mtry = 7,
ntree = 380,
nodesize = 11
)
variables_deseadas <- c("A9", "A11", "A8", "A10", "A15", "A6", "A3", "A14", "A2", "A7", "A5", "A13", "A1", "A12", "Class")
# Filtrar el dataset para que contenga solo estas variables
data <- temporal_train %>% dplyr::select(all_of(variables_deseadas))
predictors <- data[, !names(data) %in% "Class"]
target <- data[["Class"]]
set.seed(125)
model_temporal <- train(
x = predictors,
y = target,
method=RF3param,
tuneGrid = rf2parGrid,
trControl=control_aux
)
print(model_nulos)## Random Forest with 3 Parameters
##
## 547 samples
## 12 predictor
## 2 classes: '-', '+'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 493, 493, 492, 492, 492, 492, ...
## Resampling results:
##
## Accuracy Kappa
## 0.8884848 0.7742818
##
## Tuning parameter 'mtry' was held constant at a value of 7
## Tuning
## parameter 'ntree' was held constant at a value of 270
## Tuning
## parameter 'nodesize' was held constant at a value of 5## Random Forest with 3 Parameters
##
## 547 samples
## 14 predictor
## 2 classes: '-', '+'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 493, 493, 492, 492, 492, 492, ...
## Resampling results:
##
## Accuracy Kappa
## 0.8793266 0.7558307
##
## Tuning parameter 'mtry' was held constant at a value of 7
## Tuning
## parameter 'ntree' was held constant at a value of 380
## Tuning
## parameter 'nodesize' was held constant at a value of 11Los modelos con distintos preprocesado tienen accuracy muy parecidos. Luego vamos a optar por el que tenga unos parámetros que permitan un menor coste de computación. Nos interesa valores de de ntree bajos. El segundo modelo es más sencillo al tener solo ntree = 270 Luego nos quedamos con el primer modelo:
- preprocesado : Datos nulos y sin A4 variables : “A9”, “A11”, “A8”, “A10”, “A15”, “A6”, “A3”, “A14”, “A2”, “A7”, “A5”, “A13”, “Class”
- mtry = 7
- ntree = 270
- nodesize = 5
Tras encontrar el mejor modelo con un determinado preprocesado y sus mejores hiper-parámetros, en este modelo hemos hecho un estudio más profundo reduciendo el número de variables y ver si influye positivamente o negativemnte en los resultados. Tras las pruebas hemos podido reducir el número de variables a 8: A9, A11, A10, A3, A14, A7, A5 y A13. Realizaremos una nueva búsqueda de hiper-parámetros, donde los valores a probar estarán cerca de los valores de los hiper-parámetros del antigüo modelo: ntree = (50 - 250) y nodesize = (5 - 10) con mtry = (7 - 8), ya que es el número de predcitores que usaremos en el modelo:
# Grid de hiperparámetros
rf2parGrid <- expand.grid(
mtry = c(7, 8),
ntree = c(50, 100, 150, 200, 250),
nodesize = c(5, 7, 9, 10)
)
variables_deseadas <- c("A9", "A11","A10", "A3", "A14", "A7", "A5", "A13", "Class")
# Seleccionar las variables deseadas
train_subset <- credit.fix3.categoricalFix %>% dplyr::select(all_of(variables_deseadas))
predictors <- train_subset[, !names(train_subset) %in% "Class"]
target <- train_subset[["Class"]]
control_aux <- trainControl(method = 'repeatedcv',
number = 10,
repeats = 3,
search = 'grid',
returnResamp = 'all',
savePredictions = 'final',
verbose = FALSE,
selectionFunction = 'best')
set.seed(125)
model_fino <- train(
x = predictors,
y = target,
method = RF3param,
tuneGrid = rf2parGrid,
trControl = control_aux
)
print(model_fino)## Random Forest with 3 Parameters
##
## 547 samples
## 8 predictor
## 2 classes: '-', '+'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 493, 493, 492, 492, 492, 492, ...
## Resampling results across tuning parameters:
##
## mtry ntree nodesize Accuracy Kappa
## 7 50 5 0.8720354 0.7403335
## 7 50 7 0.8739198 0.7439744
## 7 50 9 0.8769729 0.7504071
## 7 50 10 0.8763668 0.7492408
## 7 100 5 0.8775565 0.7518184
## 7 100 7 0.8781962 0.7529855
## 7 100 9 0.8751435 0.7469407
## 7 100 10 0.8799816 0.7569333
## 7 150 5 0.8775902 0.7517302
## 7 150 7 0.8745370 0.7455713
## 7 150 9 0.8769613 0.7505678
## 7 150 10 0.8793639 0.7556045
## 7 200 5 0.8775573 0.7519047
## 7 200 7 0.8738865 0.7443140
## 7 200 9 0.8775677 0.7516754
## 7 200 10 0.8763444 0.7494322
## 7 250 5 0.8793755 0.7557797
## 7 250 7 0.8744817 0.7457037
## 7 250 9 0.8763664 0.7491638
## 7 250 10 0.8775677 0.7520859
## 8 50 5 0.8756722 0.7478401
## 8 50 7 0.8757275 0.7481310
## 8 50 9 0.8757387 0.7480504
## 8 50 10 0.8745150 0.7454708
## 8 100 5 0.8732812 0.7426991
## 8 100 7 0.8733145 0.7432148
## 8 100 9 0.8751102 0.7470119
## 8 100 10 0.8738873 0.7442115
## 8 150 5 0.8800036 0.7566402
## 8 150 7 0.8757383 0.7480869
## 8 150 9 0.8751211 0.7467002
## 8 150 10 0.8781742 0.7531670
## 8 200 5 0.8738757 0.7441193
## 8 200 7 0.8726299 0.7419332
## 8 200 9 0.8751431 0.7469347
## 8 200 10 0.8757612 0.7483885
## 8 250 5 0.8751219 0.7468382
## 8 250 7 0.8738869 0.7445338
## 8 250 9 0.8781962 0.7531638
## 8 250 10 0.8720795 0.7406596
##
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were mtry = 8, ntree = 150 and nodesize = 5.El mejor modelo es con mtry = 8, ntree = 150 y nodesize = 5 con un accuracy de 0.8800036. Nos quedamos con este nuevo modelo al ser más simple (tiene menos predictores) y tener el mismo accuracy que el anterior.
5.7 Entrenamiento del modelo con el conjunto completo de datos
Entrenamos el modelo completo con todos los datos de entrenamiento:
rf2parGrid<-expand.grid(
mtry = 8,
ntree = 150,
nodesize = 5
)
variables_deseadas <- c("A9", "A11","A10", "A3", "A14", "A7", "A5", "A13", "Class")
train_subset <- credit.fix3.categoricalFix %>% dplyr::select(all_of(variables_deseadas))
predictors <- train_subset[, !names(train_subset) %in% "Class"]
target <- train_subset[["Class"]]
control_aux <- trainControl(method = "none", seeds = list(125))
set.seed(125)
model_final_rf <- train(
x = predictors,
y = target,
method=RF3param,
tuneGrid = rf2parGrid,
trControl=control_aux
)5.8 Evaluación del modelo seleccionado
En primer lugar procesamos el conjunto de test para que tenga la misma estructura que el conjunto de entrenamiento:
test_rf <- credit.Datos.Test
test_rf <- test_rf[, !names(test_rf) %in% "A4"]
test_rf$A14 <- as.numeric(test_rf$A14)
# Añadir el nivel "gg" a la variable A5
levels(test_rf$A5) <- c(levels(test_rf$A5), "gg")
# Añadir los niveles "r" y "Desconocido" a la variable A6
levels(test_rf$A6) <- c(levels(test_rf$A6), "r", "Desconocido")
# Añadir los niveles "dd", "n", "o" a la variable A7
levels(test_rf$A7) <- c(levels(test_rf$A7), "dd", "n", "o")
# Añadir el nivel "p" a la variable A13
levels(test_rf$A13) <- c(levels(test_rf$A13), "p")
# Filtrar el dataset para que contenga solo estas variables
variables_deseadas <- c("A9", "A11","A10", "A3", "A14", "A7", "A5", "A13", "Class")
test_rf <- test_rf %>% dplyr::select(all_of(variables_deseadas))Le aplicamos el test para ver los resultados finales, y obtenemos su error de entrenamiento para comprobar si hay overfitting:
# Error de entrenamiento
preds_train <- predict(model_final_rf, newdata=predictors, type = 'prob')
pred_classes_train <- ifelse(preds_train$`+` > preds_train$`-`, "+", "-")
pred_classes_train <- factor(pred_classes_train, levels = levels(test_rf$Class))
true_labels <- target
true_labels <- factor(true_labels, levels = levels(test_rf$Class))
# Generar la matriz de confusión
conf_matrix_train <- confusionMatrix(pred_classes_train, true_labels, positive="+")
error_train_df <- data.frame(
Metric = c("Error de entrenamiento"),
Value = c(
1 - conf_matrix_train$overall["Accuracy"]
)
)
print (error_train_df)## Metric Value
## Accuracy Error de entrenamiento 0.03839122# Error de test
newdata <- test_rf[, !names(test_rf) %in% "Class"]
preds<-predict(model_final_rf, newdata=newdata, type = 'prob')
pred_classes <- ifelse(preds$`+` > preds$`-`, "+", "-")
pred_classes <- factor(pred_classes, levels = levels(test_rf$Class))
true_labels <- test_rf$Class
true_labels <- factor(true_labels, levels = levels(test_rf$Class))
# Generar la matriz de confusión
conf_matrix_test <- confusionMatrix(pred_classes, true_labels, positive="+")
error_test_df <- data.frame(
Metric = c("Error de test"),
Value = c(
1 - conf_matrix_test$overall["Accuracy"]
)
)
print(error_test_df)## Metric Value
## Accuracy Error de test 0.1167883Observamos el error de entrenamiento es de 0.04, mientras que el error de test es de 0.11. Observamos que se distinguen en 0.07 puntos, lo que indica que no hay un overfitting que le perjudique demasiado, ya que permite al modelo generalizar obteniendo un 88.32% de accuracy en el test. Observamos la información que se obtiene en la matriz de confusión:
metrics <- data.frame(
Threshold = numeric(),
Accuracy = numeric(),
NoInformationRate = numeric(),
CI_Lower = numeric(),
CI_Upper = numeric(),
Sensitivity = numeric(),
Specificity = numeric(),
Precision = numeric(),
F1 = numeric()
)
# Almacenar métricas
metrics <- rbind(metrics, data.frame(
Threshold = 0.5,
Accuracy = conf_matrix_test$overall["Accuracy"],
NoInformationRate = conf_matrix_test$overall["AccuracyNull"],
CI_Lower = conf_matrix_test$overall["AccuracyLower"],
CI_Upper = conf_matrix_test$overall["AccuracyUpper"],
Sensitivity = conf_matrix_test$byClass["Sensitivity"],
Specificity = conf_matrix_test$byClass["Specificity"],
F1 = conf_matrix_test$byClass["F1"]
))
print (metrics)## Threshold Accuracy NoInformationRate CI_Lower CI_Upper Sensitivity
## Accuracy 0.5 0.8832117 0.5547445 0.8172792 0.931751 0.9344262
## Specificity F1
## Accuracy 0.8421053 0.8769231El modelo clasifica correctamente el 88.32% de las observaciones. El intervalo de confianza con un 95% de certeza se encuentra entre 81.73% y 93.17%. El valor de No Information Rate es de 55.47%, es decir, un modelo sin información que predijera siempre a la clase mayoritaria tendría ese accuracy. Nuestro valor mínimo del intervalo de confianza supera este valor, luego el modelo lo puede mejorar. Observando la sensibilidad y especificidad vemos que el modelo identifica el 93.44% los casos positivos correctamente, y un 84.21% los casos negativos, es decir, es más estricto con los casos positivos que negativos, luego habrá más falsos positivos que falsos negativos. F1 nos da 87.69%, lo que indica un buen balance entre la capacidad de detectar casos positivos y evitar falsos positivos.
En conclusión, el modelo minimiza los falsos negativos más que los falsos positivos. Esto puede ser un problema ya que en nuestro caso preferimos reducir los falsos positivos, pero sin que perjudique demasiado a los falsos negativos. Esto puede deberse a que hay un más datos con clases negativas que positivss, lo que puede hacer que el modelo se ajuste a predecir mejor los casos negativos. Vamos a realizar un análisis donde iremos modificando el threshold desde 0.1 hasta 0.9 e ir comentando los resultados:
# Crear un rango de thresholds
thresholds <- seq(0.1, 0.9, by = 0.1)
# Inicializar un data frame para almacenar las métricas
metrics <- data.frame(
Threshold = numeric(),
Accuracy = numeric(),
F1 = numeric()
)
# Iterar sobre cada threshold
for (threshold in thresholds) {
# Clasificar según el threshold
pred_classes <- ifelse(preds[, 2] > threshold, "+", "-")
pred_classes <- factor(pred_classes, levels = levels(test_rf$Class))
# Generar la matriz de confusión
cm <- confusionMatrix(pred_classes, test_rf$Class, positive = "+")
cm_table <- cm$table
FN <- cm_table["-", "+"]
FP <- cm_table["+", "-"]
# Calcular métricas
accuracy <- cm$overall["Accuracy"]
test_error <- 1 - as.numeric(accuracy) # Calcular el error de test
sensitivity <- cm$byClass["Sensitivity"]
specificity <- cm$byClass["Specificity"]
f1 <- cm$byClass["F1"]
# Almacenar métricas
metrics <- rbind(metrics, data.frame(
Threshold = threshold,
Accuracy = as.numeric(accuracy),
F1 = as.numeric(f1),
FP = as.numeric(FP),
FN = as.numeric(FN),
Sensitivity = as.numeric(sensitivity),
Specificity = as.numeric(specificity)
))
}
print(metrics)## Threshold Accuracy F1 FP FN Sensitivity Specificity
## 1 0.1 0.8102190 0.8169014 23 3 0.9508197 0.6973684
## 2 0.2 0.8394161 0.8405797 19 3 0.9508197 0.7500000
## 3 0.3 0.8613139 0.8592593 16 3 0.9508197 0.7894737
## 4 0.4 0.8832117 0.8787879 13 3 0.9508197 0.8289474
## 5 0.5 0.8832117 0.8769231 12 4 0.9344262 0.8421053
## 6 0.6 0.8686131 0.8593750 12 6 0.9016393 0.8421053
## 7 0.7 0.8686131 0.8500000 8 10 0.8360656 0.8947368
## 8 0.8 0.8540146 0.8214286 5 15 0.7540984 0.9342105
## 9 0.9 0.7737226 0.6868687 4 27 0.5573770 0.9473684Observamos que conforme reducimos los FP el accuracy se resiente demasiado. Luego, como nuestra prioridad es que el modelo consiga una buena tasa de clasificación, decidimos sacrificar la idea de reducir el número de FP. Vemos los resultados de cómo varía el accuracy y el F1 en función del threshold:
ggplot(metrics, aes(x = Threshold)) +
geom_line(aes(y = Accuracy, color = "Accuracy"), size = 1) +
geom_point(aes(y = Accuracy, color = "Accuracy"), size = 3) +
geom_line(aes(y = F1, color = "F1-Score"), size = 1) +
geom_point(aes(y = F1, color = "F1-Score"), size = 3) +
labs(
title = "Accuracy y F1-Score vs Threshold",
x = "Threshold",
y = "Métricas"
) +
scale_color_manual(
name = "Métricas",
values = c("Accuracy" = "blue", "F1-Score" = "green")
) +
theme_minimal()
Observamos que se pude mejorar la métrica F1-score y Accuracy con un mayor equilibrio entre sensibilidad y especificidad. Vemos que con valores de threshold menores de 0.25, y mayores de 0.75, ambas métricas caen drásticamente. Calculamos el mejor threshold usando la curva ROC con la búsqueda del índice de Youden:
## Setting direction: controls < cases# Visualizar la curva ROC
plot(roc_rf, col = "blue", lwd = 2, main = "Curva ROC")
abline(a = 0, b = 1, col = "gray", lty = 2) # Línea diagonal (azar)
## El valor de AUC es: 0.9173857# Añadir la información de la curva ROC al data frame
roc_data <- data.frame(
Threshold = coords(roc_rf, seq(0, 1, by = 0.01), ret = "threshold"),
Sensitivity = coords(roc_rf, seq(0, 1, by = 0.01), ret = "sensitivity"),
Specificity = coords(roc_rf, seq(0, 1, by = 0.01), ret = "specificity")
)
# Threshold óptimo según el índice de Youden
optimal_metrics <- coords(roc_rf, "best", ret = c("threshold", "sensitivity", "specificity"), best.method = "youden")
# Crear una tabla con los resultados
optimal_results <- data.frame(
Threshold = optimal_metrics["threshold"],
Sensitivity = optimal_metrics["sensitivity"],
Specificity = optimal_metrics["specificity"]
)
# Mostrar la tabla
print(optimal_results)## threshold sensitivity specificity
## 1 0.49 0.9508197 0.8421053Podemos observar al realizar la búsqueda del índice de Youden que, efectivamente, cerca de 0.5. Esto se corroborá con la gráfica de la curva ROC, pues se encuentra alejada de la diagonal gris. Esto significa que nuestro modelo tiene buena capacidad discriminativa. El área bajo la curva (AUC) es alta (0.917), lo cual respalda esta afirmación.
5.9 Creación de una población y obtención del intervalo de confianza
Para poder compararlo con otros modelos obtendremos su intervalo de confianza con la distribución t de Student variando la semilla en 30 valores. Calcularemos el intervalo tanto para el modelo con el threshold 0.5:
# Grid de hiperparámetros
rf2parGrid <- expand.grid(
mtry = 8,
ntree = 150,
nodesize = 5
)
variables_deseadas <- c("A9", "A11","A10", "A3", "A14", "A7", "A5", "A13", "Class")
# Seleccionar las variables deseadas
train_subset <- credit.fix3.categoricalFix %>% dplyr::select(all_of(variables_deseadas))
predictors <- train_subset[, !names(train_subset) %in% "Class"]
target <- train_subset[["Class"]]
control_aux <- trainControl(method = "none")
# Vectores para almacenar los accuracy de cada iteración
accuracy_values <- c()
for (seed in 100:130) {
set.seed(seed)
model_rf_boot <- train(
x = predictors,
y = target,
method = RF3param,
tuneGrid = rf2parGrid,
trControl = control_aux
)
newdata <- test_rf[, !names(test_rf) %in% "Class"]
preds <- predict(model_rf_boot, newdata = newdata, type = 'prob')
# Predicciones con threshold por defecto (compara prob + vs -)
pred_classes <- ifelse(preds$`+` > preds$`-`, "+", "-")
pred_classes <- factor(pred_classes, levels = c("-", "+"))
true_labels <- factor(test_rf$Class, levels = c("-", "+"))
conf_matrix <- confusionMatrix(pred_classes, true_labels, positive = "+")
accuracy <- conf_matrix$overall["Accuracy"]
# Almacenar los accuracy en cada iteración
accuracy_values <- c(accuracy_values, accuracy)
}
### Cálculo del IC al 95% para accuracy_values
mean_acc <- mean(accuracy_values)
std_error <- sd(accuracy_values) / sqrt(length(accuracy_values))
t_value <- qt(0.975, df = length(accuracy_values) - 1)
ci_lower <- mean_acc - t_value * std_error
ci_upper <- mean_acc + t_value * std_error
cat("Precisión promedio (threshold 0.5):", mean_acc, "\n")## Precisión promedio (threshold 0.5): 0.886979## IC 95% t-Student: [ 0.885167 , 0.8887911 ]Observamos que para un threshold de 0.5 se obtiene un intervalo de confianza entre 88.52% y 88.88%. Podemos afirmar que ambos modelos tienen su accuracy con un 95% entre esos intervalos respectivamente. Es un buen indicativo que el rango de sus intervalores sea de menos de 0.03, indica que es un modelo consistente.
if (!require(tidyverse)) install.packages("tidyverse", dependencies = TRUE)
if (!require(ggplot2)) install.packages("ggplot2", dependencies = TRUE)
if (!require(dplyr)) install.packages("dplyr", dependencies = TRUE)
if (!require(gridExtra)) install.packages("gridExtra", dependencies = TRUE)
if (!require(tidyr)) install.packages("tidyr", dependencies = TRUE)
if (!require(caret)) install.packages("caret", dependencies = TRUE)
if (!require(lattice)) install.packages("lattice", dependencies = TRUE)
if (!require(reshape2)) install.packages("reshape2", dependencies = TRUE)
if (!require(DescTools)) install.packages("DescTools", dependencies = TRUE)
if (!require(kableExtra)) install.packages("kableExtra", dependencies = TRUE)
if (!require(randomForest)) install.packages("randomForest", dependencies = TRUE)
if (!require(GGally)) install.packages("GGally", dependencies = TRUE)
if (!require(here)) install.packages("here", dependencies = TRUE)
if (!require(nnet)) install.packages("nnet", dependencies = TRUE)## Cargando paquete requerido: nnetif (!require(pROC)) install.packages("pROC", dependencies = TRUE)
# Cargar las librerías
library(tidyverse)
library(ggplot2)
library(dplyr)
library(gridExtra)
library(tidyr)
library(caret)
library(lattice)
library(reshape2)
library(DescTools)
library(kableExtra)
library(randomForest)
library(GGally)
library(here)
library(nnet)
library(pROC)6 Redes Neuronales
6.1 Justificación del modelo elegido
Hemos decidido utilizar un modelo de red neuronal simple debido a su eficacia en tareas de clasificación binaria. Con una sola neurona de salida y una función de activación sigmoidal, estas redes son ideales para calcular probabilidades de clasificación de manera intuitiva. Esto se debe a su capacidad para manejar relaciones complejas y no lineales entre las variables predictoras y la clase objetivo, lo cual resulta particularmente útil en nuestro conjunto de datos, donde algunas variables numéricas no siguen una distribución normal.
Una de las ventajas clave de las redes neuronales es su capacidad para trabajar con datos categóricos. Al aplicar técnicas como la codificación dummy, son capaces de aprender patrones significativos entre las diferentes categorías. Esto es especialmente beneficioso en nuestro caso, ya que nuestro conjunto de datos contiene un gran número de variables categóricas. Así, podemos afirmar que las redes neuronales son eficaces en el manejo de conjuntos de datos mixtos. Además, a diferencia de modelos como la regresión logística (por ejemplo, bayesglm), las redes neuronales no requieren suposiciones estrictas sobre la distribución de los datos.
En particular, utilizaremos el modelo nnet, una red neuronal simple de una sola capa oculta. Este modelo es especialmente adecuado para problemas de clasificación binaria en configuraciones simples. Es decir, para conjuntos de datos pequeños como el nuestro. Sin embargo, las redes neuronales tienden a ajustarse demasiado al conjunto de entrenamiento (overfitting) cuando el volúmen de datos es limitado, por lo que tendremos que implementar estrategias de regularización y optimización de hiperparámetros para mitigar este riesgo.
6.2 Análisis para el preprocesado de datos
Para aprovechar al máximo las ventajas que nos ofrece este modelo, es importante que tengamos en cuenta algunos puntos clave relacionados con el preprocesado:
Realización de un preprocesamiento adecuado de los datos de entrenamiento, como escalar las variables numéricas y codificar las categóricas. Esto último lo hicimos ya en el análisis inicial.
Eliminación de valores nulos. De lo contrario, la función nnet realiza una acción específica para estos que puede perjudicar nuestro modelo. Sin embargo, esto no nos supondrá ningún problema, ya que en el apartado en del análisis exploratorio realizamos el tratamiento oportuno a los datos con valores nulos.
Los valores atípicos pueden afectar al entrenamiento de la red neuronal simple. Por tanto, aprovecharemos el tratamiento que hicimos a estos datos en el análisis exploratorio.
El PCA podría ser beneficioso al intentar reducir la complejidad del modelo.
Por tanto, teniendo en cuenta todos estos aspectos clave, llevaremos a cabo los siguientes preprocesados de datos:
Datos escalados con variables dummy sin nulos, etiquetas variables categóricas modificadas, eliminación de A4 y A6 [ff] por alta colinealidad y outliers winsorizados.
Igual que el anterior, pero aplicándole el PCA.
Datos escalados con variables dummy sin nulos sin la variable A4 y eliminación A6 [ff].
Mismos datos que el procesado anterior pero con pca.
Los dos primeros conjuntos de datos están ya creado como temporal_train_dummy y temporal_train_dummy_escalados_pca. Los otros dos hay que construirlos.
6.3 Análisis para la búsqueda de hiper-parámetros del modelo nnet
Para comprender mejor el modelo nnet, averiguaremos en primer lugar cuáles son los hiper-parámetros usados en este algoritmo:
size: Número de neuronas en la capa oculta. La capa oculta es donde se modelan las relaciones no lineales entre las variables predictoras y la variable objetivo. Con un valor bajo puede que no capte patrones complejos de los datos, lo que puede derivar en subajuste (underfitting). En cambio, si el valor es alto, puede producir overfitting al capturar demasiada información.
decay: Ayuda a prevenir el sobreajuste a los datos de entrenamiento al penalizar pesos excesivamente grandes.
Si seguimos analizando el algoritmo, podemos observar otros posibles parámetros:
- maxit: Número máximo de interacciones (por defecto 100). Con un valor bajo el entrenamiento podrá detenerse sin que el modelo haya llegado a converger (underfitting). Con un valor alto podría dar problemas de sobreajuste.
- abstol: Es un criterio de parada del entrenamiento de modelo. Se detiene cuando se alcanza un error por debajo de un umbral.
- reltol: Otro criterio de parada que evita que el entrenamiento continúe cuando las mejoras son ínfimas.
En nuestro caso, usaremos las condiciones de parada con valores de abstol = 1e-4, y reltol = 1e-5. Abstol tendrá un valor más grande que retol para que, en caso de que no se alcance el error 1e-4, se detenga porque entre cada iteración no haya una mejora de más de 1e-6. Además, usaremos maxit = 20, ya que la base de datos es simple y no queremos overfitting.
En un primer estudio inicial de los hiper-parámetros, vamos a usar la siguiente parrilla en cada preprocesado:
- size = (3, 5, 8, 10)
- decay = (0.1, 3, 6, 10)
Se han elegido estos valores teniendo en cuenta el tamaño del conjunto de entrenamiento. Un intervalo entre 3 y 10 para el número de neuronas es útil para captar las relaciones existentes y evitar el sobreajuste sin complicar demasiado el modelo. En el caso de decay, incluir un rango amplio de valores nos va a permitir observar cómo la regularización afecta al modelo.
6.4 Primer preprocesado
El primer conjunto de datos que vamos a utilizar, temporal_train_dummy no ha sido escalado previamente. Por lo que será necesario realizar el escalado de las variables numéricas entre el rango [0, 1] ya que las redes neuronales trabajan bien en ese rango.
# Variables categorizadas como Gaussianas y no Gaussianas
var <- c("A2", "A3", "A14", "A8", "A11", "A15")
#######################################################
#######################################################
pre_process_model2 <- preProcess(temporal_train_dummy[, var], method = "range")
transformed_no_gaussians2 <- predict(pre_process_model2, temporal_train_dummy[, var])
categorical2 <- temporal_train_dummy[, setdiff(names(temporal_train_dummy), var), drop = FALSE]
temporal_train_dummy_escalados <- cbind(transformed_no_gaussians2, categorical2)6.4.1 Sin aplicar el PCA al conjunto
Al igual que hicimos en otros modelos anteriores, utilizaremos la validación cruzada de k pliegues (3 pliegues) con varias repeticiones (10) para la búsquedad grid. Además, usaremos la métrica de accuracy para observar los resultados, puesto que las clases están balanceadas. A continuación, creamos la función para entrenar los modelos y que tengan la misma semilla.
# Configuración de control para el entrenamiento
control <- trainControl(method = 'repeatedcv',
number = 10,
repeats = 3,
search = 'grid',
verbose = FALSE)Ahora, probamos la parrilla propuesta al inicio para obtener una primera vista del rendimiento de los modelos con diferentes configuraciones. Lo haremos para ambos preprocesados.
# Definir un grid personalizado
grid_aux <- expand.grid(
size = c(3, 5, 8, 10),
decay = c(1, 3, 6, 10)
)
set.seed(125)
model_dummy_escalados <- train(
Class ~ .,
data = temporal_train_dummy_escalados,
method = "nnet",
trControl = control,
tuneGrid = grid_aux,
metric = "Accuracy",
maxit = 20,
trace = FALSE,
abstol = 1e-4,
reltol = 1e-5,
)
print(model_dummy_escalados)## Neural Network
##
## 547 samples
## 25 predictor
## 2 classes: '-', '+'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 493, 493, 492, 492, 492, 492, ...
## Resampling results across tuning parameters:
##
## size decay Accuracy Kappa
## 3 1 0.8677273 0.7333273
## 3 3 0.8720471 0.7418977
## 3 6 0.8756714 0.7462882
## 3 10 0.8415520 0.6708294
## 5 1 0.8664927 0.7308433
## 5 3 0.8696449 0.7372789
## 5 6 0.8793523 0.7544495
## 5 10 0.8531790 0.6961931
## 8 1 0.8683117 0.7344264
## 8 3 0.8702509 0.7385206
## 8 6 0.8787470 0.7537337
## 8 10 0.8550196 0.7005795
## 10 1 0.8677381 0.7332576
## 10 3 0.8702289 0.7382338
## 10 6 0.8817993 0.7596090
## 10 10 0.8623152 0.7161532
##
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were size = 10 and decay = 6.Observamos que se obtienen los mejores resultados con size = 10, decay = 6 con un accuracy de 0.8817993.
6.4.2 Aplicando el PCA al conjunto
Realizaremos también la búsqueda hiper-parámetros para el conjunto de datos temporal_train_dummy_escalados_pca.
# Definir un grid personalizado
grid_aux <- expand.grid(
size = c(3, 5, 8, 10),
decay = c(0.1, 3, 6, 10)
)
set.seed(125)
model_dummy_escalados_pca <- train(
Class ~ .,
data = temporal_train_dummy_escalados_pca,
method = "nnet",
trControl = control,
tuneGrid = grid_aux,
metric = "Accuracy",
maxit = 20,
trace = FALSE,
abstol = 1e-4,
reltol = 1e-5,
)
print(model_dummy_escalados_pca)## Neural Network
##
## 547 samples
## 19 predictor
## 2 classes: '-', '+'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 493, 493, 492, 492, 492, 492, ...
## Resampling results across tuning parameters:
##
## size decay Accuracy Kappa
## 3 0.1 0.8648180 0.7252160
## 3 3.0 0.8750669 0.7471599
## 3 6.0 0.8665584 0.7276570
## 3 10.0 0.8561544 0.7025422
## 5 0.1 0.8623601 0.7203269
## 5 3.0 0.8744829 0.7461005
## 5 6.0 0.8708233 0.7361007
## 5 10.0 0.8628772 0.7166590
## 8 0.1 0.8586568 0.7128090
## 8 3.0 0.8763236 0.7498009
## 8 6.0 0.8647619 0.7238397
## 8 10.0 0.8634832 0.7183338
## 10 0.1 0.8599238 0.7155469
## 10 3.0 0.8763236 0.7498943
## 10 6.0 0.8684319 0.7313496
## 10 10.0 0.8635169 0.7187416
##
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were size = 8 and decay = 3.En este caso, observamos que los mejores resultados los obtenemos cuando size y decay valen 8 y 3 respectivamente. En concreto, el accuracy resultante es 0.8763236. A priori, este resultado es peor que el obtenido sin PCA, aunque la diferencia es mínima y el número de variables es considerablemente más bajo que antes (de 25 a 19 sin incluir la variable de clase).
6.5 Segundo preprocesado
En el conjunto credit.fix3.categoricalFix se han eliminado todos los nulos, pero no se ha realizado la eliminación de variables por alta colinealidad. Además, tampoco se han agrupado/eliminado categorías poco frecuentes ni se han tratado los outliers. Por tanto, utilizaremos este conjunto de base para el preprocesamiento del segundo conjunto y le aplicaremos las modificaciones que comentamos antes:
- Datos escalados con variables dummy (sin nulos).
- Eliminación de la variable A4 y A6.ff.
# Datos no nulos
data_no_nulos <- credit.fix3.categoricalFix
# Eliminacion A4
data_no_nulos <- data_no_nulos[, !names(data_no_nulos) %in% "A4"]
# Escalamos los datos
var <- c("A2", "A3", "A14", "A8", "A11", "A15")
categorical_vars <- setdiff(names(data_no_nulos), var)
pre_process_model2 <- preProcess(data_no_nulos[, var], method = "range")
transformed_no_gaussians2 <- predict(pre_process_model2, data_no_nulos[, var])
categorical2 <- data_no_nulos[, setdiff(names(data_no_nulos), var), drop = FALSE]
data_escalados <- cbind(transformed_no_gaussians2, categorical2)
# transformamos a dummy
data <- data_escalados
categorical_vars <- c("A1", "A5", "A6", "A7", "A9", "A10", "A12", "A13")
numeric_vars <- c("A2", "A3", "A8", "A11", "A14", "A15")
target_var <- "Class"
input_vars <- setdiff(names(data), target_var)
cols_categorical <- NULL
if (length(categorical_vars) > 0) {
dummy_categorical <- dummyVars(
paste("~", paste(categorical_vars, collapse = " + ")),
data = data, fullRank = TRUE
)
cols_categorical <- data.frame(predict(dummy_categorical, newdata = data))
}
data_dummy <- cbind(cols_categorical, data[, numeric_vars], data[, target_var, drop = FALSE])
# Eliminación A6 [ff]
data_dummy <- data_dummy[, !names(data_dummy) %in% "A6.ff"]Dado que en las búsquedas anteriores nos han salido valores centrales de la parrilla como mejores hiper-parámetros, decidimos seguir con los mismos aquí.
# Definir un grid personalizado
grid_aux <- expand.grid(
size = c(3, 5, 8, 10),
decay = c(0.1, 3, 6, 10)
)
set.seed(125)
model_dummy_2 <- train(
Class ~ .,
data = data_dummy,
method = "nnet",
trControl = control,
tuneGrid = grid_aux,
metric = "Accuracy",
maxit = 20,
trace = FALSE,
abstol = 1e-4,
reltol = 1e-5,
)
print(model_dummy_2)## Neural Network
##
## 547 samples
## 35 predictor
## 2 classes: '-', '+'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 493, 493, 492, 492, 492, 492, ...
## Resampling results across tuning parameters:
##
## size decay Accuracy Kappa
## 3 0.1 0.8617761 0.7201708
## 3 3.0 0.8664807 0.7327646
## 3 6.0 0.8744609 0.7471421
## 3 10.0 0.8224940 0.6277671
## 5 0.1 0.8660073 0.7277115
## 5 3.0 0.8658746 0.7313837
## 5 6.0 0.8769288 0.7522544
## 5 10.0 0.8410241 0.6698852
## 8 0.1 0.8652353 0.7268665
## 8 3.0 0.8652686 0.7304501
## 8 6.0 0.8744605 0.7474558
## 8 10.0 0.8531453 0.6962422
## 10 0.1 0.8623717 0.7209123
## 10 3.0 0.8677373 0.7351976
## 10 6.0 0.8775024 0.7535403
## 10 10.0 0.8526170 0.6958002
##
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were size = 10 and decay = 6.Podemos observar que los mejores resultados se obtienen cuando los hiperparámetros size y decay tienen el valor 10 y 6 respectivamente. Es fácil ver que el accuracy alcanza un valor de 0.8775024.
6.6 Tercer preprocesado
En este caso, vamos a utilizar el mismo conjunto que antes, pero aplicándole el PCA a las variables originales (no dummy) numéricas. Por tanto, el conjunto queda como sigue:
- Datos escalados con variables dummy (sin nulos)
- Eliminación de la variable A4 y A6.ff.
- Aplicación del PCA.
# Aplicamos PCA
pca <- prcomp(data_dummy[, numeric_vars], scale = FALSE)
#Obtención de la Proporción de Varianza Explicada
VE <- pca$sdev^2
PVE <- VE / sum(VE)
PVE_rounded <- round(PVE, 2)
cumPVE <- qplot(c(1:length(PVE)), cumsum(PVE), geom = "line") +
geom_point() +
xlab("Principal Component") +
ylab("Cumulative Proportion of Variance Explained") +
ggtitle("Cumulative Scree Plot") +
ylim(0, 1) +
geom_hline(yintercept = 0.95, linetype = "dashed", color = "red")
print(cumPVE)
En la gráfica, podemos observar que con las 4 componentes principales obtenemos el 95% de la varianza. Por tanto, nos quedaremos con esas 4 componentes y nos desharemos del resto, reduciendo así la dimensionalidad de 6 variables numéricas a 4, tal y como vemos a continuación:
dataframe_pca <- as.data.frame(pca$x[, 1:4])
categorical_data <- data_dummy[, !(names(data_dummy) %in% c("A2", "A3", "A8", "A11", "A14", "A15"))]
data_pca <- cbind(dataframe_pca, categorical_data)
names (data_pca)## [1] "PC1" "PC2" "PC3" "PC4"
## [5] "A1.b" "A5.gg" "A5.p" "A6.c"
## [9] "A6.cc" "A6.d" "A6.e" "A6.i"
## [13] "A6.j" "A6.k" "A6.m" "A6.q"
## [17] "A6.r" "A6.w" "A6.x" "A6.Desconocido"
## [21] "A7.dd" "A7.ff" "A7.h" "A7.j"
## [25] "A7.n" "A7.o" "A7.v" "A7.z"
## [29] "A9.t" "A10.t" "A12.t" "A13.p"
## [33] "A13.s" "Class"Una vez realizado el preprocesado entrenamos el modelo para obtener los mejores hiper-parámetros:
# Definir un grid personalizado
grid_aux <- expand.grid(
size = c(3, 5, 8, 10),
decay = c(0.1, 3, 6, 10)
)
set.seed(125)
model_dummy_pca <- train(
Class ~ .,
data = data_pca,
method = "nnet",
trControl = control,
tuneGrid = grid_aux,
metric = "Accuracy",
maxit = 20,
trace = FALSE,
abstol = 1e-4,
reltol = 1e-5,
)
print(model_dummy_pca)## Neural Network
##
## 547 samples
## 33 predictor
## 2 classes: '-', '+'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 493, 493, 492, 492, 492, 492, ...
## Resampling results across tuning parameters:
##
## size decay Accuracy Kappa
## 3 0.1 0.8678367 0.7327185
## 3 3.0 0.8683329 0.7363550
## 3 6.0 0.8781301 0.7545883
## 3 10.0 0.8330540 0.6527015
## 5 0.1 0.8587121 0.7136508
## 5 3.0 0.8677373 0.7353283
## 5 6.0 0.8793422 0.7575227
## 5 10.0 0.8470964 0.6828377
## 8 0.1 0.8586564 0.7131200
## 8 3.0 0.8683546 0.7363912
## 8 6.0 0.8744272 0.7479025
## 8 10.0 0.8537514 0.6984604
## 10 0.1 0.8672415 0.7304996
## 10 3.0 0.8646845 0.7292842
## 10 6.0 0.8762791 0.7514725
## 10 10.0 0.8554818 0.7020433
##
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were size = 5 and decay = 6.Podemos ver que el mejor resultado se obtiene cuando los hiperparámetros size y decay valen 5 y 6 respectivamente. Con estos valores, podemos observar un accuracy de 0.8793422.
6.7 Comparación de modelos
Tenemos cuatro preprocesados distintos para el modelo de redes neuronales. En cada modelo se ha hecho un refinamiento en la búsquedad de hiper-parámetros para conseguir el mejor accuracy de validación. Además, en dos de ellos se ha reducido el número de variables aplicando el PCA sin perjudicar los resultados. A continuación, mostramos un resumen de los valores de accuracy obtenidos para cada uno de los modelos:
# Crear el DataFrame con la información de los modelos
datasets_info <- data.frame(
Dataset = c(
"temporal_train_dummy_escalados",
"temporal_train_dummy_escalados_pca",
"data_dummy",
"data_pca"
),
Hiperparámetros = c(
"size = 10; decay = 6; maxit = 20",
"size = 8; decay = 3; maxit = 20",
"size = 10; decay = 6; maxit = 20",
"size = 5; decay = 6; maxit = 20"
),
NumeroVar = c(
26,
19,
36,
34
),
Accuracy = c(
0.8817993,
0.8763236,
0.8775024,
0.8793422
)
)
# Generar la tabla formateada con kable
datasets_info %>%
kable("html",
col.names = c(
"Nombre dataset",
"Hiperparámetros",
"Número de Variables",
"Accuracy"
),
align = "l") %>%
kable_styling(
full_width = TRUE,
bootstrap_options = c("striped", "hover", "condensed", "responsive"),
font_size = 14
) %>%
column_spec(1, bold = TRUE, color = "white", background = "#0073C1") %>%
column_spec(2, width = "30%") %>%
column_spec(3, width = "10%", bold = TRUE, color = "black", background = "#F2F2F2") %>%
column_spec(4, bold = TRUE, color = "black", background = "#DFF0D8") %>%
row_spec(0, bold = TRUE, color = "white", background = "#005F8C")| Nombre dataset | Hiperparámetros | Número de Variables | Accuracy |
|---|---|---|---|
| temporal_train_dummy_escalados | size = 10; decay = 6; maxit = 20 | 26 | 0.8817993 |
| temporal_train_dummy_escalados_pca | size = 8; decay = 3; maxit = 20 | 19 | 0.8763236 |
| data_dummy | size = 10; decay = 6; maxit = 20 | 36 | 0.8775024 |
| data_pca | size = 5; decay = 6; maxit = 20 | 34 | 0.8793422 |
Los cuatro tienen un accuracy muy similar, aunque el primero destaca por tener el mayor valor. No obstante, aquellos conjuntos a los que no se les ha aplicado PCA tienen un número excesivamente elevado de variables. Por tanto, aunque obtienen buenos resultados, vamos a descartarlos para conseguir un modelo más simple. De esta manera, temporal_train_dummy_escalados_pca junto con sus hiper-parámetros es ligeramente peor que el preprocesado data_pca con sus hiper-parámetros (0.876 < 0.879), pero el primero tiene en cuenta casi la mitad menos de variables que el segundo. Además, la diferencia de accuracy con el de mayor valor no es muy grande (0.003%). Por este motivo, entrenaremos el modelo final con temporal_train_dummy_escalados_pca usando size = 8 y decay = 3.
6.7.1 Optimización del modelo elegido
Además, antes de entrenar el modelo con el conjunto completo de datos, hemos realizado una serie de modificaciones en temporal_train_dummy_escalados_pca para optimizar el rendimiento del modelo. Para ello, hemos eliminado predictores que pueden dificultar la clasificación por su débil valor predictivo. El resultado ha sido la eliminación de A6, A8, A2 y A7, de tal forma que hemos obtenido un mejor error de validación (mayor accuracy). Esta eliminación se ha llevado a cabo antes de aplicar el PCA.
# Escalamos
gaussians <- "A2"
no_gaussians <- c("A8", "A11", "A15", "A3", "A14")
categorical_vars <- setdiff(names(temporal_train), c(gaussians, no_gaussians))
escalado2 <- preProcess(temporal_train_dummy[, gaussians, drop = FALSE], method = c("center", "scale"))
transformed_gaussians2 <- predict(escalado2, temporal_train_dummy[, gaussians, drop = FALSE])
pre_process_model2 <- preProcess(temporal_train_dummy[, no_gaussians], method = "range")
transformed_no_gaussians2 <- predict(pre_process_model2, temporal_train_dummy[, no_gaussians])
categorical2 <- temporal_train_dummy[, setdiff(names(temporal_train_dummy), c(gaussians, no_gaussians)), drop = FALSE]
temporal_train_dummy_escalados <- cbind(transformed_gaussians2, transformed_no_gaussians2, categorical2)
#Eliminamos variables
temporal_train_dummy_escalados <- temporal_train_dummy_escalados %>%
dplyr::select(-starts_with("A6"), -starts_with("A8"), -starts_with("A2"), -starts_with("A7"))
#Aplicamos el pca
pca_dummy <- prcomp(temporal_train_dummy_escalados[, !colnames(temporal_train_dummy_escalados) %in% "Class"], scale = FALSE)
VE <- pca_dummy$sdev^2
PVE <- VE / sum(VE)
PVE_rounded <- round(PVE, 2)
print(PVE_rounded)## [1] 0.31 0.16 0.13 0.10 0.09 0.07 0.05 0.04 0.03 0.02cumPVE <- qplot(c(1:length(PVE)), cumsum(PVE), geom = "line") +
geom_point() +
xlab("Principal Component") +
ylab("Cumulative Proportion of Variance Explained") +
ggtitle("Cumulative Scree Plot") +
ylim(0, 1) +
geom_hline(yintercept = 0.95, color = "red", linetype = "dashed", size = 1)
print(cumPVE)
Observamos que con 8 componentes principales obtenemos el 0.95 de varianza, luego podemos prescindir de los dos últimos. A continuación, hemos buscado los mejores hiper-parámetros para este nuevo preprocesado:
pca_data_dummy <- as.data.frame(pca_dummy$x[, 1:8])
pcs <- paste0("PC", 1:8)
colnames(pca_data_dummy) <- pcs
class_data <- temporal_train_dummy_escalados[, "Class", drop = FALSE]
temporal_train_dummy_escalados_pca <- cbind(pca_data_dummy, class_data)
# Definir un grid personalizado
grid_aux <- expand.grid(
size = c(3, 5, 8, 10),
decay = c(0.1, 3, 6, 10)
)
set.seed(125)
model_dummy_escalados_pca <- train(
Class ~ .,
data = temporal_train_dummy_escalados_pca,
method = "nnet",
trControl = control,
tuneGrid = grid_aux,
metric = "Accuracy",
maxit = 20,
trace = FALSE,
abstol = 1e-4,
reltol = 1e-5,
)
print(model_dummy_escalados_pca)## Neural Network
##
## 547 samples
## 8 predictor
## 2 classes: '-', '+'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 493, 493, 492, 492, 492, 492, ...
## Resampling results across tuning parameters:
##
## size decay Accuracy Kappa
## 3 0.1 0.8737767 0.7457613
## 3 3.0 0.8670422 0.7334015
## 3 6.0 0.8622258 0.7186277
## 3 10.0 0.8342781 0.6549082
## 5 0.1 0.8707564 0.7394088
## 5 3.0 0.8694673 0.7384895
## 5 6.0 0.8677589 0.7297969
## 5 10.0 0.8373088 0.6617704
## 8 0.1 0.8689049 0.7354851
## 8 3.0 0.8640119 0.7277976
## 8 6.0 0.8647507 0.7232887
## 8 10.0 0.8415624 0.6709548
## 10 0.1 0.8719693 0.7417732
## 10 3.0 0.8670426 0.7337948
## 10 6.0 0.8671200 0.7282641
## 10 10.0 0.8415849 0.6710155
##
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were size = 3 and decay = 0.1.Los mejores hiper-parámetros son son size = 3 y decay = 0.1 con un accuracy en la validación de 0.8775296, muy parecido al de los otros modelos, pero este tiene menor número de predictores. Hemos reducido de 19 a 8 el número de predictores necesarios, consiguiendo así un modelo más simple y con el mismo rendimiento.
6.8 Entrenamiento del modelo con el conjunto completo de datos
Una vez elegido el modelo, es necesario entrenar el modelo final con el conjunto completo de datos y con los mejores hiperparámetros.
grid_aux <- expand.grid(
size = 3,
decay = 0.1
)
predictors <- temporal_train_dummy_escalados_pca[, !names(temporal_train_dummy_escalados_pca) %in% "Class"]
target <- temporal_train_dummy_escalados_pca[["Class"]]
control_train <- trainControl(method = "none")
set.seed(125)
model_nnet_final_trained <- train(x = predictors,
y = target,
method = 'nnet',
metric = 'Accuracy',
tuneGrid = grid_aux,
trControl = control_train,
maxit = 20,
trace = FALSE,
abstol = 1e-4,
reltol = 1e-5)6.9 Evaluación del modelo seleccionado
A continuación, vamos tratar los datos del conjunto de test para poder evaluar el rendimiento del modelo que hemos elegido. Para ello, será necesario realizar el mismo preprocesado que aplicamos a temporal_train_dummy_escalados_pca. Por tanto, modificaremos las variables categóricas agrupando categorías, escalaremos las variables numéricas, convertiremos en dummy las variables categóricas y eliminaremos las variables con alta colinealidad.
# Creamos una variable con el conjunto de test de nuestro modelo (según temporal_train_dummy_escalados_pca)
test_nnet <- credit.Datos.Test
# Eliminamos las variables
test_nnet <- test_nnet %>%
dplyr::select(-A4)
# Agrupamos etiquetas de variables categóricas
credit.fix4.categorias <- test_nnet
# Cambiar valores de A5
credit.fix4.categorias$A5 <- as.character(credit.fix4.categorias$A5)
credit.fix4.categorias$A5 <- ifelse(credit.fix4.categorias$A5 == "gg", "g", credit.fix4.categorias$A5)
credit.fix4.categorias$A5 <- factor(credit.fix4.categorias$A5)
# Agrupar valores de A6 según las nuevas reglas
credit.fix4.categorias$A6 <- as.character(credit.fix4.categorias$A6)
credit.fix4.categorias$A6 <- ifelse(credit.fix4.categorias$A6 == "r", "e",
ifelse(credit.fix4.categorias$A6 == "j", "m",
ifelse(credit.fix4.categorias$A6 == "Desconocido", "c", credit.fix4.categorias$A6)))
credit.fix4.categorias$A6 <- factor(credit.fix4.categorias$A6)
# Agrupar valores de A7 según las nuevas reglas
credit.fix4.categorias$A7 <- as.character(credit.fix4.categorias$A7)
credit.fix4.categorias$A7 <- ifelse(credit.fix4.categorias$A7 %in% c("dd", "j", "n", "o"), "bb",
ifelse(credit.fix4.categorias$A7 == "z", "h", credit.fix4.categorias$A7))
credit.fix4.categorias$A7 <- factor(credit.fix4.categorias$A7)
# Cambiar valores de A13
credit.fix4.categorias$A13 <- as.character(credit.fix4.categorias$A13)
credit.fix4.categorias$A13 <- ifelse(credit.fix4.categorias$A13 == "p", "g", credit.fix4.categorias$A13)
credit.fix4.categorias$A13 <- factor(credit.fix4.categorias$A13)
test_nnet <- credit.fix4.categorias
data <- test_nnet
# Lista de variables categóricas y numéricas
categorical_vars <- c("A1", "A5", "A6", "A7", "A9", "A10", "A12", "A13")
numeric_vars <- c("A2", "A3", "A8", "A11", "A14", "A15")
# variable de salida
target_var <- "Class"
# Variables de entrada
input_vars <- setdiff(names(data), target_var)
# Crear variables dummy para todas las variables categóricas (fullRank = TRUE)
cols_categorical <- NULL
if (length(categorical_vars) > 0) {
dummy_categorical <- dummyVars(
paste("~", paste(categorical_vars, collapse = " + ")),
data = data, fullRank = TRUE
)
cols_categorical <- data.frame(predict(dummy_categorical, newdata = data))
}
# Combinar variables categóricas dummy con las numéricas
test_nnet_dummy <- cbind(cols_categorical, data[, numeric_vars], data[, target_var, drop = FALSE])
# Eliminación de A6.ff
test_nnet_dummy <- test_nnet_dummy[, !names(test_nnet_dummy) %in% "A6.ff"]
# Escalamos los datos para realizar el pca
gaussians <- "A2"
no_gaussians <- c("A8", "A11", "A15", "A3", "A14")
categorical_vars <- setdiff(names(test_nnet_dummy), c(gaussians, no_gaussians))
escalado1 <- preProcess(test_nnet_dummy[, gaussians, drop = FALSE], method = c("center", "scale"))
transformed_gaussians1 <- predict(escalado1, test_nnet_dummy[, gaussians, drop = FALSE])
pre_process_model1 <- preProcess(test_nnet_dummy[, no_gaussians], method = "range")
transformed_no_gaussians1 <- predict(pre_process_model1, test_nnet_dummy[, no_gaussians])
categorical1 <- test_nnet_dummy[, c(categorical_vars), drop = FALSE]
test_nnet_dummy_escalados <- cbind(transformed_gaussians1, transformed_no_gaussians1, categorical1)
# Eliminamos las variables
test_nnet_dummy_escalados <- test_nnet_dummy_escalados %>%dplyr::select(-starts_with("A6"))
test_nnet_dummy_escalados <- test_nnet_dummy_escalados %>%dplyr::select(-starts_with("A8"))
test_nnet_dummy_escalados <- test_nnet_dummy_escalados %>%dplyr::select(-starts_with("A2"))
test_nnet_dummy_escalados <- test_nnet_dummy_escalados %>%dplyr::select(-starts_with("A7"))
# Aplicamos el pca
test_dummy_pca <- predict(pca_dummy, newdata = test_nnet_dummy_escalados)
data_test <- as.data.frame(test_dummy_pca[,1:8])
class_column <- test_nnet_dummy_escalados$Class
test_dummy_escalados_pca_nnet <- cbind(data_test, Class = class_column)## [1] 9## [1] 9Una vez realizado el preprocesamiento de los datos de test, comprobamos que efectivamente se ha realizado con éxito, puesto que ambos conjuntos, entrenamiento y test, tienen el mismo tamaño.
A continuación, vamos a evaluar el modelo utilizando el conjunto de test que acabamos de modificar.
# Error de entrenamiento
newdata <- temporal_train_dummy_escalados_pca[, !names(temporal_train_dummy_escalados_pca) %in% "Class"]
preds<-predict(model_nnet_final_trained, newdata=newdata, type = 'prob')
pred_classes <- ifelse(preds$`+` > preds$`-`, "+", "-")
pred_classes <- factor(pred_classes, levels = c("-", "+"))
true_labels <- temporal_train_dummy_escalados_pca$Class
# Generar la matriz de confusión
conf_matrix_train <- confusionMatrix(pred_classes, true_labels, positive="+")
metrics_df <- data.frame(
Metric = c("Accuracy"),
Value = c(
1 - conf_matrix_train$overall["Accuracy"]
)
)
print (metrics_df)## Metric Value
## Accuracy Accuracy 0.1170018# Error de test
newdata <- test_dummy_escalados_pca_nnet[, !names(test_dummy_escalados_pca_nnet) %in% "Class"]
preds<-predict(model_nnet_final_trained, newdata=newdata, type = 'prob')
pred_classes <- ifelse(preds$`+` > preds$`-`, "+", "-")
pred_classes <- factor(pred_classes, levels = c("-", "+"))
true_labels <- test_dummy_escalados_pca_nnet$Class
# Generar la matriz de confusión
conf_matrix <- confusionMatrix(pred_classes, true_labels, positive="+")
metrics_df <- data.frame(
Metric = c("Accuracy", "95% CI Lower", "95% CI Upper"),
Value = c(
conf_matrix$overall["Accuracy"],
conf_matrix$overall["AccuracyLower"],
conf_matrix$overall["AccuracyUpper"]
)
)
print(metrics_df)## Metric Value
## Accuracy Accuracy 0.8613139
## AccuracyLower 95% CI Lower 0.7919245
## AccuracyUpper 95% CI Upper 0.9143901Observamos que tiene un error de entrenamiento del 0.117, y un error de test del 0.138 (1 - 0.8613139), lo que indica que no hay sobre-entrenamiento. El modelo clasifica correctamente el 86.13% de las observaciones. El intervalo de confianza con un 95% de certeza se encuentra entre 79.19% y 91.44%. Es una variabilidad aceptable de 12 puntos. Sin embargo, dado el contexto de nuestro problema, es necesario explorar el riesgo que ofrece el modelo. Es decir, cómo se comportan los falsos positivos y los falsos negativos, puesto que lo ideal sería reducir el número de FP sin aumentar en exceso el de FN. Para ello, vamos a realizar un análisis donde iremos modificando el threshold desde 0.3 hasta 0.7 para ver cómo se comportan los valores de sensibilidad y especificidad.
# Definir los thresholds a probar
thresholds <- seq(0.3, 0.7, by = 0.05)
# Crear un data frame vacío para almacenar los resultados
results <- data.frame(
Threshold = numeric(),
Accuracy = numeric(),
FP = numeric(),
FN = numeric(),
Sensitivity = numeric(),
Specificity = numeric()
)
# Probar cada threshold
for (threshold in thresholds) {
# Ajustar las predicciones según el threshold
predictions_custom <- ifelse(preds[, 2] > threshold, "+", "-")
predictions_custom <- factor(predictions_custom, levels = levels(test_dummy_escalados_pca_nnet$Class))
# Generar la matriz de confusión
conf_matrix <- confusionMatrix(predictions_custom, test_dummy_escalados_pca_nnet$Class, positive = '+')
cm_table <- conf_matrix$table
FN <- cm_table["-", "+"]
FP <- cm_table["+", "-"]
# Calcular métricas
accuracy <- conf_matrix$overall["Accuracy"]
test_error <- 1 - as.numeric(accuracy) # Calcular el error de test
sensitivity <- conf_matrix$byClass["Sensitivity"]
specificity <- conf_matrix$byClass["Specificity"]
# Almacenar los resultados
results <- rbind(results, data.frame(
Threshold = threshold,
Accuracy = accuracy,
FP = FP,
FN = FN,
Sensitivity = sensitivity,
Specificity = specificity
))
}
# Mostrar los resultados
print(results)## Threshold Accuracy FP FN Sensitivity Specificity
## Accuracy 0.30 0.8467153 18 3 0.9508197 0.7631579
## Accuracy1 0.35 0.8540146 15 5 0.9180328 0.8026316
## Accuracy2 0.40 0.8540146 13 7 0.8852459 0.8289474
## Accuracy3 0.45 0.8613139 10 9 0.8524590 0.8684211
## Accuracy4 0.50 0.8613139 8 11 0.8196721 0.8947368
## Accuracy5 0.55 0.8467153 7 14 0.7704918 0.9078947
## Accuracy6 0.60 0.8394161 5 17 0.7213115 0.9342105
## Accuracy7 0.65 0.8394161 4 18 0.7049180 0.9473684
## Accuracy8 0.70 0.8394161 2 20 0.6721311 0.9736842En esta ocasión, parece que el threshold ideal para nuestro caso es 0.5 al mantener el accuracy y conseguir un menor número FP respecto a los FN (8 < 11).
# Crear la curva ROC
roc_nnet <- roc(test_dummy_escalados_pca_nnet$Class, preds[, 2], levels = rev(c('+','-')))## Setting direction: controls < cases# Visualizar la curva ROC
plot(roc_nnet, col = "blue", lwd = 2, main = "Curva ROC")
abline(a = 0, b = 1, col = "gray", lty = 2) # Línea diagonal (azar)
## El valor de AUC es: 0.9288179# Añadir la información de la curva ROC al data frame
roc_data <- data.frame(
Threshold = coords(roc_nnet, seq(0, 1, by = 0.01), ret = "threshold"),
Sensitivity = coords(roc_nnet, seq(0, 1, by = 0.01), ret = "sensitivity"),
Specificity = coords(roc_nnet, seq(0, 1, by = 0.01), ret = "specificity")
)
# Threshold óptimo según el índice de Youden
optimal_metrics <- coords(roc_nnet, "best", ret = c("threshold", "sensitivity", "specificity"), best.method = "youden")
# Crear una tabla con los resultados
optimal_results <- data.frame(
Threshold = optimal_metrics["threshold"],
Sensitivity = optimal_metrics["sensitivity"],
Specificity = optimal_metrics["specificity"]
)
# Mostrar la tabla
print(optimal_results)## threshold sensitivity specificity
## 1 0.3549918 0.9180328 0.8157895En este caso, la curva muestra un buen rendimiento, ya que se acerca significativamente al punto superior izquierdo (0,1), donde se logra máxima sensibilidad y especificidad. Esto sugiere que el modelo tiene una alta capacidad para distinguir entre clases positivas y negativas a través de distintos thresholds.
El valor del Área Bajo la Curva (AUC) es 0.9288, lo cual indica un rendimiento bastante bueno. Valores de AUC cercanos a 1 representan modelos con una gran capacidad de discriminación; es decir, el modelo tiene un 92% de probabilidad de clasificar correctamente una instancia positiva y una negativa al azar. Esto valida la eficacia del modelo en el problema.
El threshold óptimo determinado por el índice de Youden es 0.35, lo que implica que este valor proporciona el mejor balance entre sensibilidad y especificidad. Sin embargo, este valor no nos combiene, ya que buscamos reducir aún mas los falsos positivos. Por esto, elegimos el valor de 0.5 como threshold definitivo.
6.10 Creación de una población y obtención del intervalo de confianza
Para la creación de una población, es necesario entrenar de nuevo el modelo elegido con distintas semillas. Este proceso nos va a permitir obtener el intervalo de confianza del 95% tanto para el threshold por defecto 0.5.
# Grid de hiperparámetros del nnet
grid_aux <- expand.grid(
size = 3,
decay = 0.1
)
maxit <- 20
control_train <- trainControl(method = "none")
# Vectores para almacenar los accuracy en cada iteración
accuracy_values <- c()
for (seed in 100:130) {
set.seed(seed)
model_nnet_boot <- train(
x = predictors,
y = target,
method = "nnet",
metric = "Accuracy",
tuneGrid = grid_aux,
trControl = control_train,
maxit = maxit,
trace = FALSE,
abstol = 1e-4,
reltol = 1e-5
)
# Obtener probabilidades de predicción en el set de test
preds <- predict(model_nnet_boot, newdata = test_dummy_escalados_pca_nnet[, !names(test_dummy_escalados_pca_nnet) %in% "Class"], type = "prob")
# Predicciones con threshold = 0.5 (por defecto)
pred_classes <- ifelse(preds$`+` > preds$`-`, "+", "-")
pred_classes <- factor(pred_classes, levels = c("-", "+"))
true_labels <- factor(test_dummy_escalados_pca_nnet$Class, levels = c("-", "+"))
# Matrices de confusión
conf_matrix <- confusionMatrix(pred_classes, true_labels, positive = "+")
# Extraer accuracy
accuracy <- conf_matrix$overall["Accuracy"]
# Almacenar
accuracy_values <- c(accuracy_values, accuracy)
}
### Cálculo del IC al 95% para accuracy_values (threshold 0.5)
mean_acc <- mean(accuracy_values)
std_error <- sd(accuracy_values) / sqrt(length(accuracy_values))
t_value <- qt(0.975, df = length(accuracy_values) - 1)
ci_lower <- mean_acc - t_value * std_error
ci_upper <- mean_acc + t_value * std_error
cat("Precisión promedio (threshold 0.5):", mean_acc, "\n")## Precisión promedio (threshold 0.5): 0.8683777## IC 95% t-Student: [ 0.8658392 , 0.8709162 ]El modelo con un threshold de 0.5 obtiene un rendimiento medio de 0.868 con un intervalo de confianza de [ 86.58% - 87.09%]. Con un threshold de 0.5. Vemos que el rango del intervalo es de 0.5 lo que indica un modelo consistente. Podemos asegurar que este modelo predice con una seguridad dentro de esos intervalos con un 95% de confianza.
7 Comparación de Modelos
Tras realizar un preprocesado sobre el conjunto de datos credit_approval, se han entrenado 4 modelos diferentes, con el fin de predecir de la mejor forma posible el problema de la asignación de créditos centrándonos en nuestra base de datos. En concreto, se ha entrenado 1 modelo simple (Regresión Logística) y 3 modelos complejos (Random Forest, XGBoost y Red Neuronal). Para cada modelo se ha realizado:
Un preprocesado específico, eliminando variables poco útiles y transformando variables según las necesidades del modelo.
Selección del mejor modelo, en base al rendimiento de validación.
Entrenamiento y evaluación del modelo final, usando el conjunto de entrenamiento completo y el conjunto de test respectivamente.
Ajuste del threshold para balancear el porcentaje de falsos positivos y falsos negativos.
Obtención del intervalo de confianza del modelo mediante la generación de una población.
Además, para cada modelo complejo se ha hecho una búsqueda de los mejores hiperparámetros mediante grid y random (random tree). En este script se realizará una comparación de los modelos realizados, en base al rendimiento y simplicidad de los mismos, eligiendo finalmente el modelo final a usar.
7.0.1 Comparación por intervalo de confianza de 95%
En este apartado se realizará una comparación de los resultados obtenidos por los cuatro modelos realizados, teniendo en cuenta los intervalos de confianza del 95%:
modelos <- c("Regresión Logística", "Random Forest", "XGBoost Linear", "Red Neuronal")
sensibilidad <- c(0.8684, 0.9344, 0.8360, 0.8196)
especificidad <- c(0.8524, 0.8421, 0.9342, 0.8947)
ci_lower <- c(0.8379, 0.8852, 0.8620, 0.8658)
ci_upper <- c(0.8506, 0.8888, 0.8703, 0.8709)
thresholds <- c(0.7, 0.5, 0.7, 0.5)
# Creación del data frame completo
tabla_resultados <- data.frame(
Modelo = modelos,
CI_Lower = ci_lower,
CI_Upper = ci_upper,
Threshold = thresholds,
Sensibilidad = sensibilidad,
Especificidad = especificidad,
stringsAsFactors = FALSE
)
tabla_sin_intervalos <- tabla_resultados[, !colnames(tabla_resultados) %in% c("CI_Lower", "CI_Upper")]
tabla_sin_intervaloslibrary(ggplot2)
ggplot(tabla_resultados, aes(x = Modelo, y = (CI_Lower + CI_Upper)/2)) +
geom_errorbar(aes(ymin = CI_Lower, ymax = CI_Upper), width = 0.2) +
theme_minimal() +
labs(title = "Intervalos de Confianza por Modelo",
x = "Modelo",
y = "Intervalo de Confianza") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
El modelo que obtiene un mejor intervalo de confianza y que es estadísticamente diferenciable del resto de modelos es el random forest, seguido de los modelos de red neuronal (nnet) y XGBoost. Estos dos últimos modelos no son estadísticamente distinguibles luego no podemos decidir que modelo es el mejor entre ellos. Y por último, el modelo de regresión logística no se solapa con ningún otro intervalo lo que le hace ser estadísticamente distinguible, obtiene unos resultados más bajos que el resto, pero aceptables al llegar al 85% de accuracy con un 95% de seguridad.
Como ya dijimos, pensamos que en este problema puede interesar restringir más los falsos positivos que los falsos negativos, con el objetivo de al mismo tiempo que la predicción no se viera comprometida. Por ello, se buscó distinos thresholds con estas características. Se encontraron en todos los modelos excepto en el de random forest donde buscar un threshold que favoreciera a los falsos positivos no era compatible con mantener un buen accuracy. Por ello vemos que en todos los modelos, la especificadad es más alta que la sensibilidad excepto en el random forest.
7.0.2 Mejor modelo para nuestra base de datos
El mejor modelo para nuestra base de datos es el random forest ya que es el que tiene un mejor intervalo de confianza (0.8852, 0.8888) siendo estadísicamente distinguible.
7.0.3 Posible mejor modelo para datos futuros
Para datos futuros, nos interesa un modelo que no solo mantenga un buen nivel de accuracy, sino que también logre un equilibrio adecuado entre sensibilidad y especificidad. Esto se debe a que, si bien una alta sensibilidad nos asegura detectar la mayoría de los casos positivos (minimizando falsos negativos), una buena especificidad reduce la probabilidad de clasificar erróneamente casos negativos como positivos (minimizando falsos positivos). En nuestro contexto, donde es más costoso clasificar erróneamente a un negativo como positivo, es preferible contar con una especificidad ligeramente mayor, reduciendo así el número de falsos positivos. Por lo tanto, modelos como XGBoost o redes neuronales (nnet) podrían ser opciones interesantes a futuro, ya que muestran un buen balance entre sensibilidad y especificidad, adaptándose mejor a estos requerimientos.
7.1 Bibliografía
Apuntes de la asignatura de AC de cuarto de carrera de Ingenirería Informáctica.
Análisis de datos y machine learning con R (caret). (s.f.). Recuperado de: https://rubenfcasal.github.io/aprendizaje_estadistico/implementaci%C3%B3n-en-r-2.html
R Core Team, Venables, W. N. & Ripley, B. D. (s.f.). nnet:
Feed-forward Neural Networks and Multinomial Log-Linear Models.
RDocumentation.
Recuperado de: https://www.rdocumentation.org/packages/nnet/versions/7.3-19/topics/nnet
Kuhn, M. (s.f.). Model Training and Tuning. caret.
Recuperado de: https://topepo.github.io/caret/model-training-and-tuning.html
Kuhn, M. (s.f.). trainControl. caret, RDocumentation.
Recuperado de: https://www.rdocumentation.org/packages/caret/versions/6.0-92/topics/trainControl
Kuhn, M. (s.f.). Recursive Feature Elimination. caret.
Recuperado de: https://topepo.github.io/caret/recursive-feature-elimination.html
DataScientest. (s.f.). Random Forest (Bosque Aleatorio): definición y
funcionamiento.
Recuperado de: https://datascientest.com/es/random-forest-bosque-aleatorio-definicion-y-funcionamiento
Liaw, A. & Wiener, M. (s.f.). randomForest. RDocumentation.
Recuperado de: https://www.rdocumentation.org/packages/randomForest/versions/4.7-1.2/topics/randomForest
rdrr.io. (s.f.). caret package.
Recuperado de: https://rdrr.io/cran/caret/
Kuhn, M. (s.f.). caret.
Recuperado de: https://topepo.github.io/caret/
Stack Abuse. (s.f.). Random Forest Algorithm with Python and
Scikit-Learn.
Recuperado de: https://stackabuse.com/random-forest-algorithm-with-python-and-scikit-learn
CRAN r-universe. (s.f.). randomForest Manual.
Recuperado de: https://cran.r-universe.dev/randomForest/doc/manual.html
R-Bloggers. (2023, octubre). Calculate Confidence Intervals in R:
Your Practical Guide.
Recuperado de: https://www.r-bloggers.com/2023/10/calculate-confidence-intervals-in-r-your-practical-guide/
GeeksforGeeks. (s.f.). P-value in Machine Learning.
Recuperado de: https://www.geeksforgeeks.org/p-value-in-machine-learning/
Statistics Easily. (s.f.). Cramér’s V.
Recuperado de: https://es.statisticseasily.com/cramers-v/
Gelman, A., Su, Y-S., & Pittau, M. G. (s.f.). bayesglm: Bayesian Generalized Linear Models. RDocumentation. Recuperado de: https://www.rdocumentation.org/packages/arm/versions/1.14-4/topics/bayesglm
Statistics Easily. (s.f.). Supuestos de Modelos Lineales
Generalizados.
Recuperado de: https://es.statisticseasily.com/supuestos-de-modelos-lineales-generalizados/
QuestionPro. (s.f.). Simulación de Monte Carlo.
Recuperado de: https://www.questionpro.com/blog/es/simulacion-de-monte-carlo
IBM. (s.f.). Simulación de Monte Carlo.
Recuperado de: https://www.ibm.com/es-es/topics/monte-carlo-simulation
Statologos. (s.f.). Prueba exacta de Fisher.
Recuperado de: https://statologos.com/prueba-exacta-de-fishers
Ciencia de Datos. (s.f.). Test exacto de Fisher, Chi-cuadrado de
Pearson, McNemar y Q de Cochran.
Recuperado de: https://cienciadedatos.net/documentos/22.2_test_exacto_de_fisher_chi-cuadrado_de_pearson_mcnemar_qcochran
Statistics Easily. (s.f.). Análisis de varianza de
Kruskal-Wallis.
Recuperado de: https://es.statisticseasily.com/An%C3%A1lisis-de-varianza-de-Kruskal-Wallis.