Regresión logística: TP 2
Juan Pablo Vinicki
2025-06-07
Carga de librerías.
library(data.table)## Warning: package 'data.table' was built under R version 4.4.3library(tidyverse)## Warning: package 'tidyverse' was built under R version 4.4.3## Warning: package 'tidyr' was built under R version 4.4.3## Warning: package 'dplyr' was built under R version 4.4.3## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::between() masks data.table::between()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::first() masks data.table::first()
## ✖ lubridate::hour() masks data.table::hour()
## ✖ lubridate::isoweek() masks data.table::isoweek()
## ✖ dplyr::lag() masks stats::lag()
## ✖ dplyr::last() masks data.table::last()
## ✖ lubridate::mday() masks data.table::mday()
## ✖ lubridate::minute() masks data.table::minute()
## ✖ lubridate::month() masks data.table::month()
## ✖ lubridate::quarter() masks data.table::quarter()
## ✖ lubridate::second() masks data.table::second()
## ✖ purrr::transpose() masks data.table::transpose()
## ✖ lubridate::wday() masks data.table::wday()
## ✖ lubridate::week() masks data.table::week()
## ✖ lubridate::yday() masks data.table::yday()
## ✖ lubridate::year() masks data.table::year()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(broom)
library(vcd)## Warning: package 'vcd' was built under R version 4.4.3## Cargando paquete requerido: gridlibrary(sjPlot)## Warning: package 'sjPlot' was built under R version 4.4.3## Install package "strengejacke" from GitHub (`devtools::install_github("strengejacke/strengejacke")`) to load all sj-packages at once!library(epiR)## Warning: package 'epiR' was built under R version 4.4.2## Cargando paquete requerido: survival
## Package epiR 2.0.80 is loaded
## Type help(epi.about) for summary information
## Type browseVignettes(package = 'epiR') to learn how to use epiR for applied epidemiological analyseslibrary(tableone)## Warning: package 'tableone' was built under R version 4.4.3library(ggpubr)## Warning: package 'ggpubr' was built under R version 4.4.2library(vcd)
library(vcdExtra)## Warning: package 'vcdExtra' was built under R version 4.4.3## Cargando paquete requerido: gnm## Warning: package 'gnm' was built under R version 4.4.3##
## Adjuntando el paquete: 'vcdExtra'
##
## The following object is masked from 'package:dplyr':
##
## summariselibrary(CalibrationCurves)## Warning: package 'CalibrationCurves' was built under R version 4.4.3## Cargando paquete requerido: rms## Warning: package 'rms' was built under R version 4.4.3## Cargando paquete requerido: Hmisc## Warning: package 'Hmisc' was built under R version 4.4.3##
## Adjuntando el paquete: 'Hmisc'
##
## The following objects are masked from 'package:dplyr':
##
## src, summarize
##
## The following objects are masked from 'package:base':
##
## format.pval, unitslibrary(pROC)## Warning: package 'pROC' was built under R version 4.4.2## Type 'citation("pROC")' for a citation.
##
## Adjuntando el paquete: 'pROC'
##
## The following objects are masked from 'package:stats':
##
## cov, smooth, varlibrary(glmnet)## Warning: package 'glmnet' was built under R version 4.4.3## Cargando paquete requerido: Matrix
##
## Adjuntando el paquete: 'Matrix'
##
## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpack
##
## Loaded glmnet 4.1-9library(glue)## Warning: package 'glue' was built under R version 4.4.3library(dplyr)
library(tibble)
library(gtsummary)## Warning: package 'gtsummary' was built under R version 4.4.3library(rlang)## Warning: package 'rlang' was built under R version 4.4.3##
## Adjuntando el paquete: 'rlang'
##
## The following objects are masked from 'package:purrr':
##
## %@%, flatten, flatten_chr, flatten_dbl, flatten_int, flatten_lgl,
## flatten_raw, invoke, splice
##
## The following object is masked from 'package:data.table':
##
## :=library(car)## Warning: package 'car' was built under R version 4.4.3## Cargando paquete requerido: carData## Warning: package 'carData' was built under R version 4.4.1##
## Adjuntando el paquete: 'carData'
##
## The following object is masked from 'package:vcdExtra':
##
## Burt
##
##
## Adjuntando el paquete: 'car'
##
## The following objects are masked from 'package:rms':
##
## Predict, vif
##
## The following object is masked from 'package:dplyr':
##
## recode
##
## The following object is masked from 'package:purrr':
##
## somelibrary(data.table)
library(sjPlot)
library(descr)## Warning: package 'descr' was built under R version 4.4.3library(emmeans)## Warning: package 'emmeans' was built under R version 4.4.2## Welcome to emmeans.
## Caution: You lose important information if you filter this package's results.
## See '? untidy'
##
## Adjuntando el paquete: 'emmeans'
##
## The following object is masked from 'package:rms':
##
## contrastlibrary(ResourceSelection)## Warning: package 'ResourceSelection' was built under R version 4.4.3## ResourceSelection 0.3-6 2023-06-27library(rms)
library(riskRegression)## Warning: package 'riskRegression' was built under R version 4.4.3## riskRegression version 2025.05.20library(ggplot2)Carga y preparación de datos.
setwd("C:/Users/Usuario/Desktop/iecs/ano_2/regresion_logistica_multiple/actividades_asincronicas_del_18_05_al_5_06")
data <- fread("framdata_ej_1.csv")
data$smoke <- ifelse(data$cig >0,1,0)
data <- data[,-c(7:10)]Modelo
Objetivos:
- Combinación de variables que brinda la mejor respuesta a mi pregunta de investigación.
Tipo:
- Predictivo (Parsimonioso).
Paso 1: Analisis Univariable.
data[, c("sex", "smoke") := lapply(.SD, as.factor), .SDcols = c("sex", "smoke")]
catvars = c("sex", "smoke")
vars = c("age","sbp","dbp","chol","sex","smoke")
tabla_1 <- CreateTableOne(vars = vars, strata = "newchd", factorVars = catvars, data = data)
kableone(tabla_1)## Warning in attr(x, "align"): 'xfun::attr()' está en desuso.
## Utilizar 'xfun::attr2()' en su lugar.
## Ver help("Deprecated")## Warning in attr(x, "format"): 'xfun::attr()' está en desuso.
## Utilizar 'xfun::attr2()' en su lugar.
## Ver help("Deprecated")| 0 | 1 | p | test | |
|---|---|---|---|---|
| n | 1095 | 268 | ||
| age (mean (SD)) | 52.08 (4.75) | 53.58 (4.76) | <0.001 | |
| sbp (mean (SD)) | 145.11 (26.28) | 158.57 (31.14) | <0.001 | |
| dbp (mean (SD)) | 88.91 (13.53) | 94.58 (15.44) | <0.001 | |
| chol (mean (SD)) | 232.99 (45.71) | 241.30 (48.42) | 0.008 | |
| sex = 1 (%) | 479 (43.7) | 164 (61.2) | <0.001 | |
| smoke = 1 (%) | 480 (43.9) | 134 (50.0) | 0.082 |
Tabla 1. Se realizó un análisis univariable
comparando características basales según la presencia de enfermedad
coronaria nueva (newchd). Los pacientes con enfermedad
coronaria presentaron mayor edad promedio (53.58 vs 52.08 años; p <
0.001), mayores valores de presión arterial sistólica (158.57 vs 145.11
mmHg; p < 0.001) y diastólica (94.58 vs 88.91 mmHg; p < 0.001),
así como niveles más elevados de colesterol total (241.30 vs 232.99
mg/dL; p = 0.001). Además, la proporción de varones fue
significativamente mayor en el grupo con enfermedad (61.2% vs 43.7%; p
< 0.001). No se observaron diferencias estadísticamente
significativas en la proporción de fumadores (50.0% vs 43.9%; p =
0.082).
Paso 2: Regresion Logística Simple (Análisis Bivariable).
data %>%
tbl_uvregression(
method = glm,
y = newchd,
method.args = list(family = binomial),
exponentiate = TRUE,
pvalue_fun = ~style_pvalue(.x, digits = 2)
) %>%
bold_p() %>%
bold_labels()## Warning: Can't find generic `as.gtable` in package gtable to register S3 method.
## ℹ This message is only shown to developers using devtools.
## ℹ Do you need to update gtable to the latest version?| Characteristic | N | OR | 95% CI | p-value |
|---|---|---|---|---|
| age | 1,363 | 1.07 | 1.04, 1.10 | <0.001 |
| sbp | 1,363 | 1.02 | 1.01, 1.02 | <0.001 |
| dbp | 1,363 | 1.03 | 1.02, 1.04 | <0.001 |
| chol | 1,363 | 1.00 | 1.00, 1.01 | 0.009 |
| sex | 1,363 | |||
| 0 | — | — | ||
| 1 | 2.03 | 1.55, 2.67 | <0.001 | |
| smoke | 1,362 | |||
| 0 | — | — | ||
| 1 | 1.28 | 0.98, 1.67 | 0.071 | |
| Abbreviations: CI = Confidence Interval, OR = Odds Ratio | ||||
Tabla 2. Se realizó regresión logística simple
(bivariable) para evaluar la asociación entre diferentes variables
clínicas y la presencia de enfermedad coronaria nueva
(newchd). Se observó que la edad se asoció
significativamente con la enfermedad, mostrando un aumento del 7% en los
odds de presentar enfermedad coronaria por cada año adicional de edad
(OR: 1.07; IC 95%: 1.04–1.10; p < 0.001). Tanto la presión arterial
sistólica como la diastólica también presentaron asociaciones
significativas (OR: 1.02 y 1.03 respectivamente; ambos con p <
0.001). El colesterol total mostró una asociación estadísticamente
significativa, aunque de menor magnitud (OR: 1.00; IC 95%: 1.00–1.01; p
= 0.009).
Por otro lado, el sexo masculino se asoció con más del doble de odds de enfermedad coronaria en comparación con el femenino (OR: 2.03; IC 95%: 1.55–2.67; p < 0.001). En cuanto al tabaquismo, si bien se evidenció una tendencia hacia un aumento en los odds de enfermedad coronaria (OR: 1.28), esta asociación no alcanzó significancia estadística (IC 95%: 0.98–1.67; p = 0.071).
Paso 3: ¿Que hacemos con las variables numéricas?
Esta pregunta busca evaluar el primer supuesto de la regresión logística, que establece que debe existir una relación lineal entre el logit del evento (log-odds) y cada predictor continuo.
3.1 Evaluación de colesterol (chol) como variable
continua.
data<- data %>% mutate(chol_q = ntile(chol, 5))
data %>% dplyr::group_by(chol_q) %>% dplyr::summarise(tar=mean(newchd)) %>% ggplot(aes(x=chol_q, y=tar))+geom_point()+geom_smooth(method = "lm", col = "blue")## `geom_smooth()` using formula = 'y ~ x'
Descripción del gráfico:
Eje X: chol_q = quintiles de colesterol total (1 = más bajo, 5 = más alto).
Eje Y: tar = proporción media de pacientes con newchd = 1 en cada quintil.
Línea azul: Ajuste lineal (geom_smooth(method = “lm”)) sobre los puntos medios.
Banda gris: Intervalo de confianza del 95% para la regresión.
3.2 Evaluación de colesterol (chol) por quintiles
(chol_q).
crosstab(data$chol_q, data$newchd, prop.r = TRUE, prop.c = TRUE, chisq = TRUE, fisher = TRUE, expected =TRUE)
## Cell Contents
## |-------------------------|
## | Count |
## | Expected Values |
## | Row Percent |
## | Column Percent |
## |-------------------------|
##
## ====================================
## data$newchd
## data$chol_q 0 1 Total
## ------------------------------------
## 1 224 49 273
## 219.3 53.7
## 82.1% 17.9% 20.0%
## 20.5% 18.3%
## ------------------------------------
## 2 221 52 273
## 219.3 53.7
## 81.0% 19.0% 20.0%
## 20.2% 19.4%
## ------------------------------------
## 3 223 50 273
## 219.3 53.7
## 81.7% 18.3% 20.0%
## 20.4% 18.7%
## ------------------------------------
## 4 225 47 272
## 218.5 53.5
## 82.7% 17.3% 20.0%
## 20.5% 17.5%
## ------------------------------------
## 5 202 70 272
## 218.5 53.5
## 74.3% 25.7% 20.0%
## 18.4% 26.1%
## ------------------------------------
## Total 1095 268 1363
## 80.3% 19.7%
## ====================================
##
## Statistics for All Table Factors
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 8.214849 d.f. = 4 p = 0.084
##
##
##
## Fisher's Exact Test for Count Data
## ------------------------------------------------------------
## Alternative hypothesis: two.sided
## p = 0.0986
## Minimum expected frequency: 53.48202data$chol_q <- as.factor(data$chol_q)
modelo_chol <- glm(newchd ~ chol_q, data = data, family = "binomial")emm_chol <- emmeans(modelo_chol, ~ chol_q)
comparaciones_bonf <- pairs(emm_chol, adjust = "bonferroni")
print(comparaciones_bonf)## contrast estimate SE df z.ratio p.value
## chol_q1 - chol_q2 -0.0729 0.221 Inf -0.331 1.0000
## chol_q1 - chol_q3 -0.0247 0.222 Inf -0.111 1.0000
## chol_q1 - chol_q4 0.0461 0.225 Inf 0.205 1.0000
## chol_q1 - chol_q5 -0.4601 0.210 Inf -2.191 0.2849
## chol_q2 - chol_q3 0.0482 0.220 Inf 0.220 1.0000
## chol_q2 - chol_q4 0.1190 0.222 Inf 0.535 1.0000
## chol_q2 - chol_q5 -0.3871 0.207 Inf -1.867 0.6188
## chol_q3 - chol_q4 0.0708 0.224 Inf 0.316 1.0000
## chol_q3 - chol_q5 -0.4354 0.209 Inf -2.082 0.3732
## chol_q4 - chol_q5 -0.5062 0.212 Inf -2.387 0.1697
##
## Results are given on the log odds ratio (not the response) scale.
## P value adjustment: bonferroni method for 10 testsAunque el gráfico de proporciones y la línea de regresión
(geom_smooth(method = "lm")) sugieren una relación
aproximadamente lineal entre el colesterol total (chol) y
la probabilidad del evento (newchd), se construyó una tabla
de proporciones entre chol_q y newchd para
explorar más a fondo la asociación entre categorías del predictor y el
evento.
La prueba de Chi2 no mostró diferencias estadísticamente
significativas en la proporción del evento entre los quintiles de
colesterol (p > 0.05). Para confirmar esta ausencia de asociación
categórica, se ajustó un modelo de regresión logística categorizando
chol en quintiles y se aplicaron comparaciones múltiples
con ajuste de Bonferroni. Tampoco se identificaron diferencias
estadísticamente significativas entre los niveles comparados.
summary(modelo_chol)##
## Call:
## glm(formula = newchd ~ chol_q, family = "binomial", data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.51983 0.15771 -9.637 <2e-16 ***
## chol_q2 0.07291 0.22052 0.331 0.7409
## chol_q3 0.02468 0.22216 0.111 0.9116
## chol_q4 -0.04613 0.22493 -0.205 0.8375
## chol_q5 0.46005 0.21002 2.191 0.0285 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1351.2 on 1362 degrees of freedom
## Residual deviance: 1343.4 on 1358 degrees of freedom
## AIC: 1353.4
##
## Number of Fisher Scoring iterations: 4tab_model(modelo_chol, show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F, collapse.ci = F)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| chol_q2 | 1.08 | 0.24 | 0.70 – 1.66 | 0.741 |
| chol_q3 | 1.02 | 0.23 | 0.66 – 1.59 | 0.912 |
| chol_q4 | 0.95 | 0.21 | 0.61 – 1.48 | 0.838 |
| chol_q5 | 1.58 | 0.33 | 1.05 – 2.40 | 0.028 |
| Observations | 1363 | |||
| Deviance | 1343.405 | |||
| log-Likelihood | -671.702 | |||
Sólo el quintil superior (Q5) presenta una asociación
estadísticamente significativa con el outcome (newchd).
Esta asociación es positiva, lo que sugiere que niveles más altos de
colesterol están asociados con mayor riesgo de enfermedad coronaria. Los
quintiles intermedios (Q2–Q4) no difieren significativamente respecto a
Q1.
3.3 Evaluación de colesterol (chol) como variable
categórica (chol_q5_vs_rest).
data <- data %>%
mutate(chol_q = ntile(chol, 5),
chol_q5_vs_rest = ifelse(chol_q == 5, "Q5", "Resto"))
crosstab(data$chol_q5_vs_rest, data$newchd,
prop.r = TRUE, prop.c = TRUE,
chisq = TRUE, fisher = TRUE, expected = TRUE)
## Cell Contents
## |-------------------------|
## | Count |
## | Expected Values |
## | Row Percent |
## | Column Percent |
## |-------------------------|
##
## =============================================
## data$newchd
## data$chol_q5_vs_rest 0 1 Total
## ---------------------------------------------
## Q5 202 70 272
## 218.5 53.5
## 74.3% 25.7% 20.0%
## 18.4% 26.1%
## ---------------------------------------------
## Resto 893 198 1091
## 876.5 214.5
## 81.9% 18.1% 80.0%
## 81.6% 73.9%
## ---------------------------------------------
## Total 1095 268 1363
## 80.3% 19.7%
## =============================================
##
## Statistics for All Table Factors
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 7.933386 d.f. = 1 p = 0.00485
##
## Pearson's Chi-squared test with Yates' continuity correction
## ------------------------------------------------------------
## Chi^2 = 7.460368 d.f. = 1 p = 0.00631
##
##
## Fisher's Exact Test for Count Data
## ------------------------------------------------------------
## Sample estimate odds ratio: 0.640061
##
## Alternative hypothesis: true odds ratio is not equal to 1
## p = 0.00626
## 95% confidence interval: 0.4640487 0.8888311
##
## Alternative hypothesis: true odds ratio is less than 1
## p = 0.00375
## 95%s confidence interval: % 0 0.8441789
##
## Alternative hypothesis: true odds ratio is greater than 1
## p = 0.998
## 95%s confidence interval: % 0.4873624 Inf
##
## Minimum expected frequency: 53.48202data$chol_q5_vs_rest <- factor(data$chol_q5_vs_rest, levels = c("Resto", "Q5"))
options(scipen = 999)
modelo_q5_chol <- glm(newchd ~ chol_q5_vs_rest, data = data, family = binomial)
summary(modelo_q5_chol)##
## Call:
## glm(formula = newchd ~ chol_q5_vs_rest, family = binomial, data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.50632 0.07855 -19.176 < 0.0000000000000002 ***
## chol_q5_vs_restQ5 0.44655 0.15939 2.802 0.00509 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1351.2 on 1362 degrees of freedom
## Residual deviance: 1343.7 on 1361 degrees of freedom
## AIC: 1347.7
##
## Number of Fisher Scoring iterations: 4tab_model(modelo_q5_chol, show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F, collapse.ci = F)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| Resto | Reference | |||
| Q5 | 1.56 | 0.25 | 1.14 – 2.13 | 0.005 |
| Observations | 1363 | |||
| Deviance | 1343.704 | |||
| log-Likelihood | -671.852 | |||
Los individuos en el quintil 5 de colesterol tienen un 56% más de
odds de presentar enfermedad coronaria incidente (newchd),
en comparación con los que se encuentran en los quintiles 1 al 4, según
regresión logística ajustada.
Este hallazgo tiene dos interpretaciones complementarias:
Desde lo epidemiológico, puede señalar un umbral de riesgo a partir del quintil 5.
Desde lo estadístico, demuestra que dicotomizar puede ser útil en ciertos contextos si hay una justificación clínica o empírica clara (como este aumento notorio en el Q5).
3.4 Evaluación de edad (age) como variable
continua.
data<- data %>% mutate(age_q = ntile(age, 5))
data %>% dplyr::group_by(age_q) %>% dplyr::summarise(tar=mean(newchd)) %>% ggplot(aes(x=age_q, y=tar))+geom_point()+geom_smooth(method = "lm", col = "blue")## `geom_smooth()` using formula = 'y ~ x'
3.5 Evaluación de edad (age) por quintiles
(age_q).
options(scipen = 999)
crosstab(data$age_q, data$newchd, prop.r = TRUE, prop.c = TRUE, chisq = TRUE, expected =TRUE)
## Cell Contents
## |-------------------------|
## | Count |
## | Expected Values |
## | Row Percent |
## | Column Percent |
## |-------------------------|
##
## ===================================
## data$newchd
## data$age_q 0 1 Total
## -----------------------------------
## 1 234 39 273
## 219.3 53.7
## 85.7% 14.3% 20.0%
## 21.4% 14.6%
## -----------------------------------
## 2 229 44 273
## 219.3 53.7
## 83.9% 16.1% 20.0%
## 20.9% 16.4%
## -----------------------------------
## 3 227 46 273
## 219.3 53.7
## 83.2% 16.8% 20.0%
## 20.7% 17.2%
## -----------------------------------
## 4 214 58 272
## 218.5 53.5
## 78.7% 21.3% 20.0%
## 19.5% 21.6%
## -----------------------------------
## 5 191 81 272
## 218.5 53.5
## 70.2% 29.8% 20.0%
## 17.4% 30.2%
## -----------------------------------
## Total 1095 268 1363
## 80.3% 19.7%
## ===================================
##
## Statistics for All Table Factors
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 26.63502 d.f. = 4 p = 0.0000236
##
## Minimum expected frequency: 53.48202data$age_q <- as.factor(data$age_q)
modelo_age <- glm(newchd ~ age_q, data = data, family = "binomial")
emm_age <- emmeans(modelo_age, ~ age_q)
comparaciones_bonf <- pairs(emm_age, adjust = "bonferroni")
print(comparaciones_bonf)## contrast estimate SE df z.ratio p.value
## age_q1 - age_q2 -0.1422 0.239 Inf -0.596 1.0000
## age_q1 - age_q3 -0.1955 0.237 Inf -0.825 1.0000
## age_q1 - age_q4 -0.4862 0.228 Inf -2.136 0.3270
## age_q1 - age_q5 -0.9339 0.218 Inf -4.285 0.0002
## age_q2 - age_q3 -0.0532 0.231 Inf -0.231 1.0000
## age_q2 - age_q4 -0.3440 0.221 Inf -1.554 1.0000
## age_q2 - age_q5 -0.7917 0.211 Inf -3.746 0.0018
## age_q3 - age_q4 -0.2908 0.219 Inf -1.326 1.0000
## age_q3 - age_q5 -0.7385 0.209 Inf -3.532 0.0041
## age_q4 - age_q5 -0.4477 0.199 Inf -2.253 0.2427
##
## Results are given on the log odds ratio (not the response) scale.
## P value adjustment: bonferroni method for 10 testsCon el objetivo de decidir si la variable edad (age)
debía tratarse como numérica continua o transformarse en variable
categórica en los modelos de regresión, se construyó un gráfico
agrupando la población en quintiles de edad (age_q). En el
eje X se representaron los quintiles (del 1 = más jóvenes al 5 = mayor
edad), mientras que en el eje Y se graficó la proporción media de
pacientes con enfermedad coronaria nueva (newchd) dentro de
cada quintil.
La curva de tendencia azul, obtenida mediante un ajuste lineal
(geom_smooth(method = "lm")), mostró una relación positiva
y aproximadamente lineal: a mayor edad, aumentó la proporción de
eventos. La banda gris representa el intervalo de confianza del 95% y,
aunque se amplía levemente en los extremos, no se evidenció una
curvatura pronunciada ni un patrón no lineal que sugiriera
categorizaciones complejas.
Adicionalmente, se exploró si existían diferencias puntuales entre los quintiles mediante un modelo de regresión logística con comparaciones múltiples ajustadas por Bonferroni. Los resultados mostraron que el quintil 5 (mayores edades) difiere significativamente de los quintiles más jóvenes (q1, q2, q3 y q4), mientras que no se observaron diferencias consistentes entre los restantes.
summary(modelo_age)##
## Call:
## glm(formula = newchd ~ age_q, family = "binomial", data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.7918 0.1730 -10.359 < 0.0000000000000002 ***
## age_q2 0.1422 0.2388 0.596 0.5514
## age_q3 0.1955 0.2368 0.825 0.4091
## age_q4 0.4862 0.2277 2.136 0.0327 *
## age_q5 0.9339 0.2179 4.285 0.0000182 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1351.2 on 1362 degrees of freedom
## Residual deviance: 1325.8 on 1358 degrees of freedom
## AIC: 1335.8
##
## Number of Fisher Scoring iterations: 4tab_model(modelo_age, show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F, collapse.ci = F)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| age_q2 | 1.15 | 0.28 | 0.72 – 1.85 | 0.551 |
| age_q3 | 1.22 | 0.29 | 0.77 – 1.94 | 0.409 |
| age_q4 | 1.63 | 0.37 | 1.04 – 2.56 | 0.033 |
| age_q5 | 2.54 | 0.55 | 1.67 – 3.93 | <0.001 |
| Observations | 1363 | |||
| Deviance | 1325.845 | |||
| log-Likelihood | -662.923 | |||
Existe una tendencia creciente en el riesgo de enfermedad
cardiovascular a medida que aumenta la edad por quintiles. A partir del
quintil 4, la edad se asocia significativamente con una mayor odds de
presentar newchd. El quintil 5 muestra la mayor asociación,
con una OR = 2.54, lo cual indica que las personas en el quintil de
mayor edad tienen más del doble de probabilidad de presentar enfermedad
cardiovascular en comparación con el quintil más joven, ajustado dentro
del modelo.
3.6 Evaluación de edad (age) como variable categórica
(age_q5_vs_rest).
data <- data %>%
mutate(age_q = ntile(age, 5),
age_q5_vs_rest = ifelse(age_q == 5, "Q5", "Resto"))
crosstab(data$age_q5_vs_rest, data$newchd,
prop.r = TRUE, prop.c = TRUE,
chisq = TRUE, fisher = TRUE, expected = TRUE)
## Cell Contents
## |-------------------------|
## | Count |
## | Expected Values |
## | Row Percent |
## | Column Percent |
## |-------------------------|
##
## ============================================
## data$newchd
## data$age_q5_vs_rest 0 1 Total
## --------------------------------------------
## Q5 191 81 272
## 218.5 53.5
## 70.2% 29.8% 20.0%
## 17.4% 30.2%
## --------------------------------------------
## Resto 904 187 1091
## 876.5 214.5
## 82.9% 17.1% 80.0%
## 82.6% 69.8%
## --------------------------------------------
## Total 1095 268 1363
## 80.3% 19.7%
## ============================================
##
## Statistics for All Table Factors
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 22.018 d.f. = 1 p = 0.0000027
##
## Pearson's Chi-squared test with Yates' continuity correction
## ------------------------------------------------------------
## Chi^2 = 21.22514 d.f. = 1 p = 0.00000408
##
##
## Fisher's Exact Test for Count Data
## ------------------------------------------------------------
## Sample estimate odds ratio: 0.4880661
##
## Alternative hypothesis: true odds ratio is not equal to 1
## p = 0.00000784
## 95% confidence interval: 0.356746 0.6707709
##
## Alternative hypothesis: true odds ratio is less than 1
## p = 0.00000443
## 95%s confidence interval: % 0 0.6381992
##
## Alternative hypothesis: true odds ratio is greater than 1
## p = 1
## 95%s confidence interval: % 0.374295 Inf
##
## Minimum expected frequency: 53.48202data$age_q5_vs_rest <- factor(data$age_q5_vs_rest, levels = c("Resto", "Q5"))
options(scipen = 999)
modelo_q5_age <- glm(newchd ~ age_q5_vs_rest, data = data, family = binomial)
summary(modelo_q5_age)##
## Call:
## glm(formula = newchd ~ age_q5_vs_rest, family = binomial, data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.57572 0.08034 -19.614 < 0.0000000000000002 ***
## age_q5_vs_restQ5 0.71790 0.15503 4.631 0.00000365 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1351.2 on 1362 degrees of freedom
## Residual deviance: 1330.9 on 1361 degrees of freedom
## AIC: 1334.9
##
## Number of Fisher Scoring iterations: 4tab_model(modelo_q5_age, show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F, collapse.ci = F)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| Resto | Reference | |||
| Q5 | 2.05 | 0.32 | 1.51 – 2.77 | <0.001 |
| Observations | 1363 | |||
| Deviance | 1330.868 | |||
| log-Likelihood | -665.434 | |||
Las personas en el quintil más alto de edad (Q5) presentan una odds 2 veces mayor de tener enfermedad cardiovascular en comparación con el resto de la población (Q1–Q4). Este resultado es estadísticamente significativo (p < 0.001), con un intervalo de confianza ajustado que no incluye el valor nulo (1.0). El análisis apoya la decisión de tratar la edad como una variable categórica en este contexto, al menos cuando se contrasta Q5 vs el resto.
3.7 Evaluación de presion sistólica (sbp) como variable
continua.
data<- data %>% mutate(sbp_q = ntile(sbp, 5))
data %>% dplyr::group_by(sbp_q) %>% dplyr::summarise(tar=mean(newchd)) %>% ggplot(aes(x=sbp_q, y=tar))+geom_point()+geom_smooth(method = "lm", col = "blue")## `geom_smooth()` using formula = 'y ~ x'
3.8 Evaluación de presion sistólica (sbp) por quintiles
(sbp_q).
crosstab(data$sbp_q, data$newchd, prop.r = TRUE, prop.c = TRUE, chisq = TRUE, expected =TRUE)
## Cell Contents
## |-------------------------|
## | Count |
## | Expected Values |
## | Row Percent |
## | Column Percent |
## |-------------------------|
##
## ===================================
## data$newchd
## data$sbp_q 0 1 Total
## -----------------------------------
## 1 242 31 273
## 219.3 53.7
## 88.6% 11.4% 20.0%
## 22.1% 11.6%
## -----------------------------------
## 2 234 39 273
## 219.3 53.7
## 85.7% 14.3% 20.0%
## 21.4% 14.6%
## -----------------------------------
## 3 225 48 273
## 219.3 53.7
## 82.4% 17.6% 20.0%
## 20.5% 17.9%
## -----------------------------------
## 4 210 62 272
## 218.5 53.5
## 77.2% 22.8% 20.0%
## 19.2% 23.1%
## -----------------------------------
## 5 184 88 272
## 218.5 53.5
## 67.6% 32.4% 20.0%
## 16.8% 32.8%
## -----------------------------------
## Total 1095 268 1363
## 80.3% 19.7%
## ===================================
##
## Statistics for All Table Factors
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 47.09027 d.f. = 4 p = 0.00000000146
##
## Minimum expected frequency: 53.48202data$sbp_q <- as.factor(data$sbp_q)
modelo_sbp <- glm(newchd ~ sbp_q, data = data, family = "binomial")
emm_sbp <- emmeans::emmeans(modelo_sbp, ~ sbp_q)
comparaciones_bonf_sbp <- pairs(emm_sbp, adjust = "bonferroni")
print(comparaciones_bonf_sbp)## contrast estimate SE df z.ratio p.value
## sbp_q1 - sbp_q2 -0.263 0.257 Inf -1.022 1.0000
## sbp_q1 - sbp_q3 -0.510 0.248 Inf -2.054 0.3998
## sbp_q1 - sbp_q4 -0.835 0.239 Inf -3.489 0.0049
## sbp_q1 - sbp_q5 -1.317 0.231 Inf -5.712 <.0001
## sbp_q2 - sbp_q3 -0.247 0.235 Inf -1.051 1.0000
## sbp_q2 - sbp_q4 -0.572 0.225 Inf -2.537 0.1119
## sbp_q2 - sbp_q5 -1.054 0.216 Inf -4.877 <.0001
## sbp_q3 - sbp_q4 -0.325 0.215 Inf -1.512 1.0000
## sbp_q3 - sbp_q5 -0.807 0.205 Inf -3.936 0.0008
## sbp_q4 - sbp_q5 -0.482 0.194 Inf -2.485 0.1297
##
## Results are given on the log odds ratio (not the response) scale.
## P value adjustment: bonferroni method for 10 testssummary(modelo_sbp)##
## Call:
## glm(formula = newchd ~ sbp_q, family = "binomial", data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.0550 0.1908 -10.772 < 0.0000000000000002 ***
## sbp_q2 0.2632 0.2575 1.022 0.306723
## sbp_q3 0.5101 0.2483 2.054 0.039981 *
## sbp_q4 0.8350 0.2393 3.489 0.000485 ***
## sbp_q5 1.3174 0.2306 5.712 0.0000000112 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1351.2 on 1362 degrees of freedom
## Residual deviance: 1305.5 on 1358 degrees of freedom
## AIC: 1315.5
##
## Number of Fisher Scoring iterations: 4tab_model(modelo_sbp, show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F, collapse.ci = F)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| sbp_q2 | 1.30 | 0.34 | 0.79 – 2.17 | 0.307 |
| sbp_q3 | 1.67 | 0.41 | 1.03 – 2.73 | 0.040 |
| sbp_q4 | 2.30 | 0.55 | 1.45 – 3.72 | <0.001 |
| sbp_q5 | 3.73 | 0.86 | 2.40 – 5.94 | <0.001 |
| Observations | 1363 | |||
| Deviance | 1305.488 | |||
| log-Likelihood | -652.744 | |||
Existe un gradiente de riesgo creciente de enfermedad cardiovascular a medida que aumenta el quintil de presión sistólica. Q3 ya muestra una asociación estadísticamente significativa, con un 67% más de odds de enfermedad cardiovascular respecto a Q1. Q4 y Q5 presentan riesgos aún más elevados, más del doble y casi 4 veces respectivamente. Esta tendencia sugiere una asociación dosis-respuesta entre niveles de presión sistólica y riesgo cardiovascular. Podría justificarse el tratamiento de la presión sistólica como una variable categórica por quintiles, dada la no linealidad aparente en el aumento del riesgo.
3.9 Evaluación de presion sistólica (sbp) como variable
categórica (sbp_q5_vs_rest).
data <- data %>%
mutate(sbp_q = ntile(sbp, 5),
sbp_q5_vs_rest = ifelse(sbp_q == 5, "Q5", "Resto"))
crosstab(data$sbp_q5_vs_rest, data$newchd,
prop.r = TRUE, prop.c = TRUE,
chisq = TRUE, fisher = TRUE, expected = TRUE)
## Cell Contents
## |-------------------------|
## | Count |
## | Expected Values |
## | Row Percent |
## | Column Percent |
## |-------------------------|
##
## ============================================
## data$newchd
## data$sbp_q5_vs_rest 0 1 Total
## --------------------------------------------
## Q5 184 88 272
## 218.5 53.5
## 67.6% 32.4% 20.0%
## 16.8% 32.8%
## --------------------------------------------
## Resto 911 180 1091
## 876.5 214.5
## 83.5% 16.5% 80.0%
## 83.2% 67.2%
## --------------------------------------------
## Total 1095 268 1363
## 80.3% 19.7%
## ============================================
##
## Statistics for All Table Factors
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 34.64461 d.f. = 1 p = 0.00000000396
##
## Pearson's Chi-squared test with Yates' continuity correction
## ------------------------------------------------------------
## Chi^2 = 33.64821 d.f. = 1 p = 0.0000000066
##
##
## Fisher's Exact Test for Count Data
## ------------------------------------------------------------
## Sample estimate odds ratio: 0.4134637
##
## Alternative hypothesis: true odds ratio is not equal to 1
## p = 0.0000000204
## 95% confidence interval: 0.3032223 0.5655593
##
## Alternative hypothesis: true odds ratio is less than 1
## p = 0.0000000142
## 95%s confidence interval: % 0 0.5386058
##
## Alternative hypothesis: true odds ratio is greater than 1
## p = 1
## 95%s confidence interval: % 0.3180285 Inf
##
## Minimum expected frequency: 53.48202data$sbp_q5_vs_rest <- factor(data$sbp_q5_vs_rest, levels = c("Resto", "Q5"))
modelo_q5_sbp <- glm(newchd ~ sbp_q5_vs_rest, data = data, family = binomial)
summary(modelo_q5_sbp)##
## Call:
## glm(formula = newchd ~ sbp_q5_vs_rest, family = binomial, data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.62159 0.08157 -19.880 < 0.0000000000000002 ***
## sbp_q5_vs_restQ5 0.88399 0.15314 5.772 0.00000000781 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1351.2 on 1362 degrees of freedom
## Residual deviance: 1319.6 on 1361 degrees of freedom
## AIC: 1323.6
##
## Number of Fisher Scoring iterations: 4tab_model(modelo_q5_sbp, show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F, collapse.ci = F)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| Resto | Reference | |||
| Q5 | 2.42 | 0.37 | 1.79 – 3.26 | <0.001 |
| Observations | 1363 | |||
| Deviance | 1319.650 | |||
| log-Likelihood | -659.825 | |||
Para evaluar si la presión arterial sistólica (sbp)
debía incluirse como variable numérica continua o categórica en los
modelos de regresión, se graficó la proporción de pacientes con
enfermedad coronaria nueva (newchd) a lo largo de los
quintiles de sbp (sbp_q). El eje X representó los quintiles
de presión (1 = menor presión, 5 = mayor presión) y el eje Y, la
proporción media de eventos en cada grupo.
La recta de regresión lineal, generada mediante
geom_smooth(method = "lm"), evidenció una tendencia
positiva constante: a mayor sbp, mayor proporción de
pacientes con enfermedad coronaria incidente. La relación fue
aproximadamente lineal, sin cambios abruptos ni curvaturas notorias, y
la banda de confianza del 95% (sombreado gris) se mantuvo relativamente
angosta y estable.
No obstante, el test de chi2 aplicado a la tabla de proporciones
mostró una asociación significativa entre los quintiles de
sbp y la presencia del evento (p < 0.001).
Posteriormente, se realizó una comparación múltiple ajustada por
Bonferroni, que evidenció diferencias significativas entre los quintiles
más bajos (q1, q2, q3 y q4) respecto de al más alto (q5), sugiriendo una
discontinuidad en el riesgo a partir del cuarto quintil.
Si bien el patrón global sugiere linealidad, los hallazgos del análisis categórico indican que podría existir un umbral clínicamente relevante a partir de niveles más altos de presión sistólica.
Las personas en el quintil más alto de presión sistólica (Q5) presentan una odds 2.42 veces mayor de tener enfermedad cardiovascular en comparación con quienes están en los otros cuatro quintiles (Q1 a Q4). Esta asociación es estadísticamente significativa (p < 0.001). El intervalo de confianza no cruza el valor nulo (1), lo que respalda la robustez del hallazgo. Este modelo sugiere que pertenecer al quintil superior de presión sistólica representa un riesgo significativamente mayor para enfermedad cardiovascular, incluso sin ajuste por otras covariables.
3.10 Evaluación de presion diastólica (dbp) como
variable continua.
data <- data %>% mutate(dbp_q = ntile(dbp, 5))
data %>% dplyr::group_by(dbp_q) %>% dplyr::summarise(tar=mean(newchd)) %>% ggplot(aes(x=dbp_q, y=tar))+geom_point()+geom_smooth(method = "lm", col = "blue")## `geom_smooth()` using formula = 'y ~ x'
3.11 Evaluación de presion diastólica (dbp) por
quintiles (dbp_q).
crosstab(data$dbp_q, data$newchd, prop.r = TRUE, prop.c = TRUE, chisq = TRUE, expected = TRUE)
## Cell Contents
## |-------------------------|
## | Count |
## | Expected Values |
## | Row Percent |
## | Column Percent |
## |-------------------------|
##
## ===================================
## data$newchd
## data$dbp_q 0 1 Total
## -----------------------------------
## 1 236 37 273
## 219.3 53.7
## 86.4% 13.6% 20.0%
## 21.6% 13.8%
## -----------------------------------
## 2 234 39 273
## 219.3 53.7
## 85.7% 14.3% 20.0%
## 21.4% 14.6%
## -----------------------------------
## 3 222 51 273
## 219.3 53.7
## 81.3% 18.7% 20.0%
## 20.3% 19.0%
## -----------------------------------
## 4 220 52 272
## 218.5 53.5
## 80.9% 19.1% 20.0%
## 20.1% 19.4%
## -----------------------------------
## 5 183 89 272
## 218.5 53.5
## 67.3% 32.7% 20.0%
## 16.7% 33.2%
## -----------------------------------
## Total 1095 268 1363
## 80.3% 19.7%
## ===================================
##
## Statistics for All Table Factors
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 41.02544 d.f. = 4 p = 0.0000000266
##
## Minimum expected frequency: 53.48202data$dbp_q <- as.factor(data$dbp_q)
modelo_dbp <- glm(newchd ~ dbp_q, data = data, family = "binomial")
emm_dbp <- emmeans::emmeans(modelo_dbp, ~ dbp_q)
comparaciones_bonf_dbp <- pairs(emm_dbp, adjust = "bonferroni")
print(comparaciones_bonf_dbp)## contrast estimate SE df z.ratio p.value
## dbp_q1 - dbp_q2 -0.0612 0.247 Inf -0.247 1.0000
## dbp_q1 - dbp_q3 -0.3821 0.235 Inf -1.624 1.0000
## dbp_q1 - dbp_q4 -0.4105 0.235 Inf -1.750 0.8014
## dbp_q1 - dbp_q5 -1.1321 0.219 Inf -5.169 <.0001
## dbp_q2 - dbp_q3 -0.3209 0.232 Inf -1.381 1.0000
## dbp_q2 - dbp_q4 -0.3494 0.232 Inf -1.508 1.0000
## dbp_q2 - dbp_q5 -1.0709 0.216 Inf -4.960 <.0001
## dbp_q3 - dbp_q4 -0.0285 0.219 Inf -0.130 1.0000
## dbp_q3 - dbp_q5 -0.7500 0.202 Inf -3.712 0.0021
## dbp_q4 - dbp_q5 -0.7215 0.201 Inf -3.586 0.0034
##
## Results are given on the log odds ratio (not the response) scale.
## P value adjustment: bonferroni method for 10 testssummary(modelo_dbp)##
## Call:
## glm(formula = newchd ~ dbp_q, family = "binomial", data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.85291 0.17682 -10.479 < 0.0000000000000002 ***
## dbp_q2 0.06115 0.24734 0.247 0.8047
## dbp_q3 0.38206 0.23532 1.624 0.1045
## dbp_q4 0.41053 0.23461 1.750 0.0801 .
## dbp_q5 1.13206 0.21901 5.169 0.000000235 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1351.2 on 1362 degrees of freedom
## Residual deviance: 1312.8 on 1358 degrees of freedom
## AIC: 1322.8
##
## Number of Fisher Scoring iterations: 4tab_model(modelo_dbp, show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F, collapse.ci = F)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| dbp_q2 | 1.06 | 0.26 | 0.65 – 1.73 | 0.805 |
| dbp_q3 | 1.47 | 0.34 | 0.93 – 2.34 | 0.104 |
| dbp_q4 | 1.51 | 0.35 | 0.95 – 2.40 | 0.080 |
| dbp_q5 | 3.10 | 0.68 | 2.03 – 4.81 | <0.001 |
| Observations | 1363 | |||
| Deviance | 1312.833 | |||
| log-Likelihood | -656.417 | |||
Las personas con presión diastólica en el quintil superior (Q5) tienen una odds 3.10 veces mayor de enfermedad cardiovascular en comparación con las que se encuentran en los quintiles inferiores (Q1–Q4). Esta asociación es estadísticamente significativa (p < 0.001). El intervalo de confianza no incluye el valor nulo (1), lo que indica una asociación robusta. Una presión diastólica elevada (Q5) está asociada a un riesgo significativamente mayor de enfermedad cardiovascular.
3.12 Evaluación de presion diastólica (dbp) como
variable categórica (dbp_q5_vs_rest).
data <- data %>%
mutate(dbp_q = ntile(dbp, 5),
dbp_q5_vs_rest = ifelse(dbp_q == 5, "Q5", "Resto"))
crosstab(data$dbp_q5_vs_rest, data$newchd,
prop.r = TRUE, prop.c = TRUE,
chisq = TRUE, fisher = TRUE, expected = TRUE)
## Cell Contents
## |-------------------------|
## | Count |
## | Expected Values |
## | Row Percent |
## | Column Percent |
## |-------------------------|
##
## ============================================
## data$newchd
## data$dbp_q5_vs_rest 0 1 Total
## --------------------------------------------
## Q5 183 89 272
## 218.5 53.5
## 67.3% 32.7% 20.0%
## 16.7% 33.2%
## --------------------------------------------
## Resto 912 179 1091
## 876.5 214.5
## 83.6% 16.4% 80.0%
## 83.3% 66.8%
## --------------------------------------------
## Total 1095 268 1363
## 80.3% 19.7%
## ============================================
##
## Statistics for All Table Factors
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 36.68102 d.f. = 1 p = 0.00000000139
##
## Pearson's Chi-squared test with Yates' continuity correction
## ------------------------------------------------------------
## Chi^2 = 35.65554 d.f. = 1 p = 0.00000000235
##
##
## Fisher's Exact Test for Count Data
## ------------------------------------------------------------
## Sample estimate odds ratio: 0.4038854
##
## Alternative hypothesis: true odds ratio is not equal to 1
## p = 0.00000000754
## 95% confidence interval: 0.2963256 0.5521607
##
## Alternative hypothesis: true odds ratio is less than 1
## p = 0.00000000572
## 95%s confidence interval: % 0 0.5258833
##
## Alternative hypothesis: true odds ratio is greater than 1
## p = 1
## 95%s confidence interval: % 0.3108255 Inf
##
## Minimum expected frequency: 53.48202data$dbp_q5_vs_rest <- factor(data$dbp_q5_vs_rest, levels = c("Resto", "Q5"))
modelo_q5_dbp <- glm(newchd ~ dbp_q5_vs_rest, data = data, family = binomial)
summary(modelo_q5_dbp)##
## Call:
## glm(formula = newchd ~ dbp_q5_vs_rest, family = binomial, data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.62825 0.08175 -19.917 < 0.0000000000000002 ***
## dbp_q5_vs_restQ5 0.90740 0.15292 5.934 0.00000000296 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1351.2 on 1362 degrees of freedom
## Residual deviance: 1317.9 on 1361 degrees of freedom
## AIC: 1321.9
##
## Number of Fisher Scoring iterations: 4tab_model(modelo_q5_dbp, show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F, collapse.ci = F)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| Resto | Reference | |||
| Q5 | 2.48 | 0.38 | 1.83 – 3.34 | <0.001 |
| Observations | 1363 | |||
| Deviance | 1317.858 | |||
| log-Likelihood | -658.929 | |||
Para determinar si la presión arterial diastólica (dbp)
debía ser considerada como variable continua o categórica en los modelos
de regresión, se graficó la proporción de pacientes con enfermedad
coronaria nueva (newchd) a través de los quintiles de
dbp (dbp_q). En el eje X se ubicaron los
quintiles (del más bajo al más alto), y en el eje Y, la proporción media
de eventos por grupo.
El gráfico mostró una relación positiva: a mayor presión diastólica,
mayor proporción media de pacientes con enfermedad coronaria incidente.
La línea azul generada por geom_smooth(method = "lm")
sugirió un patrón aproximadamente lineal sin evidencias claras de
curvaturas o cambios abruptos. Además, la banda de confianza del 95% se
mantuvo razonablemente estrecha, indicando estabilidad en la
estimación.
Por otro lado, al realizar comparaciones múltiples con corrección de
Bonferroni, se identificó que el quintil más alto (q5)
difiere significativamente de los restantes. Esta diferencia podría
justificar su categorización en algunos contextos clínicos.
La presión sistólica (sbp) fue evaluada como variable
categórica dicotómica para contrastar el quintil superior (Q5) frente al
resto de la distribución (Q1 a Q4). Estar en el quintil más alto de
presión diastólica (Q5) se asocia con una odds 2.48 veces mayor de
enfermedad coronaria nueva en comparación con los otros quintiles. La
asociación es estadísticamente significativa (p < 0.001), y el IC 95%
no incluye 1, lo que indica robustez del hallazgo. Esto refuerza los
resultados del análisis categórico anterior, con una estimación
levemente menor del OR (antes fue 3.10), probablemente por haber
agregado covariables o haber ajustado la comparación.
3.13 Evaluación de colinealidad: sbp + dbp.
En particular, tanto la presión sistólica (sbp) como la
diastólica (dbp) mostraron asociaciones positivas. La
pendiente fue más empinada para sbp, lo que sugiere una
relación más fuerte con la probabilidad de enfermedad coronaria. Además,
la banda de confianza del 95% fue algo más estrecha en sbp,
lo cual indicaría una mayor precisión de la estimación.
Desde el punto de vista clínico y estadístico, incluir ambas puede
llevar a problemas de multicolinealidad, ya que sbp y
dbp suelen estar correlacionadas. Esto puede inflar las
varianzas de los coeficientes y dificultar la interpretación. Si bien
ambas muestran asociación con el desenlace en el análisis univariado, es
recomendable:
. Evaluar la correlación entre ambas (por ejemplo, con
cor(data$sbp, data$dbp)).
. Calcular el VIF (Variance Inflation Factor) en el
modelo multivariado. Si el VIF de alguna supera 5 o 10, se recomienda
excluirla o combinarla (por ejemplo, usando presión de pulso o media
arterial).
. Basarse también en criterios clínicos: si el objetivo es
simplificar e interpretar, suele preferirse incluir solo
sbp.
En este caso, sbp tiene una pendiente más empinada y
menor incertidumbre, por lo cual sería razonable priorizarla sobre
dbp.
cor(data$sbp, data$dbp)## [1] 0.7891946modelo_log <- glm(newchd ~ age + sbp + dbp + chol + sex + smoke, data = data, family = binomial)
vif(modelo_log)## age sbp dbp chol sex smoke
## 1.073821 2.871223 2.752278 1.072816 1.224395 1.140774🔍 Interpretación:
1. No hay multicolinealidad severa.
. Se suele considerar que un VIF mayor a 5 (algunos autores usan 10) indica riesgo de multicolinealidad.
. Acá, todos los VIF están por debajo de 3, lo cual es aceptable y no indica un problema estadístico serio.
2. Sí hay cierta correlación entre sbp y
dbp, como ya vimos (correlación de 0.78), pero no
al punto de generar inestabilidad importante en la regresión.
🩺 ¿Qué haría en la práctica?
Desde el punto de vista clínico, muchas veces se elige dejar solo una de las dos (por claridad interpretativa).
Desde lo estadístico, el modelo aguanta tener ambas sin riesgo de distorsión. Así que podrías:
Dejar ambas si querés evaluar su efecto combinado.
Quedarte solo con
sbpsi querés un modelo más parsimonioso y porque tiene:
a.pendiente más empinada,
b.menor incertidumbre,
c.IC más estrecho.
3.15 Nuevo modelo bivariado: sí o no.
Después del análisis realizado, no consideramos necesario volver a
correr nuevos modelos bivariados. Las regresiones logísticas simples ya
permitieron explorar la asociación entre cada variable independiente y
el desenlace (newchd), identificando relaciones
significativas en variables como edad, presión arterial sistólica y
diastólica, colesterol total y sexo. Además, se evaluó gráficamente la
relación entre las variables continuas (edad, presión sistólica, presión
diastólica y colesterol) y el desenlace, mostrando patrones
predominantemente lineales que respaldan su inclusión como variables
numéricas en los modelos posteriores.
En cuanto a la posible multicolinealidad entre presión sistólica y
diastólica, se corroboró que ambas presentan una correlación
moderadamente alta (r = 0.78), y se calculó el VIF para el modelo
multivariado. Ninguna variable superó el umbral de 5, lo cual sugiere
que no hay colinealidad problemática. Aun así, en base a criterios
estadísticos (pendiente más empinada e intervalo de confianza más
estrecho para sbp) y clínicos (mayor relevancia de la
presión sistólica en predicción de eventos cardiovasculares), se
priorizará incluir solo sbp en el modelo multivariado.
Asimismo, se destaca que, al realizar una dicotomización de las variables de presión (tanto sistólica como diastólica) comparando el quintil más alto (Q5) frente al resto, se observaron asociaciones estadísticamente significativas con el desenlace. Esta evidencia adicional fortalece los hallazgos obtenidos y contribuye a sustentar las decisiones de modelado, aunque no justifica por sí sola repetir los modelos bivariados.
Por todo lo anterior, no se justifica volver a correr modelos bivariados adicionales, ya que la información generada hasta ahora es suficiente para fundamentar las decisiones de modelado.
Paso 4: Regresion Logística Múltiple (Análisis Multivariable).
4.1 Inclusión progresiva de variables.
modelo_1 <- glm(newchd ~ age, data = data, family = binomial)
t<-tab_model(modelo_1, transform="exp",show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F,collapse.ci = F)
knitr::asis_output(t$knitr)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| age | 1.07 | 0.02 | 1.04 – 1.10 | <0.001 |
| Observations | 1363 | |||
| Deviance | 1330.165 | |||
| log-Likelihood | -665.082 | |||
modelo_2 <- glm(newchd ~ age + sex, data = data, family = binomial)
t<-tab_model(modelo_2, transform="exp",show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F,collapse.ci = F)
knitr::asis_output(t$knitr)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| age | 1.07 | 0.02 | 1.04 – 1.10 | <0.001 |
| sex1 | 2.05 | 0.29 | 1.56 – 2.70 | <0.001 |
| Observations | 1363 | |||
| Deviance | 1303.531 | |||
| log-Likelihood | -651.766 | |||
modelo_3 <- glm(newchd ~ age + sex + smoke, data = data, family = binomial)
t<-tab_model(modelo_3, transform="exp",show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F,collapse.ci = F)
knitr::asis_output(t$knitr)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| age | 1.07 | 0.02 | 1.04 – 1.10 | <0.001 |
| sex1 | 1.96 | 0.29 | 1.47 – 2.62 | <0.001 |
| smoke1 | 1.15 | 0.17 | 0.86 – 1.53 | 0.348 |
| Observations | 1362 | |||
| Deviance | 1302.316 | |||
| log-Likelihood | -651.158 | |||
modelo_4 <- glm(newchd ~ age + sex + smoke + chol, data = data, family = binomial)
t<-tab_model(modelo_4, transform="exp",show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F,collapse.ci = F)
knitr::asis_output(t$knitr)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| age | 1.07 | 0.02 | 1.04 – 1.10 | <0.001 |
| chol | 1.01 | 0.00 | 1.00 – 1.01 | <0.001 |
| sex1 | 2.21 | 0.34 | 1.64 – 2.99 | <0.001 |
| smoke1 | 1.14 | 0.17 | 0.85 – 1.53 | 0.373 |
| Observations | 1362 | |||
| Deviance | 1289.881 | |||
| log-Likelihood | -644.941 | |||
modelo_5 <- glm(newchd ~ age + sex + smoke + chol + sbp, data = data, family = binomial)
t<-tab_model(modelo_5, transform="exp",show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F,collapse.ci = F)
knitr::asis_output(t$knitr)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| age | 1.06 | 0.02 | 1.02 – 1.09 | <0.001 |
| chol | 1.00 | 0.00 | 1.00 – 1.01 | 0.003 |
| sbp | 1.02 | 0.00 | 1.01 – 1.02 | <0.001 |
| sex1 | 2.61 | 0.42 | 1.91 – 3.58 | <0.001 |
| smoke1 | 1.19 | 0.18 | 0.88 – 1.60 | 0.251 |
| Observations | 1362 | |||
| Deviance | 1241.541 | |||
| log-Likelihood | -620.771 | |||
modelo_6 <- glm(newchd ~ age + sex + smoke + chol + sbp + dbp, data = data, family = binomial)
t<-tab_model(modelo_6, transform="exp",show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F,collapse.ci = F)
knitr::asis_output(t$knitr)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| age | 1.06 | 0.02 | 1.03 – 1.09 | <0.001 |
| chol | 1.00 | 0.00 | 1.00 – 1.01 | 0.003 |
| dbp | 1.00 | 0.01 | 0.99 – 1.02 | 0.535 |
| sbp | 1.02 | 0.00 | 1.01 – 1.02 | <0.001 |
| sex1 | 2.59 | 0.41 | 1.90 – 3.55 | <0.001 |
| smoke1 | 1.20 | 0.18 | 0.89 – 1.61 | 0.241 |
| Observations | 1362 | |||
| Deviance | 1241.157 | |||
| log-Likelihood | -620.579 | |||
4.2 Comparación del modelo completo con el modelo nulo mediante test de verosimilitud (LRT)
options(scipen = 999)
anova(modelo_5, test="LRT")## Analysis of Deviance Table
##
## Model: binomial, link: logit
##
## Response: newchd
##
## Terms added sequentially (first to last)
##
##
## Df Deviance Resid. Df Resid. Dev Pr(>Chi)
## NULL 1361 1350.8
## age 1 21.112 1360 1329.7 0.000004331637512 ***
## sex 1 26.498 1359 1303.2 0.000000263786459 ***
## smoke 1 0.881 1358 1302.3 0.3479166
## chol 1 12.435 1357 1289.9 0.0004214 ***
## sbp 1 48.340 1356 1241.5 0.000000000003584 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1anova(modelo_6, test="LRT")## Analysis of Deviance Table
##
## Model: binomial, link: logit
##
## Response: newchd
##
## Terms added sequentially (first to last)
##
##
## Df Deviance Resid. Df Resid. Dev Pr(>Chi)
## NULL 1361 1350.8
## age 1 21.112 1360 1329.7 0.000004331637512 ***
## sex 1 26.498 1359 1303.2 0.000000263786459 ***
## smoke 1 0.881 1358 1302.3 0.3479166
## chol 1 12.435 1357 1289.9 0.0004214 ***
## sbp 1 48.340 1356 1241.5 0.000000000003584 ***
## dbp 1 0.384 1355 1241.2 0.5353531
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Este resultado indica que agregar dbp al modelo:
✅ No mejora significativamente el ajuste (p > 0.05)
⚠️ No reduce sustancialmente el deviance
⛔ No justifica su inclusión en un modelo parsimonioso
No es útil incluir dbp en el modelo final de efectos
principales ya que no mejora significativamente la predicción del evento
y puede aportar ruido innecesario.
4.3 Modelos con quintiles categorizados como Q5 vs resto
modelo_cat_1 <- glm(newchd ~ sex + age_q5_vs_rest, data = data, family = binomial)
modelo_cat_2 <- glm(newchd ~ sex + age_q5_vs_rest + sbp_q5_vs_rest, data = data, family = binomial)
modelo_cat_3 <- glm(newchd ~ sex + age_q5_vs_rest + sbp_q5_vs_rest + dbp_q5_vs_rest, data = data, family = binomial)
modelo_cat_4 <- glm(newchd ~ sex + age_q5_vs_rest + sbp_q5_vs_rest + dbp_q5_vs_rest + chol_q5_vs_rest, data = data, family = binomial)
modelo_cat_5 <- glm(newchd ~ sex + age_q5_vs_rest + sbp_q5_vs_rest + dbp_q5_vs_rest + chol_q5_vs_rest + smoke, data = data, family = binomial)
summary(modelo_cat_5)##
## Call:
## glm(formula = newchd ~ sex + age_q5_vs_rest + sbp_q5_vs_rest +
## dbp_q5_vs_rest + chol_q5_vs_rest + smoke, family = binomial,
## data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.5127 0.1568 -16.030 < 0.0000000000000002 ***
## sex1 0.8473 0.1550 5.468 0.0000000456 ***
## age_q5_vs_restQ5 0.7246 0.1636 4.428 0.0000094946 ***
## sbp_q5_vs_restQ5 0.6519 0.2061 3.163 0.00156 **
## dbp_q5_vs_restQ5 0.5259 0.2029 2.592 0.00954 **
## chol_q5_vs_restQ5 0.5505 0.1708 3.224 0.00127 **
## smoke1 0.1766 0.1513 1.167 0.24326
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1350.8 on 1361 degrees of freedom
## Residual deviance: 1248.2 on 1355 degrees of freedom
## (1 observation deleted due to missingness)
## AIC: 1262.2
##
## Number of Fisher Scoring iterations: 4t<-tab_model(modelo_cat_5, transform="exp",show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F,collapse.ci = F)
knitr::asis_output(t$knitr)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| Resto | Reference | |||
| Q5 | 2.06 | 0.34 | 1.49 – 2.84 | <0.001 |
| Resto | Reference | |||
| Q5 | 1.92 | 0.40 | 1.28 – 2.87 | 0.002 |
| Resto | Reference | |||
| Q5 | 1.69 | 0.34 | 1.13 – 2.51 | 0.010 |
| Resto | Reference | |||
| Q5 | 1.73 | 0.30 | 1.24 – 2.42 | 0.001 |
| sex1 | 2.33 | 0.36 | 1.73 – 3.17 | <0.001 |
| smoke1 | 1.19 | 0.18 | 0.89 – 1.61 | 0.243 |
| Observations | 1362 | |||
| Deviance | 1248.188 | |||
| log-Likelihood | -624.094 | |||
Paso 5: Modelo de Efectos Principales.
Nos quedamos con el modelo_5 como modelo de efectos
principales, ya que incluye las variables con significancia estadística
y relevancia clínica, y no se justifica agregar otras variables como
dbp, que no mejora el ajuste ni la predicción. Este modelo
será la base sobre la cual se evaluarán posibles interacciones en el
Paso 6.
t<-tab_model(modelo_5,show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F,collapse.ci = F)
knitr::asis_output(t$knitr)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| age | 1.06 | 0.02 | 1.02 – 1.09 | <0.001 |
| chol | 1.00 | 0.00 | 1.00 – 1.01 | 0.003 |
| sbp | 1.02 | 0.00 | 1.01 – 1.02 | <0.001 |
| sex1 | 2.61 | 0.42 | 1.91 – 3.58 | <0.001 |
| smoke1 | 1.19 | 0.18 | 0.88 – 1.60 | 0.251 |
| Observations | 1362 | |||
| Deviance | 1241.541 | |||
| log-Likelihood | -620.771 | |||
Comparando ambos modelos, el modelo 5 que utiliza variables continuas
(age, chol y sbp) junto con las
dicotómicas sex1 y smoke1 muestra un mejor
ajuste a los datos, evidenciado por un menor deviance (1241.541
vs. 1248.188) y un mayor log-likelihood (−620.771 vs. −624.094), lo que
indica mayor verosimilitud. Esto sugiere que la inclusión de las
variables como continuas permite captar mejor la variabilidad y
preservar la información original. En contraste, la categorización en
quintiles del modelo_cat_5, si bien puede facilitar la
interpretación clínica, genera pérdida de poder estadístico y no mejora
el desempeño global del modelo. Por lo tanto, se recomienda conservar
las variables en su forma continua, salvo que exista una justificación
teórica o empírica sólida para categorizar.
Paso 6: Interacción o modificación de efecto.
6.1 Término de interacción: age:chol
modelo_interaccion_1 <- glm(newchd ~ age + sex + smoke + chol + sbp + age:chol, data = data, family = binomial)
t<-tab_model(modelo_interaccion_1,show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F,collapse.ci = F)
knitr::asis_output(t$knitr)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| age | 0.87 | 0.07 | 0.74 – 1.03 | 0.103 |
| age:chol | 1.00 | 0.00 | 1.00 – 1.00 | 0.021 |
| chol | 0.96 | 0.02 | 0.93 – 1.00 | 0.041 |
| sbp | 1.02 | 0.00 | 1.01 – 1.02 | <0.001 |
| sex1 | 2.70 | 0.43 | 1.98 – 3.72 | <0.001 |
| smoke1 | 1.21 | 0.18 | 0.89 – 1.63 | 0.221 |
| Observations | 1362 | |||
| Deviance | 1236.169 | |||
| log-Likelihood | -618.085 | |||
anova(modelo_5, modelo_interaccion_1, test = "LRT")## Analysis of Deviance Table
##
## Model 1: newchd ~ age + sex + smoke + chol + sbp
## Model 2: newchd ~ age + sex + smoke + chol + sbp + age:chol
## Resid. Df Resid. Dev Df Deviance Pr(>Chi)
## 1 1356 1241.5
## 2 1355 1236.2 1 5.3723 0.02046 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1El valor p = 0.020 indica que agregar la interacción mejora significativamente el ajuste del modelo, aunque la magnitud del cambio es modesta.
El OR para el término de interacción age:chol es 1.00
con IC 95% justo en 1.00, y valor p significativo (0.021), lo que
sugiere que:
. Aunque la magnitud es pequeña, el efecto de la edad sobre los log-odds cambia ligeramente según el valor del colesterol.
. Este tipo de interacción es estadísticamente significativa pero clínicamente discreta.
Modelo sin interacción (modelo_5)
data$sex <- factor(data$sex)
data$smoke <- factor(data$smoke)
grid <- expand.grid(
age = seq(min(data$age, na.rm = TRUE), max(data$age, na.rm = TRUE), by = 1),
sex = levels(data$sex)
)
grid$chol <- mean(data$chol, na.rm = TRUE)
grid$sbp <- mean(data$sbp, na.rm = TRUE)
grid$smoke <- names(sort(table(data$smoke), decreasing = TRUE))[1]
grid$sex <- factor(grid$sex, levels = levels(data$sex))
grid$smoke <- factor(grid$smoke, levels = levels(data$smoke))
grid$pred <- predict(modelo_5, newdata = grid, type = "link")
ggplot(grid, aes(x = age, y = pred, color = sex)) +
geom_line(size = 1) +
labs(
title = "Modelo sin interacción (modelo_5)",
y = "Log-odds de enfermedad coronaria nueva",
x = "Edad"
) +
theme_minimal()## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Modelo con interacción (modelo_interaccion_1)
grid_inter <- expand.grid(
age = seq(min(data$age, na.rm = TRUE), max(data$age, na.rm = TRUE), by = 1),
chol = mean(data$chol, na.rm = TRUE),
sbp = mean(data$sbp, na.rm = TRUE),
smoke = names(sort(table(data$smoke), decreasing = TRUE))[1],
sex = levels(data$sex)
)
grid_inter$sex <- factor(grid_inter$sex, levels = levels(data$sex))
grid_inter$smoke <- factor(grid_inter$smoke, levels = levels(data$smoke))
grid$pred <- predict(modelo_interaccion_1, newdata = grid, type = "link")
ggplot(grid, aes(x = age, y = pred, color = sex)) +
geom_line(size = 1) +
labs(
title = "Modelo con interacción (modelo_interaccion_1): age * chol",
y = "Log-odds de enfermedad coronaria nueva",
x = "Edad"
) +
theme_minimal()
Calcular VIF y revisar la correlación entre age
y chol
vif(modelo_5)## age sex smoke chol sbp
## 1.044350 1.219627 1.139819 1.069268 1.080310vif(modelo_interaccion_1)## there are higher-order terms (interactions) in this model
## consider setting type = 'predictor'; see ?vif## age sex smoke chol sbp age:chol
## 31.410706 1.234192 1.144132 152.631986 1.085913 196.713974cor(data$age, data$chol, use = "complete.obs")## [1] 0.08328783🔴 VIF > 10 indica colinealidad severa.
⚠️ VIF > 100 es extremadamente alto.
Evaluación global: age:chol
La incorporación del término de interacción entre edad y colesterol
(age:chol) en el modelo mostró un valor p = 0.021 según el
Wald test, lo que indica una asociación estadísticamente significativa
entre esta interacción y el desenlace. Además, la comparación de modelos
anidados mediante test de verosimilitud (LRT) evidenció una
mejora en el ajuste del modelo al incluir dicha interacción (reducción
del deviance de 1241.5 a 1236.2; p = 0.020), respaldando su inclusión
desde el punto de vista estadístico. Si bien los gráficos de predicción
no revelaron cambios visuales relevantes en la pendiente, lo que sugiere
un efecto modesto, la presencia de colinealidad elevada entre edad y
colesterol era esperable dado que ambas variables también se incluyen de
forma independiente. La colinealidad no invalida al modelo y, frente a
un término de interacción con significancia estadística, resulta
razonable mantenerlo. En este sentido, aunque el efecto es clínicamente
discreto, su incorporación permite un modelo más ajustado que considera
posibles modificaciones del efecto de la edad en función de los niveles
de colesterol.
6.2 Término de interacción: sex:smoke
Modelo base: modelo_5
modelo_interaccion_2a <- glm(newchd ~ age + sex + smoke + chol + sbp + sex:smoke, data = data, family = binomial)
t<-tab_model(modelo_interaccion_2a,show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F,collapse.ci = F)
knitr::asis_output(t$knitr)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| age | 1.06 | 0.02 | 1.02 – 1.09 | <0.001 |
| chol | 1.00 | 0.00 | 1.00 – 1.01 | 0.003 |
| sbp | 1.02 | 0.00 | 1.01 – 1.02 | <0.001 |
| sex1 | 2.10 | 0.44 | 1.39 – 3.15 | <0.001 |
| sex1:smoke1 | 1.68 | 0.53 | 0.91 – 3.17 | 0.100 |
| smoke1 | 0.87 | 0.22 | 0.52 – 1.40 | 0.565 |
| Observations | 1362 | |||
| Deviance | 1238.767 | |||
| log-Likelihood | -619.383 | |||
Modelo base: modelo_interaccion_1
modelo_interaccion_2b <- glm(newchd ~ age + sex + smoke + chol + sbp + age:chol + sex:smoke, data = data, family = binomial)
t<-tab_model(modelo_interaccion_2b,show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F,collapse.ci = F)
knitr::asis_output(t$knitr)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| age | 0.88 | 0.07 | 0.74 – 1.04 | 0.127 |
| age:chol | 1.00 | 0.00 | 1.00 – 1.00 | 0.028 |
| chol | 0.96 | 0.02 | 0.93 – 1.00 | 0.053 |
| sbp | 1.02 | 0.00 | 1.01 – 1.02 | <0.001 |
| sex1 | 2.21 | 0.46 | 1.46 – 3.33 | <0.001 |
| sex1:smoke1 | 1.61 | 0.51 | 0.87 – 3.03 | 0.135 |
| smoke1 | 0.90 | 0.23 | 0.54 – 1.46 | 0.678 |
| Observations | 1362 | |||
| Deviance | 1233.889 | |||
| log-Likelihood | -616.944 | |||
El término de interacción sex:smoke reduce la deviance
del modelo incluso cuando se parte de un modelo que ya incluye la
interacción age:chol. De hecho, la mejora es mayor que si
se lo incorporara directamente al modelo de efectos principales. Esto
sugiere que ambas interacciones explican porciones complementarias del
riesgo de enfermedad coronaria. Aun sin alcanzar significación
estadística individual, la interacción sex:smoke contribuye
al ajuste global del modelo, reforzando la idea de que debe evaluarse el
impacto conjunto de los términos, más allá de los p-valores
aislados.
Al incorporar dos términos de interacción (age:chol y
sex:smoke), se observa una pérdida de significación
estadística en algunos predictores del modelo original, como
age y chol. Este fenómeno puede explicarse por
la redistribución del efecto que ocurre al modelar relaciones no
aditivas entre variables, más que por un problema de sobreajuste. En
este contexto, la interpretación de los coeficientes principales debe
hacerse con cautela, dado que sus efectos ya no representan estimaciones
promedio sino efectos condicionados por otros factores del modelo.
anova(modelo_5, modelo_interaccion_2a, test = "LRT")## Analysis of Deviance Table
##
## Model 1: newchd ~ age + sex + smoke + chol + sbp
## Model 2: newchd ~ age + sex + smoke + chol + sbp + sex:smoke
## Resid. Df Resid. Dev Df Deviance Pr(>Chi)
## 1 1356 1241.5
## 2 1355 1238.8 1 2.7746 0.09577 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1anova(modelo_5, modelo_interaccion_2b, test = "LRT")## Analysis of Deviance Table
##
## Model 1: newchd ~ age + sex + smoke + chol + sbp
## Model 2: newchd ~ age + sex + smoke + chol + sbp + age:chol + sex:smoke
## Resid. Df Resid. Dev Df Deviance Pr(>Chi)
## 1 1356 1241.5
## 2 1354 1233.9 2 7.6525 0.02179 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1anova(modelo_interaccion_1, modelo_interaccion_2b, test = "LRT")## Analysis of Deviance Table
##
## Model 1: newchd ~ age + sex + smoke + chol + sbp + age:chol
## Model 2: newchd ~ age + sex + smoke + chol + sbp + age:chol + sex:smoke
## Resid. Df Resid. Dev Df Deviance Pr(>Chi)
## 1 1355 1236.2
## 2 1354 1233.9 1 2.2802 0.131En el análisis de deviance se observó que la incorporación aislada
del término de interacción sex:smoke al modelo de efectos
principales no alcanzó significancia estadística (p = 0.0958), mientras
que la inclusión conjunta de sex:smoke y
age:chol resultó en una mejora global significativa del
modelo (p = 0.0218). Sin embargo, al evaluar la adición de
sex:smoke sobre un modelo que ya incluye
age:chol, no se observó una mejora estadísticamente
significativa (p = 0.131). Esto sugiere que, si bien ambas interacciones
pueden captar aspectos distintos del riesgo, la ganancia marginal
explicativa de sex:smoke se diluye cuando el modelo ya
considera age:chol.
6.3 Término de interacción: sex:chol
Modelo base: modelo_5
modelo_interaccion_3a <- glm(newchd ~ age + sex + smoke + chol + sbp + sex:chol, data = data, family = binomial)
t<-tab_model(modelo_interaccion_3a,show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F,collapse.ci = F)
knitr::asis_output(t$knitr)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| age | 1.06 | 0.02 | 1.02 – 1.09 | <0.001 |
| chol | 1.00 | 0.00 | 1.00 – 1.01 | 0.036 |
| sbp | 1.02 | 0.00 | 1.01 – 1.02 | <0.001 |
| sex1 | 2.54 | 1.97 | 0.55 – 11.70 | 0.232 |
| sex1:chol | 1.00 | 0.00 | 0.99 – 1.01 | 0.970 |
| smoke1 | 1.19 | 0.18 | 0.88 – 1.61 | 0.251 |
| Observations | 1362 | |||
| Deviance | 1241.540 | |||
| log-Likelihood | -620.770 | |||
No hay evidencia estadísticamente significativa de que el efecto
del colesterol difiera entre hombres y mujeres. No se justifica incluir
la interacción sex:chol en el modelo final.
Modelo base: modelo_interaccion_1
modelo_interaccion_3b <- glm(newchd ~ age + sex + smoke + chol + sbp + age:chol + sex:chol, data = data, family = binomial)
t<-tab_model(modelo_interaccion_3b,show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F,collapse.ci = F)
knitr::asis_output(t$knitr)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| age | 0.87 | 0.07 | 0.74 – 1.03 | 0.103 |
| age:chol | 1.00 | 0.00 | 1.00 – 1.00 | 0.021 |
| chol | 0.96 | 0.02 | 0.93 – 1.00 | 0.041 |
| sbp | 1.02 | 0.00 | 1.01 – 1.02 | <0.001 |
| sex1 | 2.51 | 1.96 | 0.54 – 11.63 | 0.238 |
| sex1:chol | 1.00 | 0.00 | 0.99 – 1.01 | 0.924 |
| smoke1 | 1.21 | 0.18 | 0.89 – 1.63 | 0.221 |
| Observations | 1362 | |||
| Deviance | 1236.160 | |||
| log-Likelihood | -618.080 | |||
6.4 Término de interacción: smoke:sbp
Modelo base: modelo_5
modelo_interaccion_4a <- glm(newchd ~ age + sex + smoke + chol + sbp + smoke:sbp, data = data, family = binomial)
t<-tab_model(modelo_interaccion_4a,show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F,collapse.ci = F)
knitr::asis_output(t$knitr)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| age | 1.06 | 0.02 | 1.02 – 1.09 | <0.001 |
| chol | 1.00 | 0.00 | 1.00 – 1.01 | 0.003 |
| sbp | 1.02 | 0.00 | 1.01 – 1.02 | <0.001 |
| sex1 | 2.61 | 0.42 | 1.91 – 3.58 | <0.001 |
| smoke1 | 1.61 | 1.22 | 0.36 – 7.09 | 0.529 |
| smoke1:sbp | 1.00 | 0.00 | 0.99 – 1.01 | 0.684 |
| Observations | 1362 | |||
| Deviance | 1241.376 | |||
| log-Likelihood | -620.688 | |||
No hay evidencia estadísticamente significativa de que haya
modificación de efecto del tabaquismo en la presión arterial sistólica.
No se justifica incluir la interacción smoke:sbp en el
modelo final.
Modelo base: modelo_interaccion_1
modelo_interaccion_4b <- glm(newchd ~ age + sex + smoke + chol + sbp + age:chol + smoke:sbp, data = data, family = binomial)
t<-tab_model(modelo_interaccion_4b,show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F,collapse.ci = F)
knitr::asis_output(t$knitr)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| age | 0.87 | 0.07 | 0.74 – 1.03 | 0.103 |
| age:chol | 1.00 | 0.00 | 1.00 – 1.00 | 0.021 |
| chol | 0.96 | 0.02 | 0.93 – 1.00 | 0.041 |
| sbp | 1.02 | 0.00 | 1.01 – 1.02 | <0.001 |
| sex1 | 2.70 | 0.43 | 1.97 – 3.71 | <0.001 |
| smoke1 | 1.65 | 1.25 | 0.37 – 7.26 | 0.510 |
| smoke1:sbp | 1.00 | 0.00 | 0.99 – 1.01 | 0.675 |
| Observations | 1362 | |||
| Deviance | 1235.993 | |||
| log-Likelihood | -617.997 | |||
6.5 Término de interacción: age:sbp
Modelo base: modelo_5
modelo_interaccion_5a <- glm(newchd ~ age + sex + smoke + chol + sbp + age:sbp, data = data, family = binomial)
t<-tab_model(modelo_interaccion_5a,show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F,collapse.ci = F)
knitr::asis_output(t$knitr)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| age | 1.03 | 0.09 | 0.88 – 1.22 | 0.689 |
| age:sbp | 1.00 | 0.00 | 1.00 – 1.00 | 0.804 |
| chol | 1.00 | 0.00 | 1.00 – 1.01 | 0.003 |
| sbp | 1.01 | 0.03 | 0.95 – 1.07 | 0.743 |
| sex1 | 2.61 | 0.42 | 1.92 – 3.58 | <0.001 |
| smoke1 | 1.19 | 0.18 | 0.88 – 1.61 | 0.250 |
| Observations | 1362 | |||
| Deviance | 1241.479 | |||
| log-Likelihood | -620.740 | |||
No se justifica incluir el término de interacción
age:sbp en el modelo final.
Modelo base: modelo_interaccion_1
modelo_interaccion_5b <- glm(newchd ~ age + sex + smoke + chol + sbp + age:chol + age:sbp, data = data, family = binomial)
t<-tab_model(modelo_interaccion_5b,show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F,collapse.ci = F)
knitr::asis_output(t$knitr)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| age | 0.87 | 0.10 | 0.70 – 1.09 | 0.220 |
| age:chol | 1.00 | 0.00 | 1.00 – 1.00 | 0.022 |
| age:sbp | 1.00 | 0.00 | 1.00 – 1.00 | 0.998 |
| chol | 0.96 | 0.02 | 0.93 – 1.00 | 0.042 |
| sbp | 1.02 | 0.03 | 0.96 – 1.08 | 0.559 |
| sex1 | 2.70 | 0.43 | 1.98 – 3.72 | <0.001 |
| smoke1 | 1.21 | 0.18 | 0.89 – 1.63 | 0.221 |
| Observations | 1362 | |||
| Deviance | 1236.169 | |||
| log-Likelihood | -618.085 | |||
6.6 Término de interacción: age:sex
Modelo base: modelo_5
modelo_interaccion_6a <- glm(newchd ~ age + sex + smoke + chol + sbp + age:sex, data = data, family = binomial)
t<-tab_model(modelo_interaccion_6a,show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F,collapse.ci = F)
knitr::asis_output(t$knitr)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| age | 1.08 | 0.03 | 1.03 – 1.14 | 0.002 |
| age:sex1 | 0.96 | 0.03 | 0.90 – 1.02 | 0.209 |
| chol | 1.00 | 0.00 | 1.00 – 1.01 | 0.004 |
| sbp | 1.02 | 0.00 | 1.01 – 1.02 | <0.001 |
| sex1 | 21.09 | 35.29 | 0.81 – 575.58 | 0.069 |
| smoke1 | 1.19 | 0.18 | 0.88 – 1.61 | 0.250 |
| Observations | 1362 | |||
| Deviance | 1239.955 | |||
| log-Likelihood | -619.978 | |||
No se justifica incluir el término de interacción
age:sex en el modelo final.
Modelo base: modelo_interaccion_1
modelo_interaccion_6b <- glm(newchd ~ age + sex + smoke + chol + sbp + age:chol + age:sex, data = data, family = binomial)
t<-tab_model(modelo_interaccion_6b,show.se = T, show.dev = T, show.loglik = T, show.intercept = F,show.stat = F, show.reflvl = T, digits = 2, digits.p = 3, show.r2 = F,collapse.ci = F)
knitr::asis_output(t$knitr)| newchd | ||||
|---|---|---|---|---|
| Predictors | Odds Ratios | std. Error | CI | p |
| age | 0.90 | 0.08 | 0.75 – 1.07 | 0.233 |
| age:chol | 1.00 | 0.00 | 1.00 – 1.00 | 0.033 |
| age:sex1 | 0.97 | 0.03 | 0.91 – 1.03 | 0.376 |
| chol | 0.96 | 0.02 | 0.93 – 1.00 | 0.060 |
| sbp | 1.02 | 0.00 | 1.01 – 1.02 | <0.001 |
| sex1 | 11.98 | 20.27 | 0.44 – 338.58 | 0.142 |
| smoke1 | 1.21 | 0.18 | 0.89 – 1.63 | 0.223 |
| Observations | 1362 | |||
| Deviance | 1235.382 | |||
| log-Likelihood | -617.691 | |||
Paso 7: Tamaño muestral (n adecuado y eventos).
¿Contamos con un tamaño muestral suficiente para sostener el modelo multivariable propuesto (modelo_interaccion_1)?
🔹 Se recomienda tener al menos entre 10 y 20 eventos por cada variable independiente incluida en el modelo para evitar sobreajuste y garantizar estabilidad en las estimaciones.
🔹 En el modelo_interaccion_1 se incluyeron las
siguientes variables independientes:
age, chol, sbp,
sex, smoke
y el término de interacción age:chol
➡️ Total: 6 variables independientes
🔹 Por lo tanto, necesitamos un mínimo de:
10 eventos/variable: 10 × 6 = 60 eventos
20 eventos/variable (recomendado): 20 × 6 = 120 eventos
🔹 Según los resultados de la Tabla 1 (análisis univariado por
presencia de enfermedad coronaria nueva), la cantidad de eventos
(newchd = 1) fue de 268.
✅ ¿Por qué se dice que hay que tener 10–20 eventos por variable independiente?
La regla de ≥10 (idealmente 20) eventos por predictor se refiere a
que por cada variable incluida en el modelo, debe haber al menos 10 (ó
20) individuos que hayan tenido el evento (es decir,
newchd == 1).
🔍 ¿Y cómo se evalúa si cada variable tiene “suficientes eventos”?
No es necesario que cada categoría de cada variable tenga 10-20 eventos, sino que:
En conjunto, el modelo debe tener suficientes eventos totales para el número de predictores ajustados.
➡️ 268 eventos superan ampliamente ambos umbrales.
🧠 Entonces, ¿debo mirar variable por variable?
Solo en casos de categorías con pocos eventos o muchos niveles (como variables categóricas con 3+ categorías o continuas transformadas en splines o cuantiles). Por ejemplo:
Si tuvieras una variable categórica con 4 niveles, y uno de ellos tiene solo 2 eventos, eso sí sería un problema (modelos inestables).
Pero:
sex tiene solo 2 niveles (0 y 1), con 164 eventos en
hombres (sex = 1, con enfermedad).
smoke también tiene 2 niveles, con 134 eventos en
fumadores.
Ambos superan el mínimo recomendado.
✅ Conclusión
Hay al menos 10–20 eventos por cada variable incluida en el modelo.
No hace falta que cada valor/categoría tenga esa cantidad, sino que el
modelo entero tenga suficientes eventos totales en
newchd = 1 para los predictores ajustados.
Paso 8: Modelo final.
Se selecciona modelo_interaccion_1 como modelo final de
efectos principales, ya que incluye variables con plausibilidad clínica
(age, sex, smoke,
chol, sbp) y un término de interacción
significativo entre edad y colesterol (age:chol).
Este modelo mejora el ajuste respecto al modelo sin interacción
(modelo_5), con una reducción en el deviance y una p <
0.05 según el test de verosimilitud. Aunque la magnitud del cambio es
discreta, su significancia estadística y coherencia clínica justifican
su inclusión.
Además, se cumple con el criterio de al menos 10–20 eventos por cada variable incluida (268 eventos totales para 6 predictores), y no se identificaron problemas de inestabilidad o sobreajuste. Por lo tanto, se considera que el modelo final es parsimonioso, estable y clínicamente interpretable para evaluar la asociación con enfermedad coronaria nueva.
Paso 9: ¿El modelo está bien calibrado?
9.1 Test de H&L.
pred_modelo <- as.data.frame(predict(modelo_interaccion_1, data, type = "response")) %>% rename(pred = `predict(modelo_interaccion_1, data, type = "response")`)
pred_modelo$verdad <- data$newchd
H_L <- HLtest(modelo_interaccion_1,10)
HL_DF <- cbind(as.data.frame(H_L$table), indice = as.factor(c(1,2,3,4,5,6,7,8,9,10)))
H_L## Hosmer and Lemeshow Goodness-of-Fit Test
##
## Call:
## glm(formula = newchd ~ age + sex + smoke + chol + sbp + age:chol,
## family = binomial, data = data)
## ChiSquare df P_value
## 6.178342 8 0.6272625HL_DF[,1:4]## cut total obs exp
## 1 [0.0346,0.0721] 137 133 128.91239
## 2 (0.0721,0.0956] 136 126 124.61176
## 3 (0.0956,0.121] 136 119 121.21781
## 4 (0.121,0.149] 136 118 117.66856
## 5 (0.149,0.171] 136 116 114.22263
## 6 (0.171,0.2] 136 107 110.84274
## 7 (0.2,0.231] 136 108 106.83661
## 8 (0.231,0.275] 136 97 101.61056
## 9 (0.275,0.35] 136 90 94.08858
## 10 (0.35,0.821] 137 80 73.98835HL_DF %>% knitr::kable()## Warning in attr(x, "align"): 'xfun::attr()' está en desuso.
## Utilizar 'xfun::attr2()' en su lugar.
## Ver help("Deprecated")## Warning in attr(x, "format"): 'xfun::attr()' está en desuso.
## Utilizar 'xfun::attr2()' en su lugar.
## Ver help("Deprecated")| cut | total | obs | exp | chi | indice |
|---|---|---|---|---|---|
| [0.0346,0.0721] | 137 | 133 | 128.91239 | 0.3600160 | 1 |
| (0.0721,0.0956] | 136 | 126 | 124.61176 | 0.1243611 | 2 |
| (0.0956,0.121] | 136 | 119 | 121.21781 | -0.2014380 | 3 |
| (0.121,0.149] | 136 | 118 | 117.66856 | 0.0305541 | 4 |
| (0.149,0.171] | 136 | 116 | 114.22263 | 0.1663038 | 5 |
| (0.171,0.2] | 136 | 107 | 110.84274 | -0.3649958 | 6 |
| (0.2,0.231] | 136 | 108 | 106.83661 | 0.1125555 | 7 |
| (0.231,0.275] | 136 | 97 | 101.61056 | -0.4573875 | 8 |
| (0.275,0.35] | 136 | 90 | 94.08858 | -0.4215060 | 9 |
| (0.35,0.821] | 137 | 80 | 73.98835 | 0.6988949 | 10 |
ggplot(HL_DF, aes(x=indice))+geom_point(aes(y=exp, color = "blue"))+geom_point(aes(y=obs, color = "red"))+scale_color_manual(labels = c("Esperado", "Observado"), values = c("blue", "red"))
Se aplicó el test de bondad de ajuste de Hosmer y Lemeshow (H&L) para evaluar la calibración del modelo final de regresión logística múltiple. Este test compara las frecuencias observadas y esperadas del evento (en este caso, enfermedad coronaria) en deciles de riesgo predicho por el modelo.
El resultado fue:
Chi² (Hosmer y Lemeshow) = 6.17
Grados de libertad = 8
Valor p = 0.6272
Dado que el valor p es mayor a 0.05, no se rechaza la hipótesis nula de buen ajuste. Esto sugiere que el modelo se encuentra adecuadamente calibrado, es decir, que las probabilidades predichas por el modelo son consistentes con los valores observados en los distintos niveles de riesgo.
Además, se construyó una tabla que agrupa a los individuos en 10 deciles según su riesgo predicho. En cada uno de ellos se comparó la cantidad de eventos observados y esperados, y se calculó la contribución individual al estadístico Chi2.
Visualmente, el gráfico de dispersión muestra buena concordancia entre los eventos esperados y observados en cada grupo.
9.2 Comentarios.
La calibración visual y numérica incluye tanto:
El test de Hosmer-Lemeshow (H&L), que evalúa la bondad de ajuste del modelo comparando predicciones esperadas vs. observadas en deciles de riesgo.
El gráfico de calibración (ggplot), que representa visualmente dicha comparación (observado vs. predicho), incluyendo pendiente y ordenada al origen.
📌 ¿Por qué q4 tiene chi2 bajo y puntos cercanos? En q4, el valor de chi-cuadrado es 0.03, y visualmente, los puntos de “Esperado” y “Observado” están muy próximos. Esto refleja buena calibración local: el modelo predijo correctamente la cantidad de eventos.
📌 ¿Por qué q10 tiene chi2 alto (0.69) pero también tiene separación visual evidente? En q10, se observa una clara diferencia entre lo esperado y lo observado (esperaba 73.9 y se observaron 80 eventos).
A pesar de esto, el chi-cuadrado local es relativamente alto pero no es lo suficientemente grande como para ser estadísticamente significativo por sí solo.
Esto ocurre porque el valor de chi² también depende del tamaño del grupo y de la varianza esperada: si hay mucha incertidumbre en la predicción en ese decil, un desvío relativamente grande puede no generar un gran chi².
9.3 Slope & Intercept.
pred_modelo <- pred_modelo[-1258,]# esta parece ser una observacion duplicada
a <- valProbggplot(pred_modelo$pred, pred_modelo$verdad)
a$ggPlot
a$Calibration## $Intercept
## Point estimate Lower confidence limit Upper confidence limit
## -0.000000007367985 -0.140011592080830 0.140011577344860
##
## $Slope
## Point estimate Lower confidence limit.2.5 %
## 1.000000 0.805085
## Upper confidence limit.97.5 %
## 1.194915La calibración visual y numérica del modelo es muy adecuada. El riesgo predicho se ajusta bien al riesgo observado, sin evidencia de sobre o subestimación sistemática.
La línea negra sigue a la línea ideal con buena precisión, y los valores del intercepto y slope son cercanos a los ideales (0 y 1 respectivamente), confirmando una buena calibración.
9.4 Comentarios.
El análisis de slope e intercept (calibration-in-the-large) también puede formar parte de la evaluación de calibración, pero tiene un enfoque distinto:
Evalúa si las predicciones están sesgadas sistemáticamente (intercept ≠ 0) o si la fuerza de asociación está bien estimada (slope ≠ 1).
Es útil especialmente en validaciones externas.
Paso 10: ¿El modelo discrimina bien?
10.1 Curva ROC.
roc<-roc(pred_modelo$verdad, pred_modelo$pred)## Setting levels: control = 0, case = 1## Setting direction: controls < casesplot(roc, main = "Curva ROC", col = "red", lwd = 3)
text(0.8, 0.2, paste("AUC ROC =", round(roc$auc, 3)), adj = c(0, 1))
ci.auc(roc)## 95% CI: 0.6737-0.7403 (DeLong)AUC = 0.7 (IC95%: 0.66 a 0.73) es la capacidad de discriminación global del modelo, y significa que, en promedio, el modelo clasifica correctamente en un 70% de los casos cuando compara un par aleatorio de individuos, uno con evento y uno sin él.
10.2 Matriz de confusión
pred_modelo <- pred_modelo %>% dplyr::mutate(prediccion = ifelse(pred > 0.2, 1,0))
tab <- tab_xtab(pred_modelo$prediccion, pred_modelo$verdad ,tdcol.row = "black",tdcol.n = "black", title = "Matriz de Confusion - cutoff = 0.2")
knitr::asis_output(tab$knitr)| prediccion | verdad | Total | |
|---|---|---|---|
| 0 | 1 | ||
| 0 | 718 | 97 | 815 |
| 1 | 376 | 171 | 547 |
| Total | 1094 | 268 | 1362 | χ2=76.398 · df=1 · &phi=0.239 · p=0.000 |
cat("Sensibilidad:", paste0(round(caret::sensitivity(factor(pred_modelo$verdad), factor(pred_modelo$prediccion)),2)))## Sensibilidad: 0.88cat("Especificidad:", paste0(round(caret::specificity(factor(pred_modelo$verdad), factor(pred_modelo$prediccion)),2)))## Especificidad: 0.31Para un punto de corte de probabilidad de 0.2, el modelo alcanzó una sensibilidad de 0.87, especificidad de 0.30, VPP de 0.297 y VPN de 0.871.
SENS=roc$sensitivities
ESPEC=roc$specificities
CUTOFF=roc$thresholds
d <- cbind(SENS,ESPEC,CUTOFF)
d%>% knitr::kable()## Warning in attr(x, "align"): 'xfun::attr()' está en desuso.
## Utilizar 'xfun::attr2()' en su lugar.
## Ver help("Deprecated")## Warning in attr(x, "format"): 'xfun::attr()' está en desuso.
## Utilizar 'xfun::attr2()' en su lugar.
## Ver help("Deprecated")| SENS | ESPEC | CUTOFF |
|---|---|---|
| 1.0000000 | 0.0000000 | -Inf |
| 1.0000000 | 0.0009141 | 0.0352128 |
| 1.0000000 | 0.0018282 | 0.0376475 |
| 1.0000000 | 0.0027422 | 0.0400345 |
| 1.0000000 | 0.0036563 | 0.0410183 |
| 1.0000000 | 0.0045704 | 0.0416844 |
| 1.0000000 | 0.0054845 | 0.0419785 |
| 1.0000000 | 0.0063985 | 0.0420178 |
| 1.0000000 | 0.0073126 | 0.0427688 |
| 1.0000000 | 0.0082267 | 0.0436177 |
| 1.0000000 | 0.0091408 | 0.0439926 |
| 1.0000000 | 0.0100548 | 0.0445626 |
| 1.0000000 | 0.0109689 | 0.0450400 |
| 0.9962687 | 0.0109689 | 0.0456895 |
| 0.9962687 | 0.0118830 | 0.0462959 |
| 0.9962687 | 0.0127971 | 0.0471580 |
| 0.9962687 | 0.0137112 | 0.0483220 |
| 0.9962687 | 0.0146252 | 0.0490004 |
| 0.9962687 | 0.0155393 | 0.0493484 |
| 0.9962687 | 0.0164534 | 0.0494998 |
| 0.9962687 | 0.0173675 | 0.0496933 |
| 0.9962687 | 0.0182815 | 0.0499543 |
| 0.9962687 | 0.0191956 | 0.0502617 |
| 0.9962687 | 0.0201097 | 0.0504821 |
| 0.9962687 | 0.0210238 | 0.0505429 |
| 0.9962687 | 0.0219378 | 0.0506306 |
| 0.9962687 | 0.0228519 | 0.0508167 |
| 0.9962687 | 0.0237660 | 0.0510481 |
| 0.9962687 | 0.0246801 | 0.0513366 |
| 0.9925373 | 0.0246801 | 0.0515467 |
| 0.9925373 | 0.0255941 | 0.0517252 |
| 0.9925373 | 0.0265082 | 0.0520333 |
| 0.9925373 | 0.0274223 | 0.0521897 |
| 0.9925373 | 0.0283364 | 0.0525134 |
| 0.9925373 | 0.0292505 | 0.0529166 |
| 0.9925373 | 0.0301645 | 0.0531032 |
| 0.9925373 | 0.0310786 | 0.0533137 |
| 0.9925373 | 0.0319927 | 0.0537224 |
| 0.9925373 | 0.0329068 | 0.0543125 |
| 0.9925373 | 0.0338208 | 0.0547613 |
| 0.9925373 | 0.0347349 | 0.0549617 |
| 0.9925373 | 0.0356490 | 0.0550423 |
| 0.9925373 | 0.0365631 | 0.0552288 |
| 0.9925373 | 0.0374771 | 0.0553924 |
| 0.9925373 | 0.0383912 | 0.0555068 |
| 0.9925373 | 0.0393053 | 0.0556908 |
| 0.9925373 | 0.0402194 | 0.0558036 |
| 0.9925373 | 0.0411335 | 0.0559933 |
| 0.9925373 | 0.0420475 | 0.0561962 |
| 0.9925373 | 0.0429616 | 0.0563972 |
| 0.9925373 | 0.0438757 | 0.0566889 |
| 0.9925373 | 0.0447898 | 0.0570410 |
| 0.9925373 | 0.0457038 | 0.0572813 |
| 0.9925373 | 0.0466179 | 0.0574900 |
| 0.9925373 | 0.0475320 | 0.0576722 |
| 0.9925373 | 0.0484461 | 0.0577181 |
| 0.9925373 | 0.0493601 | 0.0580844 |
| 0.9925373 | 0.0502742 | 0.0584243 |
| 0.9925373 | 0.0511883 | 0.0586322 |
| 0.9925373 | 0.0521024 | 0.0589924 |
| 0.9925373 | 0.0539305 | 0.0593304 |
| 0.9925373 | 0.0548446 | 0.0595411 |
| 0.9925373 | 0.0557587 | 0.0596921 |
| 0.9925373 | 0.0566728 | 0.0598030 |
| 0.9925373 | 0.0575868 | 0.0598141 |
| 0.9925373 | 0.0585009 | 0.0599821 |
| 0.9925373 | 0.0594150 | 0.0601881 |
| 0.9925373 | 0.0603291 | 0.0603985 |
| 0.9925373 | 0.0612431 | 0.0607371 |
| 0.9925373 | 0.0621572 | 0.0609714 |
| 0.9925373 | 0.0630713 | 0.0610583 |
| 0.9925373 | 0.0639854 | 0.0611976 |
| 0.9925373 | 0.0658135 | 0.0613848 |
| 0.9925373 | 0.0667276 | 0.0616476 |
| 0.9925373 | 0.0676417 | 0.0619691 |
| 0.9925373 | 0.0685558 | 0.0621075 |
| 0.9925373 | 0.0694698 | 0.0621312 |
| 0.9925373 | 0.0703839 | 0.0622450 |
| 0.9925373 | 0.0712980 | 0.0623511 |
| 0.9925373 | 0.0722121 | 0.0625343 |
| 0.9888060 | 0.0722121 | 0.0627904 |
| 0.9888060 | 0.0731261 | 0.0629183 |
| 0.9888060 | 0.0740402 | 0.0629760 |
| 0.9888060 | 0.0749543 | 0.0630655 |
| 0.9888060 | 0.0758684 | 0.0632275 |
| 0.9888060 | 0.0767824 | 0.0634499 |
| 0.9888060 | 0.0776965 | 0.0635885 |
| 0.9888060 | 0.0786106 | 0.0636453 |
| 0.9888060 | 0.0795247 | 0.0637160 |
| 0.9888060 | 0.0804388 | 0.0638660 |
| 0.9888060 | 0.0813528 | 0.0640947 |
| 0.9888060 | 0.0822669 | 0.0642275 |
| 0.9888060 | 0.0831810 | 0.0644873 |
| 0.9888060 | 0.0840951 | 0.0647269 |
| 0.9888060 | 0.0850091 | 0.0647809 |
| 0.9888060 | 0.0859232 | 0.0650284 |
| 0.9888060 | 0.0868373 | 0.0652959 |
| 0.9888060 | 0.0877514 | 0.0653809 |
| 0.9888060 | 0.0886654 | 0.0657018 |
| 0.9888060 | 0.0895795 | 0.0660883 |
| 0.9888060 | 0.0904936 | 0.0662288 |
| 0.9888060 | 0.0914077 | 0.0662980 |
| 0.9888060 | 0.0923218 | 0.0665382 |
| 0.9888060 | 0.0932358 | 0.0668064 |
| 0.9888060 | 0.0941499 | 0.0668838 |
| 0.9888060 | 0.0950640 | 0.0669225 |
| 0.9850746 | 0.0950640 | 0.0669835 |
| 0.9850746 | 0.0959781 | 0.0670703 |
| 0.9850746 | 0.0968921 | 0.0672021 |
| 0.9850746 | 0.0978062 | 0.0673506 |
| 0.9850746 | 0.0987203 | 0.0674081 |
| 0.9850746 | 0.0996344 | 0.0675009 |
| 0.9850746 | 0.1005484 | 0.0676299 |
| 0.9850746 | 0.1014625 | 0.0678170 |
| 0.9850746 | 0.1023766 | 0.0679843 |
| 0.9850746 | 0.1032907 | 0.0680494 |
| 0.9850746 | 0.1042048 | 0.0681007 |
| 0.9850746 | 0.1051188 | 0.0682197 |
| 0.9850746 | 0.1060329 | 0.0684830 |
| 0.9850746 | 0.1069470 | 0.0689342 |
| 0.9850746 | 0.1078611 | 0.0693551 |
| 0.9850746 | 0.1087751 | 0.0695330 |
| 0.9850746 | 0.1096892 | 0.0696312 |
| 0.9850746 | 0.1106033 | 0.0696832 |
| 0.9850746 | 0.1115174 | 0.0697582 |
| 0.9850746 | 0.1124314 | 0.0700198 |
| 0.9850746 | 0.1133455 | 0.0703083 |
| 0.9850746 | 0.1142596 | 0.0704611 |
| 0.9850746 | 0.1151737 | 0.0705900 |
| 0.9850746 | 0.1160878 | 0.0706924 |
| 0.9850746 | 0.1170018 | 0.0708195 |
| 0.9850746 | 0.1179159 | 0.0710147 |
| 0.9850746 | 0.1188300 | 0.0714206 |
| 0.9850746 | 0.1197441 | 0.0718497 |
| 0.9850746 | 0.1206581 | 0.0720527 |
| 0.9850746 | 0.1215722 | 0.0721797 |
| 0.9850746 | 0.1224863 | 0.0723105 |
| 0.9850746 | 0.1234004 | 0.0724518 |
| 0.9850746 | 0.1243144 | 0.0725457 |
| 0.9850746 | 0.1252285 | 0.0725892 |
| 0.9850746 | 0.1261426 | 0.0728895 |
| 0.9850746 | 0.1270567 | 0.0732379 |
| 0.9850746 | 0.1279707 | 0.0733638 |
| 0.9850746 | 0.1288848 | 0.0734854 |
| 0.9850746 | 0.1297989 | 0.0735501 |
| 0.9850746 | 0.1307130 | 0.0736581 |
| 0.9813433 | 0.1307130 | 0.0738181 |
| 0.9813433 | 0.1316271 | 0.0739893 |
| 0.9813433 | 0.1325411 | 0.0742300 |
| 0.9813433 | 0.1334552 | 0.0744206 |
| 0.9813433 | 0.1343693 | 0.0745121 |
| 0.9813433 | 0.1352834 | 0.0746243 |
| 0.9813433 | 0.1361974 | 0.0751865 |
| 0.9813433 | 0.1371115 | 0.0757665 |
| 0.9813433 | 0.1380256 | 0.0758983 |
| 0.9813433 | 0.1389397 | 0.0759376 |
| 0.9813433 | 0.1398537 | 0.0759588 |
| 0.9813433 | 0.1407678 | 0.0760192 |
| 0.9813433 | 0.1416819 | 0.0761809 |
| 0.9813433 | 0.1425960 | 0.0763391 |
| 0.9813433 | 0.1435101 | 0.0763875 |
| 0.9813433 | 0.1444241 | 0.0765135 |
| 0.9813433 | 0.1453382 | 0.0766506 |
| 0.9813433 | 0.1462523 | 0.0767460 |
| 0.9813433 | 0.1471664 | 0.0770040 |
| 0.9813433 | 0.1480804 | 0.0773893 |
| 0.9813433 | 0.1489945 | 0.0777494 |
| 0.9813433 | 0.1499086 | 0.0779254 |
| 0.9813433 | 0.1508227 | 0.0779562 |
| 0.9813433 | 0.1517367 | 0.0779926 |
| 0.9813433 | 0.1526508 | 0.0781220 |
| 0.9813433 | 0.1535649 | 0.0783179 |
| 0.9813433 | 0.1544790 | 0.0784522 |
| 0.9813433 | 0.1553931 | 0.0784944 |
| 0.9776119 | 0.1553931 | 0.0785365 |
| 0.9776119 | 0.1563071 | 0.0788454 |
| 0.9776119 | 0.1572212 | 0.0791751 |
| 0.9776119 | 0.1581353 | 0.0792384 |
| 0.9776119 | 0.1590494 | 0.0793082 |
| 0.9776119 | 0.1599634 | 0.0796015 |
| 0.9776119 | 0.1608775 | 0.0798379 |
| 0.9738806 | 0.1608775 | 0.0799065 |
| 0.9738806 | 0.1617916 | 0.0801972 |
| 0.9738806 | 0.1627057 | 0.0805184 |
| 0.9738806 | 0.1636197 | 0.0806542 |
| 0.9738806 | 0.1645338 | 0.0808508 |
| 0.9738806 | 0.1654479 | 0.0810400 |
| 0.9701493 | 0.1654479 | 0.0811588 |
| 0.9701493 | 0.1663620 | 0.0812719 |
| 0.9701493 | 0.1672761 | 0.0813385 |
| 0.9664179 | 0.1672761 | 0.0814021 |
| 0.9664179 | 0.1681901 | 0.0815598 |
| 0.9664179 | 0.1691042 | 0.0817767 |
| 0.9664179 | 0.1700183 | 0.0821129 |
| 0.9664179 | 0.1709324 | 0.0823686 |
| 0.9664179 | 0.1718464 | 0.0823964 |
| 0.9664179 | 0.1727605 | 0.0824971 |
| 0.9664179 | 0.1736746 | 0.0825801 |
| 0.9664179 | 0.1745887 | 0.0826450 |
| 0.9664179 | 0.1755027 | 0.0827334 |
| 0.9664179 | 0.1764168 | 0.0829953 |
| 0.9664179 | 0.1773309 | 0.0832601 |
| 0.9664179 | 0.1782450 | 0.0832900 |
| 0.9664179 | 0.1791590 | 0.0833617 |
| 0.9664179 | 0.1800731 | 0.0835255 |
| 0.9664179 | 0.1809872 | 0.0836382 |
| 0.9664179 | 0.1819013 | 0.0836947 |
| 0.9664179 | 0.1828154 | 0.0838105 |
| 0.9664179 | 0.1837294 | 0.0839598 |
| 0.9664179 | 0.1846435 | 0.0841543 |
| 0.9664179 | 0.1855576 | 0.0843989 |
| 0.9664179 | 0.1864717 | 0.0845425 |
| 0.9664179 | 0.1873857 | 0.0845870 |
| 0.9664179 | 0.1882998 | 0.0846710 |
| 0.9664179 | 0.1892139 | 0.0847991 |
| 0.9664179 | 0.1901280 | 0.0849900 |
| 0.9664179 | 0.1910420 | 0.0851349 |
| 0.9664179 | 0.1919561 | 0.0852175 |
| 0.9664179 | 0.1928702 | 0.0852842 |
| 0.9664179 | 0.1937843 | 0.0853117 |
| 0.9664179 | 0.1946984 | 0.0854957 |
| 0.9626866 | 0.1946984 | 0.0857571 |
| 0.9626866 | 0.1956124 | 0.0859369 |
| 0.9626866 | 0.1965265 | 0.0862077 |
| 0.9626866 | 0.1974406 | 0.0867238 |
| 0.9626866 | 0.1983547 | 0.0871808 |
| 0.9626866 | 0.1992687 | 0.0873914 |
| 0.9626866 | 0.2001828 | 0.0875142 |
| 0.9626866 | 0.2010969 | 0.0876086 |
| 0.9626866 | 0.2020110 | 0.0880382 |
| 0.9626866 | 0.2029250 | 0.0884841 |
| 0.9626866 | 0.2038391 | 0.0886500 |
| 0.9626866 | 0.2047532 | 0.0887718 |
| 0.9626866 | 0.2056673 | 0.0888329 |
| 0.9626866 | 0.2065814 | 0.0888719 |
| 0.9626866 | 0.2074954 | 0.0890850 |
| 0.9626866 | 0.2084095 | 0.0894718 |
| 0.9626866 | 0.2093236 | 0.0896941 |
| 0.9626866 | 0.2102377 | 0.0898443 |
| 0.9589552 | 0.2102377 | 0.0899469 |
| 0.9589552 | 0.2111517 | 0.0899625 |
| 0.9589552 | 0.2120658 | 0.0900490 |
| 0.9589552 | 0.2129799 | 0.0902043 |
| 0.9589552 | 0.2138940 | 0.0905026 |
| 0.9589552 | 0.2148080 | 0.0909845 |
| 0.9589552 | 0.2157221 | 0.0913611 |
| 0.9589552 | 0.2166362 | 0.0914946 |
| 0.9589552 | 0.2175503 | 0.0917944 |
| 0.9552239 | 0.2175503 | 0.0921024 |
| 0.9552239 | 0.2184644 | 0.0924080 |
| 0.9514925 | 0.2184644 | 0.0928522 |
| 0.9514925 | 0.2193784 | 0.0930457 |
| 0.9514925 | 0.2202925 | 0.0930714 |
| 0.9514925 | 0.2212066 | 0.0932155 |
| 0.9514925 | 0.2221207 | 0.0933638 |
| 0.9514925 | 0.2230347 | 0.0934381 |
| 0.9514925 | 0.2239488 | 0.0935406 |
| 0.9514925 | 0.2248629 | 0.0936161 |
| 0.9514925 | 0.2257770 | 0.0936562 |
| 0.9514925 | 0.2266910 | 0.0939210 |
| 0.9514925 | 0.2276051 | 0.0941930 |
| 0.9514925 | 0.2285192 | 0.0942439 |
| 0.9477612 | 0.2285192 | 0.0943966 |
| 0.9477612 | 0.2294333 | 0.0945632 |
| 0.9477612 | 0.2303473 | 0.0947470 |
| 0.9477612 | 0.2312614 | 0.0949728 |
| 0.9477612 | 0.2321755 | 0.0950971 |
| 0.9477612 | 0.2330896 | 0.0951745 |
| 0.9477612 | 0.2340037 | 0.0952443 |
| 0.9477612 | 0.2349177 | 0.0952933 |
| 0.9477612 | 0.2358318 | 0.0954624 |
| 0.9477612 | 0.2367459 | 0.0956172 |
| 0.9477612 | 0.2376600 | 0.0956423 |
| 0.9477612 | 0.2385740 | 0.0958837 |
| 0.9477612 | 0.2394881 | 0.0961364 |
| 0.9477612 | 0.2404022 | 0.0963832 |
| 0.9477612 | 0.2413163 | 0.0966415 |
| 0.9477612 | 0.2422303 | 0.0968361 |
| 0.9477612 | 0.2431444 | 0.0972410 |
| 0.9477612 | 0.2440585 | 0.0975358 |
| 0.9440299 | 0.2440585 | 0.0976068 |
| 0.9440299 | 0.2449726 | 0.0976512 |
| 0.9440299 | 0.2458867 | 0.0977953 |
| 0.9440299 | 0.2468007 | 0.0980174 |
| 0.9402985 | 0.2468007 | 0.0981894 |
| 0.9402985 | 0.2477148 | 0.0984790 |
| 0.9365672 | 0.2477148 | 0.0987339 |
| 0.9365672 | 0.2486289 | 0.0989904 |
| 0.9328358 | 0.2486289 | 0.0992789 |
| 0.9328358 | 0.2495430 | 0.0997006 |
| 0.9291045 | 0.2495430 | 0.1001430 |
| 0.9291045 | 0.2504570 | 0.1003196 |
| 0.9291045 | 0.2513711 | 0.1005148 |
| 0.9291045 | 0.2522852 | 0.1007659 |
| 0.9291045 | 0.2531993 | 0.1009438 |
| 0.9291045 | 0.2541133 | 0.1011276 |
| 0.9291045 | 0.2550274 | 0.1013646 |
| 0.9291045 | 0.2559415 | 0.1015442 |
| 0.9291045 | 0.2568556 | 0.1016771 |
| 0.9291045 | 0.2577697 | 0.1017945 |
| 0.9291045 | 0.2586837 | 0.1020374 |
| 0.9291045 | 0.2595978 | 0.1022429 |
| 0.9291045 | 0.2605119 | 0.1024724 |
| 0.9291045 | 0.2614260 | 0.1026600 |
| 0.9291045 | 0.2623400 | 0.1026956 |
| 0.9291045 | 0.2632541 | 0.1027343 |
| 0.9291045 | 0.2641682 | 0.1027884 |
| 0.9291045 | 0.2650823 | 0.1028443 |
| 0.9291045 | 0.2659963 | 0.1029837 |
| 0.9291045 | 0.2669104 | 0.1032239 |
| 0.9291045 | 0.2678245 | 0.1034099 |
| 0.9291045 | 0.2687386 | 0.1037337 |
| 0.9291045 | 0.2696527 | 0.1040536 |
| 0.9291045 | 0.2705667 | 0.1043004 |
| 0.9291045 | 0.2714808 | 0.1045468 |
| 0.9291045 | 0.2723949 | 0.1046262 |
| 0.9291045 | 0.2733090 | 0.1046732 |
| 0.9291045 | 0.2742230 | 0.1047717 |
| 0.9291045 | 0.2751371 | 0.1049754 |
| 0.9291045 | 0.2760512 | 0.1051606 |
| 0.9291045 | 0.2769653 | 0.1053416 |
| 0.9291045 | 0.2778793 | 0.1055083 |
| 0.9291045 | 0.2787934 | 0.1055777 |
| 0.9291045 | 0.2797075 | 0.1056384 |
| 0.9291045 | 0.2806216 | 0.1057408 |
| 0.9291045 | 0.2815356 | 0.1063040 |
| 0.9291045 | 0.2824497 | 0.1068237 |
| 0.9291045 | 0.2833638 | 0.1068770 |
| 0.9291045 | 0.2842779 | 0.1069563 |
| 0.9291045 | 0.2851920 | 0.1070844 |
| 0.9291045 | 0.2861060 | 0.1074928 |
| 0.9291045 | 0.2870201 | 0.1079729 |
| 0.9291045 | 0.2879342 | 0.1081841 |
| 0.9291045 | 0.2888483 | 0.1085479 |
| 0.9253731 | 0.2888483 | 0.1088461 |
| 0.9253731 | 0.2897623 | 0.1088852 |
| 0.9253731 | 0.2906764 | 0.1089512 |
| 0.9253731 | 0.2915905 | 0.1090152 |
| 0.9253731 | 0.2925046 | 0.1090702 |
| 0.9216418 | 0.2925046 | 0.1091263 |
| 0.9216418 | 0.2934186 | 0.1092700 |
| 0.9216418 | 0.2943327 | 0.1094026 |
| 0.9216418 | 0.2952468 | 0.1095692 |
| 0.9216418 | 0.2961609 | 0.1098152 |
| 0.9216418 | 0.2970750 | 0.1099184 |
| 0.9216418 | 0.2979890 | 0.1099569 |
| 0.9216418 | 0.2989031 | 0.1099840 |
| 0.9216418 | 0.2998172 | 0.1100227 |
| 0.9216418 | 0.3007313 | 0.1101602 |
| 0.9216418 | 0.3016453 | 0.1102680 |
| 0.9216418 | 0.3025594 | 0.1103183 |
| 0.9216418 | 0.3034735 | 0.1104890 |
| 0.9179104 | 0.3034735 | 0.1106620 |
| 0.9179104 | 0.3043876 | 0.1107955 |
| 0.9179104 | 0.3053016 | 0.1109724 |
| 0.9179104 | 0.3062157 | 0.1111340 |
| 0.9179104 | 0.3071298 | 0.1112591 |
| 0.9179104 | 0.3080439 | 0.1113270 |
| 0.9179104 | 0.3089580 | 0.1115270 |
| 0.9141791 | 0.3089580 | 0.1117392 |
| 0.9141791 | 0.3098720 | 0.1118687 |
| 0.9141791 | 0.3107861 | 0.1123650 |
| 0.9141791 | 0.3117002 | 0.1127925 |
| 0.9141791 | 0.3126143 | 0.1129302 |
| 0.9141791 | 0.3135283 | 0.1130542 |
| 0.9141791 | 0.3144424 | 0.1131714 |
| 0.9141791 | 0.3153565 | 0.1132758 |
| 0.9141791 | 0.3162706 | 0.1133905 |
| 0.9141791 | 0.3171846 | 0.1136625 |
| 0.9141791 | 0.3180987 | 0.1138588 |
| 0.9141791 | 0.3190128 | 0.1139175 |
| 0.9141791 | 0.3199269 | 0.1139538 |
| 0.9141791 | 0.3208410 | 0.1139793 |
| 0.9141791 | 0.3217550 | 0.1144053 |
| 0.9141791 | 0.3226691 | 0.1150241 |
| 0.9141791 | 0.3235832 | 0.1153174 |
| 0.9141791 | 0.3244973 | 0.1154271 |
| 0.9104478 | 0.3244973 | 0.1155549 |
| 0.9104478 | 0.3254113 | 0.1156610 |
| 0.9104478 | 0.3263254 | 0.1159303 |
| 0.9104478 | 0.3272395 | 0.1162584 |
| 0.9067164 | 0.3272395 | 0.1163487 |
| 0.9067164 | 0.3281536 | 0.1164095 |
| 0.9029851 | 0.3281536 | 0.1164504 |
| 0.8992537 | 0.3281536 | 0.1166329 |
| 0.8992537 | 0.3290676 | 0.1168761 |
| 0.8955224 | 0.3290676 | 0.1171434 |
| 0.8955224 | 0.3299817 | 0.1175655 |
| 0.8955224 | 0.3308958 | 0.1179160 |
| 0.8955224 | 0.3318099 | 0.1181383 |
| 0.8955224 | 0.3327239 | 0.1182363 |
| 0.8955224 | 0.3336380 | 0.1182550 |
| 0.8955224 | 0.3345521 | 0.1183224 |
| 0.8955224 | 0.3354662 | 0.1184163 |
| 0.8955224 | 0.3363803 | 0.1185091 |
| 0.8955224 | 0.3372943 | 0.1185998 |
| 0.8955224 | 0.3382084 | 0.1187201 |
| 0.8917910 | 0.3382084 | 0.1189761 |
| 0.8917910 | 0.3391225 | 0.1193563 |
| 0.8917910 | 0.3400366 | 0.1195756 |
| 0.8880597 | 0.3400366 | 0.1196536 |
| 0.8843284 | 0.3400366 | 0.1199068 |
| 0.8843284 | 0.3409506 | 0.1201563 |
| 0.8843284 | 0.3418647 | 0.1202925 |
| 0.8843284 | 0.3427788 | 0.1206666 |
| 0.8843284 | 0.3436929 | 0.1211006 |
| 0.8843284 | 0.3446069 | 0.1212805 |
| 0.8843284 | 0.3455210 | 0.1213421 |
| 0.8843284 | 0.3464351 | 0.1214941 |
| 0.8843284 | 0.3473492 | 0.1216496 |
| 0.8843284 | 0.3482633 | 0.1217398 |
| 0.8843284 | 0.3491773 | 0.1218290 |
| 0.8843284 | 0.3500914 | 0.1219319 |
| 0.8843284 | 0.3510055 | 0.1220228 |
| 0.8843284 | 0.3519196 | 0.1221107 |
| 0.8843284 | 0.3528336 | 0.1222886 |
| 0.8805970 | 0.3528336 | 0.1224386 |
| 0.8805970 | 0.3537477 | 0.1225183 |
| 0.8805970 | 0.3546618 | 0.1225788 |
| 0.8768657 | 0.3546618 | 0.1227677 |
| 0.8768657 | 0.3555759 | 0.1230868 |
| 0.8768657 | 0.3564899 | 0.1234260 |
| 0.8768657 | 0.3574040 | 0.1237028 |
| 0.8768657 | 0.3583181 | 0.1239586 |
| 0.8731343 | 0.3583181 | 0.1241357 |
| 0.8731343 | 0.3592322 | 0.1242166 |
| 0.8731343 | 0.3601463 | 0.1243780 |
| 0.8731343 | 0.3610603 | 0.1244979 |
| 0.8731343 | 0.3619744 | 0.1245546 |
| 0.8731343 | 0.3628885 | 0.1246637 |
| 0.8731343 | 0.3638026 | 0.1247645 |
| 0.8731343 | 0.3647166 | 0.1249987 |
| 0.8731343 | 0.3656307 | 0.1252305 |
| 0.8731343 | 0.3665448 | 0.1253771 |
| 0.8694030 | 0.3665448 | 0.1255124 |
| 0.8694030 | 0.3674589 | 0.1255320 |
| 0.8694030 | 0.3683729 | 0.1259727 |
| 0.8656716 | 0.3683729 | 0.1264135 |
| 0.8656716 | 0.3692870 | 0.1264372 |
| 0.8656716 | 0.3702011 | 0.1268549 |
| 0.8656716 | 0.3711152 | 0.1272677 |
| 0.8619403 | 0.3711152 | 0.1272946 |
| 0.8619403 | 0.3720293 | 0.1275887 |
| 0.8582090 | 0.3720293 | 0.1282684 |
| 0.8582090 | 0.3729433 | 0.1287089 |
| 0.8582090 | 0.3738574 | 0.1287929 |
| 0.8544776 | 0.3738574 | 0.1290446 |
| 0.8544776 | 0.3747715 | 0.1294706 |
| 0.8544776 | 0.3756856 | 0.1296933 |
| 0.8544776 | 0.3765996 | 0.1297598 |
| 0.8544776 | 0.3775137 | 0.1298587 |
| 0.8544776 | 0.3784278 | 0.1299695 |
| 0.8544776 | 0.3793419 | 0.1302492 |
| 0.8544776 | 0.3802559 | 0.1304626 |
| 0.8544776 | 0.3811700 | 0.1305004 |
| 0.8544776 | 0.3820841 | 0.1305490 |
| 0.8544776 | 0.3829982 | 0.1306493 |
| 0.8544776 | 0.3839122 | 0.1312167 |
| 0.8544776 | 0.3848263 | 0.1317310 |
| 0.8544776 | 0.3857404 | 0.1318176 |
| 0.8544776 | 0.3866545 | 0.1319863 |
| 0.8507463 | 0.3866545 | 0.1321640 |
| 0.8507463 | 0.3875686 | 0.1323128 |
| 0.8507463 | 0.3884826 | 0.1323985 |
| 0.8507463 | 0.3893967 | 0.1324031 |
| 0.8507463 | 0.3903108 | 0.1325044 |
| 0.8507463 | 0.3912249 | 0.1328915 |
| 0.8507463 | 0.3921389 | 0.1331973 |
| 0.8507463 | 0.3930530 | 0.1333507 |
| 0.8507463 | 0.3939671 | 0.1335225 |
| 0.8507463 | 0.3948812 | 0.1335965 |
| 0.8507463 | 0.3957952 | 0.1338623 |
| 0.8507463 | 0.3967093 | 0.1340946 |
| 0.8507463 | 0.3976234 | 0.1341278 |
| 0.8507463 | 0.3985375 | 0.1342092 |
| 0.8507463 | 0.3994516 | 0.1342794 |
| 0.8507463 | 0.4003656 | 0.1343121 |
| 0.8507463 | 0.4012797 | 0.1343687 |
| 0.8507463 | 0.4021938 | 0.1346223 |
| 0.8507463 | 0.4031079 | 0.1352135 |
| 0.8507463 | 0.4040219 | 0.1356348 |
| 0.8507463 | 0.4049360 | 0.1358780 |
| 0.8507463 | 0.4058501 | 0.1362313 |
| 0.8507463 | 0.4067642 | 0.1364635 |
| 0.8507463 | 0.4076782 | 0.1365548 |
| 0.8507463 | 0.4085923 | 0.1365888 |
| 0.8507463 | 0.4095064 | 0.1367516 |
| 0.8507463 | 0.4104205 | 0.1370486 |
| 0.8507463 | 0.4113346 | 0.1375660 |
| 0.8507463 | 0.4122486 | 0.1379726 |
| 0.8507463 | 0.4131627 | 0.1380206 |
| 0.8507463 | 0.4140768 | 0.1381074 |
| 0.8507463 | 0.4149909 | 0.1382976 |
| 0.8507463 | 0.4159049 | 0.1387267 |
| 0.8507463 | 0.4168190 | 0.1390925 |
| 0.8507463 | 0.4177331 | 0.1392400 |
| 0.8470149 | 0.4177331 | 0.1393451 |
| 0.8470149 | 0.4186472 | 0.1394154 |
| 0.8432836 | 0.4186472 | 0.1395409 |
| 0.8432836 | 0.4195612 | 0.1396521 |
| 0.8432836 | 0.4204753 | 0.1397693 |
| 0.8432836 | 0.4213894 | 0.1400196 |
| 0.8395522 | 0.4213894 | 0.1402575 |
| 0.8395522 | 0.4223035 | 0.1403617 |
| 0.8395522 | 0.4232176 | 0.1405451 |
| 0.8395522 | 0.4241316 | 0.1408078 |
| 0.8395522 | 0.4250457 | 0.1410395 |
| 0.8395522 | 0.4259598 | 0.1413865 |
| 0.8358209 | 0.4259598 | 0.1416734 |
| 0.8358209 | 0.4268739 | 0.1417462 |
| 0.8320896 | 0.4268739 | 0.1419435 |
| 0.8320896 | 0.4277879 | 0.1423354 |
| 0.8283582 | 0.4277879 | 0.1426818 |
| 0.8283582 | 0.4287020 | 0.1428475 |
| 0.8283582 | 0.4296161 | 0.1429775 |
| 0.8246269 | 0.4296161 | 0.1432647 |
| 0.8246269 | 0.4305302 | 0.1438316 |
| 0.8246269 | 0.4314442 | 0.1443330 |
| 0.8246269 | 0.4323583 | 0.1444883 |
| 0.8246269 | 0.4332724 | 0.1445416 |
| 0.8246269 | 0.4341865 | 0.1446485 |
| 0.8246269 | 0.4351005 | 0.1447362 |
| 0.8246269 | 0.4360146 | 0.1450220 |
| 0.8246269 | 0.4369287 | 0.1453132 |
| 0.8246269 | 0.4378428 | 0.1454474 |
| 0.8246269 | 0.4387569 | 0.1455937 |
| 0.8246269 | 0.4396709 | 0.1457970 |
| 0.8246269 | 0.4405850 | 0.1460089 |
| 0.8246269 | 0.4414991 | 0.1462071 |
| 0.8246269 | 0.4424132 | 0.1463768 |
| 0.8246269 | 0.4433272 | 0.1465148 |
| 0.8246269 | 0.4442413 | 0.1467136 |
| 0.8208955 | 0.4442413 | 0.1468071 |
| 0.8208955 | 0.4451554 | 0.1470525 |
| 0.8208955 | 0.4460695 | 0.1472948 |
| 0.8208955 | 0.4469835 | 0.1473315 |
| 0.8208955 | 0.4478976 | 0.1475643 |
| 0.8208955 | 0.4488117 | 0.1477885 |
| 0.8208955 | 0.4497258 | 0.1478815 |
| 0.8208955 | 0.4506399 | 0.1479988 |
| 0.8171642 | 0.4506399 | 0.1482573 |
| 0.8171642 | 0.4515539 | 0.1486079 |
| 0.8171642 | 0.4524680 | 0.1488937 |
| 0.8171642 | 0.4533821 | 0.1492050 |
| 0.8171642 | 0.4542962 | 0.1494198 |
| 0.8134328 | 0.4552102 | 0.1495035 |
| 0.8134328 | 0.4561243 | 0.1495615 |
| 0.8134328 | 0.4570384 | 0.1496799 |
| 0.8134328 | 0.4579525 | 0.1498527 |
| 0.8134328 | 0.4588665 | 0.1499958 |
| 0.8134328 | 0.4597806 | 0.1505786 |
| 0.8134328 | 0.4606947 | 0.1512523 |
| 0.8134328 | 0.4616088 | 0.1514587 |
| 0.8134328 | 0.4625229 | 0.1515523 |
| 0.8134328 | 0.4634369 | 0.1515917 |
| 0.8134328 | 0.4643510 | 0.1516011 |
| 0.8134328 | 0.4652651 | 0.1517135 |
| 0.8134328 | 0.4661792 | 0.1519180 |
| 0.8134328 | 0.4670932 | 0.1521425 |
| 0.8134328 | 0.4680073 | 0.1523349 |
| 0.8134328 | 0.4689214 | 0.1524227 |
| 0.8134328 | 0.4698355 | 0.1524477 |
| 0.8134328 | 0.4707495 | 0.1524708 |
| 0.8134328 | 0.4716636 | 0.1525319 |
| 0.8134328 | 0.4725777 | 0.1526132 |
| 0.8134328 | 0.4734918 | 0.1526922 |
| 0.8134328 | 0.4744059 | 0.1527579 |
| 0.8134328 | 0.4753199 | 0.1527904 |
| 0.8097015 | 0.4753199 | 0.1528754 |
| 0.8097015 | 0.4762340 | 0.1529953 |
| 0.8097015 | 0.4771481 | 0.1531730 |
| 0.8097015 | 0.4780622 | 0.1534014 |
| 0.8097015 | 0.4789762 | 0.1535123 |
| 0.8097015 | 0.4798903 | 0.1535416 |
| 0.8097015 | 0.4808044 | 0.1537523 |
| 0.8097015 | 0.4817185 | 0.1540853 |
| 0.8059701 | 0.4817185 | 0.1542347 |
| 0.8059701 | 0.4826325 | 0.1542629 |
| 0.8059701 | 0.4835466 | 0.1543079 |
| 0.8059701 | 0.4844607 | 0.1543432 |
| 0.8022388 | 0.4844607 | 0.1544012 |
| 0.8022388 | 0.4853748 | 0.1544864 |
| 0.8022388 | 0.4862888 | 0.1546869 |
| 0.8022388 | 0.4872029 | 0.1548790 |
| 0.8022388 | 0.4881170 | 0.1549958 |
| 0.8022388 | 0.4890311 | 0.1551702 |
| 0.8022388 | 0.4899452 | 0.1552705 |
| 0.8022388 | 0.4908592 | 0.1557601 |
| 0.8022388 | 0.4917733 | 0.1562518 |
| 0.8022388 | 0.4926874 | 0.1565180 |
| 0.8022388 | 0.4936015 | 0.1567907 |
| 0.8022388 | 0.4945155 | 0.1568265 |
| 0.8022388 | 0.4954296 | 0.1568312 |
| 0.8022388 | 0.4963437 | 0.1568454 |
| 0.8022388 | 0.4972578 | 0.1569275 |
| 0.8022388 | 0.4981718 | 0.1570365 |
| 0.8022388 | 0.4990859 | 0.1572322 |
| 0.8022388 | 0.5000000 | 0.1574662 |
| 0.7985075 | 0.5000000 | 0.1577585 |
| 0.7985075 | 0.5009141 | 0.1580154 |
| 0.7985075 | 0.5018282 | 0.1580994 |
| 0.7985075 | 0.5027422 | 0.1581791 |
| 0.7947761 | 0.5027422 | 0.1585593 |
| 0.7947761 | 0.5036563 | 0.1589106 |
| 0.7910448 | 0.5036563 | 0.1589505 |
| 0.7910448 | 0.5045704 | 0.1590600 |
| 0.7910448 | 0.5054845 | 0.1592513 |
| 0.7910448 | 0.5063985 | 0.1594596 |
| 0.7910448 | 0.5073126 | 0.1595792 |
| 0.7910448 | 0.5082267 | 0.1597281 |
| 0.7910448 | 0.5091408 | 0.1598619 |
| 0.7910448 | 0.5100548 | 0.1599190 |
| 0.7910448 | 0.5109689 | 0.1601066 |
| 0.7910448 | 0.5118830 | 0.1602863 |
| 0.7910448 | 0.5127971 | 0.1603584 |
| 0.7910448 | 0.5137112 | 0.1604041 |
| 0.7910448 | 0.5146252 | 0.1605190 |
| 0.7873134 | 0.5146252 | 0.1606821 |
| 0.7873134 | 0.5155393 | 0.1609557 |
| 0.7835821 | 0.5155393 | 0.1612174 |
| 0.7835821 | 0.5164534 | 0.1614628 |
| 0.7835821 | 0.5173675 | 0.1617117 |
| 0.7835821 | 0.5182815 | 0.1618769 |
| 0.7835821 | 0.5191956 | 0.1619928 |
| 0.7835821 | 0.5201097 | 0.1621050 |
| 0.7835821 | 0.5210238 | 0.1623164 |
| 0.7835821 | 0.5219378 | 0.1625643 |
| 0.7835821 | 0.5228519 | 0.1627349 |
| 0.7835821 | 0.5237660 | 0.1628335 |
| 0.7835821 | 0.5246801 | 0.1630753 |
| 0.7835821 | 0.5255941 | 0.1633263 |
| 0.7798507 | 0.5255941 | 0.1635052 |
| 0.7798507 | 0.5265082 | 0.1637040 |
| 0.7798507 | 0.5274223 | 0.1641448 |
| 0.7798507 | 0.5283364 | 0.1647026 |
| 0.7798507 | 0.5292505 | 0.1649398 |
| 0.7798507 | 0.5301645 | 0.1650582 |
| 0.7798507 | 0.5310786 | 0.1651711 |
| 0.7798507 | 0.5319927 | 0.1652221 |
| 0.7798507 | 0.5329068 | 0.1654123 |
| 0.7798507 | 0.5338208 | 0.1657182 |
| 0.7798507 | 0.5347349 | 0.1660180 |
| 0.7761194 | 0.5347349 | 0.1662286 |
| 0.7723881 | 0.5347349 | 0.1663247 |
| 0.7723881 | 0.5356490 | 0.1663843 |
| 0.7723881 | 0.5365631 | 0.1665119 |
| 0.7723881 | 0.5374771 | 0.1666568 |
| 0.7723881 | 0.5383912 | 0.1668189 |
| 0.7723881 | 0.5393053 | 0.1670984 |
| 0.7723881 | 0.5402194 | 0.1672664 |
| 0.7686567 | 0.5402194 | 0.1673937 |
| 0.7649254 | 0.5402194 | 0.1675749 |
| 0.7649254 | 0.5411335 | 0.1676601 |
| 0.7649254 | 0.5420475 | 0.1678048 |
| 0.7649254 | 0.5429616 | 0.1679633 |
| 0.7649254 | 0.5438757 | 0.1680076 |
| 0.7649254 | 0.5447898 | 0.1681237 |
| 0.7611940 | 0.5447898 | 0.1683610 |
| 0.7611940 | 0.5457038 | 0.1686445 |
| 0.7611940 | 0.5475320 | 0.1688976 |
| 0.7574627 | 0.5475320 | 0.1690552 |
| 0.7574627 | 0.5484461 | 0.1691730 |
| 0.7574627 | 0.5493601 | 0.1692321 |
| 0.7574627 | 0.5502742 | 0.1692402 |
| 0.7537313 | 0.5502742 | 0.1692493 |
| 0.7500000 | 0.5502742 | 0.1692762 |
| 0.7500000 | 0.5511883 | 0.1693139 |
| 0.7500000 | 0.5521024 | 0.1695103 |
| 0.7500000 | 0.5530165 | 0.1697056 |
| 0.7462687 | 0.5530165 | 0.1698225 |
| 0.7462687 | 0.5539305 | 0.1700493 |
| 0.7462687 | 0.5548446 | 0.1702936 |
| 0.7462687 | 0.5557587 | 0.1704263 |
| 0.7425373 | 0.5557587 | 0.1706096 |
| 0.7425373 | 0.5566728 | 0.1708804 |
| 0.7425373 | 0.5575868 | 0.1710241 |
| 0.7425373 | 0.5585009 | 0.1710811 |
| 0.7425373 | 0.5594150 | 0.1712331 |
| 0.7425373 | 0.5603291 | 0.1713884 |
| 0.7425373 | 0.5612431 | 0.1714682 |
| 0.7388060 | 0.5612431 | 0.1715939 |
| 0.7388060 | 0.5621572 | 0.1716649 |
| 0.7388060 | 0.5630713 | 0.1718366 |
| 0.7350746 | 0.5630713 | 0.1721054 |
| 0.7350746 | 0.5639854 | 0.1722130 |
| 0.7313433 | 0.5639854 | 0.1723453 |
| 0.7313433 | 0.5648995 | 0.1725105 |
| 0.7313433 | 0.5658135 | 0.1725948 |
| 0.7313433 | 0.5667276 | 0.1727896 |
| 0.7313433 | 0.5676417 | 0.1729430 |
| 0.7313433 | 0.5685558 | 0.1731083 |
| 0.7313433 | 0.5694698 | 0.1736671 |
| 0.7313433 | 0.5703839 | 0.1741536 |
| 0.7313433 | 0.5712980 | 0.1742862 |
| 0.7313433 | 0.5722121 | 0.1743402 |
| 0.7313433 | 0.5731261 | 0.1743678 |
| 0.7313433 | 0.5740402 | 0.1745764 |
| 0.7313433 | 0.5749543 | 0.1747835 |
| 0.7313433 | 0.5758684 | 0.1750026 |
| 0.7313433 | 0.5767824 | 0.1752216 |
| 0.7276119 | 0.5767824 | 0.1753418 |
| 0.7238806 | 0.5767824 | 0.1754900 |
| 0.7238806 | 0.5776965 | 0.1756127 |
| 0.7201493 | 0.5776965 | 0.1757037 |
| 0.7164179 | 0.5776965 | 0.1757925 |
| 0.7164179 | 0.5786106 | 0.1759434 |
| 0.7164179 | 0.5795247 | 0.1760458 |
| 0.7126866 | 0.5795247 | 0.1760924 |
| 0.7089552 | 0.5795247 | 0.1765002 |
| 0.7089552 | 0.5804388 | 0.1769074 |
| 0.7089552 | 0.5813528 | 0.1769720 |
| 0.7089552 | 0.5822669 | 0.1773799 |
| 0.7089552 | 0.5831810 | 0.1782021 |
| 0.7052239 | 0.5831810 | 0.1786879 |
| 0.7052239 | 0.5840951 | 0.1787781 |
| 0.7052239 | 0.5850091 | 0.1788637 |
| 0.7052239 | 0.5859232 | 0.1790360 |
| 0.7052239 | 0.5868373 | 0.1791878 |
| 0.7052239 | 0.5877514 | 0.1792142 |
| 0.7052239 | 0.5886654 | 0.1796114 |
| 0.7052239 | 0.5895795 | 0.1800003 |
| 0.7052239 | 0.5904936 | 0.1800681 |
| 0.7052239 | 0.5914077 | 0.1801627 |
| 0.7052239 | 0.5923218 | 0.1802395 |
| 0.7052239 | 0.5932358 | 0.1803164 |
| 0.7052239 | 0.5941499 | 0.1805027 |
| 0.7052239 | 0.5950640 | 0.1806939 |
| 0.7052239 | 0.5959781 | 0.1807747 |
| 0.7052239 | 0.5968921 | 0.1808914 |
| 0.7052239 | 0.5978062 | 0.1811311 |
| 0.7052239 | 0.5987203 | 0.1814087 |
| 0.7052239 | 0.5996344 | 0.1815441 |
| 0.7014925 | 0.5996344 | 0.1815734 |
| 0.7014925 | 0.6005484 | 0.1817640 |
| 0.7014925 | 0.6014625 | 0.1819932 |
| 0.7014925 | 0.6023766 | 0.1820537 |
| 0.7014925 | 0.6032907 | 0.1821302 |
| 0.7014925 | 0.6042048 | 0.1823014 |
| 0.6977612 | 0.6042048 | 0.1824972 |
| 0.6977612 | 0.6051188 | 0.1826130 |
| 0.6977612 | 0.6060329 | 0.1829345 |
| 0.6977612 | 0.6069470 | 0.1833082 |
| 0.6977612 | 0.6078611 | 0.1834603 |
| 0.6940299 | 0.6078611 | 0.1835608 |
| 0.6940299 | 0.6087751 | 0.1837664 |
| 0.6940299 | 0.6096892 | 0.1840879 |
| 0.6940299 | 0.6106033 | 0.1842797 |
| 0.6940299 | 0.6115174 | 0.1844383 |
| 0.6902985 | 0.6115174 | 0.1846769 |
| 0.6902985 | 0.6124314 | 0.1848297 |
| 0.6902985 | 0.6133455 | 0.1849516 |
| 0.6902985 | 0.6142596 | 0.1851392 |
| 0.6865672 | 0.6142596 | 0.1852519 |
| 0.6828358 | 0.6142596 | 0.1853872 |
| 0.6828358 | 0.6151737 | 0.1856154 |
| 0.6828358 | 0.6160878 | 0.1860611 |
| 0.6828358 | 0.6170018 | 0.1864922 |
| 0.6791045 | 0.6170018 | 0.1866429 |
| 0.6791045 | 0.6179159 | 0.1868981 |
| 0.6791045 | 0.6188300 | 0.1871388 |
| 0.6791045 | 0.6197441 | 0.1871955 |
| 0.6791045 | 0.6206581 | 0.1874041 |
| 0.6791045 | 0.6215722 | 0.1879700 |
| 0.6753731 | 0.6215722 | 0.1888239 |
| 0.6753731 | 0.6224863 | 0.1893848 |
| 0.6753731 | 0.6234004 | 0.1894741 |
| 0.6753731 | 0.6243144 | 0.1896256 |
| 0.6753731 | 0.6252285 | 0.1898498 |
| 0.6716418 | 0.6252285 | 0.1899468 |
| 0.6716418 | 0.6261426 | 0.1901504 |
| 0.6716418 | 0.6270567 | 0.1904295 |
| 0.6716418 | 0.6279707 | 0.1908227 |
| 0.6716418 | 0.6288848 | 0.1912068 |
| 0.6716418 | 0.6297989 | 0.1915839 |
| 0.6716418 | 0.6307130 | 0.1918798 |
| 0.6716418 | 0.6316271 | 0.1918920 |
| 0.6679104 | 0.6316271 | 0.1919109 |
| 0.6679104 | 0.6325411 | 0.1919830 |
| 0.6641791 | 0.6325411 | 0.1921166 |
| 0.6641791 | 0.6334552 | 0.1921954 |
| 0.6641791 | 0.6343693 | 0.1924996 |
| 0.6604478 | 0.6343693 | 0.1928602 |
| 0.6604478 | 0.6352834 | 0.1933486 |
| 0.6604478 | 0.6361974 | 0.1938211 |
| 0.6567164 | 0.6361974 | 0.1938816 |
| 0.6567164 | 0.6371115 | 0.1940960 |
| 0.6567164 | 0.6380256 | 0.1944350 |
| 0.6567164 | 0.6389397 | 0.1951371 |
| 0.6567164 | 0.6398537 | 0.1957529 |
| 0.6567164 | 0.6407678 | 0.1958542 |
| 0.6529851 | 0.6407678 | 0.1959405 |
| 0.6529851 | 0.6416819 | 0.1960008 |
| 0.6529851 | 0.6425960 | 0.1960623 |
| 0.6492537 | 0.6425960 | 0.1963544 |
| 0.6455224 | 0.6425960 | 0.1966062 |
| 0.6455224 | 0.6435101 | 0.1966121 |
| 0.6455224 | 0.6444241 | 0.1966410 |
| 0.6417910 | 0.6444241 | 0.1966732 |
| 0.6417910 | 0.6453382 | 0.1966991 |
| 0.6417910 | 0.6462523 | 0.1969271 |
| 0.6417910 | 0.6471664 | 0.1971787 |
| 0.6417910 | 0.6480804 | 0.1972772 |
| 0.6417910 | 0.6489945 | 0.1974969 |
| 0.6417910 | 0.6499086 | 0.1978660 |
| 0.6417910 | 0.6508227 | 0.1980823 |
| 0.6417910 | 0.6517367 | 0.1982272 |
| 0.6417910 | 0.6526508 | 0.1984996 |
| 0.6417910 | 0.6535649 | 0.1986429 |
| 0.6417910 | 0.6544790 | 0.1987066 |
| 0.6417910 | 0.6553931 | 0.1992522 |
| 0.6417910 | 0.6563071 | 0.1998312 |
| 0.6380597 | 0.6563071 | 0.2001095 |
| 0.6380597 | 0.6572212 | 0.2002966 |
| 0.6343284 | 0.6572212 | 0.2003505 |
| 0.6343284 | 0.6581353 | 0.2004584 |
| 0.6343284 | 0.6590494 | 0.2006119 |
| 0.6343284 | 0.6599634 | 0.2008206 |
| 0.6343284 | 0.6608775 | 0.2009807 |
| 0.6343284 | 0.6617916 | 0.2010466 |
| 0.6343284 | 0.6627057 | 0.2011702 |
| 0.6343284 | 0.6636197 | 0.2013204 |
| 0.6343284 | 0.6645338 | 0.2015816 |
| 0.6343284 | 0.6654479 | 0.2018226 |
| 0.6343284 | 0.6663620 | 0.2018826 |
| 0.6343284 | 0.6672761 | 0.2020216 |
| 0.6343284 | 0.6681901 | 0.2021657 |
| 0.6343284 | 0.6691042 | 0.2023884 |
| 0.6343284 | 0.6700183 | 0.2025753 |
| 0.6343284 | 0.6709324 | 0.2026413 |
| 0.6305970 | 0.6709324 | 0.2027187 |
| 0.6268657 | 0.6709324 | 0.2027829 |
| 0.6268657 | 0.6718464 | 0.2034946 |
| 0.6268657 | 0.6727605 | 0.2042233 |
| 0.6231343 | 0.6727605 | 0.2043777 |
| 0.6194030 | 0.6727605 | 0.2046425 |
| 0.6156716 | 0.6727605 | 0.2048803 |
| 0.6156716 | 0.6736746 | 0.2049636 |
| 0.6156716 | 0.6745887 | 0.2049884 |
| 0.6156716 | 0.6755027 | 0.2051487 |
| 0.6119403 | 0.6755027 | 0.2054497 |
| 0.6119403 | 0.6764168 | 0.2056360 |
| 0.6119403 | 0.6773309 | 0.2058057 |
| 0.6119403 | 0.6782450 | 0.2059696 |
| 0.6119403 | 0.6791590 | 0.2061958 |
| 0.6119403 | 0.6800731 | 0.2065000 |
| 0.6119403 | 0.6809872 | 0.2066190 |
| 0.6119403 | 0.6819013 | 0.2066984 |
| 0.6119403 | 0.6828154 | 0.2069230 |
| 0.6119403 | 0.6837294 | 0.2071706 |
| 0.6082090 | 0.6837294 | 0.2074395 |
| 0.6082090 | 0.6846435 | 0.2077589 |
| 0.6082090 | 0.6855576 | 0.2079559 |
| 0.6082090 | 0.6864717 | 0.2082660 |
| 0.6044776 | 0.6864717 | 0.2086914 |
| 0.6007463 | 0.6864717 | 0.2090280 |
| 0.6007463 | 0.6873857 | 0.2093315 |
| 0.6007463 | 0.6882998 | 0.2095199 |
| 0.6007463 | 0.6892139 | 0.2099842 |
| 0.6007463 | 0.6901280 | 0.2104811 |
| 0.6007463 | 0.6910420 | 0.2106619 |
| 0.6007463 | 0.6919561 | 0.2108404 |
| 0.6007463 | 0.6928702 | 0.2110883 |
| 0.6007463 | 0.6937843 | 0.2113310 |
| 0.6007463 | 0.6946984 | 0.2115000 |
| 0.5970149 | 0.6946984 | 0.2116081 |
| 0.5970149 | 0.6956124 | 0.2117368 |
| 0.5932836 | 0.6956124 | 0.2118820 |
| 0.5932836 | 0.6965265 | 0.2119208 |
| 0.5932836 | 0.6974406 | 0.2119804 |
| 0.5932836 | 0.6983547 | 0.2120943 |
| 0.5932836 | 0.6992687 | 0.2122379 |
| 0.5932836 | 0.7001828 | 0.2123409 |
| 0.5932836 | 0.7010969 | 0.2123651 |
| 0.5932836 | 0.7020110 | 0.2124681 |
| 0.5932836 | 0.7029250 | 0.2126684 |
| 0.5932836 | 0.7038391 | 0.2128222 |
| 0.5932836 | 0.7047532 | 0.2129174 |
| 0.5932836 | 0.7056673 | 0.2129739 |
| 0.5932836 | 0.7065814 | 0.2130811 |
| 0.5895522 | 0.7065814 | 0.2131950 |
| 0.5895522 | 0.7074954 | 0.2132130 |
| 0.5858209 | 0.7074954 | 0.2132521 |
| 0.5858209 | 0.7084095 | 0.2133362 |
| 0.5858209 | 0.7093236 | 0.2134724 |
| 0.5858209 | 0.7102377 | 0.2136954 |
| 0.5858209 | 0.7111517 | 0.2138849 |
| 0.5858209 | 0.7120658 | 0.2142927 |
| 0.5820896 | 0.7120658 | 0.2147424 |
| 0.5820896 | 0.7129799 | 0.2148449 |
| 0.5820896 | 0.7138940 | 0.2150546 |
| 0.5820896 | 0.7148080 | 0.2153862 |
| 0.5820896 | 0.7157221 | 0.2156605 |
| 0.5783582 | 0.7157221 | 0.2158420 |
| 0.5783582 | 0.7166362 | 0.2158933 |
| 0.5783582 | 0.7175503 | 0.2159338 |
| 0.5783582 | 0.7184644 | 0.2159966 |
| 0.5746269 | 0.7184644 | 0.2162179 |
| 0.5708955 | 0.7184644 | 0.2165408 |
| 0.5708955 | 0.7193784 | 0.2168831 |
| 0.5708955 | 0.7202925 | 0.2172646 |
| 0.5671642 | 0.7202925 | 0.2177788 |
| 0.5634328 | 0.7202925 | 0.2182371 |
| 0.5634328 | 0.7212066 | 0.2184327 |
| 0.5634328 | 0.7221207 | 0.2185272 |
| 0.5634328 | 0.7230347 | 0.2185515 |
| 0.5634328 | 0.7239488 | 0.2186954 |
| 0.5634328 | 0.7248629 | 0.2190074 |
| 0.5634328 | 0.7257770 | 0.2192731 |
| 0.5634328 | 0.7266910 | 0.2195208 |
| 0.5634328 | 0.7276051 | 0.2198061 |
| 0.5634328 | 0.7285192 | 0.2199884 |
| 0.5634328 | 0.7294333 | 0.2201742 |
| 0.5634328 | 0.7303473 | 0.2203472 |
| 0.5634328 | 0.7312614 | 0.2207465 |
| 0.5634328 | 0.7321755 | 0.2213809 |
| 0.5634328 | 0.7330896 | 0.2218086 |
| 0.5634328 | 0.7340037 | 0.2220582 |
| 0.5634328 | 0.7349177 | 0.2221740 |
| 0.5634328 | 0.7358318 | 0.2222685 |
| 0.5634328 | 0.7367459 | 0.2224558 |
| 0.5597015 | 0.7367459 | 0.2226627 |
| 0.5597015 | 0.7376600 | 0.2227977 |
| 0.5559701 | 0.7376600 | 0.2231877 |
| 0.5559701 | 0.7385740 | 0.2236107 |
| 0.5559701 | 0.7394881 | 0.2239799 |
| 0.5559701 | 0.7404022 | 0.2243570 |
| 0.5522388 | 0.7404022 | 0.2244578 |
| 0.5485075 | 0.7404022 | 0.2247047 |
| 0.5485075 | 0.7413163 | 0.2250489 |
| 0.5447761 | 0.7413163 | 0.2251852 |
| 0.5447761 | 0.7422303 | 0.2254949 |
| 0.5447761 | 0.7431444 | 0.2259899 |
| 0.5447761 | 0.7440585 | 0.2262190 |
| 0.5410448 | 0.7440585 | 0.2262813 |
| 0.5410448 | 0.7449726 | 0.2266154 |
| 0.5410448 | 0.7458867 | 0.2269920 |
| 0.5410448 | 0.7468007 | 0.2272489 |
| 0.5410448 | 0.7477148 | 0.2277196 |
| 0.5373134 | 0.7477148 | 0.2280815 |
| 0.5373134 | 0.7486289 | 0.2282379 |
| 0.5373134 | 0.7495430 | 0.2284449 |
| 0.5373134 | 0.7504570 | 0.2288443 |
| 0.5373134 | 0.7513711 | 0.2291885 |
| 0.5373134 | 0.7522852 | 0.2292568 |
| 0.5373134 | 0.7531993 | 0.2294229 |
| 0.5373134 | 0.7541133 | 0.2297654 |
| 0.5335821 | 0.7541133 | 0.2300121 |
| 0.5298507 | 0.7541133 | 0.2302211 |
| 0.5298507 | 0.7550274 | 0.2304310 |
| 0.5298507 | 0.7559415 | 0.2305193 |
| 0.5298507 | 0.7568556 | 0.2305815 |
| 0.5298507 | 0.7577697 | 0.2307517 |
| 0.5298507 | 0.7586837 | 0.2308977 |
| 0.5261194 | 0.7586837 | 0.2311372 |
| 0.5261194 | 0.7595978 | 0.2316105 |
| 0.5223881 | 0.7595978 | 0.2319866 |
| 0.5223881 | 0.7605119 | 0.2321547 |
| 0.5223881 | 0.7614260 | 0.2322339 |
| 0.5223881 | 0.7623400 | 0.2323621 |
| 0.5223881 | 0.7632541 | 0.2324753 |
| 0.5223881 | 0.7641682 | 0.2325255 |
| 0.5223881 | 0.7650823 | 0.2331658 |
| 0.5186567 | 0.7650823 | 0.2339109 |
| 0.5186567 | 0.7659963 | 0.2344278 |
| 0.5149254 | 0.7659963 | 0.2349112 |
| 0.5111940 | 0.7659963 | 0.2351374 |
| 0.5111940 | 0.7669104 | 0.2353963 |
| 0.5074627 | 0.7669104 | 0.2355478 |
| 0.5074627 | 0.7678245 | 0.2356466 |
| 0.5074627 | 0.7687386 | 0.2360693 |
| 0.5074627 | 0.7696527 | 0.2366833 |
| 0.5074627 | 0.7705667 | 0.2371164 |
| 0.5074627 | 0.7714808 | 0.2373039 |
| 0.5074627 | 0.7723949 | 0.2375084 |
| 0.5074627 | 0.7733090 | 0.2379920 |
| 0.5074627 | 0.7742230 | 0.2385614 |
| 0.5037313 | 0.7742230 | 0.2393745 |
| 0.5037313 | 0.7751371 | 0.2400396 |
| 0.5037313 | 0.7760512 | 0.2402393 |
| 0.5037313 | 0.7769653 | 0.2403747 |
| 0.5000000 | 0.7769653 | 0.2410003 |
| 0.5000000 | 0.7778793 | 0.2419310 |
| 0.4962687 | 0.7778793 | 0.2423138 |
| 0.4962687 | 0.7787934 | 0.2427633 |
| 0.4962687 | 0.7797075 | 0.2433054 |
| 0.4925373 | 0.7797075 | 0.2438474 |
| 0.4925373 | 0.7806216 | 0.2447554 |
| 0.4925373 | 0.7815356 | 0.2453346 |
| 0.4925373 | 0.7824497 | 0.2455558 |
| 0.4925373 | 0.7833638 | 0.2456758 |
| 0.4925373 | 0.7842779 | 0.2456897 |
| 0.4925373 | 0.7851920 | 0.2461306 |
| 0.4925373 | 0.7861060 | 0.2465963 |
| 0.4925373 | 0.7870201 | 0.2466551 |
| 0.4925373 | 0.7879342 | 0.2468807 |
| 0.4925373 | 0.7888483 | 0.2473775 |
| 0.4888060 | 0.7888483 | 0.2476914 |
| 0.4850746 | 0.7888483 | 0.2477563 |
| 0.4850746 | 0.7897623 | 0.2479894 |
| 0.4850746 | 0.7906764 | 0.2482398 |
| 0.4813433 | 0.7906764 | 0.2483161 |
| 0.4776119 | 0.7906764 | 0.2483869 |
| 0.4738806 | 0.7906764 | 0.2485138 |
| 0.4738806 | 0.7915905 | 0.2486346 |
| 0.4701493 | 0.7915905 | 0.2487247 |
| 0.4701493 | 0.7925046 | 0.2487727 |
| 0.4701493 | 0.7934186 | 0.2488497 |
| 0.4701493 | 0.7943327 | 0.2490909 |
| 0.4701493 | 0.7952468 | 0.2494054 |
| 0.4701493 | 0.7961609 | 0.2495520 |
| 0.4664179 | 0.7961609 | 0.2498380 |
| 0.4626866 | 0.7961609 | 0.2501281 |
| 0.4589552 | 0.7961609 | 0.2502196 |
| 0.4589552 | 0.7970750 | 0.2504991 |
| 0.4552239 | 0.7970750 | 0.2508343 |
| 0.4514925 | 0.7970750 | 0.2510411 |
| 0.4514925 | 0.7979890 | 0.2512424 |
| 0.4514925 | 0.7989031 | 0.2514232 |
| 0.4514925 | 0.7998172 | 0.2515787 |
| 0.4514925 | 0.8007313 | 0.2516916 |
| 0.4514925 | 0.8016453 | 0.2519850 |
| 0.4514925 | 0.8025594 | 0.2523855 |
| 0.4514925 | 0.8034735 | 0.2526401 |
| 0.4477612 | 0.8034735 | 0.2529680 |
| 0.4477612 | 0.8043876 | 0.2535267 |
| 0.4440299 | 0.8043876 | 0.2539571 |
| 0.4402985 | 0.8043876 | 0.2541298 |
| 0.4402985 | 0.8053016 | 0.2545768 |
| 0.4402985 | 0.8062157 | 0.2550383 |
| 0.4402985 | 0.8080439 | 0.2552378 |
| 0.4402985 | 0.8089580 | 0.2560861 |
| 0.4402985 | 0.8098720 | 0.2568694 |
| 0.4365672 | 0.8098720 | 0.2579211 |
| 0.4365672 | 0.8107861 | 0.2590199 |
| 0.4365672 | 0.8117002 | 0.2591426 |
| 0.4365672 | 0.8126143 | 0.2597186 |
| 0.4328358 | 0.8126143 | 0.2603131 |
| 0.4328358 | 0.8135283 | 0.2604563 |
| 0.4291045 | 0.8135283 | 0.2605301 |
| 0.4291045 | 0.8144424 | 0.2607189 |
| 0.4291045 | 0.8153565 | 0.2610074 |
| 0.4291045 | 0.8162706 | 0.2612181 |
| 0.4291045 | 0.8171846 | 0.2613173 |
| 0.4253731 | 0.8171846 | 0.2615507 |
| 0.4253731 | 0.8180987 | 0.2619791 |
| 0.4253731 | 0.8190128 | 0.2626802 |
| 0.4216418 | 0.8190128 | 0.2632181 |
| 0.4179104 | 0.8190128 | 0.2634416 |
| 0.4179104 | 0.8199269 | 0.2637975 |
| 0.4141791 | 0.8199269 | 0.2639855 |
| 0.4141791 | 0.8208410 | 0.2640299 |
| 0.4141791 | 0.8217550 | 0.2640673 |
| 0.4104478 | 0.8217550 | 0.2644277 |
| 0.4104478 | 0.8226691 | 0.2649813 |
| 0.4104478 | 0.8235832 | 0.2653196 |
| 0.4104478 | 0.8244973 | 0.2656002 |
| 0.4067164 | 0.8244973 | 0.2662867 |
| 0.4067164 | 0.8254113 | 0.2669009 |
| 0.4067164 | 0.8263254 | 0.2670975 |
| 0.4067164 | 0.8272395 | 0.2672945 |
| 0.4067164 | 0.8281536 | 0.2678304 |
| 0.4067164 | 0.8290676 | 0.2684991 |
| 0.4067164 | 0.8299817 | 0.2689125 |
| 0.4067164 | 0.8308958 | 0.2691852 |
| 0.4067164 | 0.8318099 | 0.2696146 |
| 0.4067164 | 0.8327239 | 0.2700283 |
| 0.4029851 | 0.8336380 | 0.2701348 |
| 0.4029851 | 0.8345521 | 0.2708530 |
| 0.3992537 | 0.8345521 | 0.2717920 |
| 0.3992537 | 0.8354662 | 0.2720807 |
| 0.3992537 | 0.8363803 | 0.2722702 |
| 0.3992537 | 0.8372943 | 0.2725876 |
| 0.3992537 | 0.8382084 | 0.2727983 |
| 0.3955224 | 0.8382084 | 0.2728966 |
| 0.3955224 | 0.8391225 | 0.2729560 |
| 0.3955224 | 0.8400366 | 0.2730341 |
| 0.3917910 | 0.8400366 | 0.2731409 |
| 0.3917910 | 0.8409506 | 0.2733270 |
| 0.3880597 | 0.8409506 | 0.2734683 |
| 0.3843284 | 0.8409506 | 0.2735839 |
| 0.3843284 | 0.8418647 | 0.2738711 |
| 0.3843284 | 0.8427788 | 0.2743371 |
| 0.3843284 | 0.8436929 | 0.2746238 |
| 0.3843284 | 0.8446069 | 0.2746873 |
| 0.3843284 | 0.8455210 | 0.2747599 |
| 0.3843284 | 0.8464351 | 0.2748373 |
| 0.3805970 | 0.8464351 | 0.2750723 |
| 0.3805970 | 0.8473492 | 0.2755892 |
| 0.3768657 | 0.8473492 | 0.2761536 |
| 0.3731343 | 0.8473492 | 0.2764126 |
| 0.3731343 | 0.8482633 | 0.2766784 |
| 0.3731343 | 0.8491773 | 0.2769329 |
| 0.3731343 | 0.8500914 | 0.2769968 |
| 0.3731343 | 0.8510055 | 0.2774360 |
| 0.3731343 | 0.8519196 | 0.2778843 |
| 0.3694030 | 0.8519196 | 0.2781135 |
| 0.3694030 | 0.8528336 | 0.2785996 |
| 0.3694030 | 0.8537477 | 0.2791791 |
| 0.3656716 | 0.8537477 | 0.2797110 |
| 0.3656716 | 0.8546618 | 0.2802399 |
| 0.3656716 | 0.8555759 | 0.2805106 |
| 0.3619403 | 0.8555759 | 0.2806274 |
| 0.3619403 | 0.8564899 | 0.2819284 |
| 0.3582090 | 0.8564899 | 0.2833814 |
| 0.3582090 | 0.8574040 | 0.2837287 |
| 0.3582090 | 0.8583181 | 0.2838640 |
| 0.3544776 | 0.8583181 | 0.2841442 |
| 0.3544776 | 0.8592322 | 0.2844434 |
| 0.3507463 | 0.8592322 | 0.2846159 |
| 0.3507463 | 0.8601463 | 0.2853087 |
| 0.3470149 | 0.8601463 | 0.2866187 |
| 0.3470149 | 0.8610603 | 0.2874831 |
| 0.3432836 | 0.8610603 | 0.2878321 |
| 0.3432836 | 0.8619744 | 0.2882941 |
| 0.3432836 | 0.8628885 | 0.2885905 |
| 0.3432836 | 0.8638026 | 0.2889431 |
| 0.3395522 | 0.8638026 | 0.2894599 |
| 0.3358209 | 0.8638026 | 0.2896732 |
| 0.3320896 | 0.8638026 | 0.2898605 |
| 0.3283582 | 0.8638026 | 0.2907032 |
| 0.3246269 | 0.8638026 | 0.2915392 |
| 0.3246269 | 0.8647166 | 0.2920221 |
| 0.3246269 | 0.8656307 | 0.2924408 |
| 0.3246269 | 0.8665448 | 0.2929309 |
| 0.3246269 | 0.8674589 | 0.2934685 |
| 0.3246269 | 0.8683729 | 0.2936698 |
| 0.3246269 | 0.8692870 | 0.2937876 |
| 0.3208955 | 0.8692870 | 0.2942024 |
| 0.3208955 | 0.8702011 | 0.2946666 |
| 0.3171642 | 0.8702011 | 0.2951850 |
| 0.3171642 | 0.8711152 | 0.2957851 |
| 0.3134328 | 0.8711152 | 0.2963611 |
| 0.3134328 | 0.8720293 | 0.2967712 |
| 0.3134328 | 0.8729433 | 0.2969522 |
| 0.3134328 | 0.8738574 | 0.2972556 |
| 0.3134328 | 0.8747715 | 0.2975699 |
| 0.3097015 | 0.8747715 | 0.2980905 |
| 0.3097015 | 0.8756856 | 0.2985880 |
| 0.3059701 | 0.8756856 | 0.2992694 |
| 0.3022388 | 0.8756856 | 0.2999151 |
| 0.3022388 | 0.8765996 | 0.3003743 |
| 0.3022388 | 0.8775137 | 0.3011045 |
| 0.2985075 | 0.8775137 | 0.3015649 |
| 0.2985075 | 0.8784278 | 0.3020826 |
| 0.2947761 | 0.8784278 | 0.3028067 |
| 0.2947761 | 0.8793419 | 0.3036183 |
| 0.2947761 | 0.8802559 | 0.3043889 |
| 0.2910448 | 0.8802559 | 0.3048624 |
| 0.2910448 | 0.8811700 | 0.3051089 |
| 0.2910448 | 0.8820841 | 0.3052211 |
| 0.2873134 | 0.8820841 | 0.3053644 |
| 0.2835821 | 0.8820841 | 0.3060060 |
| 0.2798507 | 0.8820841 | 0.3070246 |
| 0.2798507 | 0.8829982 | 0.3076288 |
| 0.2798507 | 0.8839122 | 0.3079242 |
| 0.2798507 | 0.8848263 | 0.3086394 |
| 0.2798507 | 0.8857404 | 0.3093153 |
| 0.2798507 | 0.8866545 | 0.3094848 |
| 0.2798507 | 0.8875686 | 0.3097954 |
| 0.2798507 | 0.8884826 | 0.3103882 |
| 0.2798507 | 0.8893967 | 0.3110083 |
| 0.2798507 | 0.8903108 | 0.3115977 |
| 0.2798507 | 0.8912249 | 0.3121771 |
| 0.2761194 | 0.8912249 | 0.3128636 |
| 0.2761194 | 0.8921389 | 0.3134278 |
| 0.2761194 | 0.8930530 | 0.3144587 |
| 0.2761194 | 0.8939671 | 0.3160715 |
| 0.2761194 | 0.8948812 | 0.3167900 |
| 0.2761194 | 0.8957952 | 0.3170127 |
| 0.2761194 | 0.8967093 | 0.3176919 |
| 0.2761194 | 0.8976234 | 0.3182511 |
| 0.2761194 | 0.8985375 | 0.3188469 |
| 0.2723881 | 0.8985375 | 0.3198263 |
| 0.2723881 | 0.8994516 | 0.3205665 |
| 0.2723881 | 0.9003656 | 0.3209265 |
| 0.2686567 | 0.9003656 | 0.3212245 |
| 0.2686567 | 0.9012797 | 0.3215408 |
| 0.2686567 | 0.9021938 | 0.3221329 |
| 0.2686567 | 0.9031079 | 0.3227180 |
| 0.2686567 | 0.9040219 | 0.3228318 |
| 0.2649254 | 0.9040219 | 0.3231726 |
| 0.2649254 | 0.9049360 | 0.3238254 |
| 0.2649254 | 0.9058501 | 0.3246101 |
| 0.2649254 | 0.9067642 | 0.3258377 |
| 0.2611940 | 0.9067642 | 0.3266719 |
| 0.2611940 | 0.9076782 | 0.3269712 |
| 0.2611940 | 0.9085923 | 0.3277049 |
| 0.2611940 | 0.9095064 | 0.3282956 |
| 0.2611940 | 0.9104205 | 0.3286700 |
| 0.2611940 | 0.9113346 | 0.3291076 |
| 0.2611940 | 0.9122486 | 0.3297322 |
| 0.2611940 | 0.9131627 | 0.3303300 |
| 0.2611940 | 0.9140768 | 0.3306268 |
| 0.2611940 | 0.9149909 | 0.3319770 |
| 0.2574627 | 0.9149909 | 0.3333227 |
| 0.2537313 | 0.9149909 | 0.3336539 |
| 0.2500000 | 0.9149909 | 0.3338356 |
| 0.2500000 | 0.9159049 | 0.3342547 |
| 0.2500000 | 0.9168190 | 0.3347356 |
| 0.2462687 | 0.9168190 | 0.3350003 |
| 0.2425373 | 0.9168190 | 0.3351843 |
| 0.2425373 | 0.9177331 | 0.3356672 |
| 0.2425373 | 0.9186472 | 0.3364202 |
| 0.2388060 | 0.9186472 | 0.3368108 |
| 0.2388060 | 0.9195612 | 0.3371366 |
| 0.2388060 | 0.9204753 | 0.3375383 |
| 0.2350746 | 0.9204753 | 0.3379487 |
| 0.2313433 | 0.9204753 | 0.3382609 |
| 0.2313433 | 0.9213894 | 0.3389777 |
| 0.2313433 | 0.9223035 | 0.3400983 |
| 0.2276119 | 0.9223035 | 0.3409538 |
| 0.2276119 | 0.9232176 | 0.3425428 |
| 0.2276119 | 0.9241316 | 0.3440314 |
| 0.2276119 | 0.9250457 | 0.3444674 |
| 0.2276119 | 0.9259598 | 0.3446584 |
| 0.2238806 | 0.9259598 | 0.3452417 |
| 0.2201493 | 0.9259598 | 0.3464408 |
| 0.2164179 | 0.9259598 | 0.3472598 |
| 0.2126866 | 0.9259598 | 0.3480292 |
| 0.2126866 | 0.9268739 | 0.3492416 |
| 0.2089552 | 0.9268739 | 0.3499793 |
| 0.2052239 | 0.9268739 | 0.3502743 |
| 0.2052239 | 0.9277879 | 0.3506638 |
| 0.2014925 | 0.9277879 | 0.3509704 |
| 0.2014925 | 0.9287020 | 0.3511103 |
| 0.2014925 | 0.9296161 | 0.3511960 |
| 0.2014925 | 0.9305302 | 0.3513515 |
| 0.1977612 | 0.9305302 | 0.3516761 |
| 0.1940299 | 0.9305302 | 0.3524648 |
| 0.1940299 | 0.9314442 | 0.3530793 |
| 0.1940299 | 0.9323583 | 0.3539808 |
| 0.1940299 | 0.9332724 | 0.3549439 |
| 0.1940299 | 0.9341865 | 0.3571443 |
| 0.1902985 | 0.9341865 | 0.3601105 |
| 0.1865672 | 0.9341865 | 0.3611447 |
| 0.1828358 | 0.9341865 | 0.3615754 |
| 0.1828358 | 0.9351005 | 0.3622842 |
| 0.1828358 | 0.9360146 | 0.3647127 |
| 0.1791045 | 0.9360146 | 0.3669564 |
| 0.1753731 | 0.9360146 | 0.3672146 |
| 0.1753731 | 0.9369287 | 0.3674177 |
| 0.1753731 | 0.9378428 | 0.3679312 |
| 0.1753731 | 0.9387569 | 0.3689404 |
| 0.1753731 | 0.9396709 | 0.3705536 |
| 0.1753731 | 0.9405850 | 0.3714870 |
| 0.1753731 | 0.9414991 | 0.3724052 |
| 0.1753731 | 0.9424132 | 0.3745653 |
| 0.1753731 | 0.9433272 | 0.3761018 |
| 0.1716418 | 0.9433272 | 0.3765221 |
| 0.1716418 | 0.9442413 | 0.3772103 |
| 0.1716418 | 0.9451554 | 0.3784717 |
| 0.1679104 | 0.9451554 | 0.3806348 |
| 0.1641791 | 0.9451554 | 0.3826026 |
| 0.1641791 | 0.9460695 | 0.3848098 |
| 0.1641791 | 0.9469835 | 0.3865806 |
| 0.1641791 | 0.9478976 | 0.3867611 |
| 0.1641791 | 0.9488117 | 0.3871583 |
| 0.1641791 | 0.9497258 | 0.3883662 |
| 0.1641791 | 0.9506399 | 0.3895503 |
| 0.1641791 | 0.9515539 | 0.3906952 |
| 0.1641791 | 0.9524680 | 0.3918262 |
| 0.1641791 | 0.9533821 | 0.3923034 |
| 0.1641791 | 0.9542962 | 0.3931037 |
| 0.1641791 | 0.9552102 | 0.3937878 |
| 0.1641791 | 0.9561243 | 0.3950613 |
| 0.1641791 | 0.9570384 | 0.3968648 |
| 0.1604478 | 0.9570384 | 0.3975567 |
| 0.1604478 | 0.9579525 | 0.3980464 |
| 0.1604478 | 0.9588665 | 0.3986600 |
| 0.1567164 | 0.9588665 | 0.3990582 |
| 0.1529851 | 0.9588665 | 0.4009172 |
| 0.1529851 | 0.9597806 | 0.4030070 |
| 0.1492537 | 0.9597806 | 0.4035222 |
| 0.1492537 | 0.9606947 | 0.4037920 |
| 0.1492537 | 0.9616088 | 0.4046302 |
| 0.1492537 | 0.9625229 | 0.4065422 |
| 0.1492537 | 0.9634369 | 0.4088476 |
| 0.1455224 | 0.9634369 | 0.4098902 |
| 0.1455224 | 0.9643510 | 0.4101012 |
| 0.1455224 | 0.9652651 | 0.4106131 |
| 0.1455224 | 0.9661792 | 0.4110752 |
| 0.1455224 | 0.9670932 | 0.4126873 |
| 0.1455224 | 0.9680073 | 0.4149906 |
| 0.1455224 | 0.9689214 | 0.4169788 |
| 0.1417910 | 0.9689214 | 0.4194661 |
| 0.1417910 | 0.9698355 | 0.4208655 |
| 0.1380597 | 0.9698355 | 0.4214374 |
| 0.1343284 | 0.9698355 | 0.4225822 |
| 0.1305970 | 0.9698355 | 0.4235434 |
| 0.1305970 | 0.9707495 | 0.4244039 |
| 0.1305970 | 0.9716636 | 0.4250866 |
| 0.1268657 | 0.9716636 | 0.4291871 |
| 0.1231343 | 0.9716636 | 0.4331804 |
| 0.1231343 | 0.9725777 | 0.4344447 |
| 0.1231343 | 0.9734918 | 0.4381383 |
| 0.1194030 | 0.9734918 | 0.4413745 |
| 0.1194030 | 0.9744059 | 0.4429012 |
| 0.1156716 | 0.9744059 | 0.4439648 |
| 0.1156716 | 0.9753199 | 0.4455050 |
| 0.1119403 | 0.9753199 | 0.4529705 |
| 0.1119403 | 0.9762340 | 0.4602723 |
| 0.1082090 | 0.9762340 | 0.4616571 |
| 0.1082090 | 0.9771481 | 0.4621898 |
| 0.1044776 | 0.9771481 | 0.4627649 |
| 0.1044776 | 0.9780622 | 0.4667548 |
| 0.1007463 | 0.9780622 | 0.4711407 |
| 0.0970149 | 0.9780622 | 0.4722069 |
| 0.0970149 | 0.9789762 | 0.4728381 |
| 0.0970149 | 0.9798903 | 0.4753529 |
| 0.0932836 | 0.9798903 | 0.4793767 |
| 0.0895522 | 0.9798903 | 0.4815321 |
| 0.0858209 | 0.9798903 | 0.4825484 |
| 0.0820896 | 0.9798903 | 0.4841538 |
| 0.0783582 | 0.9798903 | 0.4867842 |
| 0.0783582 | 0.9808044 | 0.4908478 |
| 0.0746269 | 0.9808044 | 0.4932227 |
| 0.0708955 | 0.9808044 | 0.4963140 |
| 0.0671642 | 0.9808044 | 0.5001697 |
| 0.0671642 | 0.9817185 | 0.5040363 |
| 0.0671642 | 0.9826325 | 0.5073678 |
| 0.0634328 | 0.9826325 | 0.5092272 |
| 0.0597015 | 0.9826325 | 0.5118035 |
| 0.0559701 | 0.9826325 | 0.5151083 |
| 0.0522388 | 0.9826325 | 0.5237672 |
| 0.0522388 | 0.9835466 | 0.5310574 |
| 0.0522388 | 0.9844607 | 0.5322619 |
| 0.0485075 | 0.9844607 | 0.5325088 |
| 0.0485075 | 0.9853748 | 0.5342202 |
| 0.0485075 | 0.9862888 | 0.5368450 |
| 0.0485075 | 0.9872029 | 0.5395130 |
| 0.0485075 | 0.9881170 | 0.5435310 |
| 0.0447761 | 0.9881170 | 0.5462423 |
| 0.0447761 | 0.9890311 | 0.5545085 |
| 0.0410448 | 0.9890311 | 0.5641753 |
| 0.0373134 | 0.9890311 | 0.5666469 |
| 0.0335821 | 0.9890311 | 0.5771411 |
| 0.0335821 | 0.9899452 | 0.5884062 |
| 0.0335821 | 0.9908592 | 0.5910226 |
| 0.0335821 | 0.9917733 | 0.5930510 |
| 0.0298507 | 0.9917733 | 0.5940660 |
| 0.0261194 | 0.9917733 | 0.5951402 |
| 0.0261194 | 0.9926874 | 0.6001773 |
| 0.0223881 | 0.9926874 | 0.6058176 |
| 0.0223881 | 0.9936015 | 0.6079765 |
| 0.0186567 | 0.9936015 | 0.6093307 |
| 0.0186567 | 0.9945155 | 0.6128734 |
| 0.0186567 | 0.9954296 | 0.6158220 |
| 0.0149254 | 0.9954296 | 0.6186794 |
| 0.0149254 | 0.9963437 | 0.6354349 |
| 0.0111940 | 0.9963437 | 0.6614851 |
| 0.0111940 | 0.9972578 | 0.6753953 |
| 0.0111940 | 0.9981718 | 0.6842232 |
| 0.0111940 | 0.9990859 | 0.7063848 |
| 0.0074627 | 0.9990859 | 0.7227603 |
| 0.0074627 | 1.0000000 | 0.7677273 |
| 0.0037313 | 1.0000000 | 0.8160404 |
| 0.0000000 | 1.0000000 | Inf |
Paso 11: Características operativas.
11.1 Estimar probabilidades con el modelo.
data <- data[-1258, ]
data$prob_modelo <- predict(modelo_interaccion_1, type = "response")11.2 Verificar las primeras estimaciones.
head(data[, c("newchd", "prob_modelo")])## newchd prob_modelo
## <int> <num>
## 1: 1 0.19280136
## 2: 0 0.11845986
## 3: 0 0.11837271
## 4: 0 0.06729466
## 5: 0 0.14635910
## 6: 1 0.16823315En el output de estás visualizando las primeras filas del dataframe
data, específicamente:
newchd: el valor observado del evento (0 = no evento, 1 = evento).prob_modelo: la probabilidad estimada por el modelomodelo_interaccion_1para que ocurra ese evento.
Esto quiere decir que el modelo está estimando, para cada individuo,
cuál es la probabilidad de tener enfermedad coronaria (o el evento que
representa newchd), en función de las covariables que
incluiste y del término de interacción.
Cuando observás que:
La observación 1 y 6 tienen
newchd= 1 (es decir, el evento ocurrió), peroLas probabilidades estimadas por el modelo (
prob_modelo) son bajas (0.19 y 0.16),
esto sugiere que el modelo no asignó una alta probabilidad de riesgo a individuos que efectivamente presentaron el evento, lo cual es un signo de baja capacidad discriminativa en esos casos puntuales.
Sin embargo, dos cosas importantes para tener en cuenta:
🔹 1. Una predicción probabilística nunca es exacta a nivel individual Los modelos de regresión logística no predicen eventos con certeza (no dicen “va a pasar”), sino que dan una probabilidad promedio estimada para personas con ciertas características. Aun con una probabilidad de 0.19, es perfectamente posible (y esperable) que haya eventos en esa franja.
🔹 2. La discriminación se evalúa globalmente, no por casos individuales Para saber si el modelo discrimina bien entre quienes tienen y no tienen el evento, necesitás evaluar medidas de desempeño global:
La curva ROC y el AUC (c-statistic) miden discriminación.
La calibración (como slope/intercept o curva de calibración) evalúa qué tan bien predice el riesgo observado.
Por ejemplo, un AUC cerca de 0.7 sugiere una capacidad de discriminación aceptable. Si fuera <0.6, ahí sí podrías preocuparte por bajo desempeño general.
11.3 Evaluar el rendimiento del modelo.
- Transformar las probabilidades en predicciones binarias
data$pred_binaria <- ifelse(data$prob_modelo > 0.2, 1, 0)- Comparar con el evento real (
newchd) usando una matriz de confusión
data$pred_binaria <- relevel(factor(data$pred_binaria), ref = "1")
data$newchd <- relevel(factor(data$newchd), ref = "1")
crosstab(data$pred_binaria, data$newchd, prop.c = TRUE)
## Cell Contents
## |-------------------------|
## | Count |
## | Column Percent |
## |-------------------------|
##
## ==========================================
## data$newchd
## data$pred_binaria 1 0 Total
## ------------------------------------------
## 1 171 376 547
## 63.8% 34.4%
## ------------------------------------------
## 0 97 718 815
## 36.2% 65.6%
## ------------------------------------------
## Total 268 1094 1362
## 19.7% 80.3%
## ==========================================Utilizando un punto de corte de 0.2 para la probabilidad estimada, el
modelo clasificó correctamente el 63.8% de los pacientes que
efectivamente presentaron enfermedad coronaria (newchd = 1)
como positivos (pred_binaria = 1), y el 65.6% de los
pacientes que no presentaron el evento como negativos
(pred_binaria = 0). Sin embargo, el modelo clasificó
incorrectamente como negativos al 36.2% de los verdaderos casos (falsos
negativos), y como positivos al 34.4% de los que no presentaron el
evento (falsos positivos).
- Calcular medidas de rendimiento.
tabla <- table(Predicho = data$pred_binaria, Real = data$newchd)
VP <- tabla["1", "1"]
VN <- tabla["0", "0"]
FP <- tabla["1", "0"]
FN <- tabla["0", "1"]
S <- VP / (VP + FN)
E <- VN / (VN + FP)
VPP <- VP / (VP + FP)
VPN <- VN / (VN + FN)
medidas <- data.frame(
Medida = c("Sensibilidad", "Especificidad", "VPP", "VPN"),
Valor = round(c(S, E, VPP, VPN) * 100, 1)
)
knitr::kable(medidas, caption = "Medidas de rendimiento del modelo (%)")## Warning in attr(x, "align"): 'xfun::attr()' está en desuso.
## Utilizar 'xfun::attr2()' en su lugar.
## Ver help("Deprecated")## Warning in attr(x, "format"): 'xfun::attr()' está en desuso.
## Utilizar 'xfun::attr2()' en su lugar.
## Ver help("Deprecated")| Medida | Valor |
|---|---|
| Sensibilidad | 63.8 |
| Especificidad | 65.6 |
| VPP | 31.3 |
| VPN | 88.1 |