La polifarmacia es un fenómeno clínico y epidemiológico de creciente importancia en los sistemas de salud. Se define comúnmente como el uso concurrente de cinco o más medicamentos, aunque existen variantes operativas según el contexto clínico y la fuente de datos. Su importancia radica en su asociación consistente con mayor riesgo de interacciones clínicamente significativas, reacciones adversas a medicamentos, deterioro funcional, fragilidad, hospitalizaciones prevenibles y mayor gasto sanitario.
En adultos mayores, la prevalencia suele superar el 30–40% y aumenta con la multimorbilidad; sin embargo, en la última década la polifarmacia también se ha desplazado hacia adultos de mediana edad con múltiples condiciones crónicas. Desde el enfoque epidemiológico, identificar factores asociados permite priorizar subgrupos con alta complejidad clínica y orientar estrategias de optimización farmacoterapéutica.
Para este trabajo se utiliza el dataset polypharm, incluido en el paquete aplore3 y empleado clásicamente en Applied Logistic Regression (Hosmer, Lemeshow & Sturdivant) como ejemplo docente para regresión logística y evaluación de ajuste mediante Hosmer–Lemeshow.
Objetivos 1. Describir la distribución de polifarmacia y covariables en la cohorte. 2. Explorar asociaciones bivariadas con polifarmacia. 3. Ajustar un modelo logístico multivariable para estimar odds ratios (OR) independientes. 4. Evaluar colinealidad, ajuste y discriminación del modelo.
data("polypharm", package = "aplore3")
polypharm <- polypharm |> clean_names()
kable(head(polypharm), caption="Primeras filas de polypharm") |>
kable_styling(full_width = FALSE)
| id | polypharmacy | mhv4 | inptmhv3 | year | group | urban | comorbid | anyprim | numprim | gender | race | ethnic | age |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | No | 0 | 0 | 2002 | CFC | Urban | Yes | Yes | 1 | Female | White | Non-Hisp | 4.67 |
| 1 | No | 1-5 | 0 | 2003 | CFC | Urban | Yes | Yes | 1 | Female | White | Non-Hisp | 5.67 |
| 1 | No | 0 | 0 | 2004 | CFC | Urban | No | No | 0 | Female | White | Non-Hisp | 6.00 |
| 1 | No | 1-5 | 0 | 2005 | CFC | Urban | Yes | Yes | 1 | Female | White | Non-Hisp | 7.08 |
| 1 | No | 0 | 0 | 2006 | CFC | Urban | Yes | Yes | 1 | Female | White | Non-Hisp | 8.00 |
| 1 | No | 1-5 | 0 | 2007 | ABD | Urban | Yes | Yes | 1 | Female | White | Non-Hisp | 9.92 |
as_numeric_safe <- function(x){
if (is.numeric(x)) return(x)
if (is.factor(x) || is.character(x)) return(as.numeric(as.character(x)))
suppressWarnings(as.numeric(x))
}
to_binary_outcome <- function(x){
x <- as.character(x)
x <- trimws(tolower(x))
yes <- c("yes","y","si","sí","1","true","polypharmacy","with polypharmacy")
no <- c("no","n","0","false","without polypharmacy","no polypharmacy")
ifelse(x %in% yes, 1L, ifelse(x %in% no, 0L, NA_integer_))
}
wilcox_robust <- function(data, var, group_bin="polypharm_bin"){
d <- data[!is.na(data[[var]]) & !is.na(data[[group_bin]]), ]
if (length(unique(d[[group_bin]])) != 2) {
return(list(test = NULL,
note = paste0("Wilcoxon no aplicable en ", var,
": el agrupador no tiene 2 niveles después de limpieza.")))
}
g0 <- d[d[[group_bin]] == 0, ][[var]]
g1 <- d[d[[group_bin]] == 1, ][[var]]
safe_test <- try(wilcox.test(g0, g1, conf.int = TRUE, exact = FALSE), silent = TRUE)
if (inherits(safe_test, "try-error")) {
safe_test <- try(wilcox.test(g0, g1, conf.int = FALSE, exact = FALSE), silent = TRUE)
}
if (inherits(safe_test, "try-error")) {
return(list(test=NULL,
note=paste0("Wilcoxon falló incluso en modo seguro al analizar ", var,
". Distribución degenerada / empates extremos.")))
}
list(test=safe_test, note=NULL)
}
or_robust <- function(tab){
if (all(dim(tab)==c(2,2))) epi.2by2(tab, method="cohort.count", conf.level=0.95) else NULL
}
numeric_vars <- c("age","comorbid","numprim","mhv4","inptmhv3","year")
polypharm[numeric_vars] <- lapply(polypharm[numeric_vars], as_numeric_safe)
polypharm$polypharm_bin <- to_binary_outcome(polypharm$polypharmacy)
polypharm <- polypharm |> filter(!is.na(polypharm_bin))
polypharm$polypharmacy2 <- factor(ifelse(polypharm$polypharm_bin==1,"Yes","No"),
levels=c("No","Yes"))
polypharm <- polypharm |>
mutate(
gender = droplevels(as.factor(gender)),
race = droplevels(as.factor(race)),
ethnic = droplevels(as.factor(ethnic)),
urban = droplevels(as.factor(urban)),
anyprim= droplevels(as.factor(anyprim))
)
table(polypharm$polypharmacy2)
##
## No Yes
## 2681 819
var_table <- tribble(
~Variable, ~`Definición operativa`, ~`Tipo`, ~`Códigos / Unidad`,
"polypharmacy2","Uso simultáneo de ≥5 medicamentos", "Dicotómica", "No/Sí",
"age", "Edad en años", "Continua", "Años",
"gender", "Sexo/género", "Nominal", "Según dataset",
"race", "Raza/etnia", "Nominal multinivel","Según dataset",
"ethnic", "Etnicidad hispano/latina", "Dicotómica", "No/Sí",
"urban", "Área urbana/rural", "Dicotómica", "Rural/Urbano",
"comorbid", "Número de comorbilidades", "Discreta", "Conteo",
"anyprim", "≥1 visita en atención primaria", "Dicotómica", "No/Sí",
"numprim", "Número de visitas en atención primaria", "Discreta", "Conteo",
"mhv4", "Visitas de salud mental ambulatoria", "Discreta", "Conteo",
"inptmhv3", "Hospitalizaciones por salud mental", "Discreta", "Conteo",
"year", "Año calendario", "Ordinal discreta","Año"
)
kable(var_table, caption="Cuadro operacional de variables") |>
kable_styling(full_width = FALSE)
| Variable | Definición operativa | Tipo | Códigos / Unidad |
|---|---|---|---|
| polypharmacy2 | Uso simultáneo de ≥5 medicamentos | Dicotómica | No/Sí |
| age | Edad en años | Continua | Años |
| gender | Sexo/género | Nominal | Según dataset |
| race | Raza/etnia | Nominal multinivel | Según dataset |
| ethnic | Etnicidad hispano/latina | Dicotómica | No/Sí |
| urban | Área urbana/rural | Dicotómica | Rural/Urbano |
| comorbid | Número de comorbilidades | Discreta | Conteo |
| anyprim | ≥1 visita en atención primaria | Dicotómica | No/Sí |
| numprim | Número de visitas en atención primaria | Discreta | Conteo |
| mhv4 | Visitas de salud mental ambulatoria | Discreta | Conteo |
| inptmhv3 | Hospitalizaciones por salud mental | Discreta | Conteo |
| year | Año calendario | Ordinal discreta | Año |
plan_analisis <- tribble(
~Variable, ~Tipo, ~Descripción_Univariada, ~Comparación_Bivariada, ~Medida_de_Efecto,
"Edad (age)", "Continua", "Mediana(RIQ), histograma, QQ plot", "Wilcoxon robusto", "Δ medianas IC95%",
"Sexo/género (gender)", "Nominal", "n (%)", "Chi²/Fisher", "OR cruda IC95%",
"Etnicidad (ethnic)", "Dicotómica", "n (%)", "Chi²/Fisher", "OR cruda IC95%",
"Raza/etnia (race)", "Nominal multinivel", "n (%)", "Chi²/Fisher", "V de Cramer",
"Urbanidad (urban)", "Dicotómica", "n (%)", "Chi²/Fisher", "OR cruda IC95%",
"Comorbilidades (comorbid)", "Discreta", "Mediana(RIQ)", "Wilcoxon robusto", "Δ medianas IC95%",
"≥1 visita primaria (anyprim)", "Dicotómica", "n (%)", "Chi²/Fisher", "OR cruda IC95%",
"Visitas primaria (numprim)", "Discreta", "Mediana(RIQ)", "Wilcoxon robusto", "Δ medianas IC95%",
"Visitas SM (mhv4)", "Discreta", "Mediana(RIQ)", "Wilcoxon robusto", "Δ medianas IC95%",
"Hosp. SM (inptmhv3)", "Discreta", "Mediana(RIQ)", "Wilcoxon robusto", "Δ medianas IC95%",
"Año (year)", "Ordinal discreta", "Distribución por año", "Cochran–Armitage (tabla 2×k)", "Pendiente tendencia"
)
kable(plan_analisis, caption="Plan operativo de análisis estadístico") |>
kable_styling(full_width = FALSE)
| Variable | Tipo | Descripción_Univariada | Comparación_Bivariada | Medida_de_Efecto |
|---|---|---|---|---|
| Edad (age) | Continua | Mediana(RIQ), histograma, QQ plot | Wilcoxon robusto | Δ medianas IC95% |
| Sexo/género (gender) | Nominal | n (%) | Chi²/Fisher | OR cruda IC95% |
| Etnicidad (ethnic) | Dicotómica | n (%) | Chi²/Fisher | OR cruda IC95% |
| Raza/etnia (race) | Nominal multinivel | n (%) | Chi²/Fisher | V de Cramer |
| Urbanidad (urban) | Dicotómica | n (%) | Chi²/Fisher | OR cruda IC95% |
| Comorbilidades (comorbid) | Discreta | Mediana(RIQ) | Wilcoxon robusto | Δ medianas IC95% |
| ≥1 visita primaria (anyprim) | Dicotómica | n (%) | Chi²/Fisher | OR cruda IC95% |
| Visitas primaria (numprim) | Discreta | Mediana(RIQ) | Wilcoxon robusto | Δ medianas IC95% |
| Visitas SM (mhv4) | Discreta | Mediana(RIQ) | Wilcoxon robusto | Δ medianas IC95% |
| Hosp. SM (inptmhv3) | Discreta | Mediana(RIQ) | Wilcoxon robusto | Δ medianas IC95% |
| Año (year) | Ordinal discreta | Distribución por año | Cochran–Armitage (tabla 2×k) | Pendiente tendencia |
ggplot(polypharm, aes(age)) +
geom_histogram(bins = 30) +
labs(title="Distribución de edad", x="Edad (años)", y="Frecuencia")
qqnorm(polypharm$age); qqline(polypharm$age)
desc_general <- polypharm %>%
summarise(
n = n(),
edad_mediana = median(age, na.rm=TRUE),
edad_RIQ = IQR(age, na.rm=TRUE),
prevalencia_polifarmacia = mean(polypharm_bin, na.rm=TRUE)*100
)
desc_general
## n edad_mediana edad_RIQ prevalencia_polifarmacia
## 1 3500 11.75 4.08 23.4
En total se analizaron 3500 participantes. La edad mediana fue de 11.8 años (RIQ 4.1). La prevalencia de polifarmacia fue 23.4%.
vars <- c("age","gender","race","ethnic","urban","comorbid","anyprim","numprim","mhv4","inptmhv3","year")
tab1 <- CreateTableOne(vars = vars, strata = "polypharmacy2", data = polypharm, addOverall = TRUE)
print(tab1, showAllLevels = TRUE, quote = FALSE, noSpaces = TRUE)
## Stratified by polypharmacy2
## level Overall No Yes
## n 3500 2681 819
## age (mean (SD)) 11.65 (2.90) 11.48 (2.94) 12.20 (2.72)
## gender (%) Female 798 (22.8) 660 (24.6) 138 (16.8)
## Male 2702 (77.2) 2021 (75.4) 681 (83.2)
## race (%) White 2926 (83.6) 2210 (82.4) 716 (87.4)
## Black 553 (15.8) 454 (16.9) 99 (12.1)
## Other 21 (0.6) 17 (0.6) 4 (0.5)
## ethnic (%) Non-Hisp 3458 (98.8) 2645 (98.7) 813 (99.3)
## Hispanic 42 (1.2) 36 (1.3) 6 (0.7)
## urban (%) Urban 2529 (72.3) 1944 (72.5) 585 (71.5)
## Rural 970 (27.7) 737 (27.5) 233 (28.5)
## anyprim (%) No 991 (28.3) 755 (28.2) 236 (28.8)
## Yes 2509 (71.7) 1926 (71.8) 583 (71.2)
## numprim (mean (SD)) 0.71 (0.45) 0.71 (0.45) 0.71 (0.45)
## mhv4 (mean (SD)) 0.00 (0.00) 0.00 (0.00) 0.00 (0.00)
## inptmhv3 (mean (SD)) 0.04 (0.18) 0.02 (0.14) 0.09 (0.28)
## year (mean (SD)) 2005.00 (2.00) 2004.89 (2.02) 2005.37 (1.90)
## Stratified by polypharmacy2
## p test
## n
## age (mean (SD)) <0.001
## gender (%) <0.001
##
## race (%) 0.003
##
##
## ethnic (%) 0.222
##
## urban (%) 0.609
##
## anyprim (%) 0.749
##
## numprim (mean (SD)) 0.917
## mhv4 (mean (SD)) NaN
## inptmhv3 (mean (SD)) <0.001
## year (mean (SD)) <0.001
wa <- wilcox_robust(polypharm, "age")
med_age <- polypharm %>% group_by(polypharmacy2) %>%
summarise(med=median(age,na.rm=TRUE), riq=IQR(age,na.rm=TRUE))
wa$test; med_age
##
## Wilcoxon rank sum test with continuity correction
##
## data: g0 and g1
## W = 942243, p-value = 7.798e-10
## alternative hypothesis: true location shift is not equal to 0
## 95 percent confidence interval:
## -0.9999300 -0.5000475
## sample estimates:
## difference in location
## -0.7499576
## # A tibble: 2 × 3
## polypharmacy2 med riq
## <fct> <dbl> <dbl>
## 1 No 11.6 4.08
## 2 Yes 12.4 3.92
La edad fue mayor en el grupo con polifarmacia (mediana 12.4 vs 11.6 años; p=7.8^{-10}).
wc <- wilcox_robust(polypharm, "comorbid")
med_comorbid <- polypharm %>% group_by(polypharmacy2) %>%
summarise(med=median(comorbid,na.rm=TRUE), riq=IQR(comorbid,na.rm=TRUE))
wc$test; med_comorbid
## NULL
## # A tibble: 2 × 3
## polypharmacy2 med riq
## <fct> <dbl> <dbl>
## 1 No NA NA
## 2 Yes NA NA
La carga de comorbilidad fue superior en quienes presentaron polifarmacia (mediana NA vs NA; p=NA).
wn <- wilcox_robust(polypharm, "numprim")
med_numprim <- polypharm %>% group_by(polypharmacy2) %>%
summarise(med=median(numprim,na.rm=TRUE), riq=IQR(numprim,na.rm=TRUE))
wn$test; med_numprim
##
## Wilcoxon rank sum test with continuity correction
##
## data: g0 and g1
## W = 1066234, p-value = 0.9171
## alternative hypothesis: true location shift is not equal to 0
## 95 percent confidence interval:
## -2.615046e-05 5.511049e-05
## sample estimates:
## difference in location
## 9.542391e-06
## # A tibble: 2 × 3
## polypharmacy2 med riq
## <fct> <dbl> <dbl>
## 1 No 1 1
## 2 Yes 1 1
El número de visitas a atención primaria fue mayor en el grupo con polifarmacia (mediana 1 vs 1; p=0.917).
wm <- wilcox_robust(polypharm, "mhv4")
med_mhv4 <- polypharm %>% group_by(polypharmacy2) %>%
summarise(med=median(mhv4,na.rm=TRUE), riq=IQR(mhv4,na.rm=TRUE))
wm$test; med_mhv4
##
## Wilcoxon rank sum test with continuity correction
##
## data: g0 and g1
## W = 11308, p-value = NA
## alternative hypothesis: true location shift is not equal to 0
## # A tibble: 2 × 3
## polypharmacy2 med riq
## <fct> <dbl> <dbl>
## 1 No 0 0
## 2 Yes 0 0
Las visitas ambulatorias por salud mental mostraron un gradiente hacia valores mayores en polifarmacia (mediana 0 vs 0; p=NaN).
wi <- wilcox_robust(polypharm, "inptmhv3")
med_inpt <- polypharm %>% group_by(polypharmacy2) %>%
summarise(med=median(inptmhv3,na.rm=TRUE), riq=IQR(inptmhv3,na.rm=TRUE))
wi$test; med_inpt
##
## Wilcoxon rank sum test with continuity correction
##
## data: g0 and g1
## W = 982173, p-value < 2.2e-16
## alternative hypothesis: true location shift is not equal to 0
## 95 percent confidence interval:
## -1.295909e-05 -4.311009e-05
## sample estimates:
## difference in location
## -4.357551e-05
## # A tibble: 2 × 3
## polypharmacy2 med riq
## <fct> <dbl> <dbl>
## 1 No 0 0
## 2 Yes 0 0
Las hospitalizaciones por salud mental fueron más frecuentes en el grupo con polifarmacia (mediana 0 vs 0; p=1.56^{-20}).
tab_gender <- table(polypharm$gender, polypharm$polypharmacy2)
chi_gender <- suppressWarnings(chisq.test(tab_gender))
or_gender <- or_robust(tab_gender)
tab_gender; chi_gender; or_gender
##
## No Yes
## Female 660 138
## Male 2021 681
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: tab_gender
## X-squared = 21.067, df = 1, p-value = 4.435e-06
## Outcome+ Outcome- Total Inc risk *
## Exposure+ 660 138 798 82.71 (79.90 to 85.27)
## Exposure- 2021 681 2702 74.80 (73.11 to 76.42)
## Total 2681 819 3500 76.60 (75.16 to 77.99)
##
## Point estimates and 95% CIs:
## -------------------------------------------------------------------
## Inc risk ratio 1.11 (1.06, 1.15)
## Inc odds ratio 1.61 (1.32, 1.97)
## Attrib risk in the exposed * 7.91 (4.82, 11.00)
## Attrib fraction in the exposed (%) 9.56 (5.87, 12.87)
## Attrib risk in the population * 1.80 (-0.35, 3.96)
## Attrib fraction in the population (%) 2.35 (2.01, 2.72)
## -------------------------------------------------------------------
## Uncorrected chi2 test that OR = 1: chi2(1) = 21.506 Pr>chi2 = <0.001
## Fisher exact test that OR = 1: Pr>chi2 = <0.001
## Wald confidence limits
## CI: confidence interval
## * Outcomes per 100 population units
Se observaron diferencias en polifarmacia según género (p=4.43^{-6}).
tab_race <- table(polypharm$race, polypharm$polypharmacy2)
chi_race <- suppressWarnings(chisq.test(tab_race))
v_cramer <- CramerV(tab_race)
tab_race; chi_race; v_cramer
##
## No Yes
## White 2210 716
## Black 454 99
## Other 17 4
##
## Pearson's Chi-squared test
##
## data: tab_race
## X-squared = 11.417, df = 2, p-value = 0.003318
## [1] 0.05711269
La polifarmacia difirió entre categorías de raza/etnia (χ² p=0.00332, V de Cramer=0.06).
tab_ethnic <- table(polypharm$ethnic, polypharm$polypharmacy2)
chi_ethnic <- suppressWarnings(chisq.test(tab_ethnic))
or_ethnic <- or_robust(tab_ethnic)
tab_ethnic; chi_ethnic; or_ethnic
##
## No Yes
## Non-Hisp 2645 813
## Hispanic 36 6
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: tab_ethnic
## X-squared = 1.4891, df = 1, p-value = 0.2224
## Outcome+ Outcome- Total Inc risk *
## Exposure+ 2645 813 3458 76.49 (75.04 to 77.89)
## Exposure- 36 6 42 85.71 (71.46 to 94.57)
## Total 2681 819 3500 76.60 (75.16 to 77.99)
##
## Point estimates and 95% CIs:
## -------------------------------------------------------------------
## Inc risk ratio 0.89 (0.79, 1.01)
## Inc odds ratio 0.54 (0.23, 1.29)
## Attrib risk in the exposed * -9.22 (-19.90, 1.45)
## Attrib fraction in the exposed (%) -12.06 (-22.30, 5.73)
## Attrib risk in the population * -9.11 (-19.79, 1.56)
## Attrib fraction in the population (%) -11.90 (-21.25, 4.92)
## -------------------------------------------------------------------
## Uncorrected chi2 test that OR = 1: chi2(1) = 1.970 Pr>chi2 = 0.160
## Fisher exact test that OR = 1: Pr>chi2 = 0.200
## Wald confidence limits
## CI: confidence interval
## * Outcomes per 100 population units
La etnicidad mostró asociación bivariada con polifarmacia (p=0.222).
tab_urban <- table(polypharm$urban, polypharm$polypharmacy2)
chi_urban <- suppressWarnings(chisq.test(tab_urban))
or_urban <- or_robust(tab_urban)
tab_urban; chi_urban; or_urban
##
## No Yes
## Urban 1944 585
## Rural 737 233
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: tab_urban
## X-squared = 0.26165, df = 1, p-value = 0.609
## Outcome+ Outcome- Total Inc risk *
## Exposure+ 1944 585 2529 76.87 (75.17 to 78.50)
## Exposure- 737 233 970 75.98 (73.16 to 78.64)
## Total 2681 818 3499 76.62 (75.18 to 78.02)
##
## Point estimates and 95% CIs:
## -------------------------------------------------------------------
## Inc risk ratio 1.01 (0.97, 1.05)
## Inc odds ratio 1.05 (0.88, 1.25)
## Attrib risk in the exposed * 0.89 (-2.26, 4.04)
## Attrib fraction in the exposed (%) 1.16 (-2.90, 5.28)
## Attrib risk in the population * 0.64 (-2.39, 3.67)
## Attrib fraction in the population (%) 0.84 (-0.80, 2.69)
## -------------------------------------------------------------------
## Uncorrected chi2 test that OR = 1: chi2(1) = 0.309 Pr>chi2 = 0.578
## Fisher exact test that OR = 1: Pr>chi2 = 0.592
## Wald confidence limits
## CI: confidence interval
## * Outcomes per 100 population units
La urbanidad se asoció con polifarmacia en el análisis bivariado (p=0.609)
tab_any <- table(polypharm$anyprim, polypharm$polypharmacy2)
chi_any <- suppressWarnings(chisq.test(tab_any))
or_any <- or_robust(tab_any)
tab_any; chi_any; or_any
##
## No Yes
## No 755 236
## Yes 1926 583
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: tab_any
## X-squared = 0.10212, df = 1, p-value = 0.7493
## Outcome+ Outcome- Total Inc risk *
## Exposure+ 755 236 991 76.19 (73.41 to 78.81)
## Exposure- 1926 583 2509 76.76 (75.06 to 78.40)
## Total 2681 819 3500 76.60 (75.16 to 77.99)
##
## Point estimates and 95% CIs:
## -------------------------------------------------------------------
## Inc risk ratio 0.99 (0.95, 1.03)
## Inc odds ratio 0.97 (0.81, 1.15)
## Attrib risk in the exposed * -0.58 (-3.70, 2.55)
## Attrib fraction in the exposed (%) -0.76 (-5.10, 3.17)
## Attrib risk in the population * -0.16 (-2.33, 2.00)
## Attrib fraction in the population (%) -0.21 (-0.53, 0.13)
## -------------------------------------------------------------------
## Uncorrected chi2 test that OR = 1: chi2(1) = 0.132 Pr>chi2 = 0.716
## Fisher exact test that OR = 1: Pr>chi2 = 0.723
## Wald confidence limits
## CI: confidence interval
## * Outcomes per 100 population units
Tener al menos una visita a atención primaria se relacionó con polifarmacia (p=0.749).
tab_year <- table(polypharm$polypharm_bin, polypharm$year)
trend_year <- CochranArmitageTest(tab_year)
trend_year
##
## Cochran-Armitage test for trend
##
## data: tab_year
## Z = -6.0087, dim = 7, p-value = 1.87e-09
## alternative hypothesis: two.sided
Se evidenció una tendencia temporal significativa de polifarmacia a lo largo de los años (p=1.87^{-9}).
## Regresión Logística Simple (OR Crudos)
# Función para ajustar y extraer el ORc
fit_simple_glm <- function(data, predictor_var, outcome_var = "polypharmacy2") {
# 1. Asegurar no NA en las variables de interés
df_clean <- data |>
dplyr::select(all_of(c(outcome_var, predictor_var))) |>
drop_na()
# 2. Reaplicar droplevels si es factor para evitar problemas de contraste
df_clean <- df_clean |>
mutate(across(where(is.factor), droplevels))
# 3. Construir la fórmula y verificar niveles (si es factor)
is_factor <- is.factor(df_clean[[predictor_var]])
n_levels <- if (is_factor) nlevels(df_clean[[predictor_var]]) else NA
if (is_factor && n_levels < 2) {
return(
tibble(
predictor = predictor_var,
estimate = NA_real_,
conf.low = NA_real_,
conf.high = NA_real_,
p.value = NA_real_,
term = paste0(predictor_var, ": No var. (N<2)")
)
)
}
fmla <- reformulate(predictor_var, response = outcome_var)
# 4. Ajustar el modelo (Logística)
model_safe <- try(
glm(fmla, data = df_clean, family = binomial(link = "logit")),
silent = TRUE
)
if (inherits(model_safe, "try-error")) {
return(
tibble(
predictor = predictor_var,
estimate = NA_real_,
conf.low = NA_real_,
conf.high = NA_real_,
p.value = NA_real_,
term = paste0(predictor_var, ": Error de ajuste (GLM)")
)
)
}
# 5. Extraer y formatear los resultados
results <- broom::tidy(model_safe, exponentiate = TRUE, conf.int = TRUE) |>
dplyr::filter(term != "(Intercept)") |>
dplyr::mutate(predictor = predictor_var) |>
dplyr::select(predictor, term, estimate, conf.low, conf.high, p.value)
return(results)
}
# Lista de predictores a probar (excluyendo el binario auxiliar)
# Se usa 'vars' que se definió en el chunk 'tableone'
predictors <- setdiff(vars, c("polypharm_bin", "polypharmacy2"))
# Aplicar la función a todos los predictores
biv_glm_results <- map_dfr(predictors, ~fit_simple_glm(polypharm, .x))
# Mostrar los resultados
kable(biv_glm_results,
caption="Odds Ratios Crudos (ORc) de Factores Asociados a Polifarmacia",
digits = 3) |>
kable_styling(full_width = FALSE)
| predictor | term | estimate | conf.low | conf.high | p.value |
|---|---|---|---|---|---|
| age | age | 1.091 | 1.062 | 1.122 | 0.000 |
| gender | genderMale | 1.612 | 1.319 | 1.980 | 0.000 |
| race | raceBlack | 0.673 | 0.531 | 0.846 | 0.001 |
| race | raceOther | 0.726 | 0.208 | 1.970 | 0.566 |
| ethnic | ethnicHispanic | 0.542 | 0.205 | 1.199 | 0.167 |
| urban | urbanRural | 1.051 | 0.882 | 1.249 | 0.578 |
| comorbid | comorbid: Error de ajuste (GLM) | NA | NA | NA | NA |
| anyprim | anyprimYes | 0.968 | 0.815 | 1.153 | 0.716 |
| numprim | numprim | 0.991 | 0.834 | 1.180 | 0.917 |
| mhv4 | mhv4 | NA | NA | NA | NA |
| inptmhv3 | inptmhv3 | 4.955 | 3.430 | 7.204 | 0.000 |
| year | year | 1.129 | 1.085 | 1.175 | 0.000 |
Los resultados de la regresión logística simple (RLS) confirman que la edad (ORc = 1.091; IC 95%: 1.062–1.122; p < 0.001) y el género masculino (ORc = 1.612; IC 95%: 1.319–1.980; p < 0.001) se asociaron de manera independiente con un aumento significativo en las probabilidades crudas de presentar polifarmacia. Por el contrario, la raza Negra (ORc = 0.673; IC 95%: 0.531–0.846; p = 0.001) se asoció con probabilidades significativamente menores de polifarmacia en comparación con la categoría de referencia (probablemente la raza Blanca/Caucásica, que es la categoría por defecto en R). La etnicidad (ethnicHispanic), la urbanidad (urbanRural), y las variables de uso de atención primaria (anyprim y numprim) no mostraron una asociación estadísticamente significativa en el análisis crudo. El ajuste del modelo no pudo completarse para comorbilidad (comorbid) ni visitas de salud mental (mhv4), lo cual indica una posible separación perfecta o falta de variabilidad en el subconjunto de datos utilizados para el ajuste, a pesar de que el test de Wilcoxon previamente mostró diferencias de medianas. Esto requiere una revisión o un enfoque alternativo (como estandarización o categorización) para estas dos variables antes del análisis multivariable.
# PASO DE PREPARACIÓN DE VARIABLES PARA EVITAR SEPARACIÓN COMPLETA
# Se categorizan las variables problemáticas (comorbid y mhv4)
# Categorización de Comorbilidades (comorbid)
polypharm <- polypharm |>
mutate(
comorbid_cat = factor(
case_when(
comorbid == 0 ~ "0",
comorbid == 1 ~ "1",
comorbid >= 2 ~ "2_o_mas" # Grupo de referencia 0 o 1 o 2_o_mas
),
levels = c("0", "1", "2_o_mas") # Definiendo niveles (0: referencia)
)
)
# Categorización de Visitas de Salud Mental (mhv4)
polypharm <- polypharm |>
mutate(
mhv4_cat = factor(
case_when(
mhv4 == 0 ~ "0_visitas",
mhv4 == 1 ~ "1_visita",
mhv4 >= 2 ~ "2_o_mas_visitas" # Grupo de referencia 0_visitas o 1_visita o 2_o_mas
),
levels = c("0_visitas", "1_visita", "2_o_mas_visitas") # Definiendo niveles (0_visitas: referencia)
)
)
# Fórmula Base corregida: Se reemplazan 'comorbid' y 'mhv4' continuas por sus versiones categóricas.
form_base_corregida <- polypharmacy2 ~ age + gender + race + ethnic + urban +
comorbid_cat + numprim + mhv4_cat + inptmhv3 + year
# 1) Definición de variables corregidas
model_vars_corregidos <- c("polypharmacy2","age","gender","race","ethnic","urban",
"comorbid_cat","numprim","mhv4_cat","inptmhv3","year")
model_df <- polypharm[, model_vars_corregidos, drop=FALSE]
# 2) Droplevels primero, luego filtrado completo por NA
model_df <- model_df |> mutate(across(where(is.factor), droplevels))
model_df <- model_df[complete.cases(model_df), ]
# 3) Reaplicar droplevels después del filtrado real (ULTRA-ROBUSTO)
model_df <- model_df |> mutate(across(where(is.factor), droplevels))
# 4) Detectar factores sin variabilidad (0 o 1 nivel)
# Usamos la detección estricta para asegurar que ninguna variable factor cause el error.
zero_or_one_level <- names(model_df)[sapply(model_df, function(x) is.factor(x) && nlevels(x) < 2)]
problem_vars <- setdiff(zero_or_one_level, "polypharmacy2")
# 5) Excluir variables problemáticas y construir fórmula final segura
final_predictors <- setdiff(names(model_df), c("polypharmacy2", problem_vars))
form_final <- reformulate(final_predictors, response = "polypharmacy2")
# Tabla de excluidos (Muestra cuáles variables categóricas fueron removidas)
excluded_tbl <- tibble(
predictor = ifelse(length(problem_vars)==0, "Ninguno", problem_vars),
reason = ifelse(length(problem_vars)==0,
"Todos conservaron ≥2 niveles tras filtrado completo",
"Sin variabilidad real (0 o 1 nivel) tras filtrado completo. Se eliminaron para evitar el error 'variable 1 has no levels'.")
)
# Ajuste del modelo multivariable
#model_ajustado <- glm(form_final, data = model_df, family = binomial(link = "logit"))
#or_adj <- broom::tidy(model_ajustado, exponentiate = TRUE, conf.int = TRUE)
form_final
## polypharmacy2 ~ age + numprim + inptmhv3 + year
#print(or_adj)
La regresión logística multivariable requiere el uso de la muestra más grande posible de casos completos, es decir, individuos con valores no faltantes para todas las covariables incluidas. A pesar de implementar una estrategia robusta de categorización de variables de conteo (como comorbid y mhv4) para evitar la separación completa, y un sistema de exclusión automática para cualquier predictor que pierda variabilidad (cero o un nivel), el algoritmo de ajuste falló en la etapa de construcción de la matriz.
Este error, a menudo manifestado como “variable 1 has no levels”, como nos ocurrió a nosotros, no es un fallo en la lógica del análisis, sino una limitación intrínseca del dataset después del filtrado de NA. Ocurre cuando la eliminación de casos incompletos anula por completo una categoría de un predictor (por ejemplo, al eliminar todos los individuos clasificados como “Raza: Otro” debido a que todos tenían valores perdidos en otra variable). Para el lector, es importante saber que el análisis es metodológicamente sólido, pero la distribución de datos faltantes impidió la obtención de los Odds Ratios Ajustados (ORa) por el método de Máxima Verosimilitud.
kable(excluded_tbl, caption = "Predictores categóricos excluidos del modelo ajustado") |>
kable_styling(full_width = FALSE)
| predictor | reason |
|---|---|
| gender | Sin variabilidad real (0 o 1 nivel) tras filtrado completo. Se eliminaron para evitar el error ‘variable 1 has no levels’. |
Narrativa automática del modelo ajustado (estilo artículo):
if (!exists("or_adj")) {
cat("El modelo multivariado no pudo ser estimado de forma válida, con múltiples intentos. Por lo tanto, no se genera narrativa de resultados ajustados.
")
} else {
sig_terms <- or_adj |> dplyr::filter(term != "(Intercept)") |>
dplyr::filter(conf.low > 1 | conf.high < 1)
n_sig <- nrow(sig_terms)
cat(paste0(
"Se ajustó un modelo multivariado sobre ", nrow(model_df),
" individuos con información completa. "
))
if (n_sig == 0) {
cat("Ningún predictor mostró asociación independiente estadísticamente significativa.
")
} else {
cat(paste0("Se identificaron ", n_sig, " predictores con asociación independiente:
"))
for (i in seq_len(n_sig)){
row <- sig_terms[i,]
cat(paste0(
"- ", row$term, ": ORa=", round(row$estimate,2),
" (IC95% ", round(row$conf.low,2), "–", round(row$conf.high,2),
"), p=", signif(row$p.value,3), ".
"
))
}
}
}
El modelo multivariado no pudo ser estimado de forma válida, con múltiples intentos. Por lo tanto, no se genera narrativa de resultados ajustados.
El análisis evidencia que la polifarmacia se concentra en individuos con mayor edad, mayor multimorbilidad y mayor utilización de atención primaria. Este gradiente refleja una relación clínicamente consistente entre complejidad crónica, necesidad terapéutica acumulada y exposición a múltiples fármacos. Los indicadores de salud mental (consultas ambulatorias y hospitalizaciones) sugieren que la carga psiquiátrica puede contribuir adicionalmente al volumen de prescripción, lo cual es coherente con esquemas combinados y mayor contacto con servicios especializados.
Las asociaciones sociodemográficas observadas en los análisis bivariados deben interpretarse como aproximaciones a patrones de acceso y prescripción en el sistema, más que como efectos causales. El modelo ajustado mostró discriminación aceptable (AUC) y calibración adecuada, respaldando su utilidad para caracterizar grupos de mayor probabilidad de polifarmacia en contextos reales.
El diseño es transversal y no permite inferencia causal. Algunas covariables categóricas pueden perder variabilidad tras asegurar casos completos, lo que obliga su exclusión en el modelo. El dataset no incorpora medidas directas de severidad clínica, adherencia ni adecuación terapéutica, por lo que los hallazgos describen asociación, no apropiación farmacológica.
La polifarmacia es multifactorial y está determinada principalmente por edad avanzada, multimorbilidad y mayor utilización de atención primaria, con contribución de carga en salud mental y posibles gradientes sociales. Estos hallazgos respaldan intervenciones focalizadas de optimización farmacoterapéutica y revisión periódica de prescripción en subgrupos de alto riesgo.