Paso 1. Depuración del conjunto de datos
Paso 2. Aplicación de la Técnica de Clasificación: Regresión Logística
- Conjuntos de Entrenamiento y Validación
- Aplicación del Modelo de Regresión Logística
  - Interpretación de los coeficientes
Paso 3. Clasificación y Medidas de Precisión

La técnica de aprendizaje supervisado Regresión Logística permite clasificar observaciones cuando la variable respuesta \(Y\) es cualitativa con dos categorías (\(Y = 0,1\)) y las variables predictoras \(X_1,...,X_p\) son variables cuantitativas.

El modelo de regresión logística se basa en la construcción de una función de probabilidad \(p(X_1,...,X_p) = P(Y = 1\mid X_1,...,X_p)\) de forma que cuando \(p(X_1,...,X_p) > 0.5\), entonces \(Y = 1\), en caso contrario \(Y = 0\). Esto implica que el modelo a construir es \[\text{logit} \left( p(X_1,...,X_p) \right) = \text{log} \left( \dfrac{p(X_1,...,X_p)}{1-p(X_1,...,X_p)} \right) = \beta_0 + \beta_1 \cdot X_1 + \cdots + \beta_p \cdot X_p\]

Para el estudio de esta técnica, utilicemos el conjunto \(\texttt{College}\) del paquete \(\texttt{ISLR}\) que contiene una base de datoos de 777 observaciones para distintas variables asociadas a datos de universidades de EEUU obtenidas de la revista US News and World Report en 1995.

library(ISLR)
dat <- College |> 
  glimpse()

## Rows: 777
## Columns: 18
## $ Private     <fct> Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes…
## $ Apps        <dbl> 1660, 2186, 1428, 417, 193, 587, 353, 1899, 1038, 582, 173…
## $ Accept      <dbl> 1232, 1924, 1097, 349, 146, 479, 340, 1720, 839, 498, 1425…
## $ Enroll      <dbl> 721, 512, 336, 137, 55, 158, 103, 489, 227, 172, 472, 484,…
## $ Top10perc   <dbl> 23, 16, 22, 60, 16, 38, 17, 37, 30, 21, 37, 44, 38, 44, 23…
## $ Top25perc   <dbl> 52, 29, 50, 89, 44, 62, 45, 68, 63, 44, 75, 77, 64, 73, 46…
## $ F.Undergrad <dbl> 2885, 2683, 1036, 510, 249, 678, 416, 1594, 973, 799, 1830…
## $ P.Undergrad <dbl> 537, 1227, 99, 63, 869, 41, 230, 32, 306, 78, 110, 44, 638…
## $ Outstate    <dbl> 7440, 12280, 11250, 12960, 7560, 13500, 13290, 13868, 1559…
## $ Room.Board  <dbl> 3300, 6450, 3750, 5450, 4120, 3335, 5720, 4826, 4400, 3380…
## $ Books       <dbl> 450, 750, 400, 450, 800, 500, 500, 450, 300, 660, 500, 400…
## $ Personal    <dbl> 2200, 1500, 1165, 875, 1500, 675, 1500, 850, 500, 1800, 60…
## $ PhD         <dbl> 70, 29, 53, 92, 76, 67, 90, 89, 79, 40, 82, 73, 60, 79, 36…
## $ Terminal    <dbl> 78, 30, 66, 97, 72, 73, 93, 100, 84, 41, 88, 91, 84, 87, 6…
## $ S.F.Ratio   <dbl> 18.1, 12.2, 12.9, 7.7, 11.9, 9.4, 11.5, 13.7, 11.3, 11.5, …
## $ perc.alumni <dbl> 12, 16, 30, 37, 2, 11, 26, 37, 23, 15, 31, 41, 21, 32, 26,…
## $ Expend      <dbl> 7041, 10527, 8735, 19016, 10922, 9727, 8861, 11487, 11644,…
## $ Grad.Rate   <dbl> 60, 56, 54, 59, 15, 55, 63, 73, 80, 52, 73, 76, 74, 68, 55…

Como podemos observar la variable \(\texttt{Private}\) es dicotómica (Yes, No), de modo que vamos considerar ésta como variable respuesta para la cual podamos clasificar observaciones a partir de variables predictoras, como pueden ser \(\texttt{Apps, Accept,...}\)

Paso 1. Depuración del conjunto de datos

En este primer punto vamos a estudiar la regresión simple de forma que solo se tiene una variable predictora, por ejemplo \(\texttt{Apps}\) que indica el número de solicitudes recibidas en la universidad, y cuyo objetivo sea clasificar la universidad según la variable \(\texttt{Private}\) que nos indica que si la universidad es privada o no. Por tanto, el primer paso será depurar el conjunto de observaciones, además de comprobar cómo está codificada la variable respuesta empleando la función \(\texttt{contrasts()}\).

dat_interes <- dat |> 
  select(Private,Apps) |> 
  drop_na() |> 
  glimpse()

## Rows: 777
## Columns: 2
## $ Private <fct> Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Ye…
## $ Apps    <dbl> 1660, 2186, 1428, 417, 193, 587, 353, 1899, 1038, 582, 1732, 2…

dat_interes |> 
  pull(Private) |> 
  contrasts()

##     Yes
## No    0
## Yes   1

Podemos observar que la variable respuesta está codificada con el valor 0 para el nivel No y con el valor 1 para el nivel Yes. De modo que nos interesa encontrar el siguiente modelo de regresión logística \[\text{logit} \left( P\left(Private = 1 \mid Apps \right) \right) = \beta_0 + \beta_1 \cdot Apps\]

Paso 2. Aplicación de la Técnica de Clasificación: Regresión Logística

Conjuntos de Entrenamiento y Validación

Antes de comenzar a trabajar con el modelo es necesario dividir el conjunto de observaciones en entrenamiento y validación que nos permitan construir el modelo y posteriormente validarlo utilizando las clasificaciones predichas por el modelo, así como determinar las distintas medidas de precisión.

set.seed(1234)
library(rsample)
dat_split <- dat_interes |> 
  initial_split(prop = 0.7)

dat_train <- dat_split |> 
  training() |> 
  glimpse()

## Rows: 543
## Columns: 2
## $ Private <fct> Yes, Yes, No, No, Yes, Yes, No, Yes, Yes, No, No, No, No, Yes,…
## $ Apps    <dbl> 2421, 601, 3580, 1618, 510, 1307, 4158, 3315, 3495, 2397, 7811…

dat_test <- dat_split |> 
  testing() |> 
  glimpse()

## Rows: 234
## Columns: 2
## $ Private <fct> Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, No, No, No, Yes, Yes, …
## $ Apps    <dbl> 1428, 193, 587, 353, 1899, 1038, 1420, 4302, 3540, 12809, 1734…

Antes de proceder a ejecutar el modelo sobre el conjunto de entrenamiento veamos si entre ambas variables existe relación y para ello representamos un Box-plot para la variable predictora diferenciando los niveles de la variable respuesta.

dat_train |> 
  ggplot() +
  aes(x = Private, y = Apps, color = Private) + 
  geom_boxplot() + 
  geom_jitter(width = 0.1) + 
  labs(
    x = "Private",
    y = "Apps"
  ) + 
  guides(color = "none") + 
  theme_bw()

En el gráfico podemos observar que sí hay diferencias significativas para la variable predictora entre los niveles de la variable respuesta, de modo que tiene sentido aplicar un modelo de regresión logística dado que la variable \(\texttt{Apps}\) sí influye sobre la variable \(\texttt{Private}\).

Aplicación del Modelo de Regresión Logística

Esta técnica se encuentra en la función \(\texttt{glm(data,family)}\) indicando el argumento \(\texttt{family} = ``\texttt{binomial}"\), dado que la variable respuesta tiene 2 niveles (0 y 1).

model_LogR <- dat_interes |> 
  glm(Private ~ Apps,
      data = _,
      family = "binomial") 

model_LogR |> 
  summary()

## 
## Call:
## glm(formula = Private ~ Apps, family = "binomial", data = dat_interes)
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  1.984e+00  1.320e-01   15.03   <2e-16 ***
## Apps        -3.088e-04  3.062e-05  -10.09   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 910.75  on 776  degrees of freedom
## Residual deviance: 758.00  on 775  degrees of freedom
## AIC: 762
## 
## Number of Fisher Scoring iterations: 5

Se puede observar que la variable predictora es significativa y por tanto sí influye sobre la variable respuesta.

Interpretación de los coeficientes

Como hemos comprobado que la variable predictora sí influye sobre la variable respuesta, entonces debemos proceder a interpretar los coeficientes del modelo. Para ello utilizamos la función \(\texttt{coef()}\) para obtener las estimaciones.

model_LogR |> 
  coef()

##   (Intercept)          Apps 
##  1.9839512959 -0.0003088397

Al ser el coeficiente asociado a la variable predictora negativo, entonces implica que a mayor número de solicitudes recibe la universidad, menor probabilidad hay de que la universidad sea privada. Por tanto, la probabilidad de que una universidad sea privada se puede calcular como:

\[P \left( Private = "Yes" \mid Apps \right) = \dfrac{e^{1.984 -3.1\times 10^{-4} \cdot Apps }}{1 + e^{1.984 -3.1\times 10^{-4} \cdot Apps }}\] De modo que la universidad se clasificará en la categoría Yes cuando dicha probabilidad sea mayor que \(0.5\).

Paso 3. Clasificación y Medidas de Precisión

Para medir la precisión de un modelo de clasificación se emplea la matriz de confusión que consiste en una matriz 2x2 tal que:

\(VP\) es el número de observaciones que pertenecen a la categoría 1 y se han clasificado correctamente (verdaderos positivos).
\(FN\) es el número de observaciones que pertenecen a la categoría 1 y se han clasificado incorrectamente (falsos negativos).
\(FP\) es el número de observaciones que pertenecen a la categoría 2 y se han clasificado incorrectamente (falsos positivos).
\(VN\) es el número de observaciones que pertenecen a la categoría 2 y se han clasificado correctamente (verdaderos negativos).

Esta matriz permite determinar las medidas:

Precisión: indica cuántas observaciones clasificadas como positivas son realmente positivas \[Precision = \dfrac{VP}{VP+FP}\]
Sensibilidad: indica cuántas observaciones clasificadas como positivas se detectaron correctamente \[Recall = \dfrac{VP}{VP+FN}\]
Especificidad: indica cuántas observaciones clasificadas como negativas se detectaron correctamente \[Specificity = \dfrac{VN}{VN+FP}\]
Exactitud: indica la proporción de predicciones correctas \[Accuracy = \dfrac{VP+VN}{VP+FP+VN+FN}\]
F1-Score: es la media armónica entre Precisión y Sensibilidad mostrando un balance entre ellas \[F1-Score = 2 \cdot \dfrac{Precision \cdot Recall}{Precision + Recall}\]
Curva ROC: es la relación entre la tasa de verdaderos positivos (sensibilidad) y la tasa de falsos positivos, el cuanto más se acerca a 1 el área bajo la curva (\(AUC\)), mejor será el modelo.

Con las definiciones dadas es necesario realizar las clasificaciones previamente para poder determinar las medidas de precisión del modelo.

Para clasificar observaciones de la variable respuesta se emplea la función \(\texttt{predict()}\) añadiendo el argumento \(\texttt{type} = ``\texttt{response}"\). Además, recordemos que una observación se clasifica en la categoría Yes si la probabilidad predicha es superior a 0.5.

dat_clasification <- dat_test |> 
  mutate(
    clasification_LogR = model_LogR |> 
      predict(newdata = dat_test,
              type = "response"),
    clasification = factor(ifelse(clasification_LogR > 0.5,
                        "Yes",
                        "No"))
  ) |> 
  glimpse()

## Rows: 234
## Columns: 4
## $ Private            <fct> Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, No, No, No,…
## $ Apps               <dbl> 1428, 193, 587, 353, 1899, 1038, 1420, 4302, 3540, …
## $ clasification_LogR <dbl> 0.8238900, 0.8726222, 0.8584727, 0.8670278, 0.80178…
## $ clasification      <fct> Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, No, Ye…

Una vez que se han clasificado nuevas observaciones podemos proceder a calcular las medidas de precisión a través de la matriz de confusión. Para calcular dicha matriz utilizamos la función \(\texttt{confusionMatrix(positive,mode="everything")}\) del paquete \(\texttt{caret}\) indicando con el argumento \(\texttt{positive}\) la categoría de observaciones positivas (en nuestro caso, observaciones que sí son universidades privadas).

Es necesario tener en cuenta que debemos seleccionar las variables de interés, en esta ocasión, las clasificaciones (como factor) y la variable respuesta, además debemos construir la tabla de frecuencias con la función \(\texttt{table()}\).

library(caret)

## Loading required package: lattice

## 
## Attaching package: 'caret'

## The following object is masked from 'package:purrr':
## 
##     lift

dat_clasification |> 
  select(clasification, Private) |> #Se utiliza el conjunto de clasificaciones predichas en primer lugar
  table() |> 
  confusionMatrix(positive = "Yes",
                  mode = "everything")

## Confusion Matrix and Statistics
## 
##              Private
## clasification  No Yes
##           No   19   8
##           Yes  48 159
##                                           
##                Accuracy : 0.7607          
##                  95% CI : (0.7008, 0.8139)
##     No Information Rate : 0.7137          
##     P-Value [Acc > NIR] : 0.06258         
##                                           
##                   Kappa : 0.287           
##                                           
##  Mcnemar's Test P-Value : 1.872e-07       
##                                           
##             Sensitivity : 0.9521          
##             Specificity : 0.2836          
##          Pos Pred Value : 0.7681          
##          Neg Pred Value : 0.7037          
##               Precision : 0.7681          
##                  Recall : 0.9521          
##                      F1 : 0.8503          
##              Prevalence : 0.7137          
##          Detection Rate : 0.6795          
##    Detection Prevalence : 0.8846          
##       Balanced Accuracy : 0.6178          
##                                           
##        'Positive' Class : Yes             
##

Podemos observar que:

\(VP\) = 19 observaciones que No son universidades privadas y se han clasificado correctamente.
\(FN\) = 8 observaciones que Sí son universidades privadas y se han clasificado incorrectamente.
\(FP\) = 48 observaciones que No son universidades privadas y se han clasificado incorrectamente.
\(VN\) = 159 observaciones que Sí son universidades privadas y se han clasificado correctamente.

En cuanto a las medidas de precisión, tenemos que:

\(Precision\) = 0.7681, esto es, el 76.81 % de las universidades que se han clasificado como privadas realmente lo son.
\(Recall\) = 0.9521, es decir, el 95.21 % de las universidades privadas se han clasificado correctamente.
\(Specificity\) = 0.2836, por tanto el 28.36 % de las universidades públicas se han clasificado correctamente.
\(Accuracy\) = 0.7607, de modo que el modelo proporciona el 76.07 % de clasificaciones correctas.
\(F1-Score\) = 0.8503, al ser cercano a 1, el modelo proporciona un buen balance entre su precisión y su sensibilidad.

Respecto a la Curva ROC, ésta muestra la capacidad del modelo para clasificar observaciones correctamente. Para representarla vamos a utilizar la función \(\texttt{roc()}\) del paquete \(\texttt{pROC}\). Para ello, representa la tasa de falsos positivos (FPR = 1-Specificity) frente a la Sensibilidad.

library(pROC)

## Type 'citation("pROC")' for a citation.

## 
## Attaching package: 'pROC'

## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var

ROC <- dat_clasification |> 
  roc(Private, clasification_LogR)

## Setting levels: control = No, case = Yes

## Setting direction: controls < cases

tibble(
  Recall = rev(ROC$sensitivities),
  FPR = rev(1-ROC$specificities)
) |> 
  ggplot() + 
  aes(x = FPR,
      y = Recall) +
  geom_line(color = "blue", linewidth = 2) +
  geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "red") +
  labs(title = "Curva ROC",
       x = "Tasa de Falsos Positivos (FPR = 1-Specificity)",
       y = "Sensibilidad")+
  theme_minimal()

Un modelo de clasificación es óptimo cuando la curva ROC está cercana a la esquina superior izquierda, esto es, un modelo con un Sensibilidad alta y una Tasa de Falsos Positivos baja. Podemos medir también el área encerrada bajo la curva (AUC) que nos indica cómo de bueno es el modelo, de forma que un AUC superior a 0.8 indica que el modelo clasifica correctamente. Para ello, podemos utilizar la función \(\texttt{auc()}\) del paquete \(\texttt{pROC}\).

ROC |> 
  auc()

## Area under the curve: 0.8231

Disponemos de un \(AUC\) superior a 0.8, y por tanto el modelo es óptimo para clasificar correctamente las observaciones en universidades privadas y públicas.

Regresión Logística Simple

Mario M. Pizarro