Yoseth Marín (2420827)
Daniela Cordero Erazo (2435076)
Santiago Domínguez (2416770)
El internet es una red global de computadoras interconectadas mediante protocolos estandarizados que permiten compartir información y recursos entre millones de dispositivos, como teléfonos inteligentes, computadores y servidores (Telefónica Tech, 2026). En las últimas décadas, ha dejado de ser únicamente una herramienta de consulta para convertirse en un elemento fundamental en las dinámicas sociales, económicas, educativas y de salud.
Sin embargo, en Colombia persiste una brecha digital significativa que limita el acceso equitativo a las tecnologías de la información, especialmente en hogares de bajos estratos socioeconómicos y zonas rurales. Comprender los factores asociados al acceso a internet resulta fundamental para analizar esta problemática, ya que mientras ciudades como Bogotá y departamentos como Valle del Cauca presentan altos niveles de conectividad, regiones como Vichada, Vaupés y Amazonas registran menores niveles de acceso y velocidades de conexión considerablemente inferiores al promedio rural de la OCDE (El Colombiano, 2026).
El presente estudio tiene como objetivo analizar y predecir el acceso a internet en hogares colombianos utilizando información de una encuesta del Departamento Administrativo Nacional de Estadística correspondiente al año 2024. La base de datos contiene información de 1.000 hogares y busca identificar cómo variables socioeconómicas y demográficas, como el estrato, la edad del jefe del hogar, el ingreso mensual, el nivel educativo y la zona de residencia, influyen en la probabilidad de contar con conexión a internet.
Para abordar el problema se emplearon dos modelos de clasificación supervisada: el algoritmo K-Vecinos Más Cercanos (KNN) y la regresión logística (Logit). Estos modelos permiten estimar la probabilidad de acceso a internet y comparar cuál ofrece un mejor equilibrio entre precisión y capacidad de clasificación, considerando que ambos métodos presentan enfoques distintos frente a la naturaleza de los datos y al comportamiento de las clases.
La información utilizada en este estudio proviene de una base de datos del Departamento Administrativo Nacional de Estadística correspondiente al año 2024. El conjunto de datos contiene información de 1.000 hogares encuestados y fue importado desde un archivo Excel para realizar el análisis estadístico. Inicialmente se realizó una inspección general de la estructura de los datos mediante funciones de visualización y resumen, con el fin de verificar las dimensiones del conjunto de datos, los tipos de variables y los primeros registros disponibles.
base <- read_excel("base_datos_taller.xlsx")
base %>%
head(10) %>%
kable(caption = "Primeros 10 registros de la base de datos", align = "c") %>%
kable_styling(bootstrap_options = c("striped","hover","condensed","responsive"),
full_width = FALSE, font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white")| ID | acceso_internet | estrato | zona | nivel_educativo | sexo | tipo_vivienda | num_personas_hogar | tiene_computador | ingreso_mensual | edad_jefe_hogar |
|---|---|---|---|---|---|---|---|---|---|---|
| 1 | No | 2 | Urbana | Secundaria | Mujer | Apartamento | 3 | No | Menos de $500k | 47 |
| 2 | Sí | 6 | Urbana | Primaria | Mujer | Cuarto | 3 | Sí | $500k-$1M | 35 |
| 3 | Sí | 4 | Rural | Universitario | Hombre | Apartamento | 5 | No | $2M-$4M | 59 |
| 4 | No | 3 | Rural | Primaria | Mujer | Casa | 3 | No | $2M-$4M | 28 |
| 5 | No | 1 | Rural | Secundaria | Mujer | Casa | 5 | Sí | $500k-$1M | 46 |
| 6 | No | 1 | Urbana | Técnico | Mujer | Casa | 1 | No | $500k-$1M | 34 |
| 7 | Sí | 1 | Urbana | Secundaria | Mujer | Casa | 5 | Sí | $1M-$2M | 43 |
| 8 | Sí | 5 | Rural | Técnico | Hombre | Casa | 5 | Sí | Menos de $500k | 73 |
| 9 | No | 3 | Urbana | Primaria | Mujer | Apartamento | 2 | No | $500k-$1M | 74 |
| 10 | Sí | 4 | Urbana | Secundaria | Hombre | Casa | 3 | Sí | $500k-$1M | 40 |
La variable dependiente del estudio corresponde al acceso a internet en el hogar. Actualmente, el acceso a internet se considera un servicio fundamental para actividades relacionadas con educación, trabajo, comunicación e inclusión social. Según cifras recientes, la cobertura de internet en Colombia alcanzó el 73.9% de los hogares en 2026, reflejando un crecimiento importante respecto a años anteriores (MinTIC, 2026).
La variable fue codificada como binaria: “Si” cuando el hogar cuenta con conexión a internet y “No” cuando no la tiene. Posteriormente, fue transformada a formato factor para facilitar su utilización en los modelos de clasificación. Su análisis resulta relevante porque permite estudiar la brecha digital existente en Colombia e identificar hogares con mayor vulnerabilidad tecnológica, aportando información útil para el diseño de políticas públicas orientadas a mejorar la conectividad.
Para predecir el acceso a internet se seleccionaron cinco variables independientes asociadas a factores socioeconómicos, demográficos y territoriales: estrato socioeconómico, edad del jefe del hogar, ingreso mensual del hogar, nivel educativo y zona de ubicación. Estas variables fueron elegidas debido a su posible relación con la probabilidad de que un hogar cuente con conexión a internet. A continuación se describe cada una y su relevancia dentro del análisis.
| Variable | Tipo | Justificación |
|---|---|---|
| X1 — Estrato socioeconómico | Numérica (1–6) | Indicador directo de capacidad económica; a mayor estrato, mayor probabilidad de acceso. |
| X2 — Edad del jefe del hogar | Numérica (18–79 años) | Refleja brecha generacional en adopción tecnológica. |
| X3 — Ingreso mensual | Categórica ordinal (5 niveles) | Determina la capacidad de pago del servicio. |
| X4 — Nivel educativo | Categórica ordinal (6 niveles) | A mayor educación, mayor demanda y uso de herramientas digitales. |
| X5 — Zona de ubicación | Categórica binaria | Las zonas rurales tienen menor cobertura de infraestructura. |
X1 — Estrato socioeconómico: En Colombia, el estrato socioeconómico corresponde a la clasificación oficial de las viviendas en categorías de 1 a 6, según sus características físicas y el entorno. Esta clasificación se utiliza para establecer tarifas diferenciales en servicios públicos: los estratos bajos reciben subsidios y los altos aportan contribuciones para financiarlos (Sobrenatural Inmobiliaria, 2026). El estrato se tomó como una variable categórica ordinal y representa un indicador directo de la capacidad económica del hogar. Se espera que, a medida que aumenta el estrato, también aumente la probabilidad de contar con acceso a internet, debido a una mayor capacidad de pago y mejores condiciones de infraestructura.
X2 — Edad del jefe del hogar: Corresponde a la edad de la persona reconocida como principal autoridad o sostén económico de la vivienda. Según el SISBÉN, esta persona debe tener mínimo 14 años (DANE, 2026). En la base utilizada, las edades oscilan entre 18 y 79 años, por lo que la variable se trató como cuantitativa continua. Esta variable refleja posibles diferencias generacionales en la adopción tecnológica. Se espera que los hogares con jefes más jóvenes tengan una mayor probabilidad de acceso a internet debido a una mayor familiaridad con herramientas digitales y necesidades laborales o académicas relacionadas con la conectividad.
X3 — Ingreso mensual: Representa la suma de los ingresos económicos de todos los integrantes del hogar. Según el DANE (2024), esta variable es clave para medir pobreza monetaria y capacidad adquisitiva. El ingreso fue codificado como una variable categórica ordinal con cinco rangos: Menos de $500k, $500k–$1M, $1M–$2M, $2M–$4M y Más de $4M. Se espera que los hogares con mayores ingresos tengan una mayor probabilidad de acceso a internet, ya que poseen más capacidad para asumir el costo del servicio. Por el contrario, los hogares con ingresos bajos suelen priorizar otros gastos básicos como alimentación y vivienda.
X4 — Nivel educativo: Representa el mayor nivel educativo alcanzado por el jefe del hogar (DANE, 2026). Se considera un indicador relevante del capital humano, las oportunidades laborales y el acceso a recursos tecnológicos. Se manejó como una variable categórica ordinal con seis categorías: Sin educación, Primaria, Secundaria, Técnico, Universitario y Posgrado. Se espera que mayores niveles educativos estén asociados con una mayor probabilidad de acceso a internet, debido a una mayor demanda de herramientas digitales para actividades académicas, laborales y de comunicación.
X5 — Zona de ubicación: Clasifica los hogares en urbanos o rurales. Esta variable resulta fundamental debido a las diferencias de infraestructura y cobertura en telecomunicaciones entre ambas zonas. En Colombia, las áreas urbanas presentan mayores niveles de conectividad y mejor infraestructura tecnológica, mientras que en las zonas rurales el acceso suele ser más limitado. Según Andesco (2026), aproximadamente el 72% de los hogares urbanos cuentan con internet, frente al 41.9% de los hogares rurales. La variable se trató como binaria (urbana/rural) y se espera que los hogares ubicados en zonas urbanas tengan una mayor probabilidad de acceso a internet debido a mejores condiciones de cobertura y disponibilidad del servicio.
Una vez seleccionadas las variables, se realizó el proceso de preparación de datos para garantizar un tratamiento adecuado en los modelos de clasificación. Las variables categóricas fueron convertidas a formato factor y organizadas según sus niveles correspondientes. Las variables de estrato y edad se mantuvieron como numéricas, mientras que ingreso mensual, nivel educativo y zona de ubicación se transformaron en variables categóricas. Posteriormente, se construyó un subconjunto de datos que incluía únicamente las variables necesarias para el análisis, descartando las demás variables presentes en la base original. Finalmente, se verificó la ausencia de valores faltantes (NA), confirmando que la información estaba completa para el desarrollo de los modelos.
base <- base %>%
mutate(
acceso_internet_f = factor(acceso_internet,
levels = c("No","Sí"),
labels = c("No","Si")),
estrato = as.numeric(estrato),
edad_jefe_hogar = as.numeric(edad_jefe_hogar),
ingreso_mensual = factor(ingreso_mensual,
levels = c("Menos de $500k","$500k-$1M",
"$1M-$2M","$2M-$4M","Más de $4M")),
nivel_educativo = factor(nivel_educativo,
levels = c("Sin educación","Primaria","Secundaria",
"Técnico","Universitario","Posgrado")),
zona = factor(zona, levels = c("Rural","Urbana"))
)
base_modelo <- base %>%
select(acceso_internet_f, estrato, edad_jefe_hogar,
ingreso_mensual, nivel_educativo, zona)
na_check <- colSums(is.na(base_modelo))
data.frame(Variable = names(na_check), Faltantes = as.integer(na_check)) %>%
kable(caption = "Verificación de valores faltantes", align = "c") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE,
font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2e7d32", color = "white")| Variable | Faltantes |
|---|---|
| acceso_internet_f | 0 |
| estrato | 0 |
| edad_jefe_hogar | 0 |
| ingreso_mensual | 0 |
| nivel_educativo | 0 |
| zona | 0 |
El conjunto de datos, compuesto por 1.000 hogares, se dividió en dos subconjuntos: el 75% se destinó al entrenamiento de los modelos y el 25% restante a la etapa de prueba. El conjunto de entrenamiento permitió que los algoritmos identificaran patrones entre las variables predictoras y el acceso a internet. Posteriormente, el conjunto de prueba se utilizó para evaluar la capacidad de generalización de los modelos y medir qué tan correctamente clasificaban hogares con y sin acceso a internet.
set.seed(28)
idx <- createDataPartition(y = base_modelo$acceso_internet_f, p = 0.75, list = FALSE)
train <- base_modelo[idx, ]
test <- base_modelo[-idx, ]
data.frame(
Conjunto = c("Entrenamiento","Prueba"),
Observaciones = c(nrow(train), nrow(test)),
Pct_No = c(round(prop.table(table(train$acceso_internet_f))[1]*100,1),
round(prop.table(table(test$acceso_internet_f))[1]*100,1)),
Pct_Si = c(round(prop.table(table(train$acceso_internet_f))[2]*100,1),
round(prop.table(table(test$acceso_internet_f))[2]*100,1))
) %>%
kable(caption = "Distribución de la variable dependiente en cada conjunto",
col.names = c("Conjunto","Observaciones","% Sin acceso","% Con acceso"),
align = "c") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE,
font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white") %>%
row_spec(1, background = "#f7f7f7") %>%
row_spec(2, background = "#ffffff")| Conjunto | Observaciones | % Sin acceso | % Con acceso |
|---|---|---|---|
| Entrenamiento | 751 | 30.0 | 70.0 |
| Prueba | 249 | 29.7 | 70.3 |
El modelo KNN es una técnica de aprendizaje supervisado no paramétrica basada en instancias, utilizada tanto para clasificación como para regresión. Su funcionamiento consiste en calcular la distancia entre una nueva observación y los datos de entrenamiento, clasificándola según la categoría predominante entre sus K vecinos más cercanos (IBM, 2026).
En este estudio, el algoritmo se utilizó para predecir si un hogar cuenta o no con acceso a internet. Para ello, el modelo identifica los hogares más similares dentro del conjunto de entrenamiento y asigna la clase mayoritaria entre dichos vecinos. La similitud entre observaciones se calculó mediante una medida de distancia considerando las cinco variables predictoras seleccionadas. Debido a que algunas variables presentan escalas diferentes, las variables numéricas fueron estandarizadas con media igual a 0 y desviación estándar igual a 1, evitando que una variable dominara el cálculo de distancia.
Para optimizar el parámetro K, se evaluaron ocho valores diferentes: 5, 7, 9, 11, 15, 21, 31 y 51. La selección se realizó mediante validación cruzada de 5 pliegues, técnica que divide los datos de entrenamiento en cinco partes, utilizando cuatro para entrenar y una para validar el modelo de manera rotativa. Finalmente, se seleccionó el valor de K que maximizó el área bajo la curva ROC (AUC), buscando un equilibrio entre modelos demasiado sensibles con valores pequeños de K y modelos excesivamente generalizados con valores grandes.
La regresión logística es un modelo de aprendizaje supervisado utilizado para problemas de clasificación binaria. Este modelo estima la probabilidad de ocurrencia de un evento a partir de una o más variables independientes, utilizando una función logística o sigmoide que transforma los resultados en valores entre 0 y 1 (IBM, 2026).
En esta investigación, el modelo Logit se empleó para estimar la probabilidad de que un hogar tenga acceso a internet. Una de sus principales ventajas es la interpretabilidad, ya que sus coeficientes permiten analizar cómo cambia la probabilidad del evento cuando una variable predictora varía, manteniendo constantes las demás variables. Para las variables categóricas, el modelo generó automáticamente variables indicadoras tomando como referencia la primera categoría de cada factor, específicamente Sin educación para el nivel educativo y Rural para la zona de ubicación.
Inicialmente, la clasificación se realizó utilizando un umbral de probabilidad de 0.50. Adicionalmente, se calculó el índice de Youden, medida que permite identificar el punto de corte óptimo maximizando simultáneamente sensibilidad y especificidad. Este ajuste resulta relevante en contextos donde tanto los falsos positivos como los falsos negativos tienen implicaciones importantes, como ocurre en la focalización de políticas públicas de conectividad.
Para evaluar el desempeño de los modelos se utilizaron diferentes métricas de clasificación. La exactitud (accuracy) permitió medir el porcentaje total de predicciones correctas realizadas sobre el conjunto de prueba. Sin embargo, debido al desbalance entre clases, esta métrica se complementó con el coeficiente Kappa, que evalúa el nivel de acuerdo del modelo descontando los aciertos esperados por azar.
También se analizaron la sensibilidad y la especificidad. La sensibilidad mide la capacidad del modelo para identificar correctamente los hogares que sí tienen acceso a internet, mientras que la especificidad evalúa qué tan bien detecta los hogares sin conexión. Estas métricas son especialmente importantes en el contexto de la brecha digital, ya que errores de clasificación pueden afectar la asignación eficiente de recursos públicos.
Adicionalmente, se calcularon el Valor Predictivo Positivo (PPV), que indica la proporción de hogares clasificados como “con internet” que realmente cuentan con el servicio, y el Valor Predictivo Negativo (NPV), que mide la precisión de las predicciones de la clase “sin internet”. Para obtener una medida más equilibrada en presencia de clases desbalanceadas, se utilizó la exactitud balanceada, calculada como el promedio entre sensibilidad y especificidad. Finalmente, se empleó el Área Bajo la Curva ROC (AUC), indicador que resume la capacidad general del modelo para distinguir entre hogares con y sin acceso a internet. En el caso del modelo Logit, también se evaluó el desempeño utilizando el umbral óptimo determinado mediante el índice de Youden.
| Métrica | Descripción |
|---|---|
| Accuracy | Proporción total de predicciones correctas. |
| Kappa | Acuerdo por encima del azar, descuenta aciertos aleatorios. |
| Sensibilidad | Proporción de hogares con internet detectados correctamente. |
| Especificidad | Proporción de hogares sin internet detectados correctamente. |
| PPV | De los clasificados como ‘con internet’, cuántos realmente lo tienen. |
| NPV | De los clasificados como ‘sin internet’, cuántos realmente no lo tienen. |
| Balanced Accuracy | Promedio de sensibilidad y especificidad; más justa ante clases desbalanceadas. |
| AUC | Capacidad discriminante global, independiente del umbral (0.5 = azar, 1.0 = perfecto). |
tabla_y <- base_modelo %>%
count(acceso_internet_f) %>%
mutate(Porcentaje = round(n / sum(n) * 100, 2)) %>%
rename(Categoría = acceso_internet_f, Frecuencia = n)
tabla_y %>%
kable(caption = "Distribución de la variable dependiente", align = "c") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE,
font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white")| Categoría | Frecuencia | Porcentaje |
|---|---|---|
| No | 299 | 29.9 |
| Si | 701 | 70.1 |
graf_y <- base_modelo %>%
count(acceso_internet_f) %>%
mutate(pct = round(n / sum(n) * 100, 1), etiqueta = paste0(pct, "%"))
plot_ly(graf_y, x = ~acceso_internet_f, y = ~pct, type = "bar",
color = ~acceso_internet_f,
colors = c("No" = "#c0392b","Si" = "#2c2c2c"),
text = ~etiqueta, textposition = "outside",
marker = list(line = list(color = "white", width = 1))) %>%
layout(title = list(text = "Distribución de hogares: Con y sin acceso a internet",
font = list(family = "Lato", size = 15)),
xaxis = list(title = "¿Tiene acceso a internet?"),
yaxis = list(title = "Porcentaje (%)", range = c(0, 85)),
showlegend = FALSE,
plot_bgcolor = "#ffffff", paper_bgcolor = "#ffffff")El análisis de la variable dependiente mostró que, de los 1.000 hogares incluidos en la muestra, el 70.1% (701 hogares) reportó tener acceso a internet, mientras que el 29.9% (299 hogares) indicó no contar con conectividad. Aunque la mayoría de los hogares dispone del servicio, los resultados evidencian que aproximadamente tres de cada diez hogares aún permanecen en situación de exclusión digital, confirmando la existencia de una brecha digital significativa en Colombia.
Esta distribución desigual entre categorías es relevante para la modelación, ya que los algoritmos de clasificación podrían presentar sesgos hacia la clase mayoritaria. Por esta razón, en etapas posteriores se aplicó una estrategia de muestreo para equilibrar las clases y mejorar la capacidad predictiva sobre los hogares sin acceso. No obstante, para el análisis descriptivo se mantuvo la distribución original de los datos con el fin de representar adecuadamente la situación de conectividad observada en la muestra.
tabla_estrato <- base_modelo %>%
count(estrato, acceso_internet_f) %>%
pivot_wider(names_from = acceso_internet_f, values_from = n, values_fill = 0) %>%
mutate(Total = No + Si,
Pct_Si = paste0(round(Si / Total * 100, 1), "%"),
Pct_No = paste0(round(No / Total * 100, 1), "%")) %>%
arrange(estrato)
tabla_estrato %>%
kable(caption = "Acceso a internet por estrato socioeconómico",
col.names = c("Estrato","Sin acceso","Con acceso","Total","% Con acceso","% Sin acceso"),
align = "c") %>%
kable_styling(bootstrap_options = c("striped","hover","condensed"),
full_width = FALSE, font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white") %>%
column_spec(1, bold = TRUE)| Estrato | Sin acceso | Con acceso | Total | % Con acceso | % Sin acceso |
|---|---|---|---|---|---|
| 1 | 113 | 112 | 225 | 49.8% | 50.2% |
| 2 | 97 | 139 | 236 | 58.9% | 41.1% |
| 3 | 46 | 181 | 227 | 79.7% | 20.3% |
| 4 | 31 | 128 | 159 | 80.5% | 19.5% |
| 5 | 11 | 96 | 107 | 89.7% | 10.3% |
| 6 | 1 | 45 | 46 | 97.8% | 2.2% |
datos_estrato <- base_modelo %>%
count(estrato, acceso_internet_f) %>%
group_by(estrato) %>%
mutate(pct = round(n / sum(n) * 100, 1))
plot_ly(datos_estrato, x = ~factor(estrato), y = ~pct,
color = ~acceso_internet_f,
colors = c("No" = "#c0392b","Si" = "#2c2c2c"),
type = "bar", text = ~paste0(pct, "%"), textposition = "inside",
marker = list(line = list(color = "white", width = 1))) %>%
layout(barmode = "stack",
title = list(text = "Proporción de acceso a internet por estrato socioeconómico",
font = list(family = "Lato", size = 14)),
xaxis = list(title = "Estrato socioeconómico"),
yaxis = list(title = "Porcentaje (%)", ticksuffix = "%"),
legend = list(title = list(text = "Acceso")),
plot_bgcolor = "#ffffff", paper_bgcolor = "#ffffff")El análisis entre estrato socioeconómico y acceso a internet evidencia un patrón claramente creciente: a medida que aumenta el estrato, también aumenta la proporción de hogares con conectividad. En el estrato 1, únicamente el 49.8% de los hogares reportó tener internet, lo que indica que cerca de la mitad de estos hogares permanece en exclusión digital. Posteriormente, la proporción aumenta progresivamente hasta alcanzar aproximadamente el 80% en el estrato 3 y el 97.8% en el estrato 6.
Este comportamiento puede explicarse por las diferencias en capacidad económica e infraestructura. Los hogares de estratos bajos suelen priorizar gastos básicos como alimentación y vivienda, mientras que los hogares de estratos altos poseen mayor capacidad de pago y generalmente se ubican en zonas con mejor cobertura de telecomunicaciones. Desde la perspectiva del modelo, el estrato socioeconómico representa una variable con alto poder predictivo, ya que permite anticipar con relativa claridad la probabilidad de que un hogar cuente con acceso a internet.
tabla_edad <- base_modelo %>%
group_by(acceso_internet_f) %>%
summarise(Media = round(mean(edad_jefe_hogar), 1),
Mediana = median(edad_jefe_hogar),
DE = round(sd(edad_jefe_hogar), 1),
Mín = min(edad_jefe_hogar),
Máx = max(edad_jefe_hogar))
tabla_edad %>%
kable(caption = "Estadísticas descriptivas de edad por grupo de acceso",
col.names = c("Acceso a internet","Media","Mediana","Desv. estándar","Mínimo","Máximo"),
align = "c") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE,
font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white")| Acceso a internet | Media | Mediana | Desv. estándar | Mínimo | Máximo |
|---|---|---|---|---|---|
| No | 47.7 | 46 | 17.9 | 18 | 79 |
| Si | 49.9 | 49 | 18.6 | 18 | 79 |
plot_ly(base_modelo, x = ~acceso_internet_f, y = ~edad_jefe_hogar,
color = ~acceso_internet_f,
colors = c("No" = "#c0392b","Si" = "#2c2c2c"),
type = "box", boxpoints = "outliers", jitter = 0.3, pointpos = 0) %>%
layout(title = list(text = "Distribución de edad del jefe del hogar por acceso a internet",
font = list(family = "Lato", size = 14)),
xaxis = list(title = "¿Tiene acceso a internet?"),
yaxis = list(title = "Edad (años)"),
showlegend = FALSE,
plot_bgcolor = "#ffffff", paper_bgcolor = "#ffffff")Al comparar la edad del jefe del hogar entre los grupos con y sin acceso a internet, se observó una diferencia moderada. Los hogares sin internet presentaron una edad promedio de 47.7 años, mientras que en los hogares con acceso el promedio fue de 49.9 años, equivalente a una diferencia de 2.2 años. Ambos grupos compartieron el mismo rango de edades, entre 18 y 79 años, además de desviaciones estándar similares, lo que indica una dispersión comparable entre los grupos.
Aunque inicialmente se esperaba que los hogares con jefes más jóvenes presentaran mayor conectividad, los resultados sugieren una relación más compleja. Esto podría explicarse porque hogares con jefes de mayor edad suelen presentar mayor estabilidad económica, mayores ingresos y necesidades digitales asociadas a actividades laborales o educativas del hogar. Por tanto, la edad aporta información relevante, aunque su efecto debe interpretarse junto con variables como ingreso y estrato socioeconómico, ya que por sí sola no determina el acceso a internet.
tabla_ingreso <- base_modelo %>%
count(ingreso_mensual, acceso_internet_f) %>%
pivot_wider(names_from = acceso_internet_f, values_from = n, values_fill = 0) %>%
mutate(Total = No + Si,
Pct_Si = paste0(round(Si / Total * 100, 1), "%")) %>%
arrange(ingreso_mensual)
tabla_ingreso %>%
kable(caption = "Acceso a internet por rango de ingreso mensual",
col.names = c("Ingreso mensual","Sin acceso","Con acceso","Total","% Con acceso"),
align = "c") %>%
kable_styling(bootstrap_options = c("striped","hover","condensed"),
full_width = FALSE, font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white") %>%
column_spec(5, bold = TRUE)| Ingreso mensual | Sin acceso | Con acceso | Total | % Con acceso |
|---|---|---|---|---|
| Menos de $500k | 88 | 71 | 159 | 44.7% |
| $500k-$1M | 105 | 147 | 252 | 58.3% |
| $1M-$2M | 69 | 255 | 324 | 78.7% |
| $2M-$4M | 29 | 146 | 175 | 83.4% |
| Más de $4M | 8 | 82 | 90 | 91.1% |
datos_ingreso <- base_modelo %>%
count(ingreso_mensual, acceso_internet_f) %>%
group_by(ingreso_mensual) %>%
mutate(pct = round(n / sum(n) * 100, 1))
plot_ly(datos_ingreso, x = ~ingreso_mensual, y = ~pct,
color = ~acceso_internet_f,
colors = c("No" = "#c0392b","Si" = "#2c2c2c"),
type = "bar", text = ~paste0(pct, "%"), textposition = "inside",
marker = list(line = list(color = "white", width = 1))) %>%
layout(barmode = "stack",
title = list(text = "Proporción de acceso a internet por ingreso mensual",
font = list(family = "Lato", size = 14)),
xaxis = list(title = "Rango de ingreso", tickangle = -15),
yaxis = list(title = "Porcentaje (%)", ticksuffix = "%"),
legend = list(title = list(text = "Acceso")),
plot_bgcolor = "#ffffff", paper_bgcolor = "#ffffff")El ingreso mensual del hogar también mostró una relación progresiva con el acceso a internet. En el rango más bajo de ingresos, inferior a $500.000 mensuales, solo el 44.7% de los hogares reportó tener acceso. En contraste, los hogares con ingresos entre $1M y $2M alcanzaron una conectividad del 79.7%, mientras que en los hogares con ingresos superiores a $4M el porcentaje ascendió al 91.1%. Este patrón refleja que la capacidad económica es un factor determinante para contratar y mantener el servicio de internet, convirtiendo al ingreso mensual en una de las variables con mayor capacidad explicativa dentro del modelo.
tabla_educ <- base_modelo %>%
count(nivel_educativo, acceso_internet_f) %>%
pivot_wider(names_from = acceso_internet_f, values_from = n, values_fill = 0) %>%
mutate(Total = No + Si,
Pct_Si = paste0(round(Si / Total * 100, 1), "%")) %>%
arrange(nivel_educativo)
tabla_educ %>%
kable(caption = "Acceso a internet por nivel educativo del jefe del hogar",
col.names = c("Nivel educativo","Sin acceso","Con acceso","Total","% Con acceso"),
align = "c") %>%
kable_styling(bootstrap_options = c("striped","hover","condensed"),
full_width = FALSE, font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white") %>%
column_spec(5, bold = TRUE)| Nivel educativo | Sin acceso | Con acceso | Total | % Con acceso |
|---|---|---|---|---|
| Sin educación | 41 | 13 | 54 | 24.1% |
| Primaria | 85 | 100 | 185 | 54.1% |
| Secundaria | 119 | 236 | 355 | 66.5% |
| Técnico | 30 | 148 | 178 | 83.1% |
| Universitario | 21 | 147 | 168 | 87.5% |
| Posgrado | 3 | 57 | 60 | 95% |
tabla_zona <- base_modelo %>%
count(zona, acceso_internet_f) %>%
pivot_wider(names_from = acceso_internet_f, values_from = n, values_fill = 0) %>%
mutate(Total = No + Si,
Pct_Si = paste0(round(Si / Total * 100, 1), "%"))
tabla_zona %>%
kable(caption = "Acceso a internet por zona de ubicación",
col.names = c("Zona","Sin acceso","Con acceso","Total","% Con acceso"),
align = "c") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE,
font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white") %>%
column_spec(5, bold = TRUE)| Zona | Sin acceso | Con acceso | Total | % Con acceso |
|---|---|---|---|---|
| Rural | 141 | 166 | 307 | 54.1% |
| Urbana | 158 | 535 | 693 | 77.2% |
datos_educ <- base_modelo %>%
count(nivel_educativo, acceso_internet_f) %>%
group_by(nivel_educativo) %>%
mutate(pct = round(n / sum(n) * 100, 1))
graf_educ <- plot_ly(datos_educ, x = ~nivel_educativo, y = ~pct,
color = ~acceso_internet_f,
colors = c("No" = "#c0392b","Si" = "#2c2c2c"),
type = "bar", text = ~paste0(pct, "%"), textposition = "inside",
marker = list(line = list(color = "white", width = 1))) %>%
layout(barmode = "stack",
title = list(text = "Nivel educativo (X4)", font = list(size = 13)),
xaxis = list(title = "", tickangle = -20),
yaxis = list(title = "Porcentaje (%)", ticksuffix = "%"),
legend = list(title = list(text = "Acceso")),
plot_bgcolor = "#ffffff", paper_bgcolor = "#ffffff")
datos_zona <- base_modelo %>%
count(zona, acceso_internet_f) %>%
group_by(zona) %>%
mutate(pct = round(n / sum(n) * 100, 1))
graf_zona <- plot_ly(datos_zona, x = ~zona, y = ~pct,
color = ~acceso_internet_f,
colors = c("No" = "#c0392b","Si" = "#2c2c2c"),
type = "bar", text = ~paste0(pct, "%"), textposition = "inside",
marker = list(line = list(color = "white", width = 1)),
showlegend = FALSE) %>%
layout(barmode = "stack",
title = list(text = "Zona de ubicación (X5)", font = list(size = 13)),
xaxis = list(title = ""),
yaxis = list(title = "", ticksuffix = "%"),
plot_bgcolor = "#ffffff", paper_bgcolor = "#ffffff")
subplot(graf_educ, graf_zona, nrows = 1, shareY = TRUE, titleX = TRUE,
widths = c(0.65, 0.35))Nivel educativo (X4): El nivel educativo del jefe del hogar mostró una relación positiva con el acceso a internet. Entre los hogares cuyo jefe no posee educación formal, únicamente el 24.1% reportó tener acceso. Posteriormente, la conectividad aumenta progresivamente: 54.1% en primaria, 66.5% en secundaria, 83.1% en técnico, 87.5% en universitario y 95% en posgrado. Estos resultados sugieren que la educación se encuentra fuertemente asociada con la adopción tecnológica, complementando factores económicos y territoriales asociados a la brecha digital.
Zona de ubicación (X5): Los resultados evidencian una brecha territorial importante: los hogares ubicados en zonas urbanas presentan una tasa de conectividad del 77.2%, mientras que en las zonas rurales esta proporción disminuye hasta el 54.1%, representando una diferencia cercana a 23 puntos porcentuales. Esta desigualdad puede explicarse principalmente por las diferencias en infraestructura y cobertura de telecomunicaciones. Desde el punto de vista del modelo, la zona de ubicación aporta información sobre restricciones estructurales que van más allá de las condiciones individuales del hogar, siendo fundamental para identificar barreras territoriales asociadas a la conectividad.
set.seed(28)
knn_entrenado <- train(
acceso_internet_f ~ .,
data = train,
method = "knn",
tuneGrid = data.frame(k = c(5, 7, 9, 11, 15, 21, 31, 51)),
preProcess = c("center","scale"),
trControl = trainControl(method = "cv", number = 5,
classProbs = TRUE,
summaryFunction = twoClassSummary),
metric = "ROC"
)
knn_resultados <- knn_entrenado$results %>% select(k, ROC, Sens, Spec)
knn_resultados %>%
mutate(across(c(ROC, Sens, Spec), ~round(., 4))) %>%
kable(caption = "AUC por valor de k en validación cruzada",
col.names = c("k","AUC","Sensibilidad","Especificidad"), align = "c") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE,
font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#1565c0", color = "white") %>%
row_spec(which(knn_resultados$k == knn_entrenado$bestTune$k),
bold = TRUE, background = "#e8f5e9",
extra_css = "border-left: 4px solid #2e7d32;")| k | AUC | Sensibilidad | Especificidad |
|---|---|---|---|
| 5 | 0.8402 | 0.5867 | 0.8860 |
| 7 | 0.8499 | 0.5733 | 0.8897 |
| 9 | 0.8532 | 0.5556 | 0.9068 |
| 11 | 0.8554 | 0.5333 | 0.9088 |
| 15 | 0.8610 | 0.4978 | 0.9353 |
| 21 | 0.8451 | 0.4489 | 0.9410 |
| 31 | 0.8215 | 0.4222 | 0.9335 |
| 51 | 0.8049 | 0.3822 | 0.9220 |
plot_ly(knn_resultados, x = ~k, y = ~ROC, type = "scatter", mode = "lines+markers",
line = list(color = "#1565c0", width = 2.5),
marker = list(color = "#1565c0", size = 9,
line = list(color = "white", width = 2)),
text = ~paste0("k = ", k, "<br>AUC = ", round(ROC, 4)),
hoverinfo = "text") %>%
add_segments(x = knn_entrenado$bestTune$k, xend = knn_entrenado$bestTune$k,
y = min(knn_resultados$ROC) - 0.01,
yend = max(knn_resultados$ROC) + 0.005,
line = list(color = "#c0392b", dash = "dot", width = 1.5),
name = paste0("k óptimo = ", knn_entrenado$bestTune$k)) %>%
layout(title = list(text = "Optimización del parámetro k — AUC en validación cruzada",
font = list(family = "Lato", size = 14)),
xaxis = list(title = "Número de vecinos (k)"),
yaxis = list(title = "AUC", range = c(0.78, 0.88)),
plot_bgcolor = "#ffffff", paper_bgcolor = "#ffffff")El modelo KNN fue evaluado mediante validación cruzada de 5 pliegues sobre el conjunto de entrenamiento, identificándose que el valor óptimo para el parámetro K corresponde a 15 vecinos. Esta selección se realizó utilizando como criterio principal la maximización del área bajo la curva ROC (AUC), priorizando así la capacidad del modelo para diferenciar correctamente entre hogares con y sin acceso a internet, independientemente del umbral de clasificación utilizado posteriormente.
El comportamiento del AUC a través de los ocho valores evaluados mostró una mejora progresiva desde K = 5 (AUC = 0.840) hasta alcanzar su máximo desempeño en K = 15 (AUC = 0.861). Posteriormente, el rendimiento comenzó a disminuir a medida que aumentaba el número de vecinos. Esto indica que valores demasiado pequeños de K producen modelos más sensibles e inestables, mientras que valores demasiado grandes generan modelos excesivamente generalizados, perdiendo capacidad para capturar patrones relevantes dentro de los datos.
knn_pred <- predict(knn_entrenado, newdata = test)
knn_pred_prob <- predict(knn_entrenado, newdata = test, type = "prob")
cm_knn <- confusionMatrix(knn_pred, test$acceso_internet_f, positive = "Si")
acc_knn <- cm_knn$overall["Accuracy"]
kappa_knn <- cm_knn$overall["Kappa"]
sens_knn <- cm_knn$byClass["Sensitivity"]
spec_knn <- cm_knn$byClass["Specificity"]
ppv_knn <- cm_knn$byClass["Pos Pred Value"]
npv_knn <- cm_knn$byClass["Neg Pred Value"]
bal_acc_knn <- cm_knn$byClass["Balanced Accuracy"]
head(data.frame(Real = test$acceso_internet_f,
Predicho = knn_pred,
Prob_No = round(knn_pred_prob$No, 3),
Prob_Si = round(knn_pred_prob$Si, 3)), 10) %>%
kable(caption = "Primeras 10 predicciones del modelo KNN", align = "c") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE,
font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white")| Real | Predicho | Prob_No | Prob_Si |
|---|---|---|---|
| No | No | 0.533 | 0.467 |
| Si | No | 0.533 | 0.467 |
| No | Si | 0.200 | 0.800 |
| No | No | 0.733 | 0.267 |
| Si | Si | 0.333 | 0.667 |
| No | No | 1.000 | 0.000 |
| Si | Si | 0.000 | 1.000 |
| Si | Si | 0.133 | 0.867 |
| No | Si | 0.133 | 0.867 |
| No | No | 0.533 | 0.467 |
La tabla de predicciones presenta las primeras diez observaciones clasificadas por el modelo KNN sobre el conjunto de prueba. En cada caso, las columnas Prob_No y Prob_Si representan el nivel de confianza asignado por el algoritmo a cada categoría. Por ejemplo, en la primera observación el modelo asignó una probabilidad de 0.533 a la categoría “No” y 0.467 a la categoría “Sí”. Debido a que la probabilidad de acceso no supera el umbral del 50%, la predicción final corresponde a “No”, coincidiendo correctamente con el valor real.
Al evaluar el modelo KNN con k = 15 sobre el conjunto de prueba, se obtuvo una exactitud global de 77.1%, superando estadísticamente la tasa de no información del 70.28% (p = 0.0098), lo que confirma que el modelo posee capacidad predictiva real. La matriz de confusión muestra que, de los 175 hogares que realmente tenían acceso a internet, el modelo identificó correctamente 154, alcanzando una sensibilidad del 88%. Sin embargo, de los 74 hogares sin internet, únicamente 38 fueron identificados correctamente, obteniendo una especificidad de 51.4%, lo que genera 36 falsos positivos.
El coeficiente Kappa de 0.418 representa una concordancia moderada entre las predicciones y los valores reales más allá del azar. El PPV alcanzó un 81.05%, indicando que cuando el modelo predice “Con internet”, acierta aproximadamente en 8 de cada 10 casos, mientras que el NPV fue de 64.41%. La exactitud balanceada de 0.697 refleja que el modelo mantiene un rendimiento moderado en ambas categorías, con una ligera preferencia hacia la detección de hogares conectados.
pred_knn_rocr <- prediction(knn_pred_prob[,"Si"],
as.numeric(test$acceso_internet_f == "Si"))
perf_knn <- performance(pred_knn_rocr, "tpr", "fpr")
auc_knn_obj <- performance(pred_knn_rocr, "auc")
auc_knn <- auc_knn_obj@y.values[[1]]
roc_knn_data <- data.frame(FPR = perf_knn@x.values[[1]],
TPR = perf_knn@y.values[[1]])
plot_ly(roc_knn_data, x = ~FPR, y = ~TPR, type = "scatter", mode = "lines",
line = list(color = "#2c2c2c", width = 2),
name = sprintf("KNN (AUC = %.3f)", auc_knn),
fill = "tozeroy", fillcolor = "rgba(44,44,44,0.07)") %>%
add_trace(x = c(0,1), y = c(0,1), type = "scatter", mode = "lines",
line = list(color = "#cccccc", dash = "dash", width = 1),
name = "Azar") %>%
layout(title = list(text = sprintf("Curva ROC — KNN | AUC = %.3f", auc_knn),
font = list(family = "Lato", size = 14)),
xaxis = list(title = "Tasa de Falsos Positivos"),
yaxis = list(title = "Tasa de Verdaderos Positivos"),
plot_bgcolor = "#ffffff", paper_bgcolor = "#ffffff")La curva ROC del modelo KNN optimizado mostró un AUC de 0.823 sobre el conjunto de prueba, valor ligeramente inferior al 0.861 obtenido durante la validación cruzada. Esta diferencia relativamente pequeña indica que el modelo conserva una buena capacidad de generalización y no presenta señales importantes de sobreajuste. El valor de AUC = 0.823 implica que el modelo tiene una probabilidad del 82.3% de clasificar correctamente un hogar con acceso a internet por encima de un hogar sin conexión seleccionado aleatoriamente.
fit_logit <- glm(acceso_internet_f ~ ., data = train, family = binomial())
or_tabla <- data.frame(
Variable = names(exp(coef(fit_logit))),
OR = round(exp(coef(fit_logit)), 3),
IC_2.5 = round(exp(confint(fit_logit))[,1], 3),
IC_97.5 = round(exp(confint(fit_logit))[,2], 3)
) %>%
mutate(Significativo = ifelse(IC_2.5 > 1 | IC_97.5 < 1, "✔", ""))
or_tabla %>%
kable(caption = "Odds Ratios e intervalos de confianza al 95% — Modelo Logit",
col.names = c("Variable","OR","IC 2.5%","IC 97.5%","Sig. (IC no cruza 1)"),
align = c("l","c","c","c","c")) %>%
kable_styling(bootstrap_options = c("striped","hover","condensed"),
full_width = TRUE, font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white") %>%
row_spec(which(or_tabla$IC_2.5 > 1), background = "#f7f7f7") %>%
column_spec(2, bold = TRUE)| Variable | OR | IC 2.5% | IC 97.5% | Sig. (IC no cruza 1) | |
|---|---|---|---|---|---|
| (Intercept) | (Intercept) | 0.000 | 0.000 | 0.001 | ✔ |
| estrato | estrato | 2.777 | 2.275 | 3.450 | ✔ |
| edad_jefe_hogar | edad_jefe_hogar | 1.009 | 0.996 | 1.021 | |
| ingreso_mensual$500k-$1M | ingreso_mensual$500k-$1M | 4.767 | 2.460 | 9.470 | ✔ |
| ingreso_mensual$1M-$2M | ingreso_mensual$1M-$2M | 18.711 | 9.259 | 39.438 | ✔ |
| ingreso_mensual$2M-$4M | ingreso_mensual$2M-$4M | 61.475 | 25.210 | 161.496 | ✔ |
| ingreso_mensualMás de $4M | ingreso_mensualMás de $4M | 92.688 | 29.792 | 330.656 | ✔ |
| nivel_educativoPrimaria | nivel_educativoPrimaria | 5.424 | 1.970 | 16.190 | ✔ |
| nivel_educativoSecundaria | nivel_educativoSecundaria | 22.322 | 8.251 | 67.042 | ✔ |
| nivel_educativoTécnico | nivel_educativoTécnico | 99.281 | 31.237 | 353.965 | ✔ |
| nivel_educativoUniversitario | nivel_educativoUniversitario | 191.652 | 57.730 | 717.853 | ✔ |
| nivel_educativoPosgrado | nivel_educativoPosgrado | 338.905 | 62.174 | 2868.451 | ✔ |
| zonaUrbana | zonaUrbana | 9.951 | 5.929 | 17.257 | ✔ |
or_plot <- or_tabla %>%
filter(Variable != "(Intercept)") %>%
mutate(Variable = reorder(Variable, OR))
plot_ly(or_plot, y = ~Variable, x = ~OR, type = "scatter", mode = "markers",
error_x = list(type = "data", symmetric = FALSE,
array = or_plot$IC_97.5 - or_plot$OR,
arrayminus = or_plot$OR - or_plot$IC_2.5,
color = "#aaaaaa"),
marker = list(color = "#c0392b", size = 10,
line = list(color = "white", width = 1.5))) %>%
add_segments(x = 1, xend = 1, y = 0.5, yend = nrow(or_plot) + 0.5,
line = list(color = "#2c2c2c", dash = "dot", width = 1.2),
showlegend = FALSE) %>%
layout(title = list(text = "Odds Ratios con intervalos de confianza al 95%",
font = list(family = "Lato", size = 14)),
xaxis = list(title = "Odds Ratio (escala logarítmica)", type = "log"),
yaxis = list(title = ""),
plot_bgcolor = "#ffffff", paper_bgcolor = "#ffffff")El modelo de regresión logística fue entrenado utilizando el 75% de los datos disponibles, estimando la probabilidad de acceso a internet a partir de las cinco variables seleccionadas. La mayoría de los coeficientes obtenidos resultaron estadísticamente significativos con valores p < 0.01, confirmando que las variables incluidas mantienen una relación real con el acceso a internet en los hogares colombianos. La única excepción fue la variable correspondiente a la edad del jefe del hogar (p = 0.178), indicando que, una vez controlados factores económicos, educativos y territoriales, la edad por sí sola aporta poca información adicional para explicar la conectividad del hogar.
Al exponenciar los coeficientes del modelo se obtuvieron los Odds Ratios (OR). El estrato socioeconómico presentó un OR de 2.777, indicando que por cada incremento de un nivel en el estrato, las odds de contar con internet se multiplican aproximadamente por 2.8. El ingreso mensual mostró un patrón escalonado muy marcado: comparando con el grupo de referencia (ingresos inferiores a $500.000), los hogares con $500k–$1M tienen odds 4.77 veces mayores, escalando a 18.71 para $1M–$2M, 61.48 para $2M–$4M y 92.68 para ingresos superiores a $4M. El nivel educativo presentó uno de los efectos más fuertes: de OR ≈ 5.42 (primaria) hasta OR ≈ 338.90 (posgrado) frente al grupo sin educación formal. Finalmente, la zona urbana mostró un OR de 9.95, confirmando que incluso controlando por estrato, ingreso y educación, los hogares urbanos tienen odds casi diez veces mayores que los rurales. Los intervalos de confianza al 95% confirman la significancia estadística de todos estos efectos, ya que ninguno incluye el valor 1.
p_hat <- predict(fit_logit, newdata = test, type = "response")
roc_logit <- roc(response = test$acceso_internet_f,
predictor = p_hat,
levels = c("No","Si"))
thr <- coords(roc_logit, x = "best", best.method = "youden", ret = "threshold")
umbral <- as.numeric(thr)
pred_clase_opt <- factor(ifelse(p_hat >= umbral, "Si", "No"), levels = c("No","Si"))
cm_logit <- confusionMatrix(pred_clase_opt, test$acceso_internet_f, positive = "Si")
acc_logit <- cm_logit$overall["Accuracy"]
kappa_logit <- cm_logit$overall["Kappa"]
sens_logit <- cm_logit$byClass["Sensitivity"]
spec_logit <- cm_logit$byClass["Specificity"]
ppv_logit <- cm_logit$byClass["Pos Pred Value"]
npv_logit <- cm_logit$byClass["Neg Pred Value"]
bal_acc_logit <- cm_logit$byClass["Balanced Accuracy"]
auc_logit <- auc(roc_logit)
data.frame(
Métrica = c("Accuracy","Kappa","Sensibilidad","Especificidad",
"PPV","NPV","Balanced Accuracy","AUC"),
Valor = round(c(acc_logit, kappa_logit, sens_logit, spec_logit,
ppv_logit, npv_logit, bal_acc_logit, auc_logit), 4)
) %>%
kable(caption = sprintf("Métricas del modelo Logit (umbral Youden = %.4f)", umbral),
align = "c") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE,
font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white")| Métrica | Valor | |
|---|---|---|
| Accuracy | Accuracy | 0.7590 |
| Kappa | Kappa | 0.5266 |
| Sensitivity | Sensibilidad | 0.6686 |
| Specificity | Especificidad | 0.9730 |
| Pos Pred Value | PPV | 0.9832 |
| Neg Pred Value | NPV | 0.5538 |
| Balanced Accuracy | Balanced Accuracy | 0.8208 |
| AUC | 0.8950 |
Con el umbral óptimo de Youden (0.8609), el Logit prioriza la especificidad (97.3%), siendo casi perfecto para identificar hogares sin internet, aunque detecta correctamente solo el 66.9% de los conectados. La exactitud balanceada de 0.821 confirma un balance más equitativo entre clases que el KNN.
head(data.frame(Real = test$acceso_internet_f,
Predicho = pred_clase_opt,
Prob_Si = round(p_hat, 3)), 10) %>%
kable(caption = "Primeras 10 predicciones del modelo Logit (umbral Youden)",
align = "c") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE,
font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white")| Real | Predicho | Prob_Si |
|---|---|---|
| No | No | 0.220 |
| Si | Si | 0.946 |
| No | No | 0.659 |
| No | No | 0.026 |
| Si | Si | 0.913 |
| No | No | 0.006 |
| Si | Si | 0.996 |
| Si | No | 0.845 |
| No | No | 0.821 |
| No | No | 0.211 |
Las primeras predicciones realizadas por el modelo Logit muestran que, en la mayoría de los casos, las clasificaciones coinciden correctamente con los valores reales observados. Por ejemplo, en la fila 2 el modelo asignó una probabilidad de 0.946 a la categoría “Sí”, predicción que coincide con la realidad del hogar evaluado. En la fila 4 se asignó una probabilidad de apenas 0.026, clasificando correctamente al hogar dentro de la categoría “No”. Sin embargo, también se presentan errores: en la fila 3 el modelo genera un falso positivo al asignar una probabilidad de 0.659 a un hogar que realmente no cuenta con internet, y algo similar ocurre en la fila 9. Cuando las probabilidades se acercan a 0 o 1, como en las filas 6 y 7, el modelo demuestra una alta certeza y logra clasificaciones correctas con mayor consistencia.
Al evaluar el modelo Logit con el umbral clásico de 0.50 sobre el conjunto de prueba, se obtuvo una exactitud global de 79.92%, sensibilidad de 87.43% y especificidad de 62.16%. El coeficiente Kappa fue de 0.508, el PPV de 84.5% y la exactitud balanceada de 74.80%.
Con el propósito de mejorar el equilibrio entre sensibilidad y especificidad, se aplicó el índice de Youden para identificar el umbral óptimo de clasificación, el cual maximiza simultáneamente ambas métricas mediante la expresión: J = Sensibilidad + Especificidad − 1. Este ajuste resulta especialmente relevante en el contexto de políticas públicas de conectividad, donde clasificar incorrectamente un hogar desconectado como conectado puede generar asignaciones ineficientes de recursos, mientras que no detectar un hogar sin acceso puede excluir poblaciones vulnerables de programas de inclusión digital.
Al aplicar el umbral óptimo de Youden (0.8609), la especificidad aumentó considerablemente hasta 97.3% y el PPV alcanzó 98.32%, a costa de reducir la sensibilidad a 66.86%. La exactitud balanceada mejoró de 74.80% a 82.08%, confirmando que el umbral de Youden logra un equilibrio global superior. La elección entre umbrales depende del objetivo: el umbral de 0.5 es más adecuado cuando se busca maximizar la detección de hogares conectados, mientras que el umbral de Youden es superior para focalizar subsidios y minimizar falsos positivos.
roc_df <- data.frame(FPR = 1 - roc_logit$specificities,
TPR = roc_logit$sensitivities)
plot_ly(roc_df, x = ~FPR, y = ~TPR, type = "scatter", mode = "lines",
line = list(color = "#c0392b", width = 2),
name = sprintf("Logit (AUC = %.3f)", auc_logit),
fill = "tozeroy", fillcolor = "rgba(192,57,43,0.07)") %>%
add_trace(x = c(0,1), y = c(0,1), type = "scatter", mode = "lines",
line = list(color = "#cccccc", dash = "dash", width = 1),
name = "Azar") %>%
layout(title = list(text = sprintf("Curva ROC — Logit | AUC = %.3f | Umbral = %.3f",
auc_logit, umbral),
font = list(family = "Lato", size = 14)),
xaxis = list(title = "Tasa de Falsos Positivos"),
yaxis = list(title = "Tasa de Verdaderos Positivos"),
plot_bgcolor = "#ffffff", paper_bgcolor = "#ffffff")La curva ROC del modelo de regresión logística evidencia una capacidad discriminante sólida, alcanzando un AUC de 0.895, valor que supera de manera importante al obtenido por el modelo KNN (0.823). La forma de la curva se aproxima claramente a la esquina superior izquierda del gráfico, indicando una alta capacidad para distinguir entre hogares con y sin acceso a internet. El umbral óptimo de 0.8609 —considerablemente alto— indica que el modelo exige una probabilidad estimada muy elevada para clasificar un hogar como conectado, lo que explica la especificidad tan alta observada en la matriz de confusión.
comparacion <- data.frame(
Metrica = c("Accuracy","Kappa","Sensibilidad","Especificidad",
"PPV","NPV","Balanced Accuracy","AUC"),
KNN = round(c(acc_knn, kappa_knn, sens_knn, spec_knn,
ppv_knn, npv_knn, bal_acc_knn, auc_knn), 4),
Logit = round(c(acc_logit, kappa_logit, sens_logit, spec_logit,
ppv_logit, npv_logit, bal_acc_logit, auc_logit), 4)
) %>%
mutate(Mejor = ifelse(KNN > Logit, "KNN", ifelse(Logit > KNN, "Logit", "Empate")))
comparacion %>%
kable(caption = "Tabla comparativa de métricas: KNN vs Logit", align = "c") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE,
font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white") %>%
row_spec(which(comparacion$Mejor == "Logit"), background = "#f7f7f7") %>%
column_spec(4, bold = TRUE)| Metrica | KNN | Logit | Mejor | |
|---|---|---|---|---|
| Accuracy | Accuracy | 0.7711 | 0.7590 | KNN |
| Kappa | Kappa | 0.4180 | 0.5266 | Logit |
| Sensitivity | Sensibilidad | 0.8800 | 0.6686 | KNN |
| Specificity | Especificidad | 0.5135 | 0.9730 | Logit |
| Pos Pred Value | PPV | 0.8105 | 0.9832 | Logit |
| Neg Pred Value | NPV | 0.6441 | 0.5538 | KNN |
| Balanced Accuracy | Balanced Accuracy | 0.6968 | 0.8208 | Logit |
| AUC | 0.8231 | 0.8950 | Logit |
roc_knn_orig <- roc(response = test$acceso_internet_f,
predictor = knn_pred_prob[,"Si"],
levels = c("No","Si"))
roc_knn_df <- data.frame(FPR = 1 - roc_knn_orig$specificities,
TPR = roc_knn_orig$sensitivities)
plot_ly() %>%
add_trace(data = roc_knn_df, x = ~FPR, y = ~TPR,
type = "scatter", mode = "lines",
line = list(color = "#2c2c2c", width = 2),
name = sprintf("KNN (AUC = %.3f)", auc_knn)) %>%
add_trace(data = roc_df, x = ~FPR, y = ~TPR,
type = "scatter", mode = "lines",
line = list(color = "#c0392b", width = 2),
name = sprintf("Logit (AUC = %.3f)", auc_logit)) %>%
add_trace(x = c(0,1), y = c(0,1), type = "scatter", mode = "lines",
line = list(color = "#cccccc", dash = "dash", width = 1),
name = "Azar") %>%
layout(title = list(text = "Comparación de Curvas ROC: KNN vs Logit",
font = list(family = "Lato", size = 14)),
xaxis = list(title = "Tasa de Falsos Positivos"),
yaxis = list(title = "Tasa de Verdaderos Positivos"),
plot_bgcolor = "#ffffff", paper_bgcolor = "#ffffff")comparacion %>%
filter(Metrica != "Kappa") %>%
pivot_longer(cols = c(KNN, Logit), names_to = "Modelo", values_to = "Valor") %>%
plot_ly(x = ~Valor, y = ~Metrica, color = ~Modelo,
colors = c("KNN" = "#2c2c2c","Logit" = "#c0392b"),
type = "bar", orientation = "h",
text = ~round(Valor, 3), textposition = "outside",
marker = list(line = list(color = "white", width = 1))) %>%
layout(barmode = "group",
title = list(text = "Comparación de métricas: KNN vs Logit",
font = list(family = "Lato", size = 14)),
xaxis = list(title = "Valor", range = c(0, 1.1)),
yaxis = list(title = ""),
legend = list(title = list(text = "Modelo")),
plot_bgcolor = "#ffffff", paper_bgcolor = "#ffffff")La comparación integral entre los modelos KNN y regresión logística permite observar diferencias importantes en términos de desempeño predictivo y utilidad práctica. En general, el modelo Logit con umbral óptimo de Youden supera al KNN en cinco de las ocho métricas evaluadas, destacándose especialmente en capacidad discriminante global, exactitud balanceada y coeficiente Kappa. El Logit obtuvo un AUC de 0.895 frente al 0.823 del KNN, una exactitud balanceada de 82.08% frente al 69.68% y un Kappa de 0.527 frente a 0.418.
Sin embargo, el modelo KNN mostró ventajas puntuales: la exactitud global fue ligeramente superior (77.11% frente a 75.90%) y presentó una sensibilidad más alta (88% frente a 66.86%), detectando mejor los hogares que sí poseen internet. Por el contrario, el modelo Logit priorizó claramente la especificidad (97.3% frente a 51.35%) y obtuvo un PPV de 98.32%, indicando que cuando clasifica un hogar como “con internet”, prácticamente nunca se equivoca.
La comparación visual de las curvas ROC confirma la superioridad del Logit: su curva se mantiene consistentemente por encima de la del KNN en casi todo el rango de especificidad, y asciende más rápidamente en los tramos iniciales de alta especificidad, indicando que logra identificar hogares conectados manteniendo simultáneamente un mejor control sobre los falsos positivos. Considerando el contexto de políticas públicas para reducir la brecha digital en Colombia, el Logit con umbral de Youden se posiciona como la opción más adecuada, ya que su alta especificidad y PPV minimizan el riesgo de falsos positivos, permitiendo focalizar intervenciones en hogares verdaderamente desconectados con mayor certeza estadística.
set.seed(28)
base_si <- base_modelo %>% filter(acceso_internet_f == "Si")
base_no <- base_modelo %>% filter(acceso_internet_f == "No")
base_si_sub <- base_si %>% slice_sample(n = 350)
base_sub <- bind_rows(base_si_sub, base_no)
data.frame(
Categoría = c("Con acceso (Si)","Sin acceso (No)","Total"),
Base_original = c(701, 299, 1000),
Base_sub = c(350, 299, 649),
Pct_original = c("70.1%","29.9%","100%"),
Pct_sub = c("53.9%","46.1%","100%")
) %>%
kable(caption = "Comparación de distribución: base original vs base submuestreada",
col.names = c("Categoría","N original","N submuestreada","% original","% submuestreada"),
align = "c") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE,
font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white") %>%
row_spec(3, bold = TRUE, background = "#f7f7f7")| Categoría | N original | N submuestreada | % original | % submuestreada |
|---|---|---|---|---|
| Con acceso (Si) | 701 | 350 | 70.1% | 53.9% |
| Sin acceso (No) | 299 | 299 | 29.9% | 46.1% |
| Total | 1000 | 649 | 100% | 100% |
La base original presenta un desbalance de 70.1% frente a 29.9%, lo que puede inducir sesgos hacia la clase mayoritaria durante el entrenamiento de los modelos. Para mitigar este problema se aplicó una estrategia de undersampling, seleccionando aleatoriamente 350 hogares con acceso a internet (de los 701 disponibles) y conservando los 299 hogares sin acceso. Como resultado, la nueva distribución quedó en 53.9% Sí / 46.1% No, considerablemente más equilibrada.
set.seed(28)
idx_sub <- createDataPartition(y = base_sub$acceso_internet_f, p = 0.75, list = FALSE)
train_sub <- base_sub[idx_sub, ]
test_sub <- base_sub[-idx_sub, ]
data.frame(
Conjunto = c("Entrenamiento","Prueba"),
Observaciones = c(nrow(train_sub), nrow(test_sub)),
Pct_No = c(round(prop.table(table(train_sub$acceso_internet_f))[1]*100,1),
round(prop.table(table(test_sub$acceso_internet_f))[1]*100,1)),
Pct_Si = c(round(prop.table(table(train_sub$acceso_internet_f))[2]*100,1),
round(prop.table(table(test_sub$acceso_internet_f))[2]*100,1))
) %>%
kable(caption = "Partición de la base submuestreada",
col.names = c("Conjunto","Observaciones","% Sin acceso","% Con acceso"),
align = "c") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE,
font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white")| Conjunto | Observaciones | % Sin acceso | % Con acceso |
|---|---|---|---|
| Entrenamiento | 488 | 46.1 | 53.9 |
| Prueba | 161 | 46.0 | 54.0 |
La distribución de clases se mantuvo prácticamente constante entre
entrenamiento y prueba, confirmando que createDataPartition
estratificó correctamente.
set.seed(28)
knn_sub <- train(
acceso_internet_f ~ .,
data = train_sub,
method = "knn",
tuneGrid = data.frame(k = c(5, 7, 9, 11, 15, 21, 31, 51)),
preProcess = c("center","scale"),
trControl = trainControl(method = "cv", number = 5,
classProbs = TRUE,
summaryFunction = twoClassSummary),
metric = "ROC"
)
knn_res_sub <- knn_sub$results %>% select(k, ROC, Sens, Spec)
knn_res_sub %>%
mutate(across(c(ROC, Sens, Spec), ~round(., 4))) %>%
kable(caption = "AUC por valor de k — Base submuestreada",
col.names = c("k","AUC","Sensibilidad","Especificidad"), align = "c") %>%
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE,
font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#1565c0", color = "white") %>%
row_spec(which(knn_res_sub$k == knn_sub$bestTune$k),
bold = TRUE, background = "#e8f5e9",
extra_css = "border-left: 4px solid #2e7d32;")| k | AUC | Sensibilidad | Especificidad |
|---|---|---|---|
| 5 | 0.8285 | 0.7733 | 0.7716 |
| 7 | 0.8385 | 0.7556 | 0.7718 |
| 9 | 0.8400 | 0.7511 | 0.7832 |
| 11 | 0.8386 | 0.7333 | 0.7946 |
| 15 | 0.8188 | 0.7022 | 0.7721 |
| 21 | 0.8066 | 0.6844 | 0.7648 |
| 31 | 0.7926 | 0.7422 | 0.6733 |
| 51 | 0.7893 | 0.8356 | 0.5855 |
plot_ly(knn_res_sub, x = ~k, y = ~ROC, type = "scatter", mode = "lines+markers",
line = list(color = "#1565c0", width = 2.5),
marker = list(color = "#1565c0", size = 9,
line = list(color = "white", width = 2)),
text = ~paste0("k = ", k, "<br>AUC = ", round(ROC, 4)),
hoverinfo = "text") %>%
add_segments(x = knn_sub$bestTune$k, xend = knn_sub$bestTune$k,
y = min(knn_res_sub$ROC) - 0.01,
yend = max(knn_res_sub$ROC) + 0.005,
line = list(color = "#c0392b", dash = "dot", width = 1.5),
name = paste0("k óptimo = ", knn_sub$bestTune$k)) %>%
layout(title = list(text = "Optimización del parámetro k — Base submuestreada",
font = list(family = "Lato", size = 14)),
xaxis = list(title = "Número de vecinos (k)"),
yaxis = list(title = "AUC"),
plot_bgcolor = "#ffffff", paper_bgcolor = "#ffffff")knn_pred_sub <- predict(knn_sub, newdata = test_sub)
knn_pred_prob_sub <- predict(knn_sub, newdata = test_sub, type = "prob")
cm_knn_sub <- confusionMatrix(knn_pred_sub, test_sub$acceso_internet_f, positive = "Si")
acc_knn_sub <- cm_knn_sub$overall["Accuracy"]
kappa_knn_sub <- cm_knn_sub$overall["Kappa"]
sens_knn_sub <- cm_knn_sub$byClass["Sensitivity"]
spec_knn_sub <- cm_knn_sub$byClass["Specificity"]
ppv_knn_sub <- cm_knn_sub$byClass["Pos Pred Value"]
npv_knn_sub <- cm_knn_sub$byClass["Neg Pred Value"]
bal_acc_knn_sub <- cm_knn_sub$byClass["Balanced Accuracy"]
roc_knn_sub <- roc(response = test_sub$acceso_internet_f,
predictor = knn_pred_prob_sub[,"Si"],
levels = c("No","Si"))
auc_knn_sub <- auc(roc_knn_sub)Con la base equilibrada, el KNN seleccionó k = 9 como valor óptimo, con un AUC de validación cruzada de 0.84.
Con la base submuestreada, el modelo KNN logró un desempeño más equilibrado, alcanzando una exactitud de 72.67%, una sensibilidad de 75.86% y una especificidad de 68.92%. En comparación con la base completa, la sensibilidad disminuyó de 88% a 75.86%, mientras que la especificidad mejoró notablemente de 51.35% a 68.92%. Estos resultados sugieren que el submuestreo reduce el sesgo hacia la clase mayoritaria y mejora la capacidad del modelo para identificar hogares sin acceso a internet. El Kappa de 0.449 indica acuerdo moderado más allá del azar, y el AUC de 0.807 refleja una capacidad discriminante buena aunque inferior al modelo logístico.
fit_logit_sub <- glm(acceso_internet_f ~ ., data = train_sub, family = binomial())
or_sub <- data.frame(
Variable = names(exp(coef(fit_logit_sub))),
OR = round(exp(coef(fit_logit_sub)), 3),
IC_2.5 = round(exp(confint(fit_logit_sub))[,1], 3),
IC_97.5 = round(exp(confint(fit_logit_sub))[,2], 3)
) %>%
mutate(Significativo = ifelse(IC_2.5 > 1 | IC_97.5 < 1, "✔", ""))
or_sub %>%
kable(caption = "Odds Ratios — Modelo Logit sobre base submuestreada",
col.names = c("Variable","OR","IC 2.5%","IC 97.5%","Sig."),
align = c("l","c","c","c","c")) %>%
kable_styling(bootstrap_options = c("striped","hover","condensed"),
full_width = TRUE, font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white") %>%
column_spec(2, bold = TRUE)| Variable | OR | IC 2.5% | IC 97.5% | Sig. | |
|---|---|---|---|---|---|
| (Intercept) | (Intercept) | 0.000 | 0.000 | 0.001 | ✔ |
| estrato | estrato | 2.609 | 2.086 | 3.334 | ✔ |
| edad_jefe_hogar | edad_jefe_hogar | 1.001 | 0.987 | 1.016 | |
| ingreso_mensual$500k-$1M | ingreso_mensual$500k-$1M | 5.454 | 2.513 | 12.410 | ✔ |
| ingreso_mensual$1M-$2M | ingreso_mensual$1M-$2M | 19.431 | 8.659 | 46.518 | ✔ |
| ingreso_mensual$2M-$4M | ingreso_mensual$2M-$4M | 40.287 | 14.800 | 119.628 | ✔ |
| ingreso_mensualMás de $4M | ingreso_mensualMás de $4M | 72.963 | 21.296 | 286.280 | ✔ |
| nivel_educativoPrimaria | nivel_educativoPrimaria | 3.621 | 1.250 | 11.664 | ✔ |
| nivel_educativoSecundaria | nivel_educativoSecundaria | 11.057 | 3.968 | 35.028 | ✔ |
| nivel_educativoTécnico | nivel_educativoTécnico | 67.150 | 19.911 | 259.446 | ✔ |
| nivel_educativoUniversitario | nivel_educativoUniversitario | 76.092 | 20.753 | 319.620 | ✔ |
| nivel_educativoPosgrado | nivel_educativoPosgrado | 372.725 | 56.590 | 3851.479 | ✔ |
| zonaUrbana | zonaUrbana | 8.617 | 4.874 | 15.873 | ✔ |
p_hat_sub <- predict(fit_logit_sub, newdata = test_sub, type = "response")
roc_logit_sub <- roc(response = test_sub$acceso_internet_f,
predictor = p_hat_sub,
levels = c("No","Si"))
thr_sub <- coords(roc_logit_sub, x = "best", best.method = "youden", ret = "threshold")
umbral_sub <- as.numeric(thr_sub)
pred_opt_sub <- factor(ifelse(p_hat_sub >= umbral_sub, "Si", "No"),
levels = c("No","Si"))
cm_logit_sub <- confusionMatrix(pred_opt_sub, test_sub$acceso_internet_f, positive = "Si")
acc_logit_sub <- cm_logit_sub$overall["Accuracy"]
kappa_logit_sub <- cm_logit_sub$overall["Kappa"]
sens_logit_sub <- cm_logit_sub$byClass["Sensitivity"]
spec_logit_sub <- cm_logit_sub$byClass["Specificity"]
ppv_logit_sub <- cm_logit_sub$byClass["Pos Pred Value"]
npv_logit_sub <- cm_logit_sub$byClass["Neg Pred Value"]
bal_acc_logit_sub <- cm_logit_sub$byClass["Balanced Accuracy"]
auc_logit_sub <- auc(roc_logit_sub)Al igual que en la base completa, la edad del jefe del hogar no resultó significativa (p = 0.85), confirmando la consistencia de este hallazgo. Los OR más relevantes de la base submuestreada presentan ligeras diferencias respecto a la base completa, lo cual es esperado dado el tamaño de muestra menor: estrato (OR = 2.61), ingreso superior a $4M (OR ≈ 73), posgrado (OR = 373) y zona urbana (OR = 8.6), todos confirmando los patrones identificados en la base original.
Con el umbral óptimo de Youden (0.7159), el Logit sobre la base submuestreada alcanzó una exactitud de 82.61%, especificidad de 95.95% y un AUC de 0.913, el mejor desempeño global de todo el análisis. La exactitud balanceada de 83.61% confirma el equilibrio más alto entre clases observado en el estudio.
comp_final <- data.frame(
Metrica = c("Accuracy","Kappa","Sensibilidad","Especificidad",
"PPV","NPV","Balanced Accuracy","AUC"),
KNN_orig = round(c(acc_knn, kappa_knn, sens_knn, spec_knn,
ppv_knn, npv_knn, bal_acc_knn, auc_knn), 4),
Logit_orig = round(c(acc_logit, kappa_logit, sens_logit, spec_logit,
ppv_logit, npv_logit, bal_acc_logit, auc_logit), 4),
KNN_sub = round(c(acc_knn_sub, kappa_knn_sub, sens_knn_sub, spec_knn_sub,
ppv_knn_sub, npv_knn_sub, bal_acc_knn_sub, auc_knn_sub), 4),
Logit_sub = round(c(acc_logit_sub, kappa_logit_sub, sens_logit_sub, spec_logit_sub,
ppv_logit_sub, npv_logit_sub, bal_acc_logit_sub, auc_logit_sub), 4)
)
comp_final %>%
kable(caption = "Comparación completa de métricas: base original vs submuestreada",
col.names = c("Métrica","KNN original","Logit original",
"KNN submuestreado","Logit submuestreado"),
align = "c") %>%
kable_styling(bootstrap_options = c("striped","hover","condensed"),
full_width = TRUE, font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white") %>%
column_spec(2:3, background = "#f0f4f8") %>%
column_spec(4:5, background = "#fdf3f2") %>%
row_spec(which(comp_final$Metrica == "AUC"), bold = TRUE)| Métrica | KNN original | Logit original | KNN submuestreado | Logit submuestreado | |
|---|---|---|---|---|---|
| Accuracy | Accuracy | 0.7711 | 0.7590 | 0.7267 | 0.8261 |
| Kappa | Kappa | 0.4180 | 0.5266 | 0.4487 | 0.6575 |
| Sensitivity | Sensibilidad | 0.8800 | 0.6686 | 0.7586 | 0.7126 |
| Specificity | Especificidad | 0.5135 | 0.9730 | 0.6892 | 0.9595 |
| Pos Pred Value | PPV | 0.8105 | 0.9832 | 0.7416 | 0.9538 |
| Neg Pred Value | NPV | 0.6441 | 0.5538 | 0.7083 | 0.7396 |
| Balanced Accuracy | Balanced Accuracy | 0.6968 | 0.8208 | 0.7239 | 0.8361 |
| AUC | 0.8231 | 0.8950 | 0.8070 | 0.9129 |
roc_knn_sub_df <- data.frame(
FPR = 1 - roc_knn_sub$specificities,
TPR = roc_knn_sub$sensitivities
)
roc_logit_sub_df <- data.frame(
FPR = 1 - roc_logit_sub$specificities,
TPR = roc_logit_sub$sensitivities
)
plot_ly() %>%
add_trace(
data = roc_knn_sub_df,
x = ~FPR,
y = ~TPR,
type = "scatter",
mode = "lines",
line = list(color = "#1E88E5", width = 2),
name = sprintf("KNN submuestreado (AUC = %.3f)", auc_knn_sub)
) %>%
add_trace(
data = roc_logit_sub_df,
x = ~FPR,
y = ~TPR,
type = "scatter",
mode = "lines",
line = list(color = "#E53935", width = 2),
name = sprintf("Logit submuestreado (AUC = %.3f)", auc_logit_sub)
) %>%
add_trace(
x = c(0,1),
y = c(0,1),
type = "scatter",
mode = "lines",
line = list(color = "gray60", dash = "dash"),
name = "Azar"
) %>%
layout(
title = list(
text = "Comparación Curvas ROC: KNN vs Logit (base submuestreada)",
font = list(family = "Lato", size = 14)
),
xaxis = list(title = "Tasa de Falsos Positivos"),
yaxis = list(title = "Tasa de Verdaderos Positivos"),
plot_bgcolor = "#ffffff",
paper_bgcolor = "#ffffff"
)comp_final %>%
filter(Metrica != "Kappa") %>%
pivot_longer(cols = c(KNN_orig, Logit_orig, KNN_sub, Logit_sub),
names_to = "Modelo", values_to = "Valor") %>%
mutate(Modelo = recode(Modelo,
"KNN_orig" = "KNN original",
"Logit_orig" = "Logit original",
"KNN_sub" = "KNN submuestreado",
"Logit_sub" = "Logit submuestreado")) %>%
plot_ly(x = ~Valor, y = ~Metrica, color = ~Modelo,
colors = c("KNN original" = "#90a4ae",
"Logit original" = "#ef9a9a",
"KNN submuestreado" = "#2c2c2c",
"Logit submuestreado" = "#c0392b"),
type = "bar", orientation = "h",
text = ~round(Valor, 3), textposition = "outside",
marker = list(line = list(color = "white", width = 1))) %>%
layout(barmode = "group",
title = list(text = "Comparación de métricas: todos los modelos",
font = list(family = "Lato", size = 14)),
xaxis = list(title = "Valor", range = c(0, 1.15)),
yaxis = list(title = ""),
legend = list(title = list(text = "Modelo")),
plot_bgcolor = "#ffffff", paper_bgcolor = "#ffffff")La comparación entre ambas bases permite identificar dos hallazgos principales. En primer lugar, el submuestreo mejora el equilibrio entre sensibilidad y especificidad en el modelo KNN: la especificidad aumenta de 51.35% a 68.92%, aunque a costa de reducir la sensibilidad de 88% a 75.86%. En segundo lugar, el modelo Logit entrenado sobre la base submuestreada presenta el mejor desempeño global de todo el análisis, alcanzando un AUC de 0.913, una exactitud balanceada de 83.61% y una especificidad de 95.95%, indicando que la regresión logística es más robusta frente al desbalance de clases y mantiene un desempeño superior al KNN tanto en la base original como en la submuestreada.
El análisis realizado permitió identificar factores socioeconómicos y territoriales fuertemente asociados al acceso a internet en los hogares colombianos. Variables como el estrato socioeconómico, el ingreso mensual, el nivel educativo del jefe del hogar y la zona de ubicación evidenciaron una relación clara con la probabilidad de conectividad, confirmando que la brecha digital en Colombia mantiene un importante componente económico, educativo y geográfico.
Los resultados descriptivos mostraron patrones progresivos consistentes, donde los hogares con mayores niveles de ingreso, educación y estrato presentan porcentajes considerablemente más altos de acceso a internet. Asimismo, se identificó una diferencia significativa entre zonas urbanas y rurales, reflejando limitaciones estructurales relacionadas con infraestructura y cobertura de telecomunicaciones en áreas menos desarrolladas.
En la comparación de modelos, la regresión logística presentó un desempeño global superior frente al algoritmo KNN. El modelo Logit obtuvo mejores resultados en métricas clave como el Área Bajo la Curva ROC (AUC), la exactitud balanceada y el coeficiente Kappa, evidenciando una mayor capacidad discriminante y un comportamiento más estable frente al desbalance de clases presente en los datos. Aunque el modelo KNN alcanzó una sensibilidad más alta y logró detectar correctamente una mayor proporción de hogares conectados, presentó una especificidad considerablemente menor, generando una mayor cantidad de falsos positivos.
La implementación del umbral óptimo calculado mediante el índice de Youden permitió mejorar el equilibrio entre sensibilidad y especificidad dentro del modelo Logit. Con este ajuste, el modelo alcanzó una especificidad de 97.3% y un valor predictivo positivo de 98.32%, reduciendo significativamente la probabilidad de clasificar erróneamente como conectados a hogares que realmente no poseen acceso a internet. Aunque este ajuste disminuyó parcialmente la sensibilidad del modelo, proporcionó un desempeño más consistente para contextos donde la focalización eficiente de recursos públicos resulta prioritaria.
Además de su mejor rendimiento predictivo, el modelo de regresión logística presentó una ventaja importante en términos de interpretabilidad. A diferencia del KNN, el modelo Logit permitió cuantificar el efecto individual de cada variable sobre la probabilidad de acceso a internet mediante Odds Ratios, facilitando la comprensión de los factores que influyen en la conectividad y aportando evidencia útil para el diseño de políticas públicas orientadas a reducir la brecha digital.
En términos generales, se considera que el objetivo de la investigación fue cumplido satisfactoriamente, ya que los modelos lograron clasificar hogares según su acceso a internet con niveles de desempeño adecuados y permitieron identificar patrones relevantes asociados a la desigualdad digital en Colombia. Los resultados obtenidos evidencian que la conectividad no depende únicamente de decisiones individuales de los hogares, sino también de condiciones estructurales relacionadas con ingresos, educación y ubicación geográfica.
Finalmente, se concluye que el modelo de regresión logística con umbral óptimo de Youden constituye la herramienta más adecuada para orientar estrategias de focalización de recursos y programas de conectividad, debido a su mayor estabilidad predictiva, alta especificidad e interpretabilidad. No obstante, futuras investigaciones podrían incorporar variables relacionadas con infraestructura tecnológica, calidad del servicio, disponibilidad de dispositivos y condiciones regionales específicas, además de explorar modelos más avanzados de aprendizaje supervisado que permitan mejorar aún más la capacidad predictiva y el análisis de la brecha digital en Colombia.
Una de las principales limitaciones de esta investigación corresponde al posible sesgo de muestreo. Debido a que no se contó con información detallada sobre el marco muestral utilizado para construir la base de datos, los resultados obtenidos no pueden generalizarse completamente al total de hogares colombianos.
Asimismo, el estudio presenta posibles problemas de variable omitida, ya que factores relevantes como la infraestructura de telecomunicaciones disponible, la cantidad de dispositivos tecnológicos en el hogar, la composición familiar o las actitudes frente a la tecnología no fueron incluidos en los modelos. La ausencia de estas variables puede generar sesgos en la estimación de los coeficientes y limitar parcialmente la interpretación de los resultados.
Otra limitación importante proviene de la estrategia de submuestreo utilizada para equilibrar las clases. Aunque esta técnica permitió mejorar el desempeño de los algoritmos frente al desbalance de datos, implicó la pérdida de información al descartar observaciones de la clase mayoritaria. Alternativas como SMOTE o técnicas híbridas podrían explorarse en investigaciones futuras. Además, el tamaño relativamente reducido del conjunto de prueba genera intervalos de confianza más amplios y una mayor sensibilidad a variaciones aleatorias.
También debe considerarse que el umbral óptimo calculado mediante el índice de Youden fue derivado sobre el mismo conjunto de prueba utilizado para evaluar el modelo, lo que podría introducir cierto riesgo de sobreajuste. Esto se evidencia en que pequeños cambios en el umbral producen variaciones importantes en sensibilidad y especificidad.
Finalmente, debido a la naturaleza transversal de los datos, los resultados obtenidos permiten identificar asociaciones estadísticas, pero no establecer relaciones causales entre las variables. Para realizar inferencia causal serían necesarios diseños longitudinales o metodologías econométricas más avanzadas. Adicionalmente, en el modelo logístico no se verificaron formalmente supuestos como la linealidad en el logit ni se realizaron diagnósticos de observaciones influyentes.
Andesco. (2026). Conectividad en Colombia: hogares urbanos y rurales. https://andesco.org.co
Chicano Noticias. (2026, 30 de abril). Hogares con Internet en Colombia: avances y desafíos pendientes. https://www.chicanoticias.com/2026/04/30/hogares-internet-en-colombia/
Departamento Administrativo Nacional de Estadística. (2024). Pobreza monetaria: Resultados y metodología [Informe técnico]. https://www.dane.gov.co/files/operaciones/PM/pres-PM-2024.pdf
Departamento Administrativo Nacional de Estadística. (2026). Indicadores y operaciones estadísticas. https://www.dane.gov.co/index.php?option=com_content&task=category§ionid=37&id=164&Itemid=349
El Colombiano. (2026). Brecha de conectividad a Internet en zonas rurales de Colombia, según la OCDE. https://www.elcolombiano.com/negocios/ocde-brecha-conectividad-internet-rural-colombia-PF35128610
IBM. (2026). ¿Qué es K-Nearest Neighbors (KNN)? https://www.ibm.com/mx-es/think/topics/knn
IBM. (2026). ¿Qué es la regresión logística? https://www.ibm.com/es-es/think/topics/logistic-regression
Ministerio de Tecnologías de la Información y las Comunicaciones. (2026). Gobierno Petro conectó 3,5 millones de hogares en tres años. https://www.mintic.gov.co/portal/inicio/Sala-de-prensa/Noticias/437305
Sobrenatural Inmobiliaria. (2026). Estratos socioeconómicos en Colombia: entendiendo el sistema para tu propiedad. https://sobrenaturalinmobiliaria.com/blog/estratos-socioeconomicos-en-colombia-entendiendo-el-sistema-para-tu-propiedad/25265
Statology. (2026). What is a good AUC score? https://www.statology.org/what-is-a-good-auc-score/
Telefónica Tech. (2026). Evolución de Internet [Entrada de blog]. https://telefonicatech.com/blog/evolucion-de-internet