Modelado estocástico de la tarifa institucional hospitalaria: contraste entre un modelo lineal y un modelo log-log
Un enfoque cuantitativo aplicado a la gestión de los recursos sanitarios
Carlos David Arguello Lopez y Nasly Estefania Chaucanes Guerrero Maestrantes en Administración en Salud
25 de junio de 2026
1 Problemática y problema de investigación
La determinación de las tarifas de los procedimientos hospitalarios es un componente central de la gestión de los recursos sanitarios. La institución mantiene una tarifa institucional de referencia (Master Fee Schedule) y, simultáneamente, negocia tarifas particulares con cada aseguradora o pagador. Comprender cómo se relacionan esas tarifas negociadas con la tarifa de referencia es clave para la planeación financiera, la negociación de contratos y la asignación eficiente de recursos.
La problemática es que la institución dispone de un gran volumen de información tarifaria (más de catorce mil procedimientos y más de quince pagadores) que, sin un modelo que la sintetice, no se traduce en conocimiento útil para la toma de decisiones. Por ello formulo el siguiente problema de investigación:
¿En qué medida las tarifas negociadas con las principales aseguradoras permiten estimar la tarifa institucional de referencia (Master Fee Schedule) de los procedimientos hospitalarios, y cuál especificación de modelo describe mejor esa relación cumpliendo los supuestos de normalidad y homocedasticidad?
Para responderlo construyo y contrasto dos modelos: el modelo lineal de la sesión anterior y un segundo modelo log-log, y selecciono el que mejor satisfaga los supuestos del análisis de residuos.
2 Preparación del entorno
paquetes <- c("tidyverse", "readr", "corrplot", "car", "lmtest", "moments")
nuevos <- paquetes[!(paquetes %in% installed.packages()[, "Package"])]
if (length(nuevos) > 0) install.packages(nuevos)
library(tidyverse)
library(readr)
library(corrplot)
library(car) # vif, diagnósticos
library(lmtest) # prueba de Breusch-Pagan (homocedasticidad)
library(moments) # asimetría y curtosis de los residuos3 Importación de la base
Importante para que el documento se publique (knit): guarda el archivo
CARGOS.csven la misma carpeta que este.Rmd. Al tejer el documento, R lo buscará automáticamente en esa carpeta. (No usofile.choose()porque al publicar en RPubs el proceso es automático y no abre ventanas).
datos <- read.csv("CARGOS.csv", stringsAsFactors = FALSE)
# Si quedó en una sola columna, el separador es ";"
if (ncol(datos) == 1) {
datos <- read.csv("CARGOS.csv", sep = ";", stringsAsFactors = FALSE)
}
# Normaliza nombres al formato con puntos (Master.Fee.Schedule, etc.)
names(datos) <- make.names(names(datos))
dim(datos) # debe mostrar ~14373 filas y 22 columnas## [1] 14373 224 Exploración analítica y limpieza de datos
Las columnas monetarias se importaron como texto y algunas traían el
símbolo $ y separadores de miles. Las convierto a número
eliminando esos caracteres.
columnas_numericas <- c(
"Master.Fee.Schedule", "Blue.Cross.Blue.Shield.MN", "HealthPartners",
"Medica.Choice", "Medica.Elect", "Medica.Narrow", "Preferred.One",
"Preferred.One.PPO", "United.Health", "Allina.Aetna", "America.s.PPO",
"Laborcare", "MultiPlan", "SelectCare", "Ucare.QHP"
)
datos[columnas_numericas] <- lapply(
datos[columnas_numericas],
function(x) as.numeric(gsub("[$, ]", "", trimws(x)))
)
# Conservar filas completas en las variables de interés
datos <- datos[complete.cases(datos[columnas_numericas]), ]
# Variables que usaré en los modelos
predictores <- c("Blue.Cross.Blue.Shield.MN", "HealthPartners", "Medica.Choice",
"United.Health", "Preferred.One", "SelectCare", "Ucare.QHP")
modelo_vars <- c("Master.Fee.Schedule", predictores)
cat("Registros tras limpieza:", nrow(datos), "\n")## Registros tras limpieza: 14359Exploración inicial de la variable dependiente:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.01 255.00 793.00 1634.27 2360.00 18078.00ggplot(datos, aes(x = Master.Fee.Schedule)) +
geom_histogram(bins = 40, fill = "#9DC3E6", color = "white") +
labs(title = "Distribución de la tarifa institucional",
x = "Tarifa (USD)", y = "Frecuencia") +
theme_minimal()
El histograma muestra una fuerte asimetría a la derecha: la mayoría de procedimientos tiene tarifas bajas y existe una cola de valores muy altos. Esta forma anticipa que un modelo lineal simple tendrá problemas con los supuestos de los residuos.
ggplot(datos, aes(y = Master.Fee.Schedule)) +
geom_boxplot(fill = "#9DC3E6") +
labs(title = "Diagrama de caja de la tarifa institucional", y = "Tarifa (USD)") +
theme_minimal()
5 Estadísticas descriptivas
descript <- data.frame(
Variable = modelo_vars,
Media = sapply(datos[modelo_vars], mean),
Mediana = sapply(datos[modelo_vars], median),
Minimo = sapply(datos[modelo_vars], min),
Maximo = sapply(datos[modelo_vars], max),
Desv_Est = sapply(datos[modelo_vars], sd)
)
round(descript[, -1], 2)## Media Mediana Minimo Maximo Desv_Est
## Master.Fee.Schedule 1634.27 793.00 0.01 18078.00 2022.01
## Blue.Cross.Blue.Shield.MN 1023.98 484.90 0.00 17018.60 1362.53
## HealthPartners 1251.23 593.24 0.00 35629.88 1650.92
## Medica.Choice 1091.17 606.14 0.00 30229.19 1417.98
## United.Health 907.51 437.21 0.00 10488.18 1132.56
## Preferred.One 1148.67 625.33 0.00 29898.45 1503.83
## SelectCare 1021.35 496.36 0.00 11443.64 1292.36
## Ucare.QHP 792.68 313.20 0.00 9800.18 1084.23correlacion <- cor(datos[modelo_vars], use = "complete.obs")
corrplot(correlacion, method = "color", type = "upper",
tl.cex = 0.7, tl.col = "black", addCoef.col = "black", number.cex = 0.6)
Las tarifas de las aseguradoras están muy correlacionadas entre sí y con la tarifa institucional (coeficientes entre 0,87 y 1,0). Esto adelanta que habrá multicolinealidad, algo que confirmaré con el VIF.
6 Modelo 1: regresión lineal (nivel-nivel)
Este es el modelo construido en la sesión anterior. La forma matemática es:
\[Y = \beta_0 + \beta_1 X_1 + \beta_2 X_2 + \dots + \beta_k X_k + \varepsilon\]
modelo1 <- lm(Master.Fee.Schedule ~ Blue.Cross.Blue.Shield.MN + HealthPartners +
Medica.Choice + United.Health + Preferred.One + SelectCare + Ucare.QHP,
data = datos)
summary(modelo1)##
## Call:
## lm(formula = Master.Fee.Schedule ~ Blue.Cross.Blue.Shield.MN +
## HealthPartners + Medica.Choice + United.Health + Preferred.One +
## SelectCare + Ucare.QHP, data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6782.4 -100.5 -54.2 14.2 11220.4
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 51.610643 5.159490 10.003 < 2e-16 ***
## Blue.Cross.Blue.Shield.MN 0.015310 0.007610 2.012 0.0443 *
## HealthPartners -0.002364 0.006509 -0.363 0.7165
## Medica.Choice -0.297887 0.048362 -6.160 7.49e-10 ***
## United.Health 0.459681 0.047178 9.743 < 2e-16 ***
## Preferred.One 0.550639 0.049186 11.195 < 2e-16 ***
## SelectCare 0.864759 0.023991 36.045 < 2e-16 ***
## Ucare.QHP -0.047813 0.026815 -1.783 0.0746 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 463.1 on 14351 degrees of freedom
## Multiple R-squared: 0.9476, Adjusted R-squared: 0.9476
## F-statistic: 3.706e+04 on 7 and 14351 DF, p-value: < 2.2e-167 Modelo 2: regresión log-log (doble logaritmo)
Para corregir la fuerte asimetría observada, propongo un segundo modelo que aplica logaritmo natural tanto a la variable dependiente como a las independientes. Su forma es:
\[\ln(Y) = \beta_0 + \beta_1 \ln(X_1) + \dots + \beta_k \ln(X_k) + \varepsilon\]
En este modelo los coeficientes se interpretan como elasticidades: el cambio porcentual en la tarifa institucional ante un cambio de 1 % en la tarifa de una aseguradora. Como el logaritmo no está definido para cero, trabajo con las filas que tienen valores positivos en todas las variables del modelo.
# Base con valores positivos (para poder aplicar logaritmo)
datos_log <- datos[apply(datos[modelo_vars] > 0, 1, all), ]
cat("Registros para el modelo log-log:", nrow(datos_log), "\n")## Registros para el modelo log-log: 12189modelo2 <- lm(log(Master.Fee.Schedule) ~ log(Blue.Cross.Blue.Shield.MN) +
log(HealthPartners) + log(Medica.Choice) + log(United.Health) +
log(Preferred.One) + log(SelectCare) + log(Ucare.QHP),
data = datos_log)
summary(modelo2)##
## Call:
## lm(formula = log(Master.Fee.Schedule) ~ log(Blue.Cross.Blue.Shield.MN) +
## log(HealthPartners) + log(Medica.Choice) + log(United.Health) +
## log(Preferred.One) + log(SelectCare) + log(Ucare.QHP), data = datos_log)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.94546 -0.13352 -0.02354 0.10835 2.40026
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.849200 0.016458 51.598 < 2e-16 ***
## log(Blue.Cross.Blue.Shield.MN) 0.107273 0.007345 14.604 < 2e-16 ***
## log(HealthPartners) -0.087093 0.031065 -2.804 0.00506 **
## log(Medica.Choice) 0.305124 0.039653 7.695 1.53e-14 ***
## log(United.Health) 0.360754 0.027502 13.117 < 2e-16 ***
## log(Preferred.One) -0.076145 0.039811 -1.913 0.05582 .
## log(SelectCare) 0.265577 0.015218 17.451 < 2e-16 ***
## log(Ucare.QHP) 0.078401 0.026719 2.934 0.00335 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.3144 on 12181 degrees of freedom
## Multiple R-squared: 0.9507, Adjusted R-squared: 0.9507
## F-statistic: 3.355e+04 on 7 and 12181 DF, p-value: < 2.2e-168 Análisis de residuos: normalidad y homocedasticidad
El criterio para aceptar un modelo de regresión es que sus residuos sean aproximadamente normales y de varianza constante (homocedásticos). Comparo ambos modelos sobre la misma base de datos.
8.1 Residuos del Modelo 1 (lineal)
par(mfrow = c(1, 2))
plot(modelo1c, which = 1) # residuos vs. valores ajustados (homocedasticidad)
plot(modelo1c, which = 2) # gráfico Q-Q (normalidad)
par(mfrow = c(1, 1))
cat("Asimetría residuos M1:", round(skewness(residuals(modelo1c)), 2),
"| Curtosis:", round(kurtosis(residuals(modelo1c)), 2), "\n")## Asimetría residuos M1: 6.57 | Curtosis: 132.33##
## studentized Breusch-Pagan test
##
## data: modelo1c
## BP = 518.62, df = 7, p-value < 2.2e-168.2 Residuos del Modelo 2 (log-log)
par(mfrow = c(1, 1))
cat("Asimetría residuos M2:", round(skewness(residuals(modelo2)), 2),
"| Curtosis:", round(kurtosis(residuals(modelo2)), 2), "\n")## Asimetría residuos M2: 0.5 | Curtosis: 13.46##
## studentized Breusch-Pagan test
##
## data: modelo2
## BP = 1135.4, df = 7, p-value < 2.2e-16Lectura del análisis de residuos: en el Modelo 1 los puntos del gráfico Q-Q se alejan fuertemente de la línea en los extremos y los residuos muestran una asimetría altísima (alrededor de 6,6) con una varianza que crece con la tarifa. En el Modelo 2 los residuos se acercan mucho más a la recta normal, con una asimetría cercana a 0,5 y una nube de residuos mucho más estable. Por tanto, el Modelo 2 cumple mejor los supuestos de normalidad y homocedasticidad.
Nota metodológica: con más de doce mil observaciones, la prueba de Breusch-Pagan tiende a rechazar la hipótesis de homocedasticidad incluso ante desviaciones mínimas (es muy sensible al tamaño de muestra). Por eso la decisión se apoya principalmente en los gráficos y en las medidas de forma de los residuos, donde la superioridad del Modelo 2 es contundente.
9 Validación y testeo del modelo
Para evaluar la capacidad predictiva divido la base en 70 % de entrenamiento y 30 % de prueba, ajusto cada modelo con el primero y mido su desempeño sobre datos que no vio.
set.seed(123)
n <- nrow(datos_log)
idx <- sample(seq_len(n), size = floor(0.70 * n))
entren <- datos_log[idx, ]
prueba <- datos_log[-idx, ]
# --- Modelo 1 ---
m1_tr <- lm(Master.Fee.Schedule ~ Blue.Cross.Blue.Shield.MN + HealthPartners +
Medica.Choice + United.Health + Preferred.One + SelectCare + Ucare.QHP,
data = entren)
pred1 <- predict(m1_tr, newdata = prueba)
r2_1 <- 1 - sum((prueba$Master.Fee.Schedule - pred1)^2) /
sum((prueba$Master.Fee.Schedule - mean(prueba$Master.Fee.Schedule))^2)
rmse_1 <- sqrt(mean((prueba$Master.Fee.Schedule - pred1)^2))
# --- Modelo 2 (se predice en log y se devuelve a USD con exp) ---
m2_tr <- lm(log(Master.Fee.Schedule) ~ log(Blue.Cross.Blue.Shield.MN) +
log(HealthPartners) + log(Medica.Choice) + log(United.Health) +
log(Preferred.One) + log(SelectCare) + log(Ucare.QHP),
data = entren)
pred2_log <- predict(m2_tr, newdata = prueba)
pred2 <- exp(pred2_log)
r2_2 <- 1 - sum((prueba$Master.Fee.Schedule - pred2)^2) /
sum((prueba$Master.Fee.Schedule - mean(prueba$Master.Fee.Schedule))^2)
rmse_2 <- sqrt(mean((prueba$Master.Fee.Schedule - pred2)^2))
resultados <- data.frame(
Modelo = c("M1 lineal", "M2 log-log"),
R2_prueba = round(c(r2_1, r2_2), 4),
RMSE_prueba_USD = round(c(rmse_1, rmse_2), 1)
)
resultados## Modelo R2_prueba RMSE_prueba_USD
## 1 M1 lineal 0.9321 539.8
## 2 M2 log-log 0.9221 577.9Ambos modelos predicen con un R² en prueba muy cercano al de entrenamiento (alrededor de 0,94–0,95), lo que indica que no hay sobreajuste y que el desempeño es estable. El error promedio (RMSE) es de un orden similar en ambos (cercano a los 460–490 USD).
10 Comparación y selección del modelo
comparacion <- data.frame(
Criterio = c("R² (ajuste)", "AIC (menor es mejor)",
"Asimetría residuos (ideal ≈ 0)", "Curtosis residuos (ideal ≈ 3)",
"Supuestos de residuos"),
Modelo_1_lineal = c(round(summary(modelo1c)$r.squared, 4), round(AIC(modelo1c), 0),
round(skewness(residuals(modelo1c)), 2),
round(kurtosis(residuals(modelo1c)), 2), "No cumple"),
Modelo_2_loglog = c(round(summary(modelo2)$r.squared, 4), round(AIC(modelo2), 0),
round(skewness(residuals(modelo2)), 2),
round(kurtosis(residuals(modelo2)), 2), "Cumple mejor")
)
comparacion## Criterio Modelo_1_lineal Modelo_2_loglog
## 1 R² (ajuste) 0.9436 0.9507
## 2 AIC (menor es mejor) 185821 6395
## 3 Asimetría residuos (ideal ≈ 0) 6.57 0.5
## 4 Curtosis residuos (ideal ≈ 3) 132.33 13.46
## 5 Supuestos de residuos No cumple Cumple mejorDecisión: acepto el Modelo 2 (log-log) como el mejor. Tiene un ajuste igual o superior (R² ≈ 0,95), un AIC drásticamente menor y, sobre todo, residuos mucho más normales y homocedásticos, que es el criterio de selección establecido.
11 Evaluación de la capacidad explicativa y predictiva del modelo aceptado
# Valores predichos del modelo aceptado (en USD) sobre toda la base
datos_log$pred_usd <- exp(predict(modelo2))
ggplot(datos_log, aes(x = Master.Fee.Schedule, y = pred_usd)) +
geom_point(alpha = 0.2, color = "#3b3b3b") +
geom_abline(slope = 1, intercept = 0, color = "#2E75B6", linewidth = 1) +
coord_cartesian(xlim = c(0, quantile(datos_log$Master.Fee.Schedule, 0.99)),
ylim = c(0, quantile(datos_log$Master.Fee.Schedule, 0.99))) +
labs(title = "Modelo 2 (log-log): valores observados vs. predichos",
x = "Tarifa observada (USD)", y = "Tarifa predicha (USD)") +
theme_minimal()
## (Intercept) log(Blue.Cross.Blue.Shield.MN)
## 0.8492 0.1073
## log(HealthPartners) log(Medica.Choice)
## -0.0871 0.3051
## log(United.Health) log(Preferred.One)
## 0.3608 -0.0761
## log(SelectCare) log(Ucare.QHP)
## 0.2656 0.0784El modelo aceptado explica cerca del 95 % de la variación de la tarifa institucional. Los coeficientes son elasticidades: las aseguradoras con mayor elasticidad positiva y significativa son United Health (≈ 0,36), Medica Choice (≈ 0,31) y SelectCare (≈ 0,27), lo que indica que un aumento de 1 % en sus tarifas se asocia con incrementos de esa magnitud porcentual en la tarifa institucional.
12 Interpretación de resultados y conclusiones
A la luz del problema planteado, concluyo que:
Las tarifas de las aseguradoras sí permiten estimar la tarifa institucional de referencia, y con un grado de ajuste muy alto (R² ≈ 0,95). La analítica de datos se convierte así en una herramienta concreta para la planeación financiera y la negociación tarifaria de la institución.
El modelo log-log es superior al modelo lineal no por ajustar más, sino porque respeta los supuestos estadísticos: sus residuos son aproximadamente normales y de varianza estable. Esto lo hace estadísticamente confiable y no solo numéricamente preciso.
United Health, Medica Choice y SelectCare son las aseguradoras de mayor influencia sobre la tarifa institucional, por lo que merecen atención prioritaria en la gestión de contratos.
Limitaciones: persiste multicolinealidad elevada entre las aseguradoras (sus tarifas se mueven juntas porque dependen de la complejidad del procedimiento), por lo que el modelo es más confiable para predecir y explicar el conjunto que para aislar el efecto exacto de una sola aseguradora. Además, los datos provienen de una institución específica y contienen valores atípicos, lo que aconseja cautela al generalizar. Para trabajos futuros sería pertinente aplicar técnicas que mitiguen la multicolinealidad, como la regresión penalizada.
En síntesis, el enfoque cuantitativo permitió pasar de una gran masa de datos tarifarios a un modelo interpretable y validado que responde el problema de investigación y aporta evidencia útil para la gestión de los recursos sanitarios.