Factores de Riesgo en el Seguro de Gastos Médicos
GISELLE ABIGAIL DELGADO CUELLAR
2026-06-13
1 Carga de Paquetes y Datos
paquetes <- c("readr", "dplyr", "lmtest", "sandwich", "car", "performance",
"nortest", "tseries", "Metrics", "stargazer", "equatiomatic",
"fitdistrplus", "fastGraph", "mctest", "skedastic", "robustbase",
"forecast", "kableExtra", "caret", "DescTools")
instalados <- paquetes %in% rownames(installed.packages())
if (any(!instalados)) install.packages(paquetes[!instalados])
library(readr); library(dplyr); library(lmtest); library(sandwich)
library(car); library(performance); library(nortest); library(tseries)
library(Metrics); library(stargazer); library(equatiomatic)
library(fitdistrplus); library(fastGraph); library(mctest); library(skedastic)
library(robustbase); library(forecast); library(kableExtra); library(caret)
library(DescTools)insurance <- read_csv("C:/Users/gisel/Downloads/insurance.csv")
# Creación de variable indicadora de obesidad (IMC >= 30)
insurance <- insurance %>%
mutate(obeso = ifelse(bmi >= 30, "yes", "no"))Nota sobre los datos: El dataset contiene 1,338 observaciones de beneficiarios de seguros médicos en Estados Unidos, con variables como edad, IMC, número de hijos, condición de fumador, región geográfica y cargos médicos anuales. Se construyó adicionalmente la variable
obesocomo indicador binario (IMC ≥ 30) para capturar la interacción entre obesidad y tabaquismo.
2 Modelo Mejorado — Estimación OLS
El modelo especificado incorpora una relación no lineal de la edad
(término cuadrático), efectos principales de IMC, hijos, tabaquismo y
región, así como dos términos de interacción clave:
smoker:bmi y smoker:obeso. La variable
dependiente se transforma logarítmicamente para corregir la asimetría
positiva de los gastos médicos.
Modelo estadístico estimado:
\[\ln(\text{charges}_i) = \beta_0 + \beta_1 \text{age}_i + \beta_2 \text{age}_i^2 + \beta_3 \text{bmi}_i + \beta_4 \text{children}_i + \beta_5 \text{smoker}_i + \beta_6 \text{region}_i + \beta_7 (\text{smoker} \times \text{bmi})_i + \beta_8 (\text{smoker} \times \text{obeso})_i + \varepsilon_i\]
modelo_mejorado <- lm(
formula = log(charges) ~ age + I(age^2) + bmi + children + smoker +
region + smoker:bmi + smoker:obeso,
data = insurance
)
stargazer(modelo_mejorado, type = "text",
title = "Resultados del Modelo Mejorado — Seguro de Salud",
dep.var.labels = "log(charges)")##
## Resultados del Modelo Mejorado — Seguro de Salud
## ===============================================
## Dependent variable:
## ---------------------------
## log(charges)
## -----------------------------------------------
## age 0.054***
## (0.006)
##
## I(age2) -0.0002***
## (0.0001)
##
## bmi 0.004
## (0.004)
##
## children 0.093***
## (0.010)
##
## smokeryes 0.902***
## (0.201)
##
## regionnorthwest -0.062*
## (0.033)
##
## regionsoutheast -0.152***
## (0.034)
##
## regionsouthwest -0.138***
## (0.033)
##
## bmi:smokeryes 0.012
## (0.008)
##
## smokerno:obesoyes -0.006
## (0.043)
##
## smokeryes:obesoyes 0.505***
## (0.087)
##
## Constant 6.961***
## (0.136)
##
## -----------------------------------------------
## Observations 1,338
## R2 0.788
## Adjusted R2 0.787
## Residual Std. Error 0.425 (df = 1326)
## F Statistic 449.261*** (df = 11; 1326)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.012.1 Interpretación de los Coeficientes
## === Efectos marginales calculados ===## Efecto marginal de edad a los 30 años: 0.0395## Efecto marginal de edad a los 50 años: 0.0299## Incremento porcentual por hijo adicional: 9.7 %## Incremento porcentual por fumar (no obeso): 146.41 %## Incremento porcentual fumador+obeso: 308.41 %Constante (β₀ = 6.961): El logaritmo esperado de gastos médicos para un individuo de referencia (no fumador, no obeso, región northeast, con todas las variables continuas en cero) es 6.961, equivalente a aproximadamente $1,057. Este valor no posee interpretación económica directa pero ancla la escala del modelo.
Edad — age (β₁ = 0.054) e I(age²)
(β₂ = −0.0002): Ambos coeficientes son estadísticamente
significativos al 1%. La relación entre edad y gastos médicos es
no lineal y cóncava: el incremento en costos médicos
por cada año adicional de vida se desacelera progresivamente. A los 30
años, el efecto marginal de la edad es aproximadamente +0.042 en
log(charges); a los 50 años se reduce a +0.034. Esto es consistente con
la teoría actuarial: el deterioro de salud es acelerado en edades medias
pero tiende a estabilizarse en edades mayores dentro del rango de los
datos.
IMC — bmi (β₃ = 0.004, no
significativo): En ausencia de tabaquismo, el IMC por sí solo
no presenta efecto estadísticamente significativo sobre los gastos
médicos (p = 0.301). Su relevancia se manifiesta únicamente a través de
la interacción con el tabaquismo, capturada en los términos de
interacción.
Número de hijos — children (β₄ =
0.093): Significativo al 1%. Cada hijo adicional incrementa los
gastos médicos esperados en aproximadamente 9.7%
(e^0.093 − 1). Esto refleja la estructura de los planes de seguro
familiar, donde la cobertura de dependientes genera costos adicionales
proporcionales.
Fumador — smokeryes (β₅ = 0.902):
Significativo al 1%. Para un fumador no obeso, el tabaquismo incrementa
los gastos médicos en aproximadamente 147% respecto a
un no fumador con igual perfil. Este es el regresor de mayor impacto
individual en el modelo, lo que confirma al tabaquismo como el principal
factor de riesgo en la determinación de primas de seguro.
Región geográfica: Las tres regiones alternativas presentan costos menores que la región northeast (categoría base). La región southeast registra el mayor descuento relativo (−15.2%, significativo al 1%), seguida de southwest (−13.8%, al 1%) y northwest (−6.2%, significativo al 10%). Estas diferencias regionales pueden atribuirse a variaciones en el costo de vida, acceso a servicios médicos y prevalencia de condiciones crónicas por zona geográfica.
Interacción bmi:smokeryes (β₇ = 0.012, no
significativo): El efecto continuo del IMC sobre los gastos en
fumadores no alcanza significancia estadística (p = 0.105). El efecto
diferencial del IMC para fumadores queda mejor capturado por la variable
categórica de obesidad en la siguiente interacción.
Interacción smokerno:obesoyes (β₈ₐ = −0.006, no
significativo): Para los no fumadores, la condición de obesidad
no genera un diferencial estadísticamente significativo en los gastos
médicos (p = 0.893). La obesidad aislada del tabaquismo no constituye un
factor de riesgo detectado en estos datos.
Interacción smokeryes:obesoyes (β₈ᵦ =
0.505): Este es el hallazgo más relevante del modelo,
significativo al 1%. Un fumador que además es obeso (IMC ≥ 30) acumula
un incremento adicional de 0.505 en log(charges) sobre el efecto base
del tabaquismo. En términos totales, un fumador obeso
presenta un incremento de 0.902 + 0.505 = 1.407 en log(charges),
equivalente a un aumento del 308% en gastos médicos
respecto a un no fumador no obeso con igual perfil. Este efecto
sinérgico entre tabaquismo y obesidad tiene pleno respaldo clínico:
ambas condiciones conjuntas elevan desproporcionadamente el riesgo
cardiovascular, metabólico y respiratorio.
Bondad de ajuste: El modelo explica el 78.8% de la varianza del logaritmo de los gastos médicos (R² = 0.788, R² ajustado = 0.787). El estadístico F (449.26, p < 0.01) confirma la significancia global del modelo: el conjunto de regresores aporta poder explicativo real sobre los gastos médicos.
3 Verificación de Supuestos del MCRLM
3.1 Normalidad de los Residuos
##
## Shapiro-Wilk normality test
##
## data: residuos_m
## W = 0.80689, p-value < 0.00000000000000022Wn_salida <- qnorm(salida_SW$p.value, lower.tail = FALSE)
cat("Estadístico estandarizado Wn (Shapiro-Wilk):", Wn_salida, "\n")## Estadístico estandarizado Wn (Shapiro-Wilk): 12.69655##
## Jarque Bera Test
##
## data: residuos_m
## X-squared = 2535.4, df = 2, p-value < 0.00000000000000022##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: residuos_m
## D = 0.2213, p-value < 0.00000000000000022alpha_sig <- 0.05
JB_stat <- jb_test$statistic
gl <- jb_test$parameter
VC_jb <- qchisq(1 - alpha_sig, gl, lower.tail = TRUE)
shadeDist(VC_jb, ddist = "dchisq", parm1 = gl, lower.tail = FALSE,
xmin = 0, xmax = 40,
sub = paste("VC:", round(VC_jb, 2), " | Estadístico JB:", round(JB_stat, 2)))
Interpretación — Normalidad: Las tres pruebas rechazan contundentemente el supuesto de normalidad en los residuos (Shapiro-Wilk: W = 0.807, p < 0.001; Jarque-Bera: χ² = 2,535.4, p < 0.001; Lilliefors: D = 0.221, p < 0.001). El estadístico estandarizado de Shapiro-Wilk (Wn = 12.70) confirma el alejamiento significativo de la distribución normal. Sin embargo, dado el tamaño muestral (n = 1,338), el Teorema Central del Límite garantiza la validez asintótica de la inferencia. Este resultado justifica adicionalmente el uso de errores estándar robustos aplicados en la sección siguiente.
3.2 Multicolinealidad
##
## Call:
## omcdiag(mod = mod, Inter = TRUE, detr = detr, red = red, conf = conf,
## theil = theil, cn = cn)
##
##
## Overall Multicollinearity Diagnostics
##
## MC Results detection
## Determinant |X'X|: 0.0000 1
## Farrar Chi-Square: 14223.6417 1
## Red Indicator: 0.2864 0
## Sum of Lambda Inverse: 235.4446 1
## Theil's Method: -0.5267 0
## Condition Number: 63.4614 1
##
## 1 --> COLLINEARITY is detected by the test
## 0 --> COLLINEARITY is not detected by the test## # Check for Multicollinearity
##
## Low Correlation
##
## Term VIF VIF 95% CI adj. VIF Tolerance Tolerance 95% CI
## bmi 3.70 [ 3.38, 4.07] 1.92 0.27 [0.25, 0.30]
## children 1.10 [ 1.05, 1.19] 1.05 0.91 [0.84, 0.95]
## region 1.11 [ 1.06, 1.20] 1.05 0.90 [0.83, 0.94]
##
## High Correlation
##
## Term VIF VIF 95% CI adj. VIF Tolerance Tolerance 95% CI
## age 47.84 [43.08, 53.14] 6.92 0.02 [0.02, 0.02]
## I(age^2) 47.79 [43.04, 53.09] 6.91 0.02 [0.02, 0.02]
## smoker 49.03 [44.15, 54.46] 7.00 0.02 [0.02, 0.02]
## bmi:smoker 72.40 [65.17, 80.45] 8.51 0.01 [0.01, 0.02]
## smoker:obeso 16.94 [15.29, 18.78] 4.12 0.06 [0.05, 0.07]
Interpretación — Multicolinealidad: Se detecta multicolinealidad entre los términos
age,I(age²),smokery sus interacciones (VIFs > 10). Este resultado es esperado y estructural en modelos que incluyen términos cuadráticos e interacciones: un regresor y su cuadrado están necesariamente correlacionados, al igual que una variable y el término de interacción que la contiene. No constituye un problema de especificación sino una característica de la forma funcional elegida. Las variables de controlchildrenyregionpresentan VIFs bajos (< 1.2), confirmando que la colinealidad se limita a los términos relacionados entre sí por construcción.
3.3 Homocedasticidad
##
## studentized Breusch-Pagan test
##
## data: modelo_mejorado
## BP = 100.96, df = 11, p-value < 0.00000000000000022## # A tibble: 1 × 5
## statistic p.value parameter method alternative
## <dbl> <dbl> <dbl> <chr> <chr>
## 1 146. 0.00000357 77 White's Test greaterInterpretación — Homocedasticidad: Tanto la prueba de Breusch-Pagan (BP = 100.96, df = 11, p < 0.001) como la prueba de White (χ² = 146, p < 0.001) rechazan la hipótesis nula de varianza constante en los residuos. Se confirma la presencia de heterocedasticidad, lo que implica que la varianza del error no es uniforme a lo largo de los valores predichos. Esta violación no sesga los estimadores OLS pero sí invalida los errores estándar clásicos, haciendo necesaria la corrección mediante matrices de covarianzas robustas (sección siguiente).
3.4 Autocorrelación
## lag Autocorrelation D-W Statistic p-value
## 1 -0.01111677 2.019989 0.766
## Alternative hypothesis: rho != 0## Breusch-Godfrey Orden 1:##
## Breusch-Godfrey test for serial correlation of order up to 1
##
## data: modelo_mejorado
## LM test = 0.16665, df = 1, p-value = 0.6831## Breusch-Godfrey Orden 2:##
## Breusch-Godfrey test for serial correlation of order up to 2
##
## data: modelo_mejorado
## LM test = 0.18253, df = 2, p-value = 0.9128Interpretación — Autocorrelación: Las pruebas de Durbin-Watson (DW = 2.02, p = 0.734) y Breusch-Godfrey de primer orden (LM = 0.167, p = 0.683) y segundo orden (LM = 0.183, p = 0.913) no rechazan la hipótesis nula de ausencia de autocorrelación. El estadístico DW próximo a 2 confirma que no existe correlación serial en los residuos. Este resultado es coherente con la naturaleza de corte transversal de los datos, donde la autocorrelación no es un problema estructuralmente esperado.
4 Correcciones al Modelo y Estimaciones Robustas
# A) Errores estándar robustos HC1 (corrección por heterocedasticidad)
coeftest(modelo_mejorado, vcov. = vcovHC(modelo_mejorado, type = "HC1"))##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 6.960770574 0.154551701 45.0385 < 0.00000000000000022 ***
## age 0.053989510 0.006310282 8.5558 < 0.00000000000000022 ***
## I(age^2) -0.000240927 0.000073619 -3.2726 0.001093 **
## bmi 0.003719951 0.003595278 1.0347 0.301008
## children 0.092535951 0.009224541 10.0315 < 0.00000000000000022 ***
## smokeryes 0.901844544 0.192540929 4.6839 0.000003103775 ***
## regionnorthwest -0.062298903 0.033803923 -1.8429 0.065560 .
## regionsoutheast -0.152165437 0.035650203 -4.2683 0.000021098482 ***
## regionsouthwest -0.137708283 0.032917609 -4.1834 0.000030603020 ***
## bmi:smokeryes 0.012188417 0.007518623 1.6211 0.105235
## smokerno:obesoyes -0.005946579 0.044034934 -0.1350 0.892599
## smokeryes:obesoyes 0.505250051 0.087493934 5.7747 0.000000009592 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Interpretación — Errores HC1: Al recalcular los errores estándar con la matriz de covarianzas HC1 (heteroskedasticity-consistent), los coeficientes se mantienen idénticos a los del OLS clásico (los estimadores puntuales no cambian), pero los errores estándar se corrigen para ser válidos bajo heterocedasticidad. Las variables que permanecen significativas con errores robustos son:
age,I(age²),children,smokeryes,regionsoutheast,regionsouthwestysmokeryes:obesoyes. La robustez de la significancia ante esta corrección valida la estabilidad inferencial del modelo.
# B) Estimación robusta MM-Type (resistente a valores atípicos)
modelo_robust_MM <- lmrob(
log(charges) ~ age + I(age^2) + bmi + children + smoker + region +
smoker:bmi + smoker:obeso,
data = insurance,
setting = "KS2014" # CORRECCIÓN: evita el breakdown local detectado en smokeryes
)stargazer(modelo_mejorado, modelo_robust_MM, type = "text",
title = "Comparativa: OLS Tradicional vs Robust MM-Type",
column.labels = c("OLS Mejorado", "Robust MM-Type"))##
## Comparativa: OLS Tradicional vs Robust MM-Type
## =========================================================================
## Dependent variable:
## -----------------------------------------
## log(charges)
## OLS MM-type
## linear
## OLS Mejorado Robust MM-Type
## (1) (2)
## -------------------------------------------------------------------------
## age 0.054*** 0.085***
## (0.006) (0.002)
##
## I(age2) -0.0002*** -0.001***
## (0.0001) (0.00002)
##
## bmi 0.004 0.001
## (0.004) (0.001)
##
## children 0.093*** 0.092***
## (0.010) (0.003)
##
## smokeryes 0.902*** 0.556***
## (0.201) (0.072)
##
## regionnorthwest -0.062* -0.045***
## (0.033) (0.010)
##
## regionsoutheast -0.152*** -0.115***
## (0.034) (0.010)
##
## regionsouthwest -0.138*** -0.099***
## (0.033) (0.010)
##
## bmi:smokeryes 0.012 0.017***
## (0.008) (0.003)
##
## smokerno:obesoyes -0.006 -0.001
## (0.043) (0.012)
##
## smokeryes:obesoyes 0.505*** 0.364***
## (0.087) (0.034)
##
## Constant 6.961*** 6.189***
## (0.136) (0.040)
##
## -------------------------------------------------------------------------
## Observations 1,338 1,338
## R2 0.788 0.979
## Adjusted R2 0.787 0.978
## Residual Std. Error (df = 1326) 0.425 0.119
## F Statistic 449.261*** (df = 11; 1326)
## =========================================================================
## Note: *p<0.1; **p<0.05; ***p<0.01Interpretación — Comparativa OLS vs MM-Type: La estimación MM-Type, diseñada para ser resistente a la influencia de observaciones atípicas, presenta coeficientes con la misma dirección que el OLS en las variables principales, confirmando la estabilidad de las relaciones estimadas. Las diferencias en magnitud —especialmente en
smokeryesysmokeryes:obesoyes— se explican porque el estimador MM reduce el peso de observaciones extremas que en el OLS sesgan al alza esos coeficientes. El R² del modelo MM-Type no es directamente comparable con el del OLS por diferencias en la función objetivo de optimización.
5 Pruebas de Hipótesis e Intervalos de Confianza de los Parámetros
# Intervalos de confianza al 95% para todos los parámetros
ic_95 <- confint(modelo_mejorado, level = 0.95)
ic_99 <- confint(modelo_mejorado, level = 0.99)
cat("=== Intervalos de Confianza al 95% ===\n")## === Intervalos de Confianza al 95% ===## 2.5 % 97.5 %
## (Intercept) 6.694339 7.227203
## age 0.042773 0.065206
## I(age^2) -0.000381 -0.000101
## bmi -0.003471 0.010911
## children 0.072692 0.112379
## smokeryes 0.506635 1.297054
## regionnorthwest -0.127855 0.003258
## regionsoutheast -0.218112 -0.086219
## regionsouthwest -0.203415 -0.072002
## bmi:smokeryes -0.003052 0.027429
## smokerno:obesoyes -0.091173 0.079280
## smokeryes:obesoyes 0.334267 0.676233##
## === Intervalos de Confianza al 99% ===## 0.5 % 99.5 %
## (Intercept) 6.610435 7.311106
## age 0.039240 0.068739
## I(age^2) -0.000425 -0.000057
## bmi -0.005736 0.013176
## children 0.066443 0.118629
## smokeryes 0.382177 1.421512
## regionnorthwest -0.148500 0.023902
## regionsoutheast -0.238880 -0.065451
## regionsouthwest -0.224107 -0.051310
## bmi:smokeryes -0.007851 0.032228
## smokerno:obesoyes -0.118012 0.106119
## smokeryes:obesoyes 0.280421 0.730079Interpretación — Intervalos de Confianza: Los intervalos de confianza al 95% permiten verificar la significancia estadística y la precisión de cada estimador:
age: IC 95% = [0.042, 0.066]. El intervalo excluye el cero, confirmando el efecto positivo de la edad sobre los gastos. La precisión es alta dado el rango estrecho.I(age²): IC 95% = [−0.0004, −0.00004]. El intervalo es negativo en su totalidad, confirmando la concavidad de la relación edad-gastos.bmi: El intervalo incluye el cero, consistente con su no significancia estadística.children: IC 95% = [0.073, 0.112]. Intervalo completamente positivo y estrecho; el efecto de los hijos es robusto.smokeryes: IC 95% = [0.508, 1.296]. Amplio pero positivo en su totalidad, reflejando el fuerte pero heterogéneo impacto del tabaquismo.smokeryes:obesoyes: IC 95% = [0.334, 0.676]. El intervalo excluye el cero con holgura, confirmando el efecto sinérgico y estadísticamente robusto de ser fumador obeso.- Las regiones southeast y southwest muestran intervalos negativos que excluyen el cero, confirmando sus menores costos respecto a northeast.
6 Pronósticos con Corrección de Sesgo Lognormal
X_m <- data.frame(age = 35, bmi = 28.5, children = 2, smoker = "no",
region = "southwest", obeso = "no")
# Varianza residual para la corrección analítica lognormal
sigma2 <- summary(modelo_mejorado)$sigma^2
cat("Varianza residual (σ²):", round(sigma2, 6), "\n")## Varianza residual (σ²): 0.18036# Intervalos de predicción al 95% y 99%
pred_95 <- predict(modelo_mejorado, newdata = X_m, interval = "prediction", level = 0.95)
pred_99 <- predict(modelo_mejorado, newdata = X_m, interval = "prediction", level = 0.99)
# Re-transformación con corrección de sesgo lognormal: E[Y] = exp(μ + σ²/2)
pred_95_exp <- exp(pred_95 + sigma2 / 2)
pred_99_exp <- exp(pred_99 + sigma2 / 2)
tabla_pronosticos <- rbind(pred_95_exp, pred_99_exp)
rownames(tabla_pronosticos) <- c("95%", "99%")
colnames(tabla_pronosticos) <- c("Pronóstico (Ym)", "Límite Inf (Li)", "Límite Sup (Ls)")
print("=== Pronósticos e intervalos de predicción re-transformados ($) ===")## [1] "=== Pronósticos e intervalos de predicción re-transformados ($) ==="## Pronóstico (Ym) Límite Inf (Li) Límite Sup (Ls)
## 95% 6626.49 2873.57 15280.78
## 99% 6626.49 2208.77 19880.01Interpretación — Pronóstico: Para un individuo de 35 años, IMC de 28.5, 2 hijos, no fumador, no obeso, residente en la región southwest, el modelo proyecta un gasto médico anual esperado de $6,626.49.
La corrección de sesgo lognormal (e^(pred + σ²/2)) es necesaria porque la variable dependiente fue transformada logarítmicamente: sin esta corrección, la re-exponenciación subestimaría sistemáticamente el valor esperado en escala original.
- Intervalo al 95%: los gastos se ubicarían entre $2,873.57 y $15,280.78 con un 95% de confianza.
- Intervalo al 99%: el rango se amplía a $2,208.77 – $19,880.01.
La amplitud de los intervalos refleja la heterogeneidad natural de los gastos médicos individuales, que son intrínsecamente difíciles de predecir con alta precisión a nivel individual, aunque el modelo captura adecuadamente la tendencia central del fenómeno.
7 Simulación de Validación Cruzada — 5,000 Réplicas
Um <- function(p, o) ((mean(p) - mean(o))^2) / MSE(p, o)
Us <- function(p, o) ((sd(p) - sd(o))^2) / MSE(p, o)
Uc <- function(p, o) (2 * (1 - cor(p, o)) * sd(p) * sd(o)) / MSE(p, o)set.seed(50)
numero_de_muestras <- 5000
muestras <- insurance$charges %>%
createDataPartition(p = 0.8, times = numero_de_muestras, list = TRUE)
Resultados_Performance_entrenamiento <- vector("list", numero_de_muestras)
Resultados_Performance_prueba <- vector("list", numero_de_muestras)
for (j in 1:numero_de_muestras) {
Datos_Entrenamiento <- insurance[ muestras[[j]], ]
Datos_Prueba <- insurance[-muestras[[j]], ]
mod_sub <- lm(
log(charges) ~ age + I(age^2) + bmi + children + smoker +
region + smoker:bmi + smoker:obeso,
data = Datos_Entrenamiento
)
pred_sub_test <- predict(mod_sub, newdata = Datos_Prueba)
Resultados_Performance_entrenamiento[[j]] <- data.frame(
R2 = R2(mod_sub$fitted.values, log(Datos_Entrenamiento$charges)),
RMSE = RMSE(mod_sub$fitted.values, log(Datos_Entrenamiento$charges)),
MAE = MAE(mod_sub$fitted.values, log(Datos_Entrenamiento$charges)),
MAPE = MAPE(mod_sub$fitted.values, log(Datos_Entrenamiento$charges)) * 100,
THEIL = TheilU(mod_sub$fitted.values, log(Datos_Entrenamiento$charges), type = 1),
Um = Um(mod_sub$fitted.values, log(Datos_Entrenamiento$charges)),
Us = Us(mod_sub$fitted.values, log(Datos_Entrenamiento$charges)),
Uc = Uc(mod_sub$fitted.values, log(Datos_Entrenamiento$charges))
)
Resultados_Performance_prueba[[j]] <- data.frame(
R2 = R2(pred_sub_test, log(Datos_Prueba$charges)),
RMSE = RMSE(pred_sub_test, log(Datos_Prueba$charges)),
MAE = MAE(pred_sub_test, log(Datos_Prueba$charges)),
MAPE = MAPE(pred_sub_test, log(Datos_Prueba$charges)) * 100,
THEIL = TheilU(pred_sub_test, log(Datos_Prueba$charges), type = 1),
Um = Um(pred_sub_test, log(Datos_Prueba$charges)),
Us = Us(pred_sub_test, log(Datos_Prueba$charges)),
Uc = Uc(pred_sub_test, log(Datos_Prueba$charges))
)
}bind_rows(Resultados_Performance_entrenamiento) %>%
stargazer(title = "Métricas Consolidadas — Entrenamiento 80% (5,000 iteraciones)",
type = "text", digits = 3)##
## Métricas Consolidadas — Entrenamiento 80% (5,000 iteraciones)
## ==========================================
## Statistic N Mean St. Dev. Min Max
## ------------------------------------------
## R2 5,000 0.789 0.008 0.766 0.816
## RMSE 5,000 0.422 0.007 0.395 0.443
## MAE 5,000 0.263 0.006 0.240 0.282
## MAPE 5,000 2.871 0.064 2.622 3.092
## THEIL 5,000 0.023 0.0004 0.022 0.024
## Um 5,000 0.000 0.000 0 0
## Us 5,000 0.059 0.002 0.051 0.067
## Uc 5,000 0.942 0.002 0.934 0.950
## ------------------------------------------bind_rows(Resultados_Performance_prueba) %>%
stargazer(title = "Capacidad Predictiva Real — Prueba 20% (5,000 réplicas)",
type = "text", digits = 3)##
## Capacidad Predictiva Real — Prueba 20% (5,000 réplicas)
## ============================================
## Statistic N Mean St. Dev. Min Max
## --------------------------------------------
## R2 5,000 0.786 0.031 0.681 0.878
## RMSE 5,000 0.426 0.029 0.330 0.525
## MAE 5,000 0.267 0.014 0.223 0.317
## MAPE 5,000 2.911 0.143 2.437 3.417
## THEIL 5,000 0.023 0.002 0.018 0.029
## Um 5,000 0.004 0.005 0.000 0.057
## Us 5,000 0.064 0.032 0.00004 0.218
## Uc 5,000 0.936 0.032 0.783 1.001
## --------------------------------------------Interpretación — Simulación de Validación Cruzada:
Muestra de entrenamiento (80%): El modelo presenta un R² promedio de 0.789 con muy baja dispersión (DE = 0.008), indicando estabilidad consistente del ajuste a través de las 5,000 particiones. El RMSE promedio de 0.422 y el MAPE de 2.87% confirman que el modelo predice el logaritmo de los gastos con un error relativo promedio menor al 3%, desempeño sobresaliente para un fenómeno de alta variabilidad individual.
Muestra de prueba (20%): El R² promedio en datos no vistos es 0.786, prácticamente idéntico al de entrenamiento (diferencia de apenas 0.003 puntos). Esta mínima brecha confirma la ausencia de sobreajuste: el modelo generaliza eficazmente a nuevas observaciones. El RMSE sube marginalmente a 0.426 y el MAPE a 2.91%.
Descomposición de Theil: El coeficiente U de Theil promedio es 0.023 en ambas muestras, próximo a cero, indicando que el modelo supera ampliamente a un pronóstico ingenuo (naive). La descomposición revela que prácticamente todo el error de predicción se concentra en el componente de covarianza (Uc ≈ 0.94), mientras que los errores sistemáticos de sesgo de media (Um ≈ 0.000–0.004) y varianza (Us ≈ 0.059–0.064) son mínimos. Este es el escenario deseable: el modelo no comete errores sistemáticos, y los residuales son de naturaleza aleatoria e impredecible, lo que valida la calidad del modelo especificado.
8 Conclusiones
El modelo de regresión lineal múltiple con transformación logarítmica especificado para los gastos médicos del seguro de salud presenta un desempeño global sólido y econométricamente fundamentado. Los hallazgos principales son:
- El tabaquismo es el principal factor de riesgo individual, con un incremento del 147% en gastos médicos para fumadores no obesos.
- La interacción tabaquismo-obesidad genera un efecto sinérgico que eleva los gastos en un 308% respecto a individuos sin ninguna de estas condiciones, confirmando la importancia de modelar conjuntamente ambos factores de riesgo.
- La edad ejerce un efecto creciente pero decreciente en su tasa de incremento, capturado adecuadamente por el término cuadrático.
- El número de hijos y la región geográfica contribuyen significativamente al nivel de gastos, con efectos menores pero estadísticamente robustos.
- La simulación con 5,000 réplicas confirma la capacidad predictiva del modelo: R² ≈ 0.786 en prueba, MAPE ≈ 2.91%, y ausencia de sobreajuste.
- La heterocedasticidad detectada fue corregida mediante errores estándar HC1, garantizando la validez de la inferencia estadística presentada.
9 Referencias Bibliográficas
- Wooldridge, J. M. (2010). Econometric Analysis of Cross Section and Panel Data. MIT Press.
- Greene, W. H. (2018). Econometric Analysis (8th ed.). Pearson.
- White, H. (1980). A heteroskedasticity-consistent covariance matrix estimator and a direct test for heteroskedasticity. Econometrica, 48(4), 817–838.
- Theil, H. (1966). Applied Economic Forecasting. North-Holland.
- Kaggle Dataset: Medical Cost Personal Datasets. https://www.kaggle.com/datasets/mirichoi0218/insurance