A continuación se encuentra la práctica de los modelos de regresión

Regresión lineal simple

La regresión lineal simple es una técnica estadística que permite modelar la relación entre una variable dependiente (Y) y una variable independiente (X). La idea es encontrar la recta de mejor ajuste que explique cómo cambia Y a partir de cambios en X.

Cuándo aplicarlo

  • Cuando existe relación lineal entre la variable independiente y la dependiente.

  • Cuando se desea analizar y predecir la relación lineal entre dos variables cuantitativas.

  • Para predicción, interpretación de relaciones y evaluación de impactos.

Qué esperar

  • La precisión se mide con R², MSE o RMSE, y depende de la calidad de los datos y de qué tan fuerte sea la relación lineal.

Ejemplo en R

En este análisis, nos enfocaremos en el dataset de jugadores de fútbol profesional y evaluaremos si existe una relación entre la altura del jugador (Height) y su habilidad general (Overall).

Paso 1: librerías

library(readxl)     # Para leer archivos Excel
library(dplyr)      # Para manipulación de datos
## 
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(ggplot2)    # Para gráficos
library(corrplot)   # Para mapa de correlación
## corrplot 0.95 loaded

Paso 2: Cargar y explorar los datos

#Se estará utilizando el excel de clase student depression
df <- read_excel("C:/Users/natal/Downloads/FIFA_19 (2).xlsx")

#Es importante revisar la estructura por lo que se utiliza head para visualizar las primeras filas y str para revisar la estructura y tipo de datos
head(df)
## # A tibble: 6 × 18
##       ID Name               Age Nationality Overall Potential Club   Value  Wage
##    <dbl> <chr>            <dbl> <chr>         <dbl>     <dbl> <chr>  <dbl> <dbl>
## 1 158023 L. Messi            31 Argentina        94        94 FC B… 110500   565
## 2  20801 Cristiano Ronal…    33 Portugal         94        94 Juve…  77000   405
## 3 190871 Neymar Jr           26 Brazil           92        93 Pari… 118500   290
## 4 193080 De Gea              27 Spain            91        93 Manc…  72000   260
## 5 192985 K. De Bruyne        27 Belgium          91        92 Manc… 102000   355
## 6 183277 E. Hazard           27 Belgium          91        91 Chel…  93000   340
## # ℹ 9 more variables: `Preferred Foot` <chr>, `International Reputation` <dbl>,
## #   `Skill Moves` <dbl>, Position <chr>, Joined <dbl>,
## #   `Contract Valid Until` <dttm>, Height <dbl>, Weight <dbl>,
## #   `Release Clause` <dbl>
str(df)
## tibble [18,207 × 18] (S3: tbl_df/tbl/data.frame)
##  $ ID                      : num [1:18207] 158023 20801 190871 193080 192985 ...
##  $ Name                    : chr [1:18207] "L. Messi" "Cristiano Ronaldo" "Neymar Jr" "De Gea" ...
##  $ Age                     : num [1:18207] 31 33 26 27 27 27 32 31 32 25 ...
##  $ Nationality             : chr [1:18207] "Argentina" "Portugal" "Brazil" "Spain" ...
##  $ Overall                 : num [1:18207] 94 94 92 91 91 91 91 91 91 90 ...
##  $ Potential               : num [1:18207] 94 94 93 93 92 91 91 91 91 93 ...
##  $ Club                    : chr [1:18207] "FC Barcelona" "Juventus" "Paris Saint-Germain" "Manchester United" ...
##  $ Value                   : num [1:18207] 110500 77000 118500 72000 102000 ...
##  $ Wage                    : num [1:18207] 565 405 290 260 355 340 420 455 380 94 ...
##  $ Preferred Foot          : chr [1:18207] "Left" "Right" "Right" "Right" ...
##  $ International Reputation: num [1:18207] 5 5 5 4 4 4 4 5 4 3 ...
##  $ Skill Moves             : num [1:18207] 4 5 5 1 4 4 4 3 3 1 ...
##  $ Position                : chr [1:18207] "RF" "ST" "LW" "GK" ...
##  $ Joined                  : num [1:18207] 2004 2018 2017 2011 2015 ...
##  $ Contract Valid Until    : POSIXct[1:18207], format: "2021-01-01" "2022-01-01" ...
##  $ Height                  : num [1:18207] 5.58 6.17 5.75 6.33 5.92 ...
##  $ Weight                  : num [1:18207] 159 183 150 168 154 163 146 190 181 192 ...
##  $ Release Clause          : num [1:18207] 226500 127100 228100 138600 196400 ...
#Para visualizar un resumen estadístico 
summary(df)
##        ID             Name                Age        Nationality       
##  Min.   :    16   Length:18207       Min.   :16.00   Length:18207      
##  1st Qu.:200316   Class :character   1st Qu.:21.00   Class :character  
##  Median :221759   Mode  :character   Median :25.00   Mode  :character  
##  Mean   :214298                      Mean   :25.12                     
##  3rd Qu.:236530                      3rd Qu.:28.00                     
##  Max.   :246620                      Max.   :45.00                     
##                                                                        
##     Overall        Potential         Club               Value       
##  Min.   :46.00   Min.   :48.00   Length:18207       Min.   :    10  
##  1st Qu.:62.00   1st Qu.:67.00   Class :character   1st Qu.:   325  
##  Median :66.00   Median :71.00   Mode  :character   Median :   700  
##  Mean   :66.24   Mean   :71.31                      Mean   :  2446  
##  3rd Qu.:71.00   3rd Qu.:75.00                      3rd Qu.:  2100  
##  Max.   :94.00   Max.   :95.00                      Max.   :118500  
##                                                     NA's   :280     
##       Wage         Preferred Foot     International Reputation  Skill Moves   
##  Min.   :  0.000   Length:18207       Min.   :1.000            Min.   :1.000  
##  1st Qu.:  1.000   Class :character   1st Qu.:1.000            1st Qu.:2.000  
##  Median :  3.000   Mode  :character   Median :1.000            Median :2.000  
##  Mean   :  9.739                      Mean   :1.113            Mean   :2.362  
##  3rd Qu.:  9.000                      3rd Qu.:1.000            3rd Qu.:3.000  
##  Max.   :565.000                      Max.   :5.000            Max.   :5.000  
##  NA's   :28                           NA's   :76               NA's   :76     
##    Position             Joined     Contract Valid Until         
##  Length:18207       Min.   :1991   Min.   :2018-01-01 00:00:00  
##  Class :character   1st Qu.:2016   1st Qu.:2019-01-01 00:00:00  
##  Mode  :character   Median :2017   Median :2020-01-01 00:00:00  
##                     Mean   :2016   Mean   :2020-03-08 02:42:25  
##                     3rd Qu.:2018   3rd Qu.:2021-01-01 00:00:00  
##                     Max.   :2018   Max.   :2026-01-01 00:00:00  
##                     NA's   :28     NA's   :317                  
##      Height          Weight    Release Clause  
##  Min.   :5.083   Min.   :110   Min.   :    13  
##  1st Qu.:5.750   1st Qu.:154   1st Qu.:   572  
##  Median :5.917   Median :165   Median :  1300  
##  Mean   :5.947   Mean   :166   Mean   :  4588  
##  3rd Qu.:6.083   3rd Qu.:176   3rd Qu.:  4585  
##  Max.   :6.750   Max.   :243   Max.   :228100  
##  NA's   :28      NA's   :28    NA's   :28

Paso 3: limpieza

Ahora pasamos a una limpieza básica, en la cual buscamos manejar algún valor faltante. En lugar de eliminar las observaciones con valores faltantes (lo cual reduce el tamaño de la muestra y puede afectar la representatividad), realizamos imputación por la media.

df$Height[is.na(df$Height)] <- mean(df$Height, na.rm = TRUE)
df$Overall[is.na(df$Overall)] <- mean(df$Overall, na.rm = TRUE)

Paso 4: Análisis exploratorio

# Relación entre Height y Overall
pairs(df[, c("Height", "Overall")])

# Correlación
cor(df$Height, df$Overall)
## [1] 0.03845741

Paso 5: train y test

set.seed(123) # Para reproducibilidad
indice <- sample(1:nrow(df), size = 0.7 * nrow(df)) # 70% para train
train <- df[indice, ]
test <- df[-indice, ]

Paso 6: Ajuste del modelo

regresion <- lm(Overall ~ Height, data = train)
summary(regresion)
## 
## Call:
## lm(formula = Overall ~ Height, data = train)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -20.1049  -4.2809  -0.1049   4.5431  28.1592 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  59.9441     1.6484  36.364  < 2e-16 ***
## Height        1.0561     0.2771   3.812 0.000139 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6.894 on 12742 degrees of freedom
## Multiple R-squared:  0.001139,   Adjusted R-squared:  0.00106 
## F-statistic: 14.53 on 1 and 12742 DF,  p-value: 0.0001387

Paso 7: Predicción sobre el dataset de test

Overall_pred <- predict(regresion, test)
test$Overall_Pred <- Overall_pred

Paso 8: Visualización

# Gráfico de dispersión con línea de regresión
ggplot(df, aes(x = Height, y = Overall)) +
  geom_point(color = "blue", size = 2) +        # puntos reales
  geom_smooth(method = "lm", color = "red", se = FALSE) +  # línea de regresión
  labs(
    title = "Regresión lineal: Overall vs Height",
    x = "Height",
    y = "Overall"
  ) +
  theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'

Paso 9: Evaluación del modelo

Primero se separan los datos en train (70%) y test (30%) para validar desempeño:

mse <- mean((test$Overall - test$Overall_Pred)^2)
rmse <- sqrt(mse)

print(paste("MSE:", round(mse, 2)))
## [1] "MSE: 47.98"
print(paste("RMSE:", round(rmse, 2)))
## [1] "RMSE: 6.93"

Paso 10: intepretar resultados

La altura (Height) tiene una influencia mínima sobre la habilidad general (Overall) de los jugadores. El coeficiente de correlación y el R² indican que la altura explica apenas un 0.11% de la variabilidad de Overall.

En cuanto a lo encontrado por el modelo, la altura no influye significativamente en la calificación general de los jugadores.

Modelo de Regresión Lineal Múltiple - PREDICCIÓN DE ADDICTION LEVEL

La regresión lineal múltiple es una técnica estadística que permite modelar la relación entre una variable dependiente (Y) y dos o más variables independientes (X₁, X₂, X₃, …, Xₙ). El objetivo es encontrar el plano o hiperplano de mejor ajuste que explique cómo cambia la variable dependiente a partir de los cambios combinados en las variables independientes.En este modelo, cada variable independiente aporta su propio efecto parcial sobre la variable dependiente, controlando el impacto de las demás.

Cuándo aplicarlo

Cuando se desea analizar cómo varias variables cuantitativas (y algunas categóricas convertidas a dummies) influyen en una variable respuesta o cuando existe una relación lineal múltiple entre las variables predictoras y la dependiente. También para predecir, interpretar y evaluar impactos simultáneos de distintos factores sobre una variable principal. Es ideal cuando se busca determinar qué variables tienen mayor peso o significancia estadística en el resultado.

Qué esperar

La precisión del modelo se mide con: R², R², MSE (Mean Squared Error) o RMSE (Root Mean Squared Error). El desempeño del modelo depende de: La calidad de los datos (sin valores atípicos ni colinealidad), qué tan adecuada sea la elección de las variables predictoras y si la relación entre las variables es lineal y cumple los supuestos del modelo.

Ejemplo en R

En este análisis, nos enfocaremos en el dataset phone_addiction y evaluaremos si existe una relación entre distintos hábitos y comportamientos relacionados con el uso del teléfono —como las horas de uso diario, las horas de sueño, la ansiedad o la autoestima— y el nivel de adicción al teléfono (adiccion).

Paso 1. Librerias

# Cargamos las librerías necesarias
library(GGally)
library(ggplot2)
library(readxl)    
library(dplyr) 
library(corrplot)

Paso 2. Cargar y prepapar los datos

El primer paso para construir un modelo lineal múltiple es analizar la relación entre las variables. Esta información es crítica para identificar cuáles son los mejores predictores, qué relaciones no son lineales y si existe colinealidad entre predictores.

# Convertimos el dataset en data frame
datos <- read_excel("C:/Users/natal/Downloads/phone_addiction.xlsx")
# Renombrar las variables con nombres más cortos y claros para el análisis
datos <- rename(
  datos,
  edad = Age,
  genero = Gender,
  grado = School_Grade,
  uso_diario = Daily_Usage_Hours,
  horas_sueno = Sleep_Hours,
  rendimiento = Academic_Performance,
  interacciones = Social_Interactions,
  ejercicio = Exercise_Hours,
  ansiedad = Anxiety_Level,
  depresion = Depression_Level,
  autoestima = Self_Esteem,
  control_parental = Parental_Control,
  pantalla_noche = Screen_Time_Before_Bed,
  revisiones = Phone_Checks_Per_Day,
  apps_diarias = Apps_Used_Daily,
  tiempo_redes = Time_on_Social_Media,
  tiempo_juegos = Time_on_Gaming,
  tiempo_educ = Time_on_Education,
  comunicacion_fam = Family_Communication,
  uso_fin_semana = Weekend_Usage_Hours,
  adiccion = Addiction_Level
)


# Primeras filas del dataset transformado
head(datos)
## # A tibble: 6 × 25
##      ID Name       edad genero Location grado uso_diario horas_sueno rendimiento
##   <dbl> <chr>     <dbl> <chr>  <chr>    <chr>      <dbl>       <dbl>       <dbl>
## 1     1 Shannon …    13 Female Hansonf… 9th          4           6.1          78
## 2     2 Scott Ro…    17 Female Theodor… 7th          5.5         6.5          70
## 3     3 Adrian K…    13 Other  Lindsey… 11th         5.8         5.5          93
## 4     4 Brittany…    18 Female West An… 12th         3.1         3.9          78
## 5     5 Steven S…    14 Other  Port Li… 9th          2.5         6.7          56
## 6     6 Mary Ada…    13 Female East An… 10th         3.9         6.3          89
## # ℹ 16 more variables: interacciones <dbl>, ejercicio <dbl>, ansiedad <dbl>,
## #   depresion <dbl>, autoestima <dbl>, control_parental <dbl>,
## #   pantalla_noche <dbl>, revisiones <dbl>, apps_diarias <dbl>,
## #   tiempo_redes <dbl>, tiempo_juegos <dbl>, tiempo_educ <dbl>,
## #   Phone_Usage_Purpose <chr>, comunicacion_fam <dbl>, uso_fin_semana <dbl>,
## #   adiccion <dbl>

Paso 3. Análisis exploratorio de variables

# Analizar la relación entre variables
ggpairs(datos[, c("uso_diario", "horas_sueno", "ansiedad", "depresion",
                  "autoestima", "pantalla_noche", "revisiones", "adiccion")],
        lower = list(continuous = "smooth"),
        diag = list(continuous = "barDiag"),
        axisLabels = "none")
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.

En general, la mayoría de las correlaciones son bajas, lo que indica relaciones lineales débiles entre las variables. Sin embargo, se destacan dos asociaciones importantes: una correlación positiva fuerte entre uso diario y adicción (0.601), y una correlación positiva moderada entre revisiones y adicción (0.246), lo que sugiere que cuanto más se usa y revisa el teléfono, mayor es el nivel de adicción. Además, existe una correlación negativa significativa entre uso diario y horas de sueño (-0.217), indicando que un mayor uso del teléfono se asocia con dormir menos horas.

Paso 4. Limpieza

#  Convertir variables categóricas a factores
datos$genero <- as.factor(datos$genero)
datos$Location <- as.factor(datos$Location)     
datos$grado <- as.factor(datos$grado)
datos$Phone_Usage_Purpose <- as.factor(datos$Phone_Usage_Purpose)

Paso 5. Creacion del modelo

# Modelo inicial con múltiples predictores relevantes.
modelo_inicial <- lm(adiccion ~ uso_diario + horas_sueno + ansiedad + depresion +
                     autoestima + pantalla_noche + revisiones + apps_diarias +
                     tiempo_redes + tiempo_juegos + tiempo_educ +
                     comunicacion_fam + uso_fin_semana, data = datos)

summary(modelo_inicial)
## 
## Call:
## lm(formula = adiccion ~ uso_diario + horas_sueno + ansiedad + 
##     depresion + autoestima + pantalla_noche + revisiones + apps_diarias + 
##     tiempo_redes + tiempo_juegos + tiempo_educ + comunicacion_fam + 
##     uso_fin_semana, data = datos)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.2830 -0.5043  0.1397  0.6640  1.2570 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       4.0065112  0.1324994  30.238   <2e-16 ***
## uso_diario        0.4969211  0.0076838  64.671   <2e-16 ***
## horas_sueno      -0.2511220  0.0100885 -24.892   <2e-16 ***
## ansiedad          0.0074173  0.0052007   1.426   0.1539    
## depresion        -0.0025284  0.0052394  -0.483   0.6294    
## autoestima       -0.0050950  0.0052616  -0.968   0.3330    
## pantalla_noche   -0.0035612  0.0305442  -0.117   0.9072    
## revisiones        0.0103337  0.0003983  25.945   <2e-16 ***
## apps_diarias      0.1050532  0.0032653  32.172   <2e-16 ***
## tiempo_redes      0.4934597  0.0152177  32.427   <2e-16 ***
## tiempo_juegos     0.4887855  0.0161197  30.322   <2e-16 ***
## tiempo_educ      -0.0169137  0.0232177  -0.728   0.4664    
## comunicacion_fam -0.0099635  0.0052513  -1.897   0.0579 .  
## uso_fin_semana   -0.0126516  0.0074821  -1.691   0.0910 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8225 on 2986 degrees of freedom
## Multiple R-squared:   0.74,  Adjusted R-squared:  0.7389 
## F-statistic: 653.9 on 13 and 2986 DF,  p-value: < 2.2e-16
# Método step() para simplificar el modelo y conservar solo los predictores que realmente aportan
modelo_final <- step(object = modelo_inicial, direction = "both", trace = 1)
## Start:  AIC=-1158.82
## adiccion ~ uso_diario + horas_sueno + ansiedad + depresion + 
##     autoestima + pantalla_noche + revisiones + apps_diarias + 
##     tiempo_redes + tiempo_juegos + tiempo_educ + comunicacion_fam + 
##     uso_fin_semana
## 
##                    Df Sum of Sq    RSS      AIC
## - pantalla_noche    1      0.01 2019.8 -1160.81
## - depresion         1      0.16 2020.0 -1160.59
## - tiempo_educ       1      0.36 2020.2 -1160.29
## - autoestima        1      0.63 2020.4 -1159.88
## <none>                          2019.8 -1158.82
## - ansiedad          1      1.38 2021.2 -1158.78
## - uso_fin_semana    1      1.93 2021.7 -1157.95
## - comunicacion_fam  1      2.44 2022.2 -1157.21
## - horas_sueno       1    419.12 2438.9  -595.16
## - revisiones        1    455.33 2475.1  -550.95
## - tiempo_juegos     1    621.93 2641.7  -355.52
## - apps_diarias      1    700.14 2719.9  -268.00
## - tiempo_redes      1    711.26 2731.1  -255.76
## - uso_diario        1   2829.07 4848.9  1466.41
## 
## Step:  AIC=-1160.81
## adiccion ~ uso_diario + horas_sueno + ansiedad + depresion + 
##     autoestima + revisiones + apps_diarias + tiempo_redes + tiempo_juegos + 
##     tiempo_educ + comunicacion_fam + uso_fin_semana
## 
##                    Df Sum of Sq    RSS      AIC
## - depresion         1      0.16 2020.0 -1162.58
## - tiempo_educ       1      0.36 2020.2 -1162.27
## - autoestima        1      0.64 2020.5 -1161.87
## <none>                          2019.8 -1160.81
## - ansiedad          1      1.38 2021.2 -1160.77
## - uso_fin_semana    1      1.95 2021.8 -1159.92
## - comunicacion_fam  1      2.44 2022.3 -1159.19
## + pantalla_noche    1      0.01 2019.8 -1158.82
## - horas_sueno       1    419.11 2438.9  -597.16
## - revisiones        1    455.37 2475.2  -552.88
## - tiempo_juegos     1    621.93 2641.8  -357.51
## - apps_diarias      1    700.53 2720.3  -269.56
## - tiempo_redes      1    711.30 2731.1  -257.70
## - uso_diario        1   2829.06 4848.9  1464.41
## 
## Step:  AIC=-1162.58
## adiccion ~ uso_diario + horas_sueno + ansiedad + autoestima + 
##     revisiones + apps_diarias + tiempo_redes + tiempo_juegos + 
##     tiempo_educ + comunicacion_fam + uso_fin_semana
## 
##                    Df Sum of Sq    RSS      AIC
## - tiempo_educ       1      0.35 2020.3 -1164.06
## - autoestima        1      0.62 2020.6 -1163.66
## <none>                          2020.0 -1162.58
## - ansiedad          1      1.36 2021.3 -1162.56
## - uso_fin_semana    1      1.94 2021.9 -1161.70
## - comunicacion_fam  1      2.42 2022.4 -1160.99
## + depresion         1      0.16 2019.8 -1160.81
## + pantalla_noche    1      0.01 2020.0 -1160.59
## - horas_sueno       1    418.97 2438.9  -599.14
## - revisiones        1    455.42 2475.4  -554.64
## - tiempo_juegos     1    622.16 2642.1  -359.08
## - apps_diarias      1    700.38 2720.4  -271.55
## - tiempo_redes      1    711.29 2731.3  -259.54
## - uso_diario        1   2828.93 4848.9  1462.42
## 
## Step:  AIC=-1164.06
## adiccion ~ uso_diario + horas_sueno + ansiedad + autoestima + 
##     revisiones + apps_diarias + tiempo_redes + tiempo_juegos + 
##     comunicacion_fam + uso_fin_semana
## 
##                    Df Sum of Sq    RSS      AIC
## - autoestima        1      0.61 2020.9 -1165.16
## - ansiedad          1      1.33 2021.7 -1164.09
## <none>                          2020.3 -1164.06
## - uso_fin_semana    1      1.90 2022.2 -1163.24
## + tiempo_educ       1      0.35 2020.0 -1162.58
## - comunicacion_fam  1      2.44 2022.8 -1162.44
## + depresion         1      0.14 2020.2 -1162.27
## + pantalla_noche    1      0.01 2020.3 -1162.08
## - horas_sueno       1    418.78 2439.1  -600.95
## - revisiones        1    456.57 2476.9  -554.81
## - tiempo_juegos     1    622.22 2642.5  -360.61
## - apps_diarias      1    700.44 2720.8  -273.10
## - tiempo_redes      1    711.08 2731.4  -261.38
## - uso_diario        1   2828.63 4849.0  1460.46
## 
## Step:  AIC=-1165.16
## adiccion ~ uso_diario + horas_sueno + ansiedad + revisiones + 
##     apps_diarias + tiempo_redes + tiempo_juegos + comunicacion_fam + 
##     uso_fin_semana
## 
##                    Df Sum of Sq    RSS      AIC
## - ansiedad          1      1.32 2022.3 -1165.20
## <none>                          2020.9 -1165.16
## - uso_fin_semana    1      1.82 2022.8 -1164.46
## + autoestima        1      0.61 2020.3 -1164.06
## + tiempo_educ       1      0.34 2020.6 -1163.66
## - comunicacion_fam  1      2.38 2023.3 -1163.63
## + depresion         1      0.13 2020.8 -1163.34
## + pantalla_noche    1      0.01 2020.9 -1163.17
## - horas_sueno       1    419.40 2440.3  -601.43
## - revisiones        1    456.84 2477.8  -555.76
## - tiempo_juegos     1    622.47 2643.4  -361.64
## - apps_diarias      1    702.24 2723.2  -272.44
## - tiempo_redes      1    711.51 2732.4  -262.25
## - uso_diario        1   2828.17 4849.1  1458.54
## 
## Step:  AIC=-1165.2
## adiccion ~ uso_diario + horas_sueno + revisiones + apps_diarias + 
##     tiempo_redes + tiempo_juegos + comunicacion_fam + uso_fin_semana
## 
##                    Df Sum of Sq    RSS      AIC
## <none>                          2022.3 -1165.20
## + ansiedad          1      1.32 2020.9 -1165.16
## - uso_fin_semana    1      1.80 2024.0 -1164.54
## + autoestima        1      0.60 2021.7 -1164.09
## - comunicacion_fam  1      2.34 2024.6 -1163.73
## + tiempo_educ       1      0.31 2021.9 -1163.66
## + depresion         1      0.11 2022.1 -1163.37
## + pantalla_noche    1      0.01 2022.2 -1163.22
## - horas_sueno       1    418.98 2441.2  -602.33
## - revisiones        1    457.88 2480.1  -554.91
## - tiempo_juegos     1    623.38 2645.6  -361.10
## - apps_diarias      1    702.75 2725.0  -272.43
## - tiempo_redes      1    711.36 2733.6  -262.97
## - uso_diario        1   2827.40 4849.6  1456.88
summary(modelo_final)
## 
## Call:
## lm(formula = adiccion ~ uso_diario + horas_sueno + revisiones + 
##     apps_diarias + tiempo_redes + tiempo_juegos + comunicacion_fam + 
##     uso_fin_semana, data = datos)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.2826 -0.5080  0.1425  0.6630  1.2307 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       3.9780617  0.1163070   34.20   <2e-16 ***
## uso_diario        0.4966574  0.0076802   64.67   <2e-16 ***
## horas_sueno      -0.2510023  0.0100830  -24.89   <2e-16 ***
## revisiones        0.0103548  0.0003979   26.02   <2e-16 ***
## apps_diarias      0.1051443  0.0032613   32.24   <2e-16 ***
## tiempo_redes      0.4934528  0.0152128   32.44   <2e-16 ***
## tiempo_juegos     0.4892670  0.0161130   30.36   <2e-16 ***
## comunicacion_fam -0.0097625  0.0052473   -1.86   0.0629 .  
## uso_fin_semana   -0.0121682  0.0074643   -1.63   0.1032    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8223 on 2991 degrees of freedom
## Multiple R-squared:  0.7397, Adjusted R-squared:  0.739 
## F-statistic:  1063 on 8 and 2991 DF,  p-value: < 2.2e-16
modelo_final
## 
## Call:
## lm(formula = adiccion ~ uso_diario + horas_sueno + revisiones + 
##     apps_diarias + tiempo_redes + tiempo_juegos + comunicacion_fam + 
##     uso_fin_semana, data = datos)
## 
## Coefficients:
##      (Intercept)        uso_diario       horas_sueno        revisiones  
##         3.978062          0.496657         -0.251002          0.010355  
##     apps_diarias      tiempo_redes     tiempo_juegos  comunicacion_fam  
##         0.105144          0.493453          0.489267         -0.009763  
##   uso_fin_semana  
##        -0.012168
modelo_final
## 
## Call:
## lm(formula = adiccion ~ uso_diario + horas_sueno + revisiones + 
##     apps_diarias + tiempo_redes + tiempo_juegos + comunicacion_fam + 
##     uso_fin_semana, data = datos)
## 
## Coefficients:
##      (Intercept)        uso_diario       horas_sueno        revisiones  
##         3.978062          0.496657         -0.251002          0.010355  
##     apps_diarias      tiempo_redes     tiempo_juegos  comunicacion_fam  
##         0.105144          0.493453          0.489267         -0.009763  
##   uso_fin_semana  
##        -0.012168

Paso 6. Separacion en train y test

set.seed(123)
n <- nrow(datos)
idx <- sample(1:n, size = 0.7 * n)

# 70% para entrenamiento
train <- datos[idx, ]
# 30% para prueba
test <- datos[-idx, ]

Paso 7. Predecir sobre test y evakuar el RMS sobre la predicción

# Realizamos predicciones sobre el conjunto de prueba
pred_test <- predict(modelo_final, newdata = test)

# Calculamos el RMSE (Root Mean Squared Error)
RMSE_test <- sqrt(mean((test$adiccion - pred_test)^2))
RMSE_test
## [1] 0.826774
# Calculo de desv
sd(datos$adiccion, na.rm = TRUE)
## [1] 1.609598
summary(modelo_final)
## 
## Call:
## lm(formula = adiccion ~ uso_diario + horas_sueno + revisiones + 
##     apps_diarias + tiempo_redes + tiempo_juegos + comunicacion_fam + 
##     uso_fin_semana, data = datos)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.2826 -0.5080  0.1425  0.6630  1.2307 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       3.9780617  0.1163070   34.20   <2e-16 ***
## uso_diario        0.4966574  0.0076802   64.67   <2e-16 ***
## horas_sueno      -0.2510023  0.0100830  -24.89   <2e-16 ***
## revisiones        0.0103548  0.0003979   26.02   <2e-16 ***
## apps_diarias      0.1051443  0.0032613   32.24   <2e-16 ***
## tiempo_redes      0.4934528  0.0152128   32.44   <2e-16 ***
## tiempo_juegos     0.4892670  0.0161130   30.36   <2e-16 ***
## comunicacion_fam -0.0097625  0.0052473   -1.86   0.0629 .  
## uso_fin_semana   -0.0121682  0.0074643   -1.63   0.1032    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8223 on 2991 degrees of freedom
## Multiple R-squared:  0.7397, Adjusted R-squared:  0.739 
## F-statistic:  1063 on 8 and 2991 DF,  p-value: < 2.2e-16

El modelo final de regresión lineal múltiple presenta un buen ajuste, explicando el 74 % de la variabilidad en la adicción al teléfono (R² ajustado = 0.739). El RMSE de 0.83, comparado con la desviación estándar de 1.61, indica un buen desempeño predictivo. Los resultados muestran que un mayor uso diario del teléfono, tiempo en redes sociales, tiempo en juegos, uso de apps y frecuencia de revisiones incrementan significativamente la adicción, mientras que dormir más horas la reduce. En conjunto, el modelo es sólido, estadísticamente significativo y coherente con la relación esperada entre los hábitos de uso del teléfono y la adicción.

Regresión Logística

1. ¿Qué es la regresión logística?

La regresión logística modela la probabilidad de pertenecer a una clase (por ejemplo, Depresión = 1) a partir de un conjunto de predictores \(x\).

En su forma binaria, el modelo asume:

\[ P(Y=1|x) = \frac{1}{1 + e^{-(\beta_0 + \beta_1 x_1 + \beta_2 x_2 + \dots + \beta_n x_n)}} \]

Salida

La salida del modelo es una probabilidad \(p \in (0,1)\), que representa la probabilidad estimada de que ocurra el evento.
Para convertir esta probabilidad en una clasificación (por ejemplo, “sí tiene depresión” o “no tiene depresión”), se define un umbral, generalmente \(0.5\):

  • Si \(p \geq 0.5\), se predice 1 (evento positivo).
  • Si \(p < 0.5\), se predice 0 (evento negativo).

Interpretación de los coeficientes

Cada coeficiente \(\beta_j\) indica cuánto cambia el logaritmo de las probabilidades (log-odds) del evento cuando la variable \(x_j\) aumenta una unidad, manteniendo las demás constantes.

En forma logarítmica:

\[ \log\left(\frac{p}{1-p}\right) = \beta_0 + \beta_1x_1 + \beta_2x_2 + \dots + \beta_nx_n \]

Donde:

  • \(\frac{p}{1-p}\) representa las odds (razón entre la probabilidad de que ocurra el evento y la de que no ocurra).
  • \(\log(\frac{p}{1-p})\) transforma esa razón en una escala lineal que el modelo puede ajustar.

En otras palabras,

  • Si \(\beta_j > 0\), un aumento en \(x_j\) incrementa la probabilidad del evento.
  • Si \(\beta_j < 0\), un aumento en \(x_j\) la reduce.

Para una lectura más intuitiva se calcula el odds ratio, definido como:

\[ \text{odds ratio} = e^{\beta_j} \]

Esto indica cuántas veces se multiplican las probabilidades del evento por cada unidad adicional de \(x_j\).
Por ejemplo:

  • Si \(e^{\beta_j} = 1.5\), la probabilidad del evento aumenta un 50%.
  • Si \(e^{\beta_j} = 0.7\), la probabilidad disminuye un 30%.

Cuándo usarla

Se usa cuando el objetivo es clasificar observaciones en dos categorías, y se desea:

  • Un modelo explicable y con probabilidades interpretables.
  • Relaciones monótonas entre predictores y la probabilidad del evento.
  • Evaluar efectos de cada variable mediante odds ratios o intervalos de confianza.
  • Controlar el modelo mediante regularización o validación cruzada.

Supuestos prácticos

  1. Linealidad en el log-odds: la relación entre las variables numéricas y el logit debe ser aproximadamente lineal.
  2. Independencia: las observaciones deben ser independientes entre sí.
  3. Multicolinealidad: los predictores no deben estar fuertemente correlacionados.
  4. Tamaño muestral adecuado: se recomienda al menos 10–20 casos positivos por cada predictor incluido.

2. Paquetes

library(readxl)  
library(dplyr)  
library(stringr) 
library(caret)  
## Cargando paquete requerido: lattice
library(pROC)
## Type 'citation("pROC")' for a citation.
## 
## Adjuntando el paquete: 'pROC'
## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var
library(ggplot2)

3. Ejemplo con student depression.

Cargamos el dataset student_depression.xlsx:

raw <- read_excel("C:/Users/natal/Downloads/student_depression (1).xlsx")
## Warning: Expecting numeric in P4460 / R4460C16: got '?'
## Warning: Expecting numeric in P13598 / R13598C16: got '?'
## Warning: Expecting numeric in P19268 / R19268C16: got '?'

El primer paso para regresión logística involucra el entendimiento de las variables y decisiones de limpieza

El dataset original contiene las siguientes columnas:

id, gender, age, city, profession, academic_pressure, work_pressure, cgpa, study_satisfaction, job_satisfaction, sleep_duration, dietary_habits, degree, have_you_ever_had_suicidal_thoughts, work_study_hours, financial_stress, family_history_of_mental_illness, depression.

Antes de aplicar la regresión logística, es necesario analizar qué aporta realmente cada variable y cómo debe transformarse. A continuación se detalla el criterio seguido en la limpieza y selección de variables:

1. Variables eliminadas

  • id: Es un identificador único, no tiene relación causal ni predictiva con la variable objetivo. Mantenerlo solo agregaría ruido, por lo que se elimina.
  • city y profession: Son variables categóricas con muchos valores distintos (alta cardinalidad). Si se convierten en variables dummy, generarían demasiadas columnas y podrían causar sobreajuste.

2. Variables binarias (Yes/No)

Las variables con respuestas tipo Yes/No deben convertirse a formato numérico (0 y 1), para que el modelo las procese correctamente.
Ejemplos: - have_you_ever_had_suicidal_thoughts: 1 = Yes, 0 = No.
- family_history_of_mental_illness: 1 = Yes, 0 = No.

Esta transformación permite interpretar directamente los efectos de la presencia o ausencia de la característica sobre la probabilidad de depresión.

3. Variables categóricas con pocas categorías

Variables como gender, sleep_duration, dietary_habits y degree tienen pocas categorías, por lo que pueden convertirse fácilmente en variables dummy. Esto se logra con funciones como step_dummy() dentro de un recipe, generando una columna binaria para cada categoría.
Por ejemplo: Gender_Female = 1 si es mujer, 0 si no.

4. Variables numéricas

Variables como age, academic_pressure, work_pressure, cgpa, study_satisfaction, job_satisfaction, work_study_hours y financial_stress se mantienen como numéricas.
Antes del modelado se normalizan (media = 0, desviación estándar = 1) para que todas las variables tengan la misma escala. Esto es especialmente importante en modelos con regularización como GLMNET.
Se puede usar step_normalize() para hacerlo dentro del pipeline.

5. Revisión de multicolinealidad

Las variables numéricas pueden estar correlacionadas entre sí (por ejemplo, academic_pressure y study_satisfaction). Si existe alta correlación, los coeficientes pueden volverse inestables o difíciles de interpretar.
Por eso se recomienda revisar la matriz de correlación y calcular el VIF (Variance Inflation Factor).
Valores de VIF mayores a 10 indican que puede haber redundancia y se recomienda eliminar alguna de las variables.

nm <- names(raw)
nm <- tolower(nm)                 # minúsculas
nm <- gsub("[^a-z0-9]+", "_", nm) # cualquier no-alfa-numérico -> "_"
nm <- gsub("_+", "_", nm)         # colapsa múltiples "_"
nm <- gsub("^_|_$", "", nm)       # quita "_" al inicio/fin
names(raw) <- nm

df <- raw %>%
  mutate(
    sleep_duration = str_replace_all(sleep_duration, "'", "") %>% str_squish(),
    have_you_ever_had_suicidal_thoughts = case_when(
      str_to_lower(have_you_ever_had_suicidal_thoughts) %in% c("yes", "y", "1") ~ 1,
      str_to_lower(have_you_ever_had_suicidal_thoughts) %in% c("no", "n", "0") ~ 0,
      TRUE ~ NA_real_
    ),
    family_history_of_mental_illness = case_when(
      str_to_lower(family_history_of_mental_illness) %in% c("yes", "y", "1") ~ 1,
      str_to_lower(family_history_of_mental_illness) %in% c("no", "n", "0") ~ 0,
      TRUE ~ NA_real_
    ),
    gender = as.factor(gender),
    dietary_habits = as.factor(dietary_habits),
    degree = as.factor(degree),
    sleep_duration = factor(
      sleep_duration,
      levels = c("Less than 5 hours", "5-6 hours", "7-8 hours", "More than 8 hours")
    ),
    depression = as.factor(depression)
  ) %>%
  select(-id, -city, -profession) %>%
  filter(!is.na(depression))

El segundo paso para regresión logística divide entre train y test.

set.seed(123)
train_index <- createDataPartition(df$depression, p = 0.7, list = FALSE)
train <- df[train_index, ]
test  <- df[-train_index, ]

Una vez finalizada la limpieza, se procedió a dividir el conjunto de datos en dos subconjuntos: entrenamiento y prueba. El 70% de las observaciones se destinó al conjunto de entrenamiento (train), utilizado para ajustar el modelo de regresión logística, mientras que el 30% restante conformó el conjunto de prueba (test), empleado para evaluar el desempeño del modelo sobre datos nuevos.

Esta división se realizó utilizando la función createDataPartition() del paquete caret, la cual garantiza una partición estratificada, es decir, mantiene la misma proporción de casos positivos y negativos en ambos subconjuntos. De esta manera, se evita un sesgo en el entrenamiento y se asegura una evaluación más representativa del rendimiento del modelo.

Generación del modelo

Para esta etapa se emplea la función glm(), utilizada para ajustar modelos lineales generalizados. En particular, cuando se especifica el parámetro family = binomial, el modelo se convierte en una regresión logística, lo que permite estimar la probabilidad de que ocurra un evento binario, en este caso, que un estudiante presente depresión (depression = 1).

A través del modelo, se busca identificar qué variables tienen mayor influencia sobre la presencia o ausencia de depresión. El parámetro summary() permite revisar los coeficientes, errores estándar, valores z y p-values, con los cuales se puede determinar la significancia estadística de cada predictor. En esta primera versión, se incluirán todas las variables relevantes del conjunto de datos para posteriormente analizar cuáles resultan significativas y considerar una versión más parsimoniosa (más simple pero igualmente explicativa).

modelo <- glm(
  depression ~ gender + age + academic_pressure + work_pressure + cgpa +
    study_satisfaction + job_satisfaction + sleep_duration + dietary_habits +
    degree + have_you_ever_had_suicidal_thoughts + work_study_hours +
    financial_stress + family_history_of_mental_illness,
  family = binomial,
  data = train
)

summary(modelo)
## 
## Call:
## glm(formula = depression ~ gender + age + academic_pressure + 
##     work_pressure + cgpa + study_satisfaction + job_satisfaction + 
##     sleep_duration + dietary_habits + degree + have_you_ever_had_suicidal_thoughts + 
##     work_study_hours + financial_stress + family_history_of_mental_illness, 
##     family = binomial, data = train)
## 
## Coefficients:
##                                      Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                         -3.373099   0.208265 -16.196  < 2e-16 ***
## genderMale                          -0.009777   0.044078  -0.222  0.82446    
## age                                 -0.119585   0.005891 -20.298  < 2e-16 ***
## academic_pressure                    0.838526   0.017734  47.284  < 2e-16 ***
## work_pressure                        0.211206   0.601458   0.351  0.72547    
## cgpa                                 0.060536   0.014747   4.105 4.04e-05 ***
## study_satisfaction                  -0.235169   0.016231 -14.489  < 2e-16 ***
## job_satisfaction                     0.078172   0.490146   0.159  0.87328    
## sleep_duration5-6 hours             -0.336945   0.061154  -5.510 3.59e-08 ***
## sleep_duration7-8 hours             -0.331246   0.058284  -5.683 1.32e-08 ***
## sleep_durationMore than 8 hours     -0.571097   0.061581  -9.274  < 2e-16 ***
## dietary_habitsModerate               0.474018   0.053871   8.799  < 2e-16 ***
## dietary_habitsOthers                 0.097181   0.786985   0.123  0.90172    
## dietary_habitsUnhealthy              1.049271   0.055188  19.013  < 2e-16 ***
## degreeB.Arch                         0.227283   0.112217   2.025  0.04283 *  
## degreeB.Com                          0.023794   0.113562   0.210  0.83404    
## degreeB.Ed                           0.139327   0.108453   1.285  0.19890    
## degreeB.Pharm                        0.134196   0.138887   0.966  0.33393    
## degreeB.Tech                         0.297870   0.124578   2.391  0.01680 *  
## degreeBA                            -0.098184   0.150473  -0.652  0.51408    
## degreeBBA                            0.157637   0.148175   1.064  0.28739    
## degreeBCA                            0.065390   0.112251   0.583  0.56021    
## degreeBE                             0.156262   0.150978   1.035  0.30067    
## degreeBHM                            0.134296   0.133946   1.003  0.31605    
## degreeBSc                            0.368475   0.135496   2.719  0.00654 ** 
## degreeLLB                            0.317740   0.151567   2.096  0.03605 *  
## degreeLLM                            0.514602   0.175843   2.926  0.00343 ** 
## degreeM.Com                          0.258357   0.148616   1.738  0.08214 .  
## degreeM.Ed                           0.253991   0.142420   1.783  0.07452 .  
## degreeM.Pharm                        0.227276   0.161501   1.407  0.15935    
## degreeM.Tech                         0.046896   0.131438   0.357  0.72125    
## degreeMA                             0.029182   0.165293   0.177  0.85986    
## degreeMBA                            0.089302   0.161082   0.554  0.57931    
## degreeMBBS                           0.417346   0.149231   2.797  0.00516 ** 
## degreeMCA                            0.257272   0.125435   2.051  0.04026 *  
## degreeMD                             0.144335   0.165862   0.870  0.38418    
## degreeME                             0.089031   0.255221   0.349  0.72721    
## degreeMHM                            0.105486   0.247859   0.426  0.67041    
## degreeMSc                            0.013741   0.121801   0.113  0.91017    
## degreeOthers                         1.253295   0.552350   2.269  0.02327 *  
## degreePhD                            0.385154   0.169976   2.266  0.02346 *  
## have_you_ever_had_suicidal_thoughts  2.459284   0.046299  53.117  < 2e-16 ***
## work_study_hours                     0.121460   0.005947  20.423  < 2e-16 ***
## financial_stress                     0.546026   0.015827  34.500  < 2e-16 ***
## family_history_of_mental_illness     0.237791   0.043350   5.485 4.13e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 26484  on 19518  degrees of freedom
## Residual deviance: 13726  on 19474  degrees of freedom
##   (13 observations deleted due to missingness)
## AIC: 13816
## 
## Number of Fisher Scoring iterations: 6

Curva ROC y AUC para evaluación del modelo

La curva ROC (Receiver Operating Characteristic) muestra el desempeño de un clasificador binario al variar el umbral de decisión.
En el eje Y se representa la sensibilidad (True Positive Rate, proporción de positivos reales que el modelo clasifica correctamente),
y en el eje X el 1 - especificidad (False Positive Rate, proporción de negativos reales clasificados erróneamente como positivos).

Cada punto en la curva corresponde a un umbral distinto de clasificación: cuanto más cerca esté la curva de la esquina superior izquierda, mejor será el modelo.
Si la curva coincidiera con la diagonal (línea recta), el modelo no discriminaría mejor que el azar.

El AUC (Área Bajo la Curva ROC) mide la capacidad del modelo para distinguir entre clases.
Su valor oscila entre 0.5 (sin poder predictivo) y 1 (discriminación perfecta).
De forma práctica: - 0.6–0.7 → desempeño pobre
- 0.7–0.8 -> aceptable
- 0.8–0.9 -> bueno
- >0.9 -> excelente

# Probabilidades predichas
test$prob <- predict(modelo, newdata = test, type = "response")

# Curva ROC y AUC
roc_obj <- roc(response = test$depression, predictor = test$prob)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
auc_val <- auc(roc_obj)

# Mostrar el AUC
auc_val
## Area under the curve: 0.9246
# Graficar la curva ROC
plot(roc_obj, print.auc = TRUE, col = "#1b6aa5", lwd = 3,
     main = "Curva ROC - Modelo logístico (Depresión estudiantil)")
abline(a = 0, b = 1, lty = 2)

En este caso, el AUC es de 0.925, lo que indica que el modelo tiene una excelente capacidad de discriminación entre estudiantes con y sin depresión.
En términos prácticos, significa que si se seleccionan al azar dos estudiantes, como uno con depresión y otro sin ella, el modelo tiene un 92.5% de probabilidad de asignar una puntuación de riesgo mayor al estudiante con depresión.
Este resultado sugiere que el modelo logra distinguir de forma muy efectiva entre ambas clases, manteniendo un buen equilibrio entre sensibilidad y especificidad.

Evaluación del modelo

Además del AUC, es necesario evaluar el modelo con una matriz de confusión, que permite comparar las predicciones realizadas por el modelo con los valores reales.
A partir de esta matriz se pueden calcular diversas métricas de desempeño:

  • Accuracy (precisión general): proporción de observaciones correctamente clasificadas (positivas y negativas).
  • Sensibilidad (recall o TPR): proporción de casos positivos reales que el modelo identifica correctamente.
    • Fórmula: TP / (TP + FN)
  • Especificidad (TNR): proporción de casos negativos reales correctamente clasificados como negativos.
    • Fórmula: TN / (TN + FP)

Estas tres medidas brindan una visión más completa del desempeño del modelo.
Un accuracy alto no siempre implica un modelo confiable, especialmente si la sensibilidad es baja (es decir, si el modelo falla al detectar los casos positivos).

# Definir el umbral de decisión
thr <- 0.5
# Crear variable de predicción binaria
test$pred <- as.integer(test$prob >= thr)
# Matriz de confusión
cm <- table(Real = test$depression, Predicho = test$pred)
# Cálculo de métricas
accuracy <- mean(test$pred == test$depression)
sens <- cm["1", "1"] / sum(cm["1", ])
spec <- cm["0", "0"] / sum(cm["0", ])
# Resultados
list(
  Matriz_Confusion = cm,
  Accuracy = accuracy,
  Sensibilidad = sens,
  Especificidad = spec
)
## $Matriz_Confusion
##     Predicho
## Real    0    1
##    0 2741  724
##    1  532 4364
## 
## $Accuracy
## [1] NA
## 
## $Sensibilidad
## [1] 0.8913399
## 
## $Especificidad
## [1] 0.7910534

Para el ejemplo, la matriz de confusión obtenida permite analizar el desempeño general del modelo en términos de aciertos y errores de clasificación. En este caso, el modelo predijo correctamente 4,364 casos positivos (estudiantes con depresión) y 2,741 casos negativos(sin depresión), mientras que se produjeron 532 falsos negativos (casos reales de depresión clasificados como no deprimidos) y 724 falsos positivos (estudiantes sin depresión clasificados como deprimidos).

La sensibilidad del modelo es de 0.891, lo que significa que logra identificar correctamente el 89.1% de los estudiantes que realmente presentan depresión.
Este valor alto indica una muy buena capacidad del modelo para detectar los casos positivos, reduciendo el riesgo de pasar por alto estudiantes en riesgo.

Por otro lado, la especificidad es de 0.791, lo que implica que el modelo identifica correctamente el 79.1% de los estudiantes que no presentan depresión. Aunque algo menor que la sensibilidad, este resultado sigue siendo adecuado, mostrando que el modelo mantiene un equilibrio razonable entre ambos tipos de clasificación.

Representación gráfica del modelo

Para visualizar la relación entre una variable predictora y la probabilidad estimada, se puede graficar la función logística ajustada. Esto permite observar de forma intuitiva cómo cambia la probabilidad del evento conforme varía una variable independiente.

En este caso, se representará la relación entre la variable presión académica (academic_pressure) y la probabilidad de depresión estimada por el modelo.
El gráfico muestra los puntos observados y la curva ajustada por la regresión logística.

test$academic_pressure <- as.numeric(test$academic_pressure)

# Gráfico tipo "infert"
ggplot(test, aes(x = academic_pressure, y = as.numeric(as.character(depression)))) +
  geom_jitter(aes(color = factor(depression)), 
              width = 0.1, height = 0.06, alpha = 0.4, size = 1.6) +
  stat_smooth(method = "glm", 
              method.args = list(family = binomial),
              formula = y ~ x,
              se = TRUE, 
              linewidth = 1, 
              color = "#1b6aa5") +
  scale_y_continuous(limits = c(0, 1), breaks = seq(0, 1, 0.1)) +
  labs(
    title = "Regresión logística: presión académica vs depresión",
    x = "Presión académica",
    y = "Probabilidad estimada de depresión",
    color = "Depresión (1 = Sí, 0 = No)"
  ) +
  theme_bw() +
  theme(legend.position = "none")
## Warning: Removed 4234 rows containing missing values or values outside the scale range
## (`geom_point()`).

El gráfico ilustra que, a medida que aumenta la presión académica, el modelo tiende a estimar una mayor probabilidad de depresión. Este tipo de visualización permite comprobar la coherencia del modelo con la lógica teórica del fenómeno y facilita la interpretación de los coeficientes obtenidos.

Ajuste del modelo con variables más significativas

A partir del análisis de significancia del modelo completo, se construyó un modelo logístico más parsimonioso, reteniendo únicamente las variables que demostraron una relación estadísticamente significativa con la probabilidad de presentar depresión.

El modelo resultante incluye factores individuales, académicos y contextuales que mostraron evidencia empírica sólida (p < 0.05), eliminando aquellos predictores que no aportaban información adicional o generaban redundancia.

Entre las variables conservadas se encuentran la edad, presión académica, rendimiento (CGPA), satisfacción con el estudio, duración del sueño, hábitos alimenticios, antecedentes familiares de enfermedad mental, pensamientos suicidas, horas de trabajo/estudio y estrés financiero.

modelo_simple <- glm(
  depression ~ age + academic_pressure + cgpa + study_satisfaction +
  sleep_duration + dietary_habits +
  have_you_ever_had_suicidal_thoughts + 
  work_study_hours + financial_stress +
  family_history_of_mental_illness,
  family = binomial,
  data = train
)


summary(modelo_simple)
## 
## Call:
## glm(formula = depression ~ age + academic_pressure + cgpa + study_satisfaction + 
##     sleep_duration + dietary_habits + have_you_ever_had_suicidal_thoughts + 
##     work_study_hours + financial_stress + family_history_of_mental_illness, 
##     family = binomial, data = train)
## 
## Coefficients:
##                                      Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                         -3.465210   0.201965 -17.157  < 2e-16 ***
## age                                 -0.109305   0.004564 -23.948  < 2e-16 ***
## academic_pressure                    0.833290   0.017579  47.401  < 2e-16 ***
## cgpa                                 0.060388   0.014622   4.130 3.63e-05 ***
## study_satisfaction                  -0.238620   0.016114 -14.808  < 2e-16 ***
## sleep_duration5-6 hours             -0.336551   0.060922  -5.524 3.31e-08 ***
## sleep_duration7-8 hours             -0.324615   0.058073  -5.590 2.27e-08 ***
## sleep_durationMore than 8 hours     -0.567116   0.061399  -9.237  < 2e-16 ***
## dietary_habitsModerate               0.473922   0.053587   8.844  < 2e-16 ***
## dietary_habitsOthers                 0.162738   0.781130   0.208    0.835    
## dietary_habitsUnhealthy              1.043956   0.054854  19.032  < 2e-16 ***
## have_you_ever_had_suicidal_thoughts  2.450041   0.046086  53.163  < 2e-16 ***
## work_study_hours                     0.120676   0.005925  20.366  < 2e-16 ***
## financial_stress                     0.545116   0.015780  34.544  < 2e-16 ***
## family_history_of_mental_illness     0.238895   0.043232   5.526 3.28e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 26484  on 19518  degrees of freedom
## Residual deviance: 13766  on 19504  degrees of freedom
##   (13 observations deleted due to missingness)
## AIC: 13796
## 
## Number of Fisher Scoring iterations: 5

Este modelo más simple mantiene las variables con mayor peso explicativo y elimina aquellas con baja contribución estadística.
De esta forma, se obtiene un modelo más interpretable y con menor riesgo de sobreajuste.

Curva ROC y AUC del modelo ajustado

A continuación, se evalúa el rendimiento del modelo simplificado mediante la curva ROC y el cálculo del AUC, comparando sus resultados con el modelo original.

# Probabilidades predichas

test$prob_simple <- predict(modelo_simple, newdata = test, type = "response")

# ROC y AUC

roc_simple <- roc(response = test$depression, predictor = test$prob_simple)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
auc_simple <- auc(roc_simple)

# Mostrar el AUC

auc_simple
## Area under the curve: 0.9249
# Gráfico ROC

plot(roc_simple, print.auc = TRUE, col = "#006d77", lwd = 3,
main = "Curva ROC - Modelo ajustado (Depresión estudiantil)")
abline(a = 0, b = 1, lty = 2)

El modelo simplificado mantiene un AUC de 0.9249, lo cual indica una capacidad de discriminación excelente entre los estudiantes con y sin depresión.

El resultado confirma que, aunque se redujo la cantidad de variables, el modelo conserva prácticamente la misma capacidad predictiva que el modelo completo.
Esto valida la aplicación del principio de parsimonia, mostrando que es posible simplificar la estructura del modelo sin sacrificar su desempeño.

En el gráfico ROC, la curva se aproxima a la esquina superior izquierda, lo cual representa una combinación óptima de sensibilidad (tasa de verdaderos positivos) y especificidad (tasa de verdaderos negativos).

### Evaluación del modelo simplificado: matriz de confusión (versión robusta)

# Convertimos la variable objetivo y la predicción al mismo tipo
test <- test %>%
  mutate(
    depression = as.numeric(as.character(depression)),  # convierte factores "0"/"1" a numérico
    pred = as.numeric(pred)                             # asegura tipo numérico
  )

# Generamos la matriz de confusión
cm <- table(Real = test$depression, Predicho = test$pred)

# Cálculo de métricas
if (all(c("0", "1") %in% rownames(cm)) && all(c("0", "1") %in% colnames(cm))) {
  sensibilidad <- cm["1", "1"] / sum(cm["1", ])
  especificidad <- cm["0", "0"] / sum(cm["0", ])
} else {
  sensibilidad <- NA
  especificidad <- NA
}

accuracy <- sum(diag(cm)) / sum(cm)

# Resultados
list(
  Matriz_Confusion = cm,
  Accuracy = accuracy,
  Sensibilidad = sensibilidad,
  Especificidad = especificidad
)
## $Matriz_Confusion
##     Predicho
## Real    0    1
##    0 2741  724
##    1  532 4364
## 
## $Accuracy
## [1] 0.8497787
## 
## $Sensibilidad
## [1] 0.8913399
## 
## $Especificidad
## [1] 0.7910534

En este caso, el modelo logró una precisión global (Accuracy) del 84.96%, lo cual refleja una alta proporción de clasificaciones correctas entre estudiantes con y sin depresión.

La sensibilidad (0.8917) indica que el modelo identifica correctamente el 89% de los casos reales de depresión, mostrando una excelente capacidad de detección de positivos verdaderos.
Por su parte, la especificidad (0.7902) señala que el modelo clasifica correctamente el 79% de los estudiantes sin depresión, manteniendo un control razonable sobre los falsos positivos.