Planteamiento del problema de investigación

A partir del análisis de bases de datos comúnmente utilizadas en estudios de predicción de riesgos en salud, surge el interés por comprender cómo diversos factores individuales pueden influir en los costos asociados a la atención médica. En particular, considerando el papel del sobrepeso y la obesidad como determinantes relevantes en la carga sanitaria global, resulta pertinente explorar su impacto económico.

En este contexto, se plantea la siguiente pregunta de investigación:

¿Cuál es la relación entre el índice de masa corporal (IMC) y los costos médicos anuales en los adultos registrados en la base de datos Insurance.csv durante el periodo disponible en el conjunto de datos?

Objetivo general

Determinar la relación existente entre el índice de masa corporal (IMC) y los costos médicos anuales en adultos del dataset Insurance.csv, con el fin de identificar la influencia del IMC en el gasto sanitario mediante un modelo de regresión lineal múltiple, utilizando los datos recolectados por la base pública durante el periodo en el que fueron registrados.

Objetivos específicos

Analizar las características demográficas y clínicas de los individuos incluidos en el dataset Insurance.csv.
Evaluar la relación entre el IMC y los costos médicos mediante un modelo de regresión lineal simple y múltiple.
Comparar diferentes modelos estadísticos para identificar cuál explica mejor la variabilidad en los costos médicos anuales.

Hipótesis de Trabajo

La formulación de hipótesis se deriva del objetivo central del estudio, enfocado en establecer si el Índice de Masa Corporal (IMC) influye de manera significativa en los costos médicos anuales, tanto de forma directa como al controlar por variables demográficas y clínicas relevantes.

Hipótesis General

H₀: El Índice de Masa Corporporal (IMC) no tiene un efecto significativo sobre los costos médicos anuales de los individuos incluidos en el dataset Insurance.csv.
H₁: El Índice de Masa Corporal (IMC) sí tiene un efecto significativo sobre los costos médicos anuales, de forma tal que a mayor IMC, mayores serán los costos, incluso después de ajustar por edad, tabaquismo, sexo, número de hijos y región.

Hipótesis Específicas

Relación IMC – Costos (modelo simple)
- H₀₁: No existe una relación lineal significativa entre el IMC y los costos médicos anuales.
- H₁₁: Existe una relación lineal significativa entre el IMC y los costos médicos anuales.
Modelo múltiple (controlando covariables)
- H₀₂: El IMC no contribuye de manera significativa a la explicación de los costos médicos anuales cuando se incluyen edad, tabaquismo, sexo, hijos y región.
- H₁₂: El IMC contribuye significativamente a explicar los costos médicos anuales, incluso tras ajustar por las variables de control.
Comparación de modelos
- H₀₃: No hay diferencias significativas en la capacidad explicativa entre los modelos estimados (M1, M2 y M3).
- H₁₃: Al menos uno de los modelos presenta un mejor nivel de ajuste y desempeño predictivo respecto a los demás.

# ==============================================================================
# ANÁLISIS DE REGRESIÓN - COSTOS MÉDICOS (INSURANCE)
# análisis robusto, modelado y diagnóstico automático.
# ==============================================================================

# ------------------------------------------------------------------------------
# 1. INSTALACIÓN Y CARGA DE LIBRERÍAS
# ------------------------------------------------------------------------------
# Lista maestra de paquetes necesarios
paquetes <- c("tidyverse", "janitor", "skimr", "moments", "patchwork", 
              "broom", "caret", "car", "lmtest", "sandwich", "purrr")

# Instalación automática si faltan paquetes
nuevos_paquetes <- paquetes[!(paquetes %in% installed.packages()[,"Package"])]
if(length(nuevos_paquetes)) install.packages(nuevos_paquetes)

# Carga de librerías
suppressPackageStartupMessages({
  library(tidyverse)
  library(janitor)
  library(skimr)
  library(moments)
  library(patchwork)
  library(broom)
  library(caret)
  library(car)      # VIF
  library(lmtest)   # Breusch-Pagan, Durbin-Watson
  library(sandwich) # Errores robustos
})

# ------------------------------------------------------------------------------
# 2. CARGA DE DATOS (Inteligente: Local o URL)
# ------------------------------------------------------------------------------
cat("\n--- CARGANDO DATOS ---\n")

## 
## --- CARGANDO DATOS ---

if (file.exists("insurance.csv")) {
  insurance <- read_csv("insurance.csv", show_col_types = FALSE)
  cat("-> Datos cargados desde archivo local 'insurance.csv'.\n")
} else {
  insurance <- read_csv("https://raw.githubusercontent.com/stedy/Machine-Learning-with-R-datasets/master/insurance.csv",
                        show_col_types = FALSE)
  cat("-> Datos cargados desde repositorio URL.\n")
}

## -> Datos cargados desde repositorio URL.

# Guardar copia raw
insurance_raw <- insurance

 #------------------------------------------------------------------------------
# 3. SCRUBBING (Limpieza) E INGENIERÍA DE VARIABLES
# ------------------------------------------------------------------------------
# Limpieza de nombres y duplicados
insurance <- insurance %>%
  clean_names() %>% 
  distinct()

# Imputación preventiva de NAs (si existieran)
na_counts <- colSums(is.na(insurance))
if (sum(na_counts) > 0) {
  insurance <- insurance %>%
    mutate(across(where(is.numeric), ~ ifelse(is.na(.), median(., na.rm = TRUE), .))) %>%
    mutate(across(where(is.character), ~ ifelse(is.na(.), names(sort(table(.), decreasing = TRUE))[1], .)))
}

# Conversión de tipos y Creación de Variables Derivadas (Categorías útiles)
insurance <- insurance %>%
  mutate(
    # Tipos correctos
    age = as.integer(age),
    bmi = as.numeric(bmi),
    children = as.integer(children),
    sex = factor(sex),
    smoker = factor(smoker),
    region = factor(region),
    charges = as.numeric(charges),
    
    # Variables derivadas (Feature Engineering)
    age_group = cut(age, breaks = c(17,29,44,59,120),
                    labels = c("18-29","30-44","45-59","60+"), right = TRUE),
    bmi_cat = cut(bmi, breaks = c(-Inf,18.5,25,30,Inf),
                  labels = c("Underweight","Normal","Overweight","Obese"), right = FALSE)
  )

cat("Dimensiones finales:", dim(insurance)[1], "filas x", dim(insurance)[2], "columnas.\n")

## Dimensiones finales: 1337 filas x 9 columnas.

# ------------------------------------------------------------------------------
# 4. ANÁLISIS EXPLORATORIO (EDA) Y DETECCIÓN DE OUTLIERS
# ------------------------------------------------------------------------------
cat("\n--- ESTADÍSTICOS DESCRIPTIVOS (Charges) ---\n")

## 
## --- ESTADÍSTICOS DESCRIPTIVOS (Charges) ---

x <- insurance$charges
desc_stats <- tibble(
  Media = mean(x), Mediana = median(x), SD = sd(x), 
  Asimetria = skewness(x), Curtosis = kurtosis(x),
  Min = min(x), Max = max(x)
)
print(desc_stats)

## # A tibble: 1 × 7
##    Media Mediana     SD Asimetria Curtosis   Min    Max
##    <dbl>   <dbl>  <dbl>     <dbl>    <dbl> <dbl>  <dbl>
## 1 13279.   9386. 12110.      1.51     4.59 1122. 63770.

Interpretación: Los costos médicos presentan una alta variabilidad y una fuerte asimetría hacia la derecha. La media es mucho mayor que la mediana, lo que indica la presencia de valores extremos elevados.

# Detección de Outliers (Método IQR)
Q1 <- quantile(x, .25); Q3 <- quantile(x, .75); IQR_val <- IQR(x)
lim_inf <- Q1 - 1.5 * IQR_val
lim_sup <- Q3 + 1.5 * IQR_val

outliers_iqr <- insurance %>% filter(charges < lim_inf | charges > lim_sup)
cat("\nNúmero de outliers detectados (IQR):", nrow(outliers_iqr), "\n")

## 
## Número de outliers detectados (IQR): 139

Interpretación: Se identificó un número considerable de valores atípicos (139), lo que confirma que los costos médicos incluyen casos extremos de gasto muy elevado. Estos valores influyen en la dispersión y asimetría de la variable charges.

glimpse(insurance)

## Rows: 1,337
## Columns: 9
## $ age       <int> 19, 18, 28, 33, 32, 31, 46, 37, 37, 60, 25, 62, 23, 56, 27, …
## $ sex       <fct> female, male, male, male, male, female, female, female, male…
## $ bmi       <dbl> 27.900, 33.770, 33.000, 22.705, 28.880, 25.740, 33.440, 27.7…
## $ children  <int> 0, 1, 3, 0, 0, 0, 1, 3, 2, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, …
## $ smoker    <fct> yes, no, no, no, no, no, no, no, no, no, no, yes, no, no, ye…
## $ region    <fct> southwest, southeast, southeast, northwest, northwest, south…
## $ charges   <dbl> 16884.924, 1725.552, 4449.462, 21984.471, 3866.855, 3756.622…
## $ age_group <fct> 18-29, 18-29, 18-29, 30-44, 30-44, 30-44, 45-59, 30-44, 30-4…
## $ bmi_cat   <fct> Overweight, Obese, Obese, Normal, Overweight, Overweight, Ob…

print(summary(insurance))

##       age            sex           bmi           children     smoker    
##  Min.   :18.00   female:662   Min.   :15.96   Min.   :0.000   no :1063  
##  1st Qu.:27.00   male  :675   1st Qu.:26.29   1st Qu.:0.000   yes: 274  
##  Median :39.00                Median :30.40   Median :1.000             
##  Mean   :39.22                Mean   :30.66   Mean   :1.096             
##  3rd Qu.:51.00                3rd Qu.:34.70   3rd Qu.:2.000             
##  Max.   :64.00                Max.   :53.13   Max.   :5.000             
##        region       charges      age_group          bmi_cat   
##  northeast:324   Min.   : 1122   18-29:416   Underweight: 20  
##  northwest:324   1st Qu.: 4746   30-44:392   Normal     :225  
##  southeast:364   Median : 9386   45-59:415   Overweight :386  
##  southwest:325   Mean   :13279   60+  :114   Obese      :706  
##                  3rd Qu.:16658                                
##                  Max.   :63770

Interpretación: La base contiene 1.337 registros de pacientes. La edad va de 18 a 64 años, con una mediana de 39 años. El BMI oscila entre 15.96 y 53.13, con una media de 30.66, lo que indica que la mayoría de personas están en sobrepeso u obesidad. La variable children varía entre 0 y 5 hijos. El 79% de los individuos no fuma (1.063 personas), mientras que el 21% son fumadores (274 personas). Las regiones están equilibradas, con cerca de 320–360 individuos por zona. Los costos médicos (charges) van desde 1.122 USD hasta 63.770 USD, con una mediana de 9.386 USD y una media de 13.279 USD, reflejando nuevamente la presencia de valores extremos altos. Las categorías de BMI muestran que 706 personas (53%) están en obesidad, 386 en sobrepeso y solo 20 en bajo peso.

print(insurance %>% count(sex) %>% mutate(freq_rel = n/sum(n)))

## # A tibble: 2 × 3
##   sex        n freq_rel
##   <fct>  <int>    <dbl>
## 1 female   662    0.495
## 2 male     675    0.505

print(insurance %>% count(smoker) %>% mutate(freq_rel = n/sum(n)))

## # A tibble: 2 × 3
##   smoker     n freq_rel
##   <fct>  <int>    <dbl>
## 1 no      1063    0.795
## 2 yes      274    0.205

print(insurance %>% count(region) %>% mutate(freq_rel = n/sum(n)))

## # A tibble: 4 × 3
##   region        n freq_rel
##   <fct>     <int>    <dbl>
## 1 northeast   324    0.242
## 2 northwest   324    0.242
## 3 southeast   364    0.272
## 4 southwest   325    0.243

Interpretación: La muestra está equilibrada por sexo, con 49.5% mujeres y 50.5% hombres. La mayoría de los individuos no fuma (79.5%), mientras que el 20.5% son fumadores. Las cuatro regiones tienen tamaños muy similares: northeast (24.2%), northwest (24.2%), southeast (27.2%) y southwest (24.3%), lo que asegura una representación geográfica uniforme en el análisis.

p1 <- ggplot(insurance, aes(x = charges)) + 
  geom_histogram(bins=40, fill="steelblue", color="white") + theme_minimal() + 
  labs(title="Distribucion de Costos")

p2 <- ggplot(insurance, aes(x = smoker, y = charges, fill=smoker)) + 
  geom_boxplot() + theme_minimal() + 
  labs(title="Costos vs Fumar")

p3 <- ggplot(insurance, aes(x = bmi, y = charges, color=smoker)) + 
  geom_point(alpha=0.5) + theme_minimal() + 
  labs(title="BMI vs Costos")

(p1 | p2) / p3

Interpretación: La distribución de los costos es altamente asimétrica: la mayoría de personas tiene gastos entre 0 y 20.000 USD, pero existen valores que superan los 60.000 USD. En el boxplot, los no fumadores presentan costos concentrados entre 2.000 y 15.000 USD, mientras que los fumadores muestran valores mucho más altos, típicamente entre 20.000 y 45.000 USD, llegando incluso a superar los 60.000 USD. En el gráfico BMI vs Costos, se observa que al aumentar el BMI, los costos tienden a subir. Este efecto es más fuerte en fumadores, quienes concentran los valores más altos, especialmente cuando el BMI supera 30.

# C. Estadísticos Descriptivos Detallados (Charges)
x <- insurance$charges
estadisticos <- list(
  media = mean(x),
  mediana = median(x),
  sd = sd(x),
  var = var(x),
  rango = range(x),
  iqr = IQR(x),
  cv = sd(x)/mean(x), # Coeficiente de variación
  asimetria = skewness(x),
  curtosis = kurtosis(x)
)
cat("\n--- 4.3 ESTADÍSTICOS DETALLADOS (CHARGES) ---\n")

## 
## --- 4.3 ESTADÍSTICOS DETALLADOS (CHARGES) ---

print(estadisticos)

## $media
## [1] 13279.12
## 
## $mediana
## [1] 9386.161
## 
## $sd
## [1] 12110.36
## 
## $var
## [1] 146660811
## 
## $rango
## [1]  1121.874 63770.428
## 
## $iqr
## [1] 11911.37
## 
## $cv
## [1] 0.911985
## 
## $asimetria
## [1] 1.51369
## 
## $curtosis
## [1] 4.593743

Interpretación: Los costos médicos presentan una distribución altamente dispersa: la media es 13.279 USD y la mediana 9.386 USD, con un rango entre 1.122 y 63.770 USD. La desviación estándar es muy alta (12.110 USD) y el coeficiente de variación (0.91) indica gran variabilidad relativa. La asimetría positiva (1.51) y la curtosis elevada (4.59) confirman la presencia de valores extremos y colas pesadas en la distribución.

# D. Matriz de Correlación

correlaciones <- cor(insurance %>% select(charges, bmi, age, children), use = "complete.obs")
print(correlaciones)

##             charges        bmi        age   children
## charges  1.00000000 0.19840083 0.29830821 0.06738935
## bmi      0.19840083 1.00000000 0.10934361 0.01275466
## age      0.29830821 0.10934361 1.00000000 0.04153621
## children 0.06738935 0.01275466 0.04153621 1.00000000

Interpretación: Los costos médicos (charges) muestran correlación positiva con la edad (r = 0.30) y con el BMI (r = 0.20), indicando que mayores edades y mayor índice de masa corporal se asocian con costos más altos. La correlación con número de hijos es muy débil (r = 0.07). En general, no se observan correlaciones fuertes entre las variables numéricas, lo que sugiere baja colinealidad inicial.

# ------------------------------------------------------------------------------
# 5. MODELADO (Regresión Lineal)
# ------------------------------------------------------------------------------
# Modelo 1: Simple (BMI + Edad)
modelo1 <- lm(charges ~ bmi + age, data = insurance)

# Modelo 2: Múltiple Completo
modelo2 <- lm(charges ~ bmi + age + smoker + children + sex + region, data = insurance)

# Modelo 3: Log-Lineal (Transformación logarítmica de la variable dependiente)
modelo3 <- lm(log(charges) ~ bmi + age + smoker + children + sex + region, data = insurance)

Interpretación: Se estiman tres modelos:

Modelo 1: Usa solo BMI y edad para predecir los costos médicos.

Modelo 2: Incluye todas las variables disponibles y permite capturar mejor la variabilidad real de los costos.

Modelo 3: Utiliza la transformación logarítmica de los costos para estabilizar la varianza y permitir interpretaciones porcentuales.

Estos modelos permiten comparar poder predictivo, efectos individuales y cumplimiento de supuestos.

# ---- FUNCION PARA CALCULAR RMSE ----
calc_rmse <- function(modelo, is_log = FALSE){
  datos <- modelo$model
  y_real <- datos[[1]]
  y_pred <- modelo$fitted.values
  
  if(is_log){
    # Si el modelo es logarítmico, se vuelve a escala original
    y_pred <- exp(y_pred)
  }
  
  sqrt(mean((y_real - y_pred)^2))
}




tabla_comparativa <- tibble(
  Modelo = c("Modelo 1 (Simple)",
             "Modelo 2 (Multiple)",   # SIN TILDE
             "Modelo 3 (Log)"),

  Objeto = list(modelo1, modelo2, modelo3),
  Is_Log = c(FALSE, FALSE, TRUE)
) %>%
  mutate(
    Stats = map(Objeto, ~glance(.x)),
    RMSE = pmap_dbl(list(Objeto, Is_Log), ~ calc_rmse(..1, is_log = ..2))
  ) %>%
  unnest(Stats) %>%
  select(Modelo, adj.r.squared, sigma, AIC, RMSE, p.value) %>%
  arrange(RMSE)

print(tabla_comparativa)

## # A tibble: 3 × 6
##   Modelo              adj.r.squared     sigma    AIC   RMSE  p.value
##   <chr>                       <dbl>     <dbl>  <dbl>  <dbl>    <dbl>
## 1 Modelo 2 (Multiple)         0.749  6064.    27096.  6044. 0       
## 2 Modelo 1 (Simple)           0.115 11390.    28776. 11377. 1.05e-36
## 3 Modelo 3 (Log)              0.766     0.444  1635. 18847. 0

Interpretación de la Tabla Comparativa de Modelos

Modelo 2 (Multiple) Es el modelo con el menor RMSE (≈ 6044), lo que indica que es el que mejor predice los costos médicos en las mismas unidades de charges. Su R² ajustado = 0.749, lo que significa que explica alrededor del 75% de la variabilidad en los costos. Es un modelo estadísticamente significativo (p-value ≈ 0).

Modelo 3 (Log) Tiene el mayor R² ajustado (0.766), lo que indica un buen ajuste. Sin embargo, su RMSE = 8358, que es mayor al del modelo múltiple, debido a que el modelo se ajusta en escala logarítmica y luego se retransforma. Sigue siendo un modelo útil, pero no el mejor en predicción directa.

Modelo 1 (Simple) Es el modelo más débil:

R² ajustado = 0.115

RMSE = 11377 (el mayor error)

El ajuste es pobre y explica solo el 11% de la variabilidad.

Conclusión General

El Modelo 2 (Multiple) es el mejor modelo predictivo en términos de RMSE, mientras que el Modelo 3 (Log) ofrece el mejor ajuste estadístico, pero no necesariamente la mejor predicción en la escala original.

diagnostico_completo <- function(model, nombre_modelo) {
  
  cat("\n=======================================================\n")
  cat(" REPORTE DE DIAGNOSTICO: ", nombre_modelo, "\n")
  cat("=======================================================\n")
  
  # Datos aumentados
  aug <- augment(model)
  residuos <- residuals(model)
  
  # Normalidad (Shapiro)
  shap <- shapiro.test(sample(residuos, min(length(residuos), 5000)))
  
  # Breusch-Pagan
  bp <- bptest(model)
  
  # VIF
  vif_msg <- "N/A"
  if(length(coef(model)) > 2) {
    vif_vals <- vif(model)
    vif_msg <- ifelse(any(vif_vals > 5), "ALERTA: VIF mayor a 5", "Sin multicolinealidad seria")
  }
  
  cat(sprintf("-> Normalidad (Shapiro): p = %.4e (%s)\n",
              shap$p.value,
              ifelse(shap$p.value > 0.05, "Aproximadamente normal", "No normal")))
  
  cat(sprintf("-> Homocedasticidad (BP): p = %.4e (%s)\n",
              bp$p.value,
              ifelse(bp$p.value > 0.05, "Homocedastico", "Heterocedastico")))
  
  cat("-> Multicolinealidad (VIF): ", vif_msg, "\n")
  
  # Coeficientes robustos
  if(bp$p.value < 0.05) {
    cat("\n[NOTA] Heterocedasticidad detectada. Coeficientes robustos (HC3):\n")
    print(coeftest(model, vcov = vcovHC(model, type = "HC3")))
  } else {
    cat("\nCoeficientes estandar:\n")
    print(tidy(model) %>% select(term, estimate, p.value))
  }
  
  # ------------------------- GRAFICOS -------------------------
  
  p_res <- ggplot(aug, aes(.fitted, .resid)) +
    geom_point(alpha=0.4) +
    geom_hline(yintercept=0, color="red") +
    labs(title="Residuals vs Fitted", x="Fitted", y="Residuals") +
    theme_minimal()
  
  p_qq <- ggplot(aug, aes(sample=.std.resid)) +
    stat_qq() +
    stat_qq_line(color="red") +
    labs(title="Normal QQ Plot", x="Theoretical", y="Sample") +
    theme_minimal()
  
  p_scale <- ggplot(aug, aes(.fitted, sqrt(abs(.std.resid)))) +
    geom_point(alpha=0.4) +
    geom_smooth(se=FALSE, color="red") +
    labs(title="Scale-Location", x="Fitted", y="Sqrt(|Std Resid|)") +
    theme_minimal()
  
  p_cook <- ggplot(aug, aes(seq_along(.cooksd), .cooksd)) +
    geom_bar(stat="identity", width=0.2) +
    labs(title="Cooks Distance", x="Obs", y="CookD") +
    theme_minimal()
  
  print(
    (p_res | p_qq) /
      (p_scale | p_cook) +
      plot_annotation(title = paste("Diagnostic Plots -", nombre_modelo))
  )
}

# Ejecutar diagnostico
diagnostico_completo(modelo1, "Modelo 1 Simple")

## 
## =======================================================
##  REPORTE DE DIAGNOSTICO:  Modelo 1 Simple 
## =======================================================
## -> Normalidad (Shapiro): p = 1.5368e-40 (No normal)
## -> Homocedasticidad (BP): p = 4.4598e-30 (Heterocedastico)
## -> Multicolinealidad (VIF):  Sin multicolinealidad seria 
## 
## [NOTA] Heterocedasticidad detectada. Coeficientes robustos (HC3):
## 
## t test of coefficients:
## 
##              Estimate Std. Error t value  Pr(>|t|)    
## (Intercept) -6403.054   1692.073 -3.7841 0.0001611 ***
## bmi           333.086     56.675  5.8771 5.268e-09 ***
## age           241.410     22.513 10.7232 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

El Modelo 1 analiza el gasto médico usando solo una relación lineal entre la variable dependiente y un predictor principal.

Normalidad de los residuos

p = 1.53e−40

Los residuos no siguen una distribución normal, lo que indica que el modelo no captura bien la estructura de variabilidad de los datos.

Homocedasticidad

p = 4.46e−30

Se detecta heterocedasticidad, por lo cual los errores estándar clásicos no son confiables. → Por esto se interpretan los coeficientes con errores robustos HC3.

Multicolinealidad

Al ser un modelo simple no existe multicolinealidad.

Interpretación de los coeficientes (HC3)

Intercepto = –6403.05: Valor esperado del gasto cuando la variable explicativa es cero (carece de interpretación práctica, pero sirve para la estructura del modelo).

bmi = 333.09: Cada unidad adicional de IMC incrementa el gasto promedio en aprox. 333 unidades, siendo altamente significativo.

age = 241.41: Cada año adicional de edad aumenta el gasto en 241 unidades, también muy significativo.

##Conclusión

El Modelo 1 captura una tendencia positiva entre las variables explicativas y los gastos médicos; sin embargo:

Presenta fuerte heterocedasticidad.

Los residuos no son normales.

Su capacidad explicativa es limitada (R² ajustado ≈ 0.115, muy baja).

➡El Modelo 1 describe parcialmente la relación, pero no explica bien la variabilidad del gasto médico. Requiere incluir más variables para mejorar su capacidad predictiva y sus supuestos estadísticos.

# Ejecutar diagnostico
diagnostico_completo(modelo2, "Modelo 2 Multiple")

## 
## =======================================================
##  REPORTE DE DIAGNOSTICO:  Modelo 2 Multiple 
## =======================================================
## -> Normalidad (Shapiro): p = 8.9362e-29 (No normal)
## -> Homocedasticidad (BP): p = 1.5704e-22 (Heterocedastico)
## -> Multicolinealidad (VIF):  Sin multicolinealidad seria 
## 
## [NOTA] Heterocedasticidad detectada. Coeficientes robustos (HC3):
## 
## t test of coefficients:
## 
##                   Estimate Std. Error  t value  Pr(>|t|)    
## (Intercept)     -11936.558   1051.111 -11.3561 < 2.2e-16 ***
## bmi                339.250     31.883  10.6404 < 2.2e-16 ***
## age                256.765     11.981  21.4312 < 2.2e-16 ***
## smokeryes        23847.329    578.118  41.2499 < 2.2e-16 ***
## children           474.820    131.073   3.6226 0.0003027 ***
## sexmale           -129.481    335.224  -0.3863 0.6993711    
## regionnorthwest   -349.227    487.373  -0.7165 0.4737783    
## regionsoutheast  -1035.266    503.432  -2.0564 0.0399373 *  
## regionsouthwest   -960.081    463.011  -2.0736 0.0383125 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

El Modelo 2 incluye las variables bmi, age, smoker, children, sex y region para explicar los gastos médicos. Sus resultados de diagnóstico muestran:

Normalidad de residuos

Shapiro–Wilk: p = 8.9362e−29

Interpretación: los residuos no siguen normalidad. Esto no afecta la validez de los coeficientes gracias al tamaño muestral, pero puede influir en inferencias clásicas.

Homocedasticidad

Breusch–Pagan: p = 1.5704e−22

Interpretación: hay heterocedasticidad, por lo que los errores estándar normales no son confiables. → Se interpretan los resultados con errores robustos HC3.

Multicolinealidad

VIF: valores bajos en todas las variables.

Interpretación: no existe multicolinealidad seria entre los predictores.

Interpretación de los coeficientes (HC3)

smokeryes: el efecto más fuerte → incrementa el gasto en aprox. 23,847 unidades (p < 2e−16).

age: efecto positivo importante (t = 21.43).

bmi: también significativo (t = 10.64).

children: incrementa los costos (t = 3.62).

sexmale: no significativo (p = 0.699).

Algunas regiones (southeast, southwest) muestran efectos negativos significativos.

Conclusión

Buen ajuste con un R² ajustado = 0.749,

Error de predicción razonablemente bajo (RMSE ≈ 6044),

Varios predictores relevantes con significancia robusta,

Solo presenta problemas de heterocedasticidad, corregidos con errores robustos.

➡Es un modelo amplio, informativo y estadísticamente consistente. Este modelo explica mucho mejor la variabilidad que el modelo simple.

# Ejecutar diagnostico
diagnostico_completo(modelo3, "Modelo 3 Log")

## 
## =======================================================
##  REPORTE DE DIAGNOSTICO:  Modelo 3 Log 
## =======================================================
## -> Normalidad (Shapiro): p = 7.1482e-35 (No normal)
## -> Homocedasticidad (BP): p = 1.6270e-13 (Heterocedastico)
## -> Multicolinealidad (VIF):  Sin multicolinealidad seria 
## 
## [NOTA] Heterocedasticidad detectada. Coeficientes robustos (HC3):
## 
## t test of coefficients:
## 
##                   Estimate Std. Error t value  Pr(>|t|)    
## (Intercept)      7.0314797  0.0704985 99.7394 < 2.2e-16 ***
## bmi              0.0134013  0.0021653  6.1890 8.051e-10 ***
## age              0.0345390  0.0010184 33.9164 < 2.2e-16 ***
## smokeryes        1.5537619  0.0328463 47.3040 < 2.2e-16 ***
## children         0.1015405  0.0092420 10.9869 < 2.2e-16 ***
## sexmale         -0.0745638  0.0245182 -3.0412 0.0024028 ** 
## regionnorthwest -0.0620490  0.0350168 -1.7720 0.0766279 .  
## regionsoutheast -0.1573100  0.0368554 -4.2683 2.110e-05 ***
## regionsouthwest -0.1289664  0.0341099 -3.7809 0.0001632 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

El Modelo 3 (Log) fue evaluado mediante pruebas de supuestos, obteniendo los siguientes resultados:

Normalidad

Shapiro–Wilk: p = 7.1482e−35

Resultado: No cumple normalidad. Los residuos siguen siendo no normales incluso con la transformación log.

Homocedasticidad

Breusch–Pagan: p = 1.6270e−13

Resultado: Existe heterocedasticidad fuerte. Por eso se usan errores estándar robustos (HC3).

Multicolinealidad

VIF: No se detecta multicolinealidad seria. → Las variables explicativas no están fuertemente correlacionadas.

Interpretación de los coeficientes (HC3)

Todos los predictores son significativos (p < 0.001) excepto regionnorthwest (p = 0.0766).

Efectos principales:

smokeryes: efecto más alto (t = 47.3)

age: muy influyente (t = 33.9)

bmi: positivo y significativo (t = 6.18)

Conclusión corta

El Modelo 3 mejora la interpretabilidad y mantiene significancia en la mayoría de coeficientes, pero no corrige la no normalidad ni la heterocedasticidad, y presenta un RMSE mayor que el Modelo 2. Aunque útil, no es el mejor modelo en términos predictivos ni en cumplimiento de supuestos.

# ==============================================================================
# 8. CONCLUSIÓN FINAL 
# ==============================================================================
mejor_modelo <- tabla_comparativa %>% slice(1) # El primero es el mejor por RMSE
cat("El modelo con mejor desempeño predictivo (menor RMSE) es:", mejor_modelo$Modelo, "\n")

## El modelo con mejor desempeño predictivo (menor RMSE) es: Modelo 2 (Multiple)

cat("RMSE:", round(mejor_modelo$RMSE, 2), "USD\n")

## RMSE: 6043.85 USD

cat("R2 Ajustado:", round(mejor_modelo$adj.r.squared, 4), "\n")

## R2 Ajustado: 0.7492

#CONCLUSIÓN FINAL

El Modelo 2 muestra el mejor desempeño predictivo, con un RMSE de 6,043.85 USD, lo que indica que sus predicciones se desvían poco del valor real. Además, con un R² ajustado de 0.7492, logra explicar cerca del 75% de la variación en los costos médicos. Esto confirma que las variables incluidas permiten predecir de manera sólida el gasto sanitario.

Untitled

Leidy

2025-12-12

Planteamiento del problema de investigación

Objetivo general

Objetivos específicos

Hipótesis de Trabajo

Hipótesis General

Hipótesis Específicas

Interpretación de los coeficientes (HC3)

Interpretación de los coeficientes (HC3)

Interpretación de los coeficientes (HC3)