2. Carga y Limpieza de datos.

En principio se procedio con la carga de los datos para nuestro análisis, para ello se implementó el siguiente código:

datos <- read.csv("insurance.csv", stringsAsFactors = FALSE)

Vista resumida de la base de datos:

head(datos)

##   age    sex    bmi children smoker    region   charges
## 1  19 female 27.900        0    yes southwest 16884.924
## 2  18   male 33.770        1     no southeast  1725.552
## 3  28   male 33.000        3     no southeast  4449.462
## 4  33   male 22.705        0     no northwest 21984.471
## 5  32   male 28.880        0     no northwest  3866.855
## 6  31 female 25.740        0     no southeast  3756.622

En consiguiente visulizaremos el número de datos:

dim(datos)

## [1] 1338    7

Del cual apreciamos 1338 datos o filas con 7 columnas o variables. Los nombres de las columnas podemos evidenciarlo también como:

names(datos)

## [1] "age"      "sex"      "bmi"      "children" "smoker"   "region"   "charges"

Los cuales hacen referencia a la edad, sexo, imc (indice de masa corporal), children (número de hijos del asegurado), smoker (condición de fumador) y region (lugar en donde se ubica).

Posteriorimente visualizaremos si se encuentran datos nulos o vacíos con el siguiente código:

anyNA(datos)

## [1] FALSE

Donde identificamos que no se encuentra con ningun valor nulo en nuestra base de datos, también lo podemos visualizar en el siguiente gráfico:

Transformación de datos:

A continuación verificaremos los tipos de datos que se encuentran por columna, para ello utilizaremos lo siguiente

glimpse(datos)

## Rows: 1,338
## Columns: 7
## $ age      <int> 19, 18, 28, 33, 32, 31, 46, 37, 37, 60, 25, 62, 23, 56, 27, 1…
## $ sex      <chr> "female", "male", "male", "male", "male", "female", "female",…
## $ bmi      <dbl> 27.900, 33.770, 33.000, 22.705, 28.880, 25.740, 33.440, 27.74…
## $ children <int> 0, 1, 3, 0, 0, 0, 1, 3, 2, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0…
## $ smoker   <chr> "yes", "no", "no", "no", "no", "no", "no", "no", "no", "no", …
## $ region   <chr> "southwest", "southeast", "southeast", "northwest", "northwes…
## $ charges  <dbl> 16884.924, 1725.552, 4449.462, 21984.471, 3866.855, 3756.622,…

Del cual apreciamos variables de tipo entero (edad, bmi, children) y categóricos (sex, smoker, region).

Por tanto, para una mejor desarrollo del modelo transformaremos las variables categóricas a numéricas.

datos$sex <- as.factor(datos$sex)
datos$smoker <- as.factor(datos$smoker)
datos$region <- as.factor(datos$region)


datos$sex_num <- as.numeric(datos$sex)
datos$smoker_num <- as.numeric(datos$smoker)
datos$region_num <- as.numeric(datos$region)


data.frame(
  original_sex = levels(datos$sex),
  codificado = 1:length(levels(datos$sex))
)

##   original_sex codificado
## 1       female          1
## 2         male          2

data.frame(
  original_smoker = levels(datos$smoker),
  codificado = 1:length(levels(datos$smoker))
)

##   original_smoker codificado
## 1              no          1
## 2             yes          2

data.frame(
  original_region = levels(datos$region),
  codificado = 1:length(levels(datos$region))
)

##   original_region codificado
## 1       northeast          1
## 2       northwest          2
## 3       southeast          3
## 4       southwest          4

Luego si visualizamos la nueva base de datos tendremos lo siguiente:

head(datos[, c("sex", "sex_num", "smoker", "smoker_num", "region", "region_num")])

##      sex sex_num smoker smoker_num    region region_num
## 1 female       1    yes          2 southwest          4
## 2   male       2     no          1 southeast          3
## 3   male       2     no          1 southeast          3
## 4   male       2     no          1 northwest          2
## 5   male       2     no          1 northwest          2
## 6 female       1     no          1 southeast          3

Análisis exploratorio

En el siguiente apartado visualizaremos el comportamiento de las principales variables de nuestra base de datos para su posterior interpretación.

Distribución de la Edad

ggplot(datos, aes(x = age)) +
  geom_histogram(binwidth = 5, fill = "#69b3a2", color = "black") +
  labs(title = "Distribución de Edad", x = "Edad", y = "Frecuencia") +
  theme_minimal()

El histograma de la edad revela una distribución relativamente uniforme, con una concentración notable de individuos en el rango de edad más joven (18-22/23 años), seguida de una presencia constante en los rangos de edad superiores, sin evidenciar problemas significativos en la distribución.

Distribución de IMC

ggplot(datos, aes(x = bmi)) +
  geom_histogram(binwidth = 1, fill = "#FFB347", color = "black") +
  labs(title = "Distribución del Índice de Masa Corporal (BMI)",
       x = "BMI", y = "Frecuencia") +
  theme_minimal()

La distribución del índice de masa corporal (BMI) se asemeja a una distribución normal bastante simétrica, a pesar del tamaño moderado del conjunto de datos, lo que sugiere una variabilidad natural dentro de la población estudiada sin sesgos extremos aparentes.

Distribución del número de hijos

ggplot(datos, aes(x = children)) +
  geom_bar(fill = "#ff9999", color = "black") +
  labs(title = "Número de Hijos por Persona", x = "N° de Hijos", y = "Cantidad de Registros") +
  theme_minimal()

El histograma del número de hijos muestra una distribución discreta, con valores enteros que representan la cantidad de hijos, observándose una mayor frecuencia en los valores más bajos (0, 1 y 2 hijos), lo cual es consistente con las expectativas demográficas.

Distribución de los costos médicos

ggplot(datos, aes(x = charges)) +
  geom_histogram(binwidth = 2000, fill = "#77DD77", color = "black") +
  labs(title = "Distribución de los Cargos Médicos",
       x = "Cargos (USD)", y = "Frecuencia") +
  theme_minimal()

La distribución inicial de los cargos médicos anuales presenta una asimetría positiva marcada, con una gran cantidad de individuos con costos bajos y una cola larga hacia la derecha, indicando la presencia de varios individuos con gastos médicos significativamente más altos que la mayoría.

Análisis Multivariado

library(ggplot2)
library(dplyr)

# Promedios por región
region <- datos %>%
  group_by(region) %>%
  summarise(promedio_cargo = mean(charges))

# Gráfico
ggplot(region, aes(x = region, y = promedio_cargo, fill = region)) +
  geom_col() +
  labs(title = "Promedio de Cargos Médicos por Región",
       x = "Región", y = "Promedio de Cargos (USD)") +
  theme_minimal() +
  theme(legend.position = "none")

Aquí podemos observar algunas relaciones interesantes entre las variables. Al comparar los costos del seguro entre las diferentes regiones de Colombia, notamos una base para analizar si la ubicación geográfica influye en los cargos médicos en la parte sureste y noreste.

# Agrupación doble
region_sex <- datos %>%
  group_by(region, sex) %>%
  summarise(promedio_cargo = mean(charges), .groups = 'drop')

# Gráfico
ggplot(region_sex, aes(x = region, y = promedio_cargo, fill = sex)) +
  geom_col(position = "dodge") +
  labs(title = "Promedio de Cargos Médicos por Región y Sexo",
       x = "Región", y = "Promedio de Cargos (USD)", fill = "Sexo") +
  theme_minimal()

Cuando consideramos cargos, región y sexo, se hace evidente que, en general, los hombres tienden a pagar más por su seguro médico que las mujeres en la mayoría de las regiones.

# Agrupación doble
region_smoker <- datos %>%
  group_by(region, smoker) %>%
  summarise(promedio_cargo = mean(charges), .groups = 'drop')

# Gráfico
ggplot(region_smoker, aes(x = region, y = promedio_cargo, fill = smoker)) +
  geom_col(position = "dodge") +
  labs(title = "Promedio de Cargos Médicos por Región y Condición de Fumador",
       x = "Región", y = "Promedio de Cargos (USD)", fill = "Fumador") +
  theme_minimal()

Al analizar cargos, región y si la persona es fumadora, resalta una diferencia enorme en los costos del seguro entre quienes fuman y quienes no fuman en todas las regiones. Esto indica que el tabaquismo es un factor muy importante que afecta significativamente el precio del seguro, sin importar la región.

ggplot(datos, aes(x = age, y = charges, color = smoker)) +
  geom_point(alpha = 0.7) +
  labs(title = "Relación entre Edad y Cargos Médicos según Fumador",
       x = "Edad", y = "Cargos Médicos (USD)", color = "Fumador") +
  theme_minimal()

Si observamos la relación entre edad, cargos y tabaquismo, podemos ver que a medida que la edad aumenta, los costos del seguro tienden a subir. Asimismo la diferencia de costos entre fumadores y no fumadores es bastante significativa, lo que se traduce que la condición de fumador incrementa considerablemente los costos de seguro y se vuelve más pronunciada con la edad, pero se ve mínima si la persona no tiene la condición de fumador.

ggplot(datos, aes(x = bmi, y = charges, color = smoker)) +
  geom_point(alpha = 0.7) +
  labs(title = "Relación entre BMI y Cargos Médicos según Fumador",
       x = "Índice de Masa Corporal (BMI)", y = "Cargos Médicos (USD)", color = "Fumador") +
  theme_minimal()

Al relacionar el índice de masa corporal, los cargos y el tabaquismo, notamos que el BIM por sí solo no parece tener una relación muy fuerte con los costos del seguro. Pero, al considerar si la persona es fumadora o no, un BMI más alto en fumadores se asocia con costos de seguro aún mayores, sugiriendo una interacción clara entre estas dos variables.

Elaboración del modelo

Se ajustó un modelo de regresión lineal múltiple con todas las variables independientes disponibles. Luego, se aplicó un procedimiento de selección stepwise utilizando el criterio de información de Akaike (AIC), obteniéndose un modelo más parsimonioso con menor AIC y sin pérdida significativa de capacidad explicativa.

# Modelo completo con todas las variables
modelo <- lm(log(charges) ~ age + bmi + children + smoker + region, data = datos)

# Resumen del modelo
summary(modelo)

## 
## Call:
## lm(formula = log(charges) ~ age + bmi + children + smoker + region, 
##     data = datos)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.10302 -0.19707 -0.05206  0.06564  2.15091 
## 
## Coefficients:
##                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      7.0008478  0.0719853  97.254  < 2e-16 ***
## age              0.0346490  0.0008746  39.618  < 2e-16 ***
## bmi              0.0130711  0.0021004   6.223 6.52e-10 ***
## children         0.1013204  0.0101304  10.002  < 2e-16 ***
## smokeryes        1.5472965  0.0302910  51.081  < 2e-16 ***
## regionnorthwest -0.0633386  0.0350174  -1.809 0.070712 .  
## regionsoutheast -0.1568166  0.0351952  -4.456 9.07e-06 ***
## regionsouthwest -0.1285638  0.0351393  -3.659 0.000263 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.4457 on 1330 degrees of freedom
## Multiple R-squared:  0.7663, Adjusted R-squared:  0.765 
## F-statistic: 622.9 on 7 and 1330 DF,  p-value: < 2.2e-16

2. Selección del mejor modelo con Stepwise AIC

Usaremos el método de Stepwise (hacia adelante y hacia atrás) basado en el criterio de Akaike (AIC) para encontrar el modelo más parsimonioso:

# Stepwise usando AIC
modelo_step <- step(modelo, direction = "both", trace = FALSE)

# Resumen del modelo seleccionado
summary(modelo_step)

## 
## Call:
## lm(formula = log(charges) ~ age + bmi + children + smoker + region, 
##     data = datos)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.10302 -0.19707 -0.05206  0.06564  2.15091 
## 
## Coefficients:
##                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      7.0008478  0.0719853  97.254  < 2e-16 ***
## age              0.0346490  0.0008746  39.618  < 2e-16 ***
## bmi              0.0130711  0.0021004   6.223 6.52e-10 ***
## children         0.1013204  0.0101304  10.002  < 2e-16 ***
## smokeryes        1.5472965  0.0302910  51.081  < 2e-16 ***
## regionnorthwest -0.0633386  0.0350174  -1.809 0.070712 .  
## regionsoutheast -0.1568166  0.0351952  -4.456 9.07e-06 ***
## regionsouthwest -0.1285638  0.0351393  -3.659 0.000263 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.4457 on 1330 degrees of freedom
## Multiple R-squared:  0.7663, Adjusted R-squared:  0.765 
## F-statistic: 622.9 on 7 and 1330 DF,  p-value: < 2.2e-16

Estadísticos del modelo:

R² ajustado = 0.765: Explica el 76.5% de la variabilidad del logaritmo de los costos médicos.

Error estándar residual = 0.4457: Desviación media del log(predicción) frente al log(real).

F-statistic: 622.9, p < 2.2e-16: El modelo global es altamente significativo. Hay evidencia suficiente de que al menos una variable explica la variabilidad de la variable dependiente.

pred_log <- predict(modelo)     # predicciones en escala log
real_log <- log(datos$charges)      # valores reales en escala log
plot(real_log, pred_log,
     xlab = "Valores reales",
     ylab = "Valores predichos",
     main = "Valores reales vs predichos",
     pch = 20, col = "darkblue")
abline(a = 0, b = 1, col = "red", lwd = 2)  # Línea ideal

Explicación del gráfico:

El gráfico muestra los valores reales del log(cargos) en el eje X y los valores predichos en el eje Y.
La línea roja representa una línea de referencia donde los valores predichos serían exactamente iguales a los reales (Y = X).

Interpretación:

Los puntos están alineados bastante bien a lo largo de la línea roja, lo que indica buen ajuste general del modelo.
Se observa una ligera dispersión en los valores más altos, lo cual es esperable cuando hay outliers o alta varianza en los datos.
No hay patrones extraños ni curvaturas, lo que sugiere que la linealidad y homocedasticidad se mantienen razonablemente bien.

Criterios de aceptación:

R² alto (76.5%): Mide qué tan bien el modelo explica la variabilidad. Aceptable en contextos donde hay alta variabilidad (como costos médicos).

p-values bajos (< 0.05): Garantizan que los efectos observados no se deben al azar.

Error residual bajo y distribución visual coherente: Nos asegura predicciones relativamente precisas.

Transformación logarítmica: Se usa porque los costos médicos pueden ser altamente sesgados a la derecha (outliers caros). El log reduce esta distorsión.

Conclusión de modelo de regresión:

El modelo de regresión lineal múltiple aplicado sobre la variable transformada log(charges) obtuvo un R-cuadrado ajustado de 0.765, lo que indica que aproximadamente el 76.5% de la variabilidad en el logaritmo de los costos médicos se explica por las variables consideradas: edad, índice de masa corporal (IMC), número de hijos, hábito de fumar y región de residencia.

El error estándar residual fue de 0.4457 en escala logarítmica, lo que significa que, en promedio, las predicciones del modelo difieren del valor real de log(charges) en aproximadamente 0.4457 unidades logarítmicas. Si se transforma nuevamente a la escala original, esto equivale a un error cuadrático medio (RMSE) aproximado de $4,500.

Dado que los cargos médicos en el dataset varían desde unos $1,000 hasta más de $60,000, este margen de error es razonable. Aunque puede parecer alto en términos absolutos, refleja la alta variabilidad inherente a los costos médicos. Por ejemplo, un error de $4,500 representa solo el 7.5% del valor máximo registrado en el conjunto de datos, lo cual es aceptable en contextos con tanta dispersión.

En cuanto a la influencia de las variables, destacan:

Fumar: es el factor más significativo del modelo, asociado con un fuerte incremento en los costos médicos.
Edad: presenta una relación positiva con los cargos, aumentando progresivamente su impacto.
Número de hijos: aunque con menor peso, muestra una influencia estadísticamente significativa.
IMC y región de residencia: tuvieron un efecto más débil o incierto en comparación con las variables anteriores.

En resumen, el modelo captura adecuadamente las tendencias generales de los datos y permite identificar factores clave asociados al incremento de los costos médicos, aunque presenta ciertas limitaciones en la precisión individual de las predicciones cuando se expresan en dólares reales.

Recomendaciones

Este modelo lineal nos brinda una base sólida para entender los factores que influyen en los costos médicos, destacando variables como la edad, el hábito de fumar y el número de hijos. Sin embargo, aún hay espacio para mejorar la precisión del modelo explorando otras técnicas más avanzadas, como modelos no lineales o algoritmos de aprendizaje automático, que podrían capturar relaciones más complejas entre las variables.

Nuestro trabajo debe considerarse como un punto de partida para futuras investigaciones. A medida que se disponga de más datos y recursos, se recomienda evaluar otros enfoques, probar nuevas variables relevantes y aplicar técnicas de validación más robustas. Esto permitirá desarrollar modelos más precisos y útiles para apoyar la toma de decisiones en el ámbito de la salud.

Modelo de regresión lineal múltiple

Arnold Pacheco

2025-06-07

1. Introducción