Librerias a usar

library(ISLR)
library(ggplot2)
library(MASS)
library(pROC)
## Type 'citation("pROC")' for a citation.
## 
## Attaching package: 'pROC'
## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var

Instalación de paquetes y visualiazación del dataset

credit_data <- Credit
summary(credit_data)
##        ID            Income           Limit           Rating     
##  Min.   :  1.0   Min.   : 10.35   Min.   :  855   Min.   : 93.0  
##  1st Qu.:100.8   1st Qu.: 21.01   1st Qu.: 3088   1st Qu.:247.2  
##  Median :200.5   Median : 33.12   Median : 4622   Median :344.0  
##  Mean   :200.5   Mean   : 45.22   Mean   : 4736   Mean   :354.9  
##  3rd Qu.:300.2   3rd Qu.: 57.47   3rd Qu.: 5873   3rd Qu.:437.2  
##  Max.   :400.0   Max.   :186.63   Max.   :13913   Max.   :982.0  
##      Cards            Age          Education        Gender    Student  
##  Min.   :1.000   Min.   :23.00   Min.   : 5.00    Male :193   No :360  
##  1st Qu.:2.000   1st Qu.:41.75   1st Qu.:11.00   Female:207   Yes: 40  
##  Median :3.000   Median :56.00   Median :14.00                         
##  Mean   :2.958   Mean   :55.67   Mean   :13.45                         
##  3rd Qu.:4.000   3rd Qu.:70.00   3rd Qu.:16.00                         
##  Max.   :9.000   Max.   :98.00   Max.   :20.00                         
##  Married              Ethnicity      Balance       
##  No :155   African American: 99   Min.   :   0.00  
##  Yes:245   Asian           :102   1st Qu.:  68.75  
##            Caucasian       :199   Median : 459.50  
##                                   Mean   : 520.01  
##                                   3rd Qu.: 863.00  
##                                   Max.   :1999.00

Descripción de los datos

Observando el dataset se puede observar lo siguiente: 1. Variables cuantitativas: Income, Limit, Rating, Cards, Age, Education, Balance 2. Variables cualitativas: Gender, Student, Married, Ethnicity.

Gráfica de variable escogida (Gender)

Transformación de variable

Se transforma la variable “Gender” a binaria, donde 0 va a corresponder a Male y 1 a Female

#Convertimos la variable categórica a binaria (0: Male y 1: Female)
Credit$GenderBin <- ifelse(Credit$Gender == "Female", 1, 0)
table(Credit$Gender, Credit$GenderBin)
##         
##            0   1
##    Male  193   0
##   Female   0 207

Modelo de regresión logistica

#Modelo nulo (solo intercepto)
null_model <- glm(GenderBin ~ 1, data = Credit, family = "binomial")

#Modelo completo con todas las variables disponibles
full_model <- glm(GenderBin ~ . -Gender -ID, data = Credit, family = "binomial")

step_model <- step(null_model,
                   direction = "both",
                   scope = list(lower = null_model, upper = full_model),
                   trace = TRUE)  
## Start:  AIC=556.03
## GenderBin ~ 1
## 
##             Df Deviance    AIC
## <none>           554.03 556.03
## + Student    1   552.81 556.81
## + Cards      1   553.82 557.82
## + Balance    1   553.84 557.84
## + Married    1   553.97 557.97
## + Income     1   553.98 557.98
## + Limit      1   553.99 557.99
## + Rating     1   554.00 558.00
## + Education  1   554.02 558.02
## + Age        1   554.02 558.02
## + Ethnicity  2   553.75 559.75
summary(step_model)
## 
## Call:
## glm(formula = GenderBin ~ 1, family = "binomial", data = Credit)
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)
## (Intercept)  0.07003    0.10006     0.7    0.484
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 554.03  on 399  degrees of freedom
## Residual deviance: 554.03  on 399  degrees of freedom
## AIC: 556.03
## 
## Number of Fisher Scoring iterations: 3

Clasificación segun el umbral y la exactitud del modelo

#Probabilidad de ser Female
Credit$prob_pred <- predict(step_model, type = "response")

#Clasificación (umbral = 0.5)
Credit$gender_pred <- ifelse(Credit$prob_pred > 0.5, 1, 0)

#Porcentaje de predicciones correctas
mean(Credit$GenderBin == Credit$gender_pred)
## [1] 0.5175

Grafica Curva ROC- Prediccion de genero

roc_obj <- roc(Credit$GenderBin, Credit$prob_pred)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
plot(roc_obj, col = "blue", main = "Curva ROC - Predicción de Género")

Area bajo la curva

auc(roc_obj)
## Area under the curve: 0.5

Modelo de regresion logistica (70/30)

#Establecer semilla para reproducibilidad
set.seed(123)

#Dividir el dataset (70% entrenamiento, 30% prueba)
index <- sample(1:nrow(Credit), size = 0.7 * nrow(Credit))
train_data <- Credit[index, ]
test_data <- Credit[-index, ]

#Crear modelo nulo y completo
null_model1 <- glm(GenderBin ~ 1, data = train_data, family = "binomial")
full_model1 <- glm(GenderBin ~ . -Gender -ID, data = train_data, family = "binomial")

#Selección stepwise
step_model1 <- step(null_model1,
                   direction = "both",
                   scope = list(lower = null_model1, upper = full_model1),
                   trace = FALSE)  

#Ver resumen del modelo seleccionado
summary(step_model1)
## 
## Call:
## glm(formula = GenderBin ~ 1, family = "binomial", data = train_data)
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)
## (Intercept)  0.01429    0.11953    0.12    0.905
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 388.15  on 279  degrees of freedom
## Residual deviance: 388.15  on 279  degrees of freedom
## AIC: 390.15
## 
## Number of Fisher Scoring iterations: 3

Evaluacion del modelo (30% de test)

#Predecir probabilidades sobre el set de prueba
test_data$prob_pred <- predict(step_model1, newdata = test_data, type = "response")

#Clasificar usando umbral de 0.5
test_data$gender_pred <- ifelse(test_data$prob_pred > 0.5, 1, 0)

#Exactitud (Accuracy)
accuracy <- mean(test_data$gender_pred == test_data$GenderBin)
print(paste("Exactitud del modelo:", round(accuracy, 4)))
## [1] "Exactitud del modelo: 0.55"

Curva ROC

roc_obj <- roc(test_data$GenderBin, test_data$prob_pred)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
plot(roc_obj, col = "blue", main = "Curva ROC - Evaluación 30% test")

Area bajo la curva

auc(roc_obj)
## Area under the curve: 0.5

Conclusiones

Se construyó un modelo de regresión logística para predecir el género utilizando las variables del dataset Credit. Inicialmente se evaluó el modelo usando todo el conjunto de datos, y posteriormente mediante una division 70/30 para entrenamiento y prueba, aplicando selección automática de variables (stepwise) con la librería MASS. En ambos casos, el área bajo la curva (AUC) fue de 0.50, lo que indica que las variables disponibles no permiten una buena discriminación del género. Sin embargo, el modelo se construyó correctamente e hicimos la evaluación con métricas adecuadas y el uso de técnicas de selección de variables.