1. Carga de librerías.

library(data.table)
## Warning: package 'data.table' was built under R version 4.4.3
library(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
## Warning: package 'forcats' 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 errors
library(broom)
library(vcd)
## Warning: package 'vcd' was built under R version 4.4.3
## Cargando paquete requerido: grid
library(sjPlot)
## Warning: package 'sjPlot' was built under R version 4.4.3
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 analyses
library(tableone)
## Warning: package 'tableone' was built under R version 4.4.3
library(ggpubr)
## Warning: package 'ggpubr' was built under R version 4.4.2
library(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':
## 
##     summarise
library(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, units
library(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, var
library(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-9
library(glue)
## Warning: package 'glue' was built under R version 4.4.3
library(dplyr)
library(tibble)
library(gtsummary)
## Warning: package 'gtsummary' was built under R version 4.4.3
library(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':
## 
##     some
library(data.table)
library(sjPlot)
library(descr)
## Warning: package 'descr' was built under R version 4.4.3
library(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':
## 
##     contrast
library(ResourceSelection)
## Warning: package 'ResourceSelection' was built under R version 4.4.3
## ResourceSelection 0.3-6   2023-06-27
library(rms)
library(riskRegression)
## Warning: package 'riskRegression' was built under R version 4.4.3
## riskRegression version 2025.05.20
library(ggplot2)
library(readr)
library(tidyverse)
library(tableone)
library(forcats)
library(ggplot2)
library(reshape2)
## 
## Adjuntando el paquete: 'reshape2'
## 
## The following object is masked from 'package:tidyr':
## 
##     smiths
## 
## The following objects are masked from 'package:data.table':
## 
##     dcast, melt
library(gt)
## Warning: package 'gt' was built under R version 4.4.3
## 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?
## 
## Adjuntando el paquete: 'gt'
## 
## The following object is masked from 'package:Hmisc':
## 
##     html
library(vcdExtra)
library(knitr)
## Warning: package 'knitr' was built under R version 4.4.2

2. Carga y preparación de datos.

Carga inicial.

data <- read_csv("C:\\Users\\Usuario\\Desktop\\iecs\\ano_2\\regresion_logistica_multiple\\th\\train_TH.csv", show_col_types = FALSE)
names(data) <- tolower(names(data))
data <- data %>% rename(nt_probnp = `nt-probnp`)

La variable gender, codificada originalmente como 1 y 2, será recategorizada a 1 y 0 para armonizar con el resto de las variables dicotómicas.

data <- data %>% mutate(gender = ifelse(gender == "1", 1, 0))

Transformación a factor.

data <- data %>% mutate(across(c("died", "gender", "hypertension", "a_fib", "chd", "diabetes", "anemia", "depression", "hyperlipemia", "ckd", "copd"), as.factor))

Ver cuántos NA hay por variable

colSums(is.na(data))
##                     died                      age                   gender 
##                        0                        0                        0 
##             hypertension                    a_fib                      chd 
##                        0                        0                        0 
##                 diabetes                   anemia               depression 
##                        0                        0                        0 
##             hyperlipemia                      ckd                     copd 
##                        0                        0                        0 
##               heart rate  systolic blood pressure diastolic blood pressure 
##                        0                        0                        0 
##         respiratory rate              temperature                    sp o2 
##                        0                        0                        0 
##             urine output               hematocrit                leucocyte 
##                        0                        0                        0 
##                platelets                      inr                nt_probnp 
##                        0                        0                        0 
##               creatinine            urea nitrogen                  glucose 
##                        0                        0                        0 
##          blood potassium             blood sodium            blood calcium 
##                        0                        0                        0 
##                 chloride            magnesium ion                       ph 
##                        0                        0                        0 
##              bicarbonate              lactic acid                     pco2 
##                        0                        0                        0

No hay valores faltantes (NA) en ninguna de las variables.

Comparación de proporciones del evento por variable categórica

cat("\n--- Hypertension ---\n")
## 
## --- Hypertension ---
100 * prop.table(table(data$hypertension, data$died), margin = 1)
##    
##            0        1
##   0 82.62712 17.37288
##   1 88.60544 11.39456
cat("\n--- Atrial Fibrillation (a_fib) ---\n")
## 
## --- Atrial Fibrillation (a_fib) ---
100 * prop.table(table(data$a_fib, data$died), margin = 1)
##    
##            0        1
##   0 90.15660  9.84340
##   1 83.02387 16.97613
cat("\n--- Anemia ---\n")
## 
## --- Anemia ---
100 * prop.table(table(data$anemia, data$died), margin = 1)
##    
##             0         1
##   0 83.955224 16.044776
##   1 92.361111  7.638889
cat("\n--- Chronic Kidney Disease (ckd) ---\n")
## 
## --- Chronic Kidney Disease (ckd) ---
100 * prop.table(table(data$ckd, data$died), margin = 1)
##    
##            0        1
##   0 83.96947 16.03053
##   1 92.00000  8.00000
cat("\n--- COPD ---\n")
## 
## --- COPD ---
100 * prop.table(table(data$copd, data$died), margin = 1)
##    
##             0         1
##   0 86.129458 13.870542
##   1 95.522388  4.477612

Corrección de codificación de variables categóricas.

Durante el análisis inicial, observamos que varias comorbilidades presentaban odds ratios < 1 para el desenlace died, lo cual resultaba contraintuitivo. Por ejemplo, condiciones como hipertensión, diabetes, insuficiencia renal crónica (CKD), enfermedad pulmonar obstructiva crónica (COPD), dislipemia, anemia, enfermedad coronaria (CHD) y depresión mostraban una asociación paradójica: menor mortalidad en pacientes con dichas comorbilidades.

Este hallazgo se contradice con el conocimiento clínico, especialmente al considerar que la p global del modelo para el desenlace died es 0.13 y que en el análisis univariado, los pacientes fallecidos presentan peores valores en variables clínicas como presión arterial, leucocitos, temperatura, gasto urinario, etc.

Al revisar la distribución cruzada de proporciones, advertimos que en algunas comorbilidades la proporción de fallecidos era mayor en los pacientes sin la condición (por ejemplo: hipertensión ausente con 17.4% de mortalidad vs. hipertensión presente con 11.4%). Este patrón sugiere que dichas variables pueden haber sido mal codificadas, probablemente invertidas en su origen.

A fin de conservar la coherencia clínica y estadística, procedimos a invertir la codificación de las siguientes variables:

  • hypertension
  • chd
  • diabetes
  • anemia
  • depression
  • hyperlipemia
  • ckd
  • copd

Invertir codificación de comorbilidades para que 1 = presencia de comorbilidad

vars_invertir <- c("hypertension", "chd", "diabetes", "anemia", 
                   "depression", "hyperlipemia", "ckd", "copd")

for (v in vars_invertir) {
  data[[v]] <- ifelse(data[[v]] == 1, 0, 1)
}
cat("\n--- Hypertension ---\n")
## 
## --- Hypertension ---
100 * prop.table(table(data$hypertension, data$died), margin = 1)
##    
##            0        1
##   0 88.60544 11.39456
##   1 82.62712 17.37288
cat("\n--- Atrial Fibrillation (a_fib) ---\n")
## 
## --- Atrial Fibrillation (a_fib) ---
100 * prop.table(table(data$a_fib, data$died), margin = 1)
##    
##            0        1
##   0 90.15660  9.84340
##   1 83.02387 16.97613
cat("\n--- Anemia ---\n")
## 
## --- Anemia ---
100 * prop.table(table(data$anemia, data$died), margin = 1)
##    
##             0         1
##   0 92.361111  7.638889
##   1 83.955224 16.044776
cat("\n--- Chronic Kidney Disease (ckd) ---\n")
## 
## --- Chronic Kidney Disease (ckd) ---
100 * prop.table(table(data$ckd, data$died), margin = 1)
##    
##            0        1
##   0 92.00000  8.00000
##   1 83.96947 16.03053
cat("\n--- COPD ---\n")
## 
## --- COPD ---
100 * prop.table(table(data$copd, data$died), margin = 1)
##    
##             0         1
##   0 95.522388  4.477612
##   1 86.129458 13.870542

3. Modelo

Objetivos:

  1. Combinación de variables que brinda la mejor respuesta a mi pregunta de investigación.

Tipo:

  1. Predictivo (Parsimonioso).

4. Analisis Univariable.

catvars <- c("gender", "hypertension", "a_fib", "chd", 
             "diabetes", "anemia", "depression", 
             "hyperlipemia", "ckd", "copd")

vars <- c("age", "heart rate", "systolic blood pressure", "diastolic blood pressure", 
          "sp o2", "temperature", "respiratory rate",
          "urine output", "hematocrit", "leucocyte", "platelets", 
          "inr", "nt_probnp", "creatinine", "urea nitrogen",
          "glucose", "blood potassium", "blood sodium", 
          "blood calcium", "chloride", "magnesium ion", 
          "ph", "bicarbonate", "lactic acid", "pco2")

data <- data %>%
  mutate(across(c("hypertension", "a_fib", "chd", "diabetes", "anemia", "depression",
                  "hyperlipemia", "ckd", "copd", "gender"),
                ~ fct_relevel(as.factor(.), "0")))

tabla_1 <- CreateTableOne(vars = c(vars, catvars), 
                          strata = "died", 
                          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 716 108
age (mean (SD)) 73.76 (13.01) 75.98 (14.01) 0.102
heart rate (mean (SD)) 83.80 (15.83) 88.24 (14.68) 0.006
systolic blood pressure (mean (SD)) 119.21 (17.05) 110.39 (16.75) <0.001
diastolic blood pressure (mean (SD)) 60.00 (10.84) 57.67 (9.21) 0.034
sp o2 (mean (SD)) 96.35 (2.14) 95.90 (3.01) 0.054
temperature (mean (SD)) 36.70 (0.57) 36.48 (0.73) <0.001
respiratory rate (mean (SD)) 20.51 (3.93) 21.68 (4.27) 0.005
urine output (mean (SD)) 1999.65 (1271.35) 1251.19 (1042.46) <0.001
hematocrit (mean (SD)) 31.91 (5.11) 31.97 (5.43) 0.913
leucocyte (mean (SD)) 10.37 (4.52) 13.84 (7.96) <0.001
platelets (mean (SD)) 248.72 (108.03) 214.03 (133.44) 0.003
inr (mean (SD)) 1.58 (0.75) 2.02 (1.40) <0.001
nt_probnp (mean (SD)) 10814.14 (12818.97) 15554.25 (14867.09) <0.001
creatinine (mean (SD)) 1.60 (1.21) 1.84 (1.20) 0.046
urea nitrogen (mean (SD)) 34.83 (20.81) 48.71 (28.71) <0.001
glucose (mean (SD)) 148.52 (50.57) 151.15 (52.98) 0.617
blood potassium (mean (SD)) 4.15 (0.38) 4.34 (0.58) <0.001
blood sodium (mean (SD)) 139.02 (3.97) 138.18 (5.35) 0.052
blood calcium (mean (SD)) 8.54 (0.55) 8.23 (0.63) <0.001
chloride (mean (SD)) 102.12 (5.28) 103.36 (6.04) 0.026
magnesium ion (mean (SD)) 2.10 (0.24) 2.18 (0.31) 0.004
ph (mean (SD)) 7.38 (0.06) 7.36 (0.08) <0.001
bicarbonate (mean (SD)) 27.41 (5.01) 23.48 (5.32) <0.001
lactic acid (mean (SD)) 1.71 (0.75) 2.40 (1.36) <0.001
pco2 (mean (SD)) 45.49 (11.54) 43.16 (12.22) 0.053
gender = 1 (%) 334 (46.6) 56 (51.9) 0.365
hypertension = 1 (%) 195 (27.2) 41 (38.0) 0.029
a_fib = 1 (%) 313 (43.7) 64 (59.3) 0.004
chd = 1 (%) 650 (90.8) 98 (90.7) 1.000
diabetes = 1 (%) 406 (56.7) 66 (61.1) 0.448
anemia = 1 (%) 450 (62.8) 86 (79.6) 0.001
depression = 1 (%) 626 (87.4) 100 (92.6) 0.166
hyperlipemia = 1 (%) 438 (61.2) 69 (63.9) 0.664
ckd = 1 (%) 440 (61.5) 84 (77.8) 0.001
copd = 1 (%) 652 (91.1) 105 (97.2) 0.046

5. Regresion Logística Simple (Análisis Bivariable).

data %>% 
  select(`age`, `gender`, `hypertension`, `a_fib`, `chd`, `diabetes`, `anemia`, `depression`, `hyperlipemia`, `ckd`, `copd`, `heart rate`, `systolic blood pressure`, `diastolic blood pressure`, `respiratory rate`, `temperature`, `sp o2`, `urine output`, `hematocrit`, `leucocyte`, `platelets`, `inr`, `nt_probnp`, `creatinine`, `urea nitrogen`, `glucose`, `blood potassium`, `blood sodium`, `blood calcium`, `chloride`, `magnesium ion`, `ph`, `bicarbonate`, `lactic acid`, `pco2`,) %>%
  tbl_uvregression(
    method = glm,
    y = data$died,
    method.args = list(family = binomial),
    exponentiate = TRUE,
    pvalue_fun = ~style_pvalue(.x, digits = 2)
  ) %>%
  bold_p() %>%
  bold_labels()
Characteristic N OR 95% CI p-value
age 824 1.01 1.00, 1.03 0.10
gender 824


    0
— —
    1
1.23 0.82, 1.85 0.31
hypertension 824


    0
— —
    1
1.63 1.07, 2.48 0.022
a_fib 824


    0
— —
    1
1.87 1.25, 2.84 0.003
chd 824


    0
— —
    1
1.00 0.52, 2.12 0.99
diabetes 824


    0
— —
    1
1.20 0.80, 1.83 0.39
anemia 824


    0
— —
    1
2.31 1.44, 3.86 <0.001
depression 824


    0
— —
    1
1.80 0.90, 4.13 0.13
hyperlipemia 824


    0
— —
    1
1.12 0.74, 1.72 0.59
ckd 824


    0
— —
    1
2.20 1.38, 3.61 0.001
copd 824


    0
— —
    1
3.44 1.25, 14.2 0.040
heart rate 824 1.02 1.00, 1.03 0.007
systolic blood pressure 824 0.97 0.95, 0.98 <0.001
diastolic blood pressure 824 0.98 0.96, 1.00 0.034
respiratory rate 824 1.07 1.02, 1.13 0.005
temperature 824 0.55 0.39, 0.77 <0.001
sp o2 824 0.92 0.85, 1.00 0.057
urine output 824 1.00 1.00, 1.00 <0.001
hematocrit 824 1.00 0.96, 1.04 0.91
leucocyte 824 1.11 1.07, 1.15 <0.001
platelets 824 1.00 0.99, 1.00 0.003
inr 824 1.54 1.28, 1.86 <0.001
nt_probnp 824 1.00 1.00, 1.00 <0.001
creatinine 824 1.15 0.99, 1.32 0.051
urea nitrogen 824 1.02 1.01, 1.03 <0.001
glucose 824 1.00 1.00, 1.00 0.62
blood potassium 824 2.63 1.70, 4.09 <0.001
blood sodium 824 0.96 0.91, 1.00 0.053
blood calcium 824 0.36 0.25, 0.53 <0.001
chloride 824 1.04 1.01, 1.09 0.026
magnesium ion 824 2.90 1.37, 6.11 0.005
ph 824 0.00 0.00, 0.03 <0.001
bicarbonate 824 0.84 0.80, 0.88 <0.001
lactic acid 824 1.97 1.62, 2.42 <0.001
pco2 824 0.98 0.96, 1.00 0.053
Abbreviations: CI = Confidence Interval, OR = Odds Ratio

Generar una nueva tabla ordenada por p-valor

tabla_ordenada <- as_tibble(tabla_bivariada$table_body) %>%
  arrange(p.value)

options(scipen = 999)

tabla_ordenada %>%
  select(label, estimate, conf.low, conf.high, p.value) %>%
  gt() %>%
  tab_header(title = "Regresión logística bivariada - Ordenada por p-valor")

6. ¿Que hacemos con las variables numéricas?

6.1 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(as.numeric(died) - 1)) %>%
  ggplot(aes(x = age_q, y = tar)) +
  geom_point() +
  geom_smooth(method = "lm", col = "blue")
## `geom_smooth()` using formula = 'y ~ x'

6.2 Evaluación de bicarbonato (bicarbonate) como variable continua.

data <- data %>%
  mutate(bicarbonate_q = ntile(`bicarbonate`, 5))

data %>%
  dplyr::group_by(bicarbonate_q) %>%
  dplyr::summarise(tar = mean(as.numeric(died) - 1)) %>%
  ggplot(aes(x = bicarbonate_q, y = tar)) +
  geom_point() +
  geom_smooth(method = "lm", col = "blue")
## `geom_smooth()` using formula = 'y ~ x'

6.3 Evaluación de calcio en sagre (blood calcium) como variable continua.

data <- data %>%
  mutate(`blood calcium_q` = ntile(`blood calcium`, 5))

data %>%
  dplyr::group_by(`blood calcium_q`) %>%
  dplyr::summarise(tar = mean(as.numeric(died) - 1)) %>%
  ggplot(aes(x = `blood calcium_q`, y = tar)) +
  geom_point() +
  geom_smooth(method = "lm", col = "blue")
## `geom_smooth()` using formula = 'y ~ x'

6.4 Evaluación de ácido láctico (lactic_acid) como variable continua.

data <- data %>%
  mutate(lactic_q = ntile(`lactic acid`, 5))
  
  data %>%
  dplyr::group_by(lactic_q) %>%
  dplyr::summarise(tar = mean(as.numeric(died) - 1)) %>%
  ggplot(aes(x = lactic_q, y = tar)) +
  geom_point() +
  geom_smooth(method = "lm", col = "blue")
## `geom_smooth()` using formula = 'y ~ x'

6.5 Evaluación de leucocitos (leucocyte) como variable continua.

data <- data %>%
  mutate(leucocyte_q = ntile(leucocyte, 5))
  
  data %>%
  dplyr::group_by(leucocyte_q) %>%
  dplyr::summarise(tar = mean(as.numeric(died) - 1)) %>%
  ggplot(aes(x = leucocyte_q, y = tar)) +
  geom_point() +
  geom_smooth(method = "lm", col = "blue")
## `geom_smooth()` using formula = 'y ~ x'

6.6 Evaluación de pCO2 (pco2) como variable continua.

data <- data %>%
  mutate(pco2_q = ntile(pco2, 5))
  
  data %>%
  dplyr::group_by(pco2_q) %>%
  dplyr::summarise(tar = mean(as.numeric(died) - 1)) %>%
  ggplot(aes(x = pco2_q, y = tar)) +
  geom_point() +
  geom_smooth(method = "lm", col = "blue")
## `geom_smooth()` using formula = 'y ~ x'

6.7 Evaluación de presión arterial sistólica (systolic blood pressure) como variable continua.

data <- data %>%
  mutate(`systolic blood pressure_q` = ntile(`systolic blood pressure`, 5))
  
  data %>%
  dplyr::group_by(`systolic blood pressure_q`) %>%
  dplyr::summarise(tar = mean(as.numeric(died) - 1)) %>%
  ggplot(aes(x = `systolic blood pressure_q`, y = tar)) +
  geom_point() +
  geom_smooth(method = "lm", col = "blue")
## `geom_smooth()` using formula = 'y ~ x'

6.8 Evaluación de nitrógeno uréico (urea nitrogen) como variable continua.

data <- data %>%
  mutate(`urea nitrogen_q` = ntile(`urea nitrogen`, 5))
  
  data %>%
  dplyr::group_by(`urea nitrogen_q`) %>%
  dplyr::summarise(tar = mean(as.numeric(died) - 1)) %>%
  ggplot(aes(x = `urea nitrogen_q`, y = tar)) +
  geom_point() +
  geom_smooth(method = "lm", col = "blue")
## `geom_smooth()` using formula = 'y ~ x'

6.9 Evaluación de diuresis en 24 HS (urine output) como variable continua.

Aclaración: para fines prácticos, se asume que el valor en mL de cada observación del dataset es el resultado obtenido a las 24 horas del ingreso del paciente.

data <- data %>%
  mutate(urine_output_q = ntile(`urine output`, 5))

data %>%
  dplyr::group_by(urine_output_q) %>%
  dplyr::summarise(tar = mean(as.numeric(died) - 1)) %>%
  ggplot(aes(x = urine_output_q, y = tar)) +
  geom_point() +
  geom_smooth(method = "lm", col = "blue")
## `geom_smooth()` using formula = 'y ~ x'

6.10 Evaluación de SPO2 (sp o2) como variable continua.

data <- data %>%
  mutate(`sp o2_q` = ntile(`sp o2`, 5))

data %>%
  dplyr::group_by(`sp o2_q`) %>%
  dplyr::summarise(tar = mean(as.numeric(died) - 1)) %>%
  ggplot(aes(x = `sp o2_q`, y = tar)) +
  geom_point() +
  geom_smooth(method = "lm", col = "blue")
## `geom_smooth()` using formula = 'y ~ x'

Aclaración: para fines prácticos, se asume que el valor cada observación del dataset es el resultado obtenido promedio de las 24 horas del ingreso del paciente.

6.9 Matriz de correlación.

vars_cont <- data[, c("age", "glucose", "blood potassium", "blood sodium",
                      "blood calcium", "chloride", "magnesium ion",
                      "ph", "bicarbonate", "lactic acid", "pco2", "sp o2")]


cor_matrix <- round(cor(vars_cont, use = "complete.obs"), 2)
melted_cor <- melt(cor_matrix)


ggplot(data = melted_cor, aes(x = Var2, y = Var1, fill = value)) +
  geom_tile(color = "white") +
  geom_text(aes(label = sprintf("%.2f", value)), color = "black", size = 4) +
  scale_fill_gradient2(low = "blue", high = "red", mid = "white",
                       midpoint = 0, limit = c(-1, 1), space = "Lab",
                       name = "Correlacion") +
  theme_minimal(base_size = 12) +
  theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1),
        axis.text.y = element_text(size = 10),
        plot.title = element_text(size = 14, face = "bold")) +
  labs(title = "Matriz de correlacion - Variables continuas (train_TH)",
       x = "", y = "") +
  coord_fixed()

Se identificaron seis variables con alta correlación entre sí a partir del análisis de matriz de correlación con umbral de corte ≥0.4: inr, diastolic blood pressure, heart rate, urea nitrogen, creatinine y temperature. Con el objetivo de evitar problemas de multicolinealidad en los modelos de regresión, se optó por excluir estas variables del análisis multivariable.

7. Regresion Logística Múltiple (Análisis Multivariable).

modelo_1 <- glm(died ~ bicarbonate,
                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)
  died
Predictors Odds Ratios std. Error CI p
bicarbonate 0.84 0.02 0.80 – 0.88 <0.001
Observations 824
Deviance 580.368
log-Likelihood -290.184 
AIC(modelo_1)
## [1] 584.368
modelo_2 <- glm(died ~ bicarbonate + `urine output`,
                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) 
## Warning: Looks like you are using syntactically invalid variable names, quoted in
##   backticks: `urine output`. This may result in unexpected behaviour.
##   Please rename your variables (e.g., `urine.output` instead of `urine
##   output`) and fit the model again.
## Warning: Looks like you are using syntactically invalid variable names, quoted in
##   backticks: `urine output`. This may result in unexpected behaviour.
##   Please rename your variables (e.g., `urine.output` instead of `urine
##   output`) and fit the model again.
knitr::asis_output(t$knitr)
  died
Predictors Odds Ratios std. Error CI p
bicarbonate 0.86 0.02 0.82 – 0.90 <0.001
urine output 1.00 0.00 1.00 – 1.00 <0.001
Observations 824
Deviance 557.412
log-Likelihood -278.706 
AIC(modelo_2)
## [1] 563.4119
vif(modelo_2)
##    bicarbonate `urine output` 
##       1.031808       1.031808
anova(modelo_2, test = "LRT")
## Analysis of Deviance Table
## 
## Model: binomial, link: logit
## 
## Response: died
## 
## Terms added sequentially (first to last)
## 
## 
##                Df Deviance Resid. Df Resid. Dev  Pr(>Chi)    
## NULL                             823     640.10              
## bicarbonate     1   59.735       822     580.37 1.085e-14 ***
## `urine output`  1   22.956       821     557.41 1.657e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
modelo_3 <- glm(died ~ bicarbonate + `urine output` + `urea nitrogen`,
                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) 
## Warning: Looks like you are using syntactically invalid variable names, quoted in
##   backticks: `urea nitrogen`. This may result in unexpected behaviour.
##   Please rename your variables (e.g., `urea.nitrogen` instead of `urea
##   nitrogen`) and fit the model again.
## Warning: Looks like you are using syntactically invalid variable names, quoted in
##   backticks: `urea nitrogen`. This may result in unexpected behaviour.
##   Please rename your variables (e.g., `urea.nitrogen` instead of `urea
##   nitrogen`) and fit the model again.
knitr::asis_output(t$knitr)
  died
Predictors Odds Ratios std. Error CI p
bicarbonate 0.88 0.02 0.83 – 0.92 <0.001
urea nitrogen 1.01 0.00 1.00 – 1.02 0.005
urine output 1.00 0.00 1.00 – 1.00 <0.001
Observations 824
Deviance 549.726
log-Likelihood -274.863 
AIC(modelo_3)
## [1] 557.7263
vif(modelo_3)
##     bicarbonate  `urine output` `urea nitrogen` 
##        1.088530        1.052767        1.087338
anova(modelo_3, test = "LRT")
## Analysis of Deviance Table
## 
## Model: binomial, link: logit
## 
## Response: died
## 
## Terms added sequentially (first to last)
## 
## 
##                 Df Deviance Resid. Df Resid. Dev  Pr(>Chi)    
## NULL                              823     640.10              
## bicarbonate      1   59.735       822     580.37 1.085e-14 ***
## `urine output`   1   22.956       821     557.41 1.657e-06 ***
## `urea nitrogen`  1    7.686       820     549.73  0.005566 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
modelo_4 <- glm(died ~ bicarbonate + `urine output` + `urea nitrogen` + `blood calcium`,
                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) 
## Warning: Looks like you are using syntactically invalid variable names, quoted in
##   backticks: `blood calcium`. This may result in unexpected behaviour.
##   Please rename your variables (e.g., `blood.calcium` instead of `blood
##   calcium`) and fit the model again.
## Warning: Looks like you are using syntactically invalid variable names, quoted in
##   backticks: `blood calcium`. This may result in unexpected behaviour.
##   Please rename your variables (e.g., `blood.calcium` instead of `blood
##   calcium`) and fit the model again.
knitr::asis_output(t$knitr)
  died
Predictors Odds Ratios std. Error CI p
bicarbonate 0.90 0.02 0.85 – 0.95 <0.001
blood calcium 0.50 0.10 0.33 – 0.75 0.001
urea nitrogen 1.02 0.00 1.01 – 1.03 0.001
urine output 1.00 0.00 1.00 – 1.00 <0.001
Observations 824
Deviance 537.930
log-Likelihood -268.965 
AIC(modelo_4)
## [1] 547.9304
vif(modelo_4)
##     bicarbonate  `urine output` `urea nitrogen` `blood calcium` 
##        1.164843        1.066908        1.150854        1.129459
anova(modelo_4, test = "LRT")
## Analysis of Deviance Table
## 
## Model: binomial, link: logit
## 
## Response: died
## 
## Terms added sequentially (first to last)
## 
## 
##                 Df Deviance Resid. Df Resid. Dev  Pr(>Chi)    
## NULL                              823     640.10              
## bicarbonate      1   59.735       822     580.37 1.085e-14 ***
## `urine output`   1   22.956       821     557.41 1.657e-06 ***
## `urea nitrogen`  1    7.686       820     549.73 0.0055661 ** 
## `blood calcium`  1   11.796       819     537.93 0.0005936 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
modelo_5 <- glm(died ~ bicarbonate + `urine output` + `urea nitrogen` + `blood calcium` + `lactic acid`, 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) 
## Warning: Looks like you are using syntactically invalid variable names, quoted in
##   backticks: `lactic acid`. This may result in unexpected behaviour.
##   Please rename your variables (e.g., `lactic.acid` instead of `lactic
##   acid`) and fit the model again.
## Warning: Looks like you are using syntactically invalid variable names, quoted in
##   backticks: `lactic acid`. This may result in unexpected behaviour.
##   Please rename your variables (e.g., `lactic.acid` instead of `lactic
##   acid`) and fit the model again.
knitr::asis_output(t$knitr)
  died
Predictors Odds Ratios std. Error CI p
bicarbonate 0.93 0.03 0.88 – 0.98 0.010
blood calcium 0.49 0.10 0.32 – 0.74 0.001
lactic acid 1.69 0.20 1.34 – 2.14 <0.001
urea nitrogen 1.02 0.00 1.01 – 1.03 <0.001
urine output 1.00 0.00 1.00 – 1.00 0.003
Observations 824
Deviance 517.761
log-Likelihood -258.881 
AIC(modelo_5)
## [1] 529.7612
vif(modelo_5)
##     bicarbonate  `urine output` `urea nitrogen` `blood calcium`   `lactic acid` 
##        1.233242        1.078783        1.166189        1.132673        1.077371
anova(modelo_5, test = "LRT")
## Analysis of Deviance Table
## 
## Model: binomial, link: logit
## 
## Response: died
## 
## Terms added sequentially (first to last)
## 
## 
##                 Df Deviance Resid. Df Resid. Dev  Pr(>Chi)    
## NULL                              823     640.10              
## bicarbonate      1   59.735       822     580.37 1.085e-14 ***
## `urine output`   1   22.956       821     557.41 1.657e-06 ***
## `urea nitrogen`  1    7.686       820     549.73 0.0055661 ** 
## `blood calcium`  1   11.796       819     537.93 0.0005936 ***
## `lactic acid`    1   20.169       818     517.76 7.088e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
modelo_6 <- glm(died ~ bicarbonate + `urine output` + `urea nitrogen` + `blood calcium` + `lactic acid` + pco2, 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) 
## Warning: Looks like you are using syntactically invalid variable names, quoted in
##   backticks: `lactic acid`. This may result in unexpected behaviour.
##   Please rename your variables (e.g., `lactic.acid` instead of `lactic
##   acid`) and fit the model again.
## Warning: Looks like you are using syntactically invalid variable names, quoted in
##   backticks: `lactic acid`. This may result in unexpected behaviour.
##   Please rename your variables (e.g., `lactic.acid` instead of `lactic
##   acid`) and fit the model again.
knitr::asis_output(t$knitr)
  died
Predictors Odds Ratios std. Error CI p
bicarbonate 0.85 0.03 0.79 – 0.91 <0.001
blood calcium 0.53 0.11 0.34 – 0.79 0.003
lactic acid 1.83 0.23 1.43 – 2.36 <0.001
pco2 1.06 0.02 1.03 – 1.09 <0.001
urea nitrogen 1.01 0.00 1.00 – 1.02 0.004
urine output 1.00 0.00 1.00 – 1.00 0.011
Observations 824
Deviance 504.626
log-Likelihood -252.313 
AIC(modelo_6)
## [1] 518.6261
vif(modelo_6)
##     bicarbonate  `urine output` `urea nitrogen` `blood calcium`   `lactic acid` 
##        2.398614        1.083002        1.226261        1.126279        1.128585 
##            pco2 
##        2.222537
anova(modelo_6, test = "LRT")
## Analysis of Deviance Table
## 
## Model: binomial, link: logit
## 
## Response: died
## 
## Terms added sequentially (first to last)
## 
## 
##                 Df Deviance Resid. Df Resid. Dev  Pr(>Chi)    
## NULL                              823     640.10              
## bicarbonate      1   59.735       822     580.37 1.085e-14 ***
## `urine output`   1   22.956       821     557.41 1.657e-06 ***
## `urea nitrogen`  1    7.686       820     549.73 0.0055661 ** 
## `blood calcium`  1   11.796       819     537.93 0.0005936 ***
## `lactic acid`    1   20.169       818     517.76 7.088e-06 ***
## pco2             1   13.135       817     504.63 0.0002898 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
modelo_7 <- glm(died ~ bicarbonate + `urine output` + `urea nitrogen` + `blood calcium` + `lactic acid` + pco2 + `systolic blood pressure`, data = data, family = binomial)

t<-tab_model(modelo_7, 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) 
## Warning: Looks like you are using syntactically invalid variable names, quoted in
##   backticks: `systolic blood pressure`. This may result in unexpected
##   behaviour. Please rename your variables (e.g., `systolic.blood.pressure`
##   instead of `systolic blood pressure`) and fit the model again.
## Warning: Looks like you are using syntactically invalid variable names, quoted in
##   backticks: `systolic blood pressure`. This may result in unexpected
##   behaviour. Please rename your variables (e.g., `systolic.blood.pressure`
##   instead of `systolic blood pressure`) and fit the model again.
knitr::asis_output(t$knitr)
  died
Predictors Odds Ratios std. Error CI p
bicarbonate 0.85 0.03 0.79 – 0.92 <0.001
blood calcium 0.54 0.12 0.35 – 0.82 0.004
lactic acid 1.75 0.22 1.37 – 2.27 <0.001
pco2 1.06 0.02 1.03 – 1.09 <0.001
systolic blood pressure 0.98 0.01 0.96 – 1.00 0.012
urea nitrogen 1.01 0.00 1.01 – 1.02 0.003
urine output 1.00 0.00 1.00 – 1.00 0.058
Observations 824
Deviance 497.922
log-Likelihood -248.961 
AIC(modelo_7)
## [1] 513.9222
vif(modelo_7)
##               bicarbonate            `urine output`           `urea nitrogen` 
##                  2.402263                  1.147416                  1.223939 
##           `blood calcium`             `lactic acid`                      pco2 
##                  1.129896                  1.138467                  2.221805 
## `systolic blood pressure` 
##                  1.077473
anova(modelo_7, test = "LRT")
## Analysis of Deviance Table
## 
## Model: binomial, link: logit
## 
## Response: died
## 
## Terms added sequentially (first to last)
## 
## 
##                           Df Deviance Resid. Df Resid. Dev  Pr(>Chi)    
## NULL                                        823     640.10              
## bicarbonate                1   59.735       822     580.37 1.085e-14 ***
## `urine output`             1   22.956       821     557.41 1.657e-06 ***
## `urea nitrogen`            1    7.686       820     549.73 0.0055661 ** 
## `blood calcium`            1   11.796       819     537.93 0.0005936 ***
## `lactic acid`              1   20.169       818     517.76 7.088e-06 ***
## pco2                       1   13.135       817     504.63 0.0002898 ***
## `systolic blood pressure`  1    6.704       816     497.92 0.0096203 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
modelo_8 <- glm(died ~ bicarbonate + `urine output` + `urea nitrogen` + `blood calcium` + `lactic acid` + pco2 + `systolic blood pressure` + leucocyte, data = data, family = binomial)

t<-tab_model(modelo_8, 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) 
## Warning: Looks like you are using syntactically invalid variable names, quoted in
##   backticks: `systolic blood pressure`. This may result in unexpected
##   behaviour. Please rename your variables (e.g., `systolic.blood.pressure`
##   instead of `systolic blood pressure`) and fit the model again.
## Warning: Looks like you are using syntactically invalid variable names, quoted in
##   backticks: `systolic blood pressure`. This may result in unexpected
##   behaviour. Please rename your variables (e.g., `systolic.blood.pressure`
##   instead of `systolic blood pressure`) and fit the model again.
knitr::asis_output(t$knitr)
  died
Predictors Odds Ratios std. Error CI p
bicarbonate 0.86 0.03 0.79 – 0.92 <0.001
blood calcium 0.56 0.12 0.36 – 0.86 0.009
lactic acid 1.64 0.22 1.28 – 2.14 <0.001
leucocyte 1.06 0.02 1.02 – 1.10 0.005
pco2 1.06 0.02 1.03 – 1.09 <0.001
systolic blood pressure 0.98 0.01 0.97 – 1.00 0.016
urea nitrogen 1.01 0.01 1.00 – 1.02 0.005
urine output 1.00 0.00 1.00 – 1.00 0.081
Observations 824
Deviance 489.992
log-Likelihood -244.996 
AIC(modelo_8)
## [1] 507.9924
vif(modelo_8)
##               bicarbonate            `urine output`           `urea nitrogen` 
##                  2.390379                  1.150817                  1.220264 
##           `blood calcium`             `lactic acid`                      pco2 
##                  1.140925                  1.149991                  2.173123 
## `systolic blood pressure`                 leucocyte 
##                  1.077455                  1.046971
anova(modelo_8, test = "LRT")
## Analysis of Deviance Table
## 
## Model: binomial, link: logit
## 
## Response: died
## 
## Terms added sequentially (first to last)
## 
## 
##                           Df Deviance Resid. Df Resid. Dev  Pr(>Chi)    
## NULL                                        823     640.10              
## bicarbonate                1   59.735       822     580.37 1.085e-14 ***
## `urine output`             1   22.956       821     557.41 1.657e-06 ***
## `urea nitrogen`            1    7.686       820     549.73 0.0055661 ** 
## `blood calcium`            1   11.796       819     537.93 0.0005936 ***
## `lactic acid`              1   20.169       818     517.76 7.088e-06 ***
## pco2                       1   13.135       817     504.63 0.0002898 ***
## `systolic blood pressure`  1    6.704       816     497.92 0.0096203 ** 
## leucocyte                  1    7.930       815     489.99 0.0048625 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
modelo_9 <- glm(died ~ bicarbonate + `urine output` + `urea nitrogen` + `blood calcium` + `lactic acid` + pco2 + `systolic blood pressure` + leucocyte + age, data = data, family = binomial)

t<-tab_model(modelo_9, 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) 
## Warning: Looks like you are using syntactically invalid variable names, quoted in
##   backticks: `systolic blood pressure`. This may result in unexpected
##   behaviour. Please rename your variables (e.g., `systolic.blood.pressure`
##   instead of `systolic blood pressure`) and fit the model again.
## Warning: Looks like you are using syntactically invalid variable names, quoted in
##   backticks: `systolic blood pressure`. This may result in unexpected
##   behaviour. Please rename your variables (e.g., `systolic.blood.pressure`
##   instead of `systolic blood pressure`) and fit the model again.
knitr::asis_output(t$knitr)
  died
Predictors Odds Ratios std. Error CI p
age 1.01 0.01 0.99 – 1.03 0.292
bicarbonate 0.86 0.03 0.79 – 0.92 <0.001
blood calcium 0.56 0.12 0.36 – 0.86 0.008
lactic acid 1.64 0.21 1.27 – 2.13 <0.001
leucocyte 1.06 0.02 1.02 – 1.10 0.005
pco2 1.06 0.02 1.03 – 1.09 <0.001
systolic blood pressure 0.98 0.01 0.97 – 1.00 0.017
urea nitrogen 1.01 0.01 1.00 – 1.02 0.004
urine output 1.00 0.00 1.00 – 1.00 0.116
Observations 824
Deviance 488.857
log-Likelihood -244.429 
AIC(modelo_9)
## [1] 508.8572
vif(modelo_9)
##               bicarbonate            `urine output`           `urea nitrogen` 
##                  2.375864                  1.173584                  1.212623 
##           `blood calcium`             `lactic acid`                      pco2 
##                  1.141484                  1.148924                  2.182454 
## `systolic blood pressure`                 leucocyte                       age 
##                  1.078119                  1.049405                  1.036421
anova(modelo_9, test = "LRT")
## Analysis of Deviance Table
## 
## Model: binomial, link: logit
## 
## Response: died
## 
## Terms added sequentially (first to last)
## 
## 
##                           Df Deviance Resid. Df Resid. Dev  Pr(>Chi)    
## NULL                                        823     640.10              
## bicarbonate                1   59.735       822     580.37 1.085e-14 ***
## `urine output`             1   22.956       821     557.41 1.657e-06 ***
## `urea nitrogen`            1    7.686       820     549.73 0.0055661 ** 
## `blood calcium`            1   11.796       819     537.93 0.0005936 ***
## `lactic acid`              1   20.169       818     517.76 7.088e-06 ***
## pco2                       1   13.135       817     504.63 0.0002898 ***
## `systolic blood pressure`  1    6.704       816     497.92 0.0096203 ** 
## leucocyte                  1    7.930       815     489.99 0.0048625 ** 
## age                        1    1.135       814     488.86 0.2866728    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
modelo_10 <- glm(died ~ bicarbonate + `urine output` + `urea nitrogen` + `blood calcium` + `lactic acid` + pco2 + `systolic blood pressure` + leucocyte + age + `sp o2`, data = data, family = binomial)

t<-tab_model(modelo_10, 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) 
## Warning: Looks like you are using syntactically invalid variable names, quoted in
##   backticks: `sp o2`. This may result in unexpected behaviour. Please
##   rename your variables (e.g., `sp.o2` instead of `sp o2`) and fit the
##   model again.
## Warning: Looks like you are using syntactically invalid variable names, quoted in
##   backticks: `sp o2`. This may result in unexpected behaviour. Please
##   rename your variables (e.g., `sp.o2` instead of `sp o2`) and fit the
##   model again.
knitr::asis_output(t$knitr)
  died
Predictors Odds Ratios std. Error CI p
age 1.01 0.01 0.99 – 1.03 0.341
bicarbonate 0.85 0.03 0.79 – 0.92 <0.001
blood calcium 0.52 0.12 0.33 – 0.81 0.004
lactic acid 1.63 0.21 1.27 – 2.12 <0.001
leucocyte 1.06 0.02 1.02 – 1.10 0.007
pco2 1.05 0.02 1.02 – 1.09 0.001
sp o2 0.87 0.05 0.78 – 0.96 0.010
systolic blood pressure 0.98 0.01 0.96 – 1.00 0.017
urea nitrogen 1.01 0.01 1.00 – 1.02 0.005
urine output 1.00 0.00 1.00 – 1.00 0.124
Observations 824
Deviance 481.862
log-Likelihood -240.931 
AIC(modelo_10)
## [1] 503.862
vif(modelo_10)
##               bicarbonate            `urine output`           `urea nitrogen` 
##                  2.487263                  1.186116                  1.219518 
##           `blood calcium`             `lactic acid`                      pco2 
##                  1.172793                  1.148074                  2.273222 
## `systolic blood pressure`                 leucocyte                       age 
##                  1.079870                  1.049017                  1.038937 
##                   `sp o2` 
##                  1.115657
anova(modelo_10, test = "LRT")
## Analysis of Deviance Table
## 
## Model: binomial, link: logit
## 
## Response: died
## 
## Terms added sequentially (first to last)
## 
## 
##                           Df Deviance Resid. Df Resid. Dev  Pr(>Chi)    
## NULL                                        823     640.10              
## bicarbonate                1   59.735       822     580.37 1.085e-14 ***
## `urine output`             1   22.956       821     557.41 1.657e-06 ***
## `urea nitrogen`            1    7.686       820     549.73 0.0055661 ** 
## `blood calcium`            1   11.796       819     537.93 0.0005936 ***
## `lactic acid`              1   20.169       818     517.76 7.088e-06 ***
## pco2                       1   13.135       817     504.63 0.0002898 ***
## `systolic blood pressure`  1    6.704       816     497.92 0.0096203 ** 
## leucocyte                  1    7.930       815     489.99 0.0048625 ** 
## age                        1    1.135       814     488.86 0.2866728    
## `sp o2`                    1    6.995       813     481.86 0.0081729 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
modelo_9 <- glm(died ~ `magnesium ion` + `blood calcium` + `lactic acid` + `blood potassium` +
          bicarbonate + chloride + ph + hematocrit + `sp o2` + oliguria_cat, data = data, family = binomial)

t<-tab_model(modelo_9, 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)

AIC(modelo_9)
vif(modelo_9)
anova(modelo_9, test = "LRT")

8. Modelo de Efectos Principales.

Texto: modelo_10.

9. Interacción o modificación de efecto.

modelo_10_interacciones <- glm(
  died ~ (bicarbonate + `urine output` + `urea nitrogen` + `blood calcium` + `lactic acid` + pco2 + `systolic blood pressure` + leucocyte + age + `sp o2`)^2,
  data = data,
  family = binomial
)
summary(modelo_10_interacciones)
## 
## Call:
## glm(formula = died ~ (bicarbonate + `urine output` + `urea nitrogen` + 
##     `blood calcium` + `lactic acid` + pco2 + `systolic blood pressure` + 
##     leucocyte + age + `sp o2`)^2, family = binomial, data = data)
## 
## Coefficients:
##                                             Estimate Std. Error z value
## (Intercept)                                1.714e+02  1.214e+02   1.411
## bicarbonate                                1.600e+00  2.291e+00   0.699
## `urine output`                             7.023e-04  8.109e-03   0.087
## `urea nitrogen`                           -2.432e-01  3.305e-01  -0.736
## `blood calcium`                           -7.047e+00  1.186e+01  -0.594
## `lactic acid`                              3.122e+00  8.238e+00   0.379
## pco2                                      -9.918e-01  9.740e-01  -1.018
## `systolic blood pressure`                 -4.893e-01  4.755e-01  -1.029
## leucocyte                                  4.652e-01  1.442e+00   0.323
## age                                       -3.009e-01  6.028e-01  -0.499
## `sp o2`                                   -1.968e+00  1.167e+00  -1.686
## bicarbonate:`urine output`                 1.519e-05  4.677e-05   0.325
## bicarbonate:`urea nitrogen`               -2.547e-05  1.831e-03  -0.014
## bicarbonate:`blood calcium`               -1.035e-01  7.883e-02  -1.313
## bicarbonate:`lactic acid`                 -9.349e-02  5.884e-02  -1.589
## bicarbonate:pco2                           7.934e-04  2.291e-03   0.346
## bicarbonate:`systolic blood pressure`      2.055e-03  2.845e-03   0.722
## bicarbonate:leucocyte                      2.370e-03  8.331e-03   0.284
## bicarbonate:age                            2.147e-03  3.736e-03   0.575
## bicarbonate:`sp o2`                       -1.269e-02  2.197e-02  -0.578
## `urine output`:`urea nitrogen`             1.294e-06  5.767e-06   0.224
## `urine output`:`blood calcium`            -3.767e-05  3.009e-04  -0.125
## `urine output`:`lactic acid`               1.993e-04  1.899e-04   1.049
## `urine output`:pco2                       -6.052e-06  1.814e-05  -0.334
## `urine output`:`systolic blood pressure`   6.970e-06  7.729e-06   0.902
## `urine output`:leucocyte                   2.233e-05  2.767e-05   0.807
## `urine output`:age                        -9.136e-06  9.700e-06  -0.942
## `urine output`:`sp o2`                    -1.714e-05  7.012e-05  -0.244
## `urea nitrogen`:`blood calcium`            4.294e-03  1.140e-02   0.377
## `urea nitrogen`:`lactic acid`             -1.128e-02  8.374e-03  -1.347
## `urea nitrogen`:pco2                       5.577e-04  6.959e-04   0.801
## `urea nitrogen`:`systolic blood pressure`  7.604e-04  4.200e-04   1.811
## `urea nitrogen`:leucocyte                  3.731e-03  1.274e-03   2.928
## `urea nitrogen`:age                        1.254e-03  5.657e-04   2.216
## `urea nitrogen`:`sp o2`                   -9.452e-05  3.001e-03  -0.031
## `blood calcium`:`lactic acid`              1.587e-01  2.931e-01   0.541
## `blood calcium`:pco2                       2.164e-02  3.232e-02   0.670
## `blood calcium`:`systolic blood pressure` -2.138e-02  1.792e-02  -1.193
## `blood calcium`:leucocyte                 -2.938e-02  4.422e-02  -0.664
## `blood calcium`:age                       -1.378e-03  2.113e-02  -0.065
## `blood calcium`:`sp o2`                    1.092e-01  1.140e-01   0.958
## `lactic acid`:pco2                         1.034e-02  2.307e-02   0.448
## `lactic acid`:`systolic blood pressure`   -2.032e-02  1.365e-02  -1.489
## `lactic acid`:leucocyte                   -2.663e-02  2.336e-02  -1.140
## `lactic acid`:age                          6.374e-03  1.331e-02   0.479
## `lactic acid`:`sp o2`                      1.595e-03  7.536e-02   0.021
## pco2:`systolic blood pressure`             1.110e-04  1.189e-03   0.093
## pco2:leucocyte                            -2.953e-03  3.771e-03  -0.783
## pco2:age                                  -4.350e-04  1.333e-03  -0.326
## pco2:`sp o2`                               9.000e-03  8.813e-03   1.021
## `systolic blood pressure`:leucocyte        1.146e-03  1.728e-03   0.663
## `systolic blood pressure`:age             -7.252e-05  7.217e-04  -0.100
## `systolic blood pressure`:`sp o2`          6.027e-03  4.421e-03   1.363
## leucocyte:age                             -1.547e-03  2.037e-03  -0.760
## leucocyte:`sp o2`                         -2.382e-03  1.351e-02  -0.176
## age:`sp o2`                                2.868e-03  5.506e-03   0.521
##                                           Pr(>|z|)   
## (Intercept)                                0.15818   
## bicarbonate                                0.48479   
## `urine output`                             0.93098   
## `urea nitrogen`                            0.46176   
## `blood calcium`                            0.55240   
## `lactic acid`                              0.70472   
## pco2                                       0.30858   
## `systolic blood pressure`                  0.30355   
## leucocyte                                  0.74702   
## age                                        0.61769   
## `sp o2`                                    0.09183 . 
## bicarbonate:`urine output`                 0.74537   
## bicarbonate:`urea nitrogen`                0.98890   
## bicarbonate:`blood calcium`                0.18935   
## bicarbonate:`lactic acid`                  0.11206   
## bicarbonate:pco2                           0.72909   
## bicarbonate:`systolic blood pressure`      0.47022   
## bicarbonate:leucocyte                      0.77605   
## bicarbonate:age                            0.56549   
## bicarbonate:`sp o2`                        0.56349   
## `urine output`:`urea nitrogen`             0.82244   
## `urine output`:`blood calcium`             0.90036   
## `urine output`:`lactic acid`               0.29395   
## `urine output`:pco2                        0.73865   
## `urine output`:`systolic blood pressure`   0.36720   
## `urine output`:leucocyte                   0.41968   
## `urine output`:age                         0.34631   
## `urine output`:`sp o2`                     0.80688   
## `urea nitrogen`:`blood calcium`            0.70642   
## `urea nitrogen`:`lactic acid`              0.17810   
## `urea nitrogen`:pco2                       0.42288   
## `urea nitrogen`:`systolic blood pressure`  0.07017 . 
## `urea nitrogen`:leucocyte                  0.00341 **
## `urea nitrogen`:age                        0.02669 * 
## `urea nitrogen`:`sp o2`                    0.97487   
## `blood calcium`:`lactic acid`              0.58819   
## `blood calcium`:pco2                       0.50306   
## `blood calcium`:`systolic blood pressure`  0.23276   
## `blood calcium`:leucocyte                  0.50643   
## `blood calcium`:age                        0.94801   
## `blood calcium`:`sp o2`                    0.33788   
## `lactic acid`:pco2                         0.65392   
## `lactic acid`:`systolic blood pressure`    0.13652   
## `lactic acid`:leucocyte                    0.25418   
## `lactic acid`:age                          0.63213   
## `lactic acid`:`sp o2`                      0.98311   
## pco2:`systolic blood pressure`             0.92563   
## pco2:leucocyte                             0.43364   
## pco2:age                                   0.74419   
## pco2:`sp o2`                               0.30713   
## `systolic blood pressure`:leucocyte        0.50710   
## `systolic blood pressure`:age              0.91996   
## `systolic blood pressure`:`sp o2`          0.17276   
## leucocyte:age                              0.44751   
## leucocyte:`sp o2`                          0.86007   
## age:`sp o2`                                0.60252   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 640.10  on 823  degrees of freedom
## Residual deviance: 436.28  on 768  degrees of freedom
## AIC: 548.28
## 
## Number of Fisher Scoring iterations: 6
tab_model(modelo_10_interacciones, transform = "exp")
  died
Predictors Odds Ratios CI p
(Intercept) 269243483750122642804066862486284240224666648466804086608088646644462804004.00 0.00 – 301379804203753591924486064486868820848886642666862240808866466402062262266840624884048040624246024220800042880840802648028426244240004006220844482004204200884060424448824866602684.00 0.158
bicarbonate 4.95 0.05 – 399.48 0.485
urine output 1.00 0.99 – 1.02 0.931
urea nitrogen 0.78 0.41 – 1.51 0.462
blood calcium 0.00 0.00 – 2728182.97 0.552
lactic acid 22.69 0.00 – 574751078.65 0.705
pco2 0.37 0.06 – 2.59 0.309
systolic blood pressure 0.61 0.24 – 1.56 0.304
leucocyte 1.59 0.10 – 29.92 0.747
age 0.74 0.23 – 2.44 0.618
sp o2 0.14 0.01 – 1.28 0.092
bicarbonate × urine
output 		1.00 1.00 – 1.00 0.745
bicarbonate × urea
nitrogen 		1.00 1.00 – 1.00 0.989
bicarbonate × blood
calcium 		0.90 0.77 – 1.05 0.189
bicarbonate × lactic acid 0.91 0.81 – 1.01 0.112
bicarbonate × pco2 1.00 1.00 – 1.01 0.729
bicarbonate × systolic
blood pressure 		1.00 1.00 – 1.01 0.470
bicarbonate × leucocyte 1.00 0.99 – 1.02 0.776
bicarbonate × age 1.00 0.99 – 1.01 0.565
bicarbonate × sp o2 0.99 0.95 – 1.03 0.563
urine output × urea
nitrogen 		1.00 1.00 – 1.00 0.822
urine output × blood
calcium 		1.00 1.00 – 1.00 0.900
urine output × lactic
acid 		1.00 1.00 – 1.00 0.294
urine output × pco2 1.00 1.00 – 1.00 0.739
urine output × systolic
blood pressure 		1.00 1.00 – 1.00 0.367
urine output × leucocyte 1.00 1.00 – 1.00 0.420
urine output × age 1.00 1.00 – 1.00 0.346
urine output × sp o2 1.00 1.00 – 1.00 0.807
urea nitrogen × blood
calcium 		1.00 0.98 – 1.03 0.706
urea nitrogen × lactic
acid 		0.99 0.97 – 1.01 0.178
urea nitrogen × pco2 1.00 1.00 – 1.00 0.423
urea nitrogen × systolic
blood pressure 		1.00 1.00 – 1.00 0.070
urea nitrogen × leucocyte 1.00 1.00 – 1.01 0.003
urea nitrogen × age 1.00 1.00 – 1.00 0.027
urea nitrogen × sp o2 1.00 0.99 – 1.01 0.975
blood calcium × lactic
acid 		1.17 0.65 – 2.08 0.588
blood calcium × pco2 1.02 0.96 – 1.09 0.503
blood calcium × systolic
blood pressure 		0.98 0.94 – 1.01 0.233
blood calcium × leucocyte 0.97 0.89 – 1.06 0.506
blood calcium × age 1.00 0.96 – 1.04 0.948
blood calcium × sp o2 1.12 0.91 – 1.41 0.338
lactic acid × pco2 1.01 0.97 – 1.06 0.654
lactic acid × systolic
blood pressure 		0.98 0.95 – 1.01 0.137
lactic acid × leucocyte 0.97 0.93 – 1.02 0.254
lactic acid × age 1.01 0.98 – 1.03 0.632
lactic acid × sp o2 1.00 0.86 – 1.16 0.983
pco2 × systolic blood
pressure 		1.00 1.00 – 1.00 0.926
pco2 × leucocyte 1.00 0.99 – 1.00 0.434
pco2 × age 1.00 1.00 – 1.00 0.744
pco2 × sp o2 1.01 0.99 – 1.03 0.307
systolic blood pressure ×
leucocyte 		1.00 1.00 – 1.00 0.507
systolic blood pressure ×
age 		1.00 1.00 – 1.00 0.920
systolic blood pressure ×
sp o2 		1.01 1.00 – 1.01 0.173
leucocyte × age 1.00 0.99 – 1.00 0.448
leucocyte × sp o2 1.00 0.97 – 1.02 0.860
age × sp o2 1.00 0.99 – 1.01 0.603
Observations 824
R2 Tjur 0.314 
coef_table <- summary(modelo_10_interacciones)$coefficients
signif_terms <- coef_table[coef_table[,4] < 0.05, ]
signif_terms
##                              Estimate   Std. Error  z value    Pr(>|z|)
## `urea nitrogen`:leucocyte 0.003730583 0.0012740373 2.928158 0.003409766
## `urea nitrogen`:age       0.001253503 0.0005656632 2.215989 0.026692283

10 Término de interacción.

modelo_10_int <- glm(died ~ bicarbonate + `urine output` + `urea nitrogen` + `blood calcium` + `lactic acid` + pco2 + `systolic blood pressure` + leucocyte +  + `sp o2` + age + `urea nitrogen`:age, data = data, family = binomial)

t<-tab_model(modelo_10_int, 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) 
## Warning: Looks like you are using syntactically invalid variable names, quoted in
##   backticks: `urea nitrogen`. This may result in unexpected behaviour.
##   Please rename your variables (e.g., `urea.nitrogen` instead of `urea
##   nitrogen`) and fit the model again.
## Warning: Looks like you are using syntactically invalid variable names, quoted in
##   backticks: `urea nitrogen`. This may result in unexpected behaviour.
##   Please rename your variables (e.g., `urea.nitrogen` instead of `urea
##   nitrogen`) and fit the model again.
knitr::asis_output(t$knitr)
  died
Predictors Odds Ratios std. Error CI p
age 0.98 0.02 0.95 – 1.02 0.323
bicarbonate 0.85 0.03 0.78 – 0.91 <0.001
blood calcium 0.52 0.12 0.33 – 0.80 0.004
lactic acid 1.59 0.21 1.24 – 2.07 <0.001
leucocyte 1.06 0.02 1.02 – 1.11 0.004
pco2 1.05 0.02 1.02 – 1.09 <0.001
sp o2 0.87 0.05 0.78 – 0.97 0.014
systolic blood pressure 0.98 0.01 0.97 – 1.00 0.025
urea nitrogen 0.97 0.03 0.92 – 1.02 0.211
urea nitrogen:age 1.00 0.00 1.00 – 1.00 0.068
urine output 1.00 0.00 1.00 – 1.00 0.085
Observations 824
Deviance 478.591
log-Likelihood -239.296 
AIC(modelo_10_int)
## [1] 502.5912
vif(modelo_10_int)
## there are higher-order terms (interactions) in this model
## consider setting type = 'predictor'; see ?vif
##               bicarbonate            `urine output`           `urea nitrogen` 
##                  2.478103                  1.195688                 32.716695 
##           `blood calcium`             `lactic acid`                      pco2 
##                  1.179895                  1.159898                  2.279344 
## `systolic blood pressure`                 leucocyte                   `sp o2` 
##                  1.083333                  1.066502                  1.122877 
##                       age       `urea nitrogen`:age 
##                  3.273181                 35.224774
anova(modelo_10_int, test = "LRT")
## Analysis of Deviance Table
## 
## Model: binomial, link: logit
## 
## Response: died
## 
## Terms added sequentially (first to last)
## 
## 
##                           Df Deviance Resid. Df Resid. Dev  Pr(>Chi)    
## NULL                                        823     640.10              
## bicarbonate                1   59.735       822     580.37 1.085e-14 ***
## `urine output`             1   22.956       821     557.41 1.657e-06 ***
## `urea nitrogen`            1    7.686       820     549.73 0.0055661 ** 
## `blood calcium`            1   11.796       819     537.93 0.0005936 ***
## `lactic acid`              1   20.169       818     517.76 7.088e-06 ***
## pco2                       1   13.135       817     504.63 0.0002898 ***
## `systolic blood pressure`  1    6.704       816     497.92 0.0096203 ** 
## leucocyte                  1    7.930       815     489.99 0.0048625 ** 
## `sp o2`                    1    7.204       814     482.79 0.0072739 ** 
## age                        1    0.926       813     481.86 0.3358212    
## `urea nitrogen`:age        1    3.271       812     478.59 0.0705251 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Texto.

10. Modelo final.

Texto: modelo_10.

11. Evaluación del Modelo final.

11.1 Calibración.

pred_modelo <- as.data.frame(predict(modelo_10, data, type = "response")) %>% rename(pred = `predict(modelo_10, data, type = "response")`)

pred_modelo$verdad <- data$died

H_L <- HLtest(modelo_10,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 = died ~ bicarbonate + `urine output` + `urea nitrogen` + 
##     `blood calcium` + `lactic acid` + pco2 + `systolic blood pressure` + 
##     leucocyte + age + `sp o2`, family = binomial, data = data)
##  ChiSquare df   P_value
##   6.986609  8 0.5380781
HL_DF[,1:4]
##                 cut total obs      exp
## 1  [0.00266,0.0191]    83  82 82.05387
## 2   (0.0191,0.0294]    82  78 80.00965
## 3   (0.0294,0.0391]    82  80 79.17369
## 4    (0.0391,0.052]    83  81 79.18877
## 5    (0.052,0.0685]    82  80 77.11997
## 6   (0.0685,0.0909]    82  75 75.54573
## 7    (0.0909,0.126]    83  74 74.03713
## 8     (0.126,0.189]    82  65 69.33365
## 9     (0.189,0.308]    82  64 62.55696
## 10    (0.308,0.984]    83  37 36.98058
HL_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.00266,0.0191] 83 82 82.05387 -0.0059471 1
(0.0191,0.0294] 82 78 80.00965 -0.2246720 2
(0.0294,0.0391] 82 80 79.17369 0.0928650 3
(0.0391,0.052] 83 81 79.18877 0.2035365 4
(0.052,0.0685] 82 80 77.11997 0.3279549 5
(0.0685,0.0909] 82 75 75.54573 -0.0627877 6
(0.0909,0.126] 83 74 74.03713 -0.0043156 7
(0.126,0.189] 82 65 69.33365 -0.5204532 8
(0.189,0.308] 82 64 62.55696 0.1824492 9
(0.308,0.984] 83 37 36.98058 0.0031926 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"))

Texto.

pred_modelo$verdad <- as.numeric(as.character(pred_modelo$verdad))

a <- valProbggplot(pred_modelo$pred, pred_modelo$verdad)
a$ggPlot

a$Calibration
## $Intercept
##         Point estimate Lower confidence limit Upper confidence limit 
##           2.067636e-14          -2.336778e-01           2.336778e-01 
## 
## $Slope
##                Point estimate  Lower confidence limit.2.5 % 
##                     1.0000000                     0.8100442 
## Upper confidence limit.97.5 % 
##                     1.1899558

Texto.

11.2 Discriminación.

roc<-roc(pred_modelo$verdad, pred_modelo$pred)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
plot(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.7833-0.8709 (DeLong)

Texto.

11.3 Características operativas (chunk: Diego Halac).

Matriz de confusión.

pred_modelo <- pred_modelo %>% dplyr::mutate(prediccion = ifelse(pred > 0.13, 1,0))

tab <- tab_xtab(pred_modelo$prediccion, pred_modelo$verdad ,tdcol.row = "black",tdcol.n = "black", title = "Matriz de Confusion - cutoff = 0.13") 

knitr::asis_output(tab$knitr)
Matriz de Confusion - cutoff = 0.13
prediccion verdad Total
0 1
0 556 27 583
1 160 81 241
Total 716 108 824
χ2=123.197 · df=1 · &phi=0.391 · p=0.000 
cat("Sensibilidad:", paste0(round(caret::sensitivity(factor(pred_modelo$verdad), factor(pred_modelo$prediccion)),2)))
## Sensibilidad: 0.95
cat("Especificidad:", paste0(round(caret::specificity(factor(pred_modelo$verdad), factor(pred_modelo$prediccion)),2)))
## Especificidad: 0.34

Matriz de sensibilidad.

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.0013966 0.0031825
1.0000000 0.0027933 0.0038189
1.0000000 0.0041899 0.0039569
1.0000000 0.0055866 0.0040128
1.0000000 0.0069832 0.0044146
1.0000000 0.0083799 0.0048193
1.0000000 0.0097765 0.0048830
1.0000000 0.0111732 0.0049579
1.0000000 0.0125698 0.0050853
1.0000000 0.0139665 0.0057308
1.0000000 0.0153631 0.0063005
1.0000000 0.0167598 0.0063687
1.0000000 0.0181564 0.0064479
1.0000000 0.0195531 0.0066081
1.0000000 0.0209497 0.0068531
1.0000000 0.0223464 0.0069753
1.0000000 0.0237430 0.0070277
1.0000000 0.0251397 0.0070640
1.0000000 0.0265363 0.0070922
1.0000000 0.0279330 0.0071229
1.0000000 0.0293296 0.0071982
1.0000000 0.0307263 0.0073793
1.0000000 0.0321229 0.0075830
1.0000000 0.0335196 0.0078075
1.0000000 0.0349162 0.0083567
1.0000000 0.0363128 0.0088457
1.0000000 0.0377095 0.0091914
1.0000000 0.0391061 0.0095123
1.0000000 0.0405028 0.0095956
1.0000000 0.0418994 0.0096672
1.0000000 0.0432961 0.0097454
1.0000000 0.0446927 0.0098440
1.0000000 0.0460894 0.0100643
1.0000000 0.0474860 0.0103463
1.0000000 0.0488827 0.0104682
1.0000000 0.0502793 0.0105640
1.0000000 0.0516760 0.0106764
1.0000000 0.0530726 0.0108454
1.0000000 0.0544693 0.0111716
1.0000000 0.0558659 0.0113694
1.0000000 0.0572626 0.0115513
1.0000000 0.0586592 0.0117770
1.0000000 0.0600559 0.0118566
1.0000000 0.0614525 0.0119386
1.0000000 0.0628492 0.0121007
1.0000000 0.0642458 0.0122745
1.0000000 0.0656425 0.0124319
1.0000000 0.0670391 0.0126243
1.0000000 0.0684358 0.0129224
1.0000000 0.0698324 0.0131223
1.0000000 0.0712291 0.0133976
1.0000000 0.0726257 0.0136632
1.0000000 0.0740223 0.0137121
1.0000000 0.0754190 0.0137734
1.0000000 0.0768156 0.0138532
1.0000000 0.0782123 0.0140015
1.0000000 0.0796089 0.0141009
1.0000000 0.0810056 0.0141358
1.0000000 0.0824022 0.0143260
1.0000000 0.0837989 0.0145039
1.0000000 0.0851955 0.0146527
1.0000000 0.0865922 0.0149048
1.0000000 0.0879888 0.0151872
1.0000000 0.0893855 0.0155958
1.0000000 0.0907821 0.0158761
1.0000000 0.0921788 0.0159320
0.9907407 0.0921788 0.0159604
0.9907407 0.0935754 0.0159985
0.9907407 0.0949721 0.0163132
0.9907407 0.0963687 0.0167051
0.9907407 0.0977654 0.0168288
0.9907407 0.0991620 0.0168767
0.9907407 0.1005587 0.0169301
0.9907407 0.1019553 0.0171183
0.9907407 0.1033520 0.0173500
0.9907407 0.1047486 0.0174483
0.9907407 0.1061453 0.0176428
0.9907407 0.1075419 0.0178292
0.9907407 0.1089385 0.0182863
0.9907407 0.1103352 0.0188257
0.9907407 0.1117318 0.0189705
0.9907407 0.1131285 0.0190271
0.9907407 0.1145251 0.0191049
0.9907407 0.1159218 0.0192782
0.9907407 0.1173184 0.0193876
0.9907407 0.1187151 0.0193912
0.9907407 0.1201117 0.0194216
0.9907407 0.1215084 0.0194522
0.9907407 0.1229050 0.0194934
0.9907407 0.1243017 0.0195894
0.9907407 0.1256983 0.0197972
0.9907407 0.1270950 0.0201319
0.9907407 0.1284916 0.0203222
0.9907407 0.1298883 0.0204322
0.9907407 0.1312849 0.0205821
0.9907407 0.1326816 0.0207405
0.9814815 0.1326816 0.0208758
0.9814815 0.1340782 0.0209313
0.9814815 0.1354749 0.0210590
0.9722222 0.1354749 0.0211717
0.9722222 0.1368715 0.0212216
0.9722222 0.1382682 0.0213046
0.9629630 0.1382682 0.0214274
0.9629630 0.1396648 0.0215388
0.9629630 0.1410615 0.0217689
0.9629630 0.1424581 0.0220774
0.9629630 0.1438547 0.0221970
0.9629630 0.1452514 0.0222212
0.9629630 0.1466480 0.0223881
0.9629630 0.1480447 0.0226072
0.9629630 0.1494413 0.0226821
0.9629630 0.1508380 0.0227288
0.9629630 0.1522346 0.0228762
0.9629630 0.1536313 0.0232654
0.9629630 0.1550279 0.0236337
0.9629630 0.1564246 0.0237185
0.9629630 0.1578212 0.0239379
0.9629630 0.1592179 0.0241580
0.9629630 0.1606145 0.0241643
0.9629630 0.1620112 0.0241939
0.9629630 0.1634078 0.0243318
0.9629630 0.1648045 0.0244779
0.9629630 0.1662011 0.0245486
0.9629630 0.1675978 0.0246056
0.9629630 0.1689944 0.0247034
0.9629630 0.1703911 0.0247806
0.9629630 0.1717877 0.0248355
0.9629630 0.1731844 0.0250012
0.9629630 0.1745810 0.0251302
0.9629630 0.1759777 0.0252089
0.9629630 0.1773743 0.0253965
0.9629630 0.1787709 0.0255325
0.9629630 0.1801676 0.0255587
0.9629630 0.1815642 0.0256285
0.9629630 0.1829609 0.0257527
0.9629630 0.1843575 0.0258443
0.9629630 0.1857542 0.0258866
0.9629630 0.1871508 0.0259339
0.9629630 0.1885475 0.0259608
0.9629630 0.1899441 0.0259791
0.9629630 0.1913408 0.0260136
0.9629630 0.1927374 0.0260385
0.9629630 0.1941341 0.0262106
0.9629630 0.1955307 0.0265818
0.9629630 0.1969274 0.0268195
0.9629630 0.1983240 0.0268832
0.9629630 0.1997207 0.0271027
0.9629630 0.2011173 0.0273466
0.9629630 0.2025140 0.0274162
0.9629630 0.2039106 0.0274443
0.9629630 0.2053073 0.0275204
0.9629630 0.2067039 0.0275890
0.9629630 0.2081006 0.0276894
0.9629630 0.2094972 0.0279372
0.9537037 0.2094972 0.0280939
0.9537037 0.2108939 0.0281881
0.9537037 0.2122905 0.0283624
0.9537037 0.2136872 0.0285267
0.9537037 0.2150838 0.0286304
0.9537037 0.2164804 0.0286627
0.9537037 0.2178771 0.0288010
0.9537037 0.2192737 0.0289467
0.9537037 0.2206704 0.0289967
0.9537037 0.2220670 0.0291058
0.9537037 0.2234637 0.0293232
0.9537037 0.2248603 0.0295240
0.9537037 0.2262570 0.0295918
0.9537037 0.2276536 0.0296035
0.9537037 0.2290503 0.0296168
0.9537037 0.2304469 0.0296252
0.9537037 0.2318436 0.0296659
0.9537037 0.2332402 0.0298168
0.9537037 0.2346369 0.0299722
0.9537037 0.2360335 0.0300220
0.9537037 0.2374302 0.0300601
0.9537037 0.2388268 0.0303464
0.9537037 0.2402235 0.0306374
0.9537037 0.2416201 0.0307480
0.9537037 0.2430168 0.0308288
0.9537037 0.2444134 0.0308669
0.9537037 0.2458101 0.0309827
0.9444444 0.2458101 0.0311139
0.9444444 0.2472067 0.0312160
0.9444444 0.2486034 0.0314336
0.9444444 0.2500000 0.0316030
0.9444444 0.2513966 0.0316282
0.9444444 0.2527933 0.0318478
0.9444444 0.2541899 0.0322118
0.9444444 0.2555866 0.0324750
0.9444444 0.2569832 0.0325821
0.9444444 0.2583799 0.0326014
0.9444444 0.2597765 0.0326691
0.9444444 0.2611732 0.0327379
0.9444444 0.2625698 0.0329007
0.9444444 0.2639665 0.0330653
0.9444444 0.2653631 0.0331370
0.9444444 0.2667598 0.0331921
0.9444444 0.2681564 0.0336953
0.9444444 0.2695531 0.0342718
0.9444444 0.2709497 0.0343482
0.9444444 0.2723464 0.0343591
0.9444444 0.2737430 0.0343819
0.9444444 0.2751397 0.0344126
0.9444444 0.2765363 0.0345094
0.9444444 0.2779330 0.0345944
0.9444444 0.2793296 0.0346467
0.9444444 0.2807263 0.0347336
0.9444444 0.2821229 0.0347840
0.9444444 0.2835196 0.0347960
0.9444444 0.2849162 0.0348054
0.9444444 0.2863128 0.0348528
0.9444444 0.2877095 0.0349362
0.9444444 0.2891061 0.0350788
0.9444444 0.2905028 0.0352685
0.9444444 0.2918994 0.0353697
0.9444444 0.2932961 0.0357764
0.9444444 0.2946927 0.0364037
0.9444444 0.2960894 0.0367807
0.9444444 0.2974860 0.0369543
0.9444444 0.2988827 0.0369851
0.9444444 0.3002793 0.0370157
0.9444444 0.3016760 0.0371598
0.9444444 0.3030726 0.0373052
0.9444444 0.3044693 0.0373730
0.9444444 0.3058659 0.0374545
0.9444444 0.3072626 0.0375073
0.9444444 0.3086592 0.0375308
0.9444444 0.3100559 0.0375662
0.9444444 0.3114525 0.0375976
0.9444444 0.3128492 0.0376676
0.9444444 0.3142458 0.0378038
0.9444444 0.3156425 0.0378977
0.9444444 0.3170391 0.0379242
0.9444444 0.3184358 0.0379817
0.9444444 0.3198324 0.0380390
0.9444444 0.3212291 0.0380487
0.9444444 0.3226257 0.0380699
0.9444444 0.3240223 0.0381073
0.9351852 0.3240223 0.0381444
0.9351852 0.3254190 0.0383147
0.9351852 0.3268156 0.0385379
0.9351852 0.3282123 0.0386104
0.9351852 0.3296089 0.0386431
0.9351852 0.3310056 0.0387586
0.9351852 0.3324022 0.0389119
0.9351852 0.3337989 0.0390144
0.9351852 0.3351955 0.0390742
0.9351852 0.3365922 0.0391013
0.9351852 0.3379888 0.0392270
0.9351852 0.3393855 0.0394219
0.9351852 0.3407821 0.0395437
0.9351852 0.3421788 0.0396172
0.9351852 0.3435754 0.0396676
0.9351852 0.3449721 0.0397769
0.9351852 0.3463687 0.0399359
0.9351852 0.3477654 0.0400947
0.9351852 0.3491620 0.0403270
0.9351852 0.3505587 0.0406444
0.9351852 0.3519553 0.0408824
0.9351852 0.3533520 0.0410130
0.9351852 0.3547486 0.0412494
0.9351852 0.3561453 0.0414614
0.9351852 0.3575419 0.0415731
0.9351852 0.3589385 0.0419877
0.9351852 0.3603352 0.0423421
0.9351852 0.3617318 0.0423823
0.9351852 0.3631285 0.0425577
0.9351852 0.3645251 0.0427321
0.9351852 0.3659218 0.0427900
0.9351852 0.3673184 0.0428635
0.9351852 0.3687151 0.0429528
0.9351852 0.3701117 0.0430924
0.9351852 0.3715084 0.0433633
0.9351852 0.3729050 0.0435706
0.9351852 0.3743017 0.0436045
0.9351852 0.3756983 0.0436719
0.9259259 0.3756983 0.0437612
0.9259259 0.3770950 0.0441995
0.9259259 0.3784916 0.0447639
0.9259259 0.3798883 0.0450628
0.9259259 0.3812849 0.0452146
0.9259259 0.3826816 0.0452727
0.9259259 0.3840782 0.0453288
0.9259259 0.3854749 0.0454000
0.9259259 0.3868715 0.0455036
0.9259259 0.3882682 0.0455607
0.9166667 0.3882682 0.0456503
0.9166667 0.3896648 0.0457395
0.9166667 0.3910615 0.0459624
0.9166667 0.3924581 0.0461907
0.9166667 0.3938547 0.0462509
0.9166667 0.3952514 0.0464225
0.9166667 0.3966480 0.0465797
0.9166667 0.3980447 0.0467484
0.9166667 0.3994413 0.0470474
0.9166667 0.4008380 0.0472305
0.9166667 0.4022346 0.0472779
0.9166667 0.4036313 0.0474182
0.9166667 0.4050279 0.0475868
0.9166667 0.4064246 0.0478920
0.9166667 0.4078212 0.0481614
0.9166667 0.4092179 0.0483042
0.9166667 0.4106145 0.0484977
0.9166667 0.4120112 0.0486596
0.9166667 0.4134078 0.0489331
0.9166667 0.4148045 0.0491690
0.9166667 0.4162011 0.0493094
0.9166667 0.4175978 0.0493970
0.9166667 0.4189944 0.0496615
0.9166667 0.4203911 0.0499744
0.9166667 0.4217877 0.0500641
0.9166667 0.4231844 0.0502243
0.9166667 0.4245810 0.0504089
0.9166667 0.4259777 0.0504682
0.9166667 0.4273743 0.0505216
0.9166667 0.4287709 0.0506764
0.9166667 0.4301676 0.0508434
0.9166667 0.4315642 0.0509280
0.9166667 0.4329609 0.0509913
0.9166667 0.4343575 0.0510391
0.9166667 0.4357542 0.0511598
0.9166667 0.4371508 0.0513318
0.9166667 0.4385475 0.0514160
0.9166667 0.4399441 0.0514526
0.9166667 0.4413408 0.0514712
0.9166667 0.4427374 0.0516065
0.9166667 0.4441341 0.0517685
0.9166667 0.4455307 0.0518239
0.9166667 0.4469274 0.0519138
0.9166667 0.4483240 0.0521192
0.9166667 0.4497207 0.0523131
0.9166667 0.4511173 0.0525973
0.9166667 0.4525140 0.0528331
0.9166667 0.4539106 0.0528494
0.9166667 0.4553073 0.0529568
0.9166667 0.4567039 0.0530864
0.9166667 0.4581006 0.0532787
0.9166667 0.4594972 0.0534583
0.9166667 0.4608939 0.0535536
0.9166667 0.4622905 0.0536709
0.9166667 0.4636872 0.0538100
0.9166667 0.4650838 0.0539371
0.9166667 0.4664804 0.0539970
0.9166667 0.4678771 0.0540600
0.9166667 0.4692737 0.0541314
0.9166667 0.4706704 0.0542972
0.9166667 0.4720670 0.0544642
0.9166667 0.4734637 0.0546367
0.9166667 0.4748603 0.0549395
0.9166667 0.4762570 0.0553535
0.9166667 0.4776536 0.0556956
0.9166667 0.4790503 0.0558553
0.9166667 0.4804469 0.0559217
0.9166667 0.4818436 0.0559757
0.9166667 0.4832402 0.0561358
0.9166667 0.4846369 0.0562665
0.9166667 0.4860335 0.0562829
0.9074074 0.4860335 0.0564343
0.9074074 0.4874302 0.0565975
0.9074074 0.4888268 0.0566118
0.9074074 0.4902235 0.0566430
0.9074074 0.4916201 0.0570130
0.9074074 0.4930168 0.0574943
0.9074074 0.4944134 0.0576520
0.9074074 0.4958101 0.0578296
0.9074074 0.4972067 0.0580120
0.9074074 0.4986034 0.0581281
0.9074074 0.5000000 0.0582606
0.9074074 0.5013966 0.0583890
0.9074074 0.5027933 0.0586150
0.9074074 0.5041899 0.0588584
0.9074074 0.5055866 0.0589921
0.9074074 0.5069832 0.0590378
0.9074074 0.5083799 0.0595620
0.9074074 0.5097765 0.0600860
0.9074074 0.5111732 0.0601767
0.9074074 0.5125698 0.0604444
0.9074074 0.5139665 0.0606879
0.9074074 0.5153631 0.0609267
0.9074074 0.5167598 0.0613101
0.9074074 0.5181564 0.0616076
0.9074074 0.5195531 0.0618011
0.9074074 0.5209497 0.0619646
0.9074074 0.5223464 0.0621860
0.9074074 0.5237430 0.0624912
0.9074074 0.5251397 0.0627310
0.9074074 0.5265363 0.0629552
0.9074074 0.5279330 0.0632300
0.9074074 0.5293296 0.0633947
0.9074074 0.5307263 0.0634652
0.9074074 0.5321229 0.0636073
0.9074074 0.5335196 0.0637838
0.9074074 0.5349162 0.0638821
0.9074074 0.5363128 0.0640773
0.9074074 0.5377095 0.0642892
0.9074074 0.5391061 0.0644445
0.9074074 0.5405028 0.0646172
0.9074074 0.5418994 0.0647148
0.9074074 0.5432961 0.0647747
0.9074074 0.5446927 0.0648469
0.9074074 0.5460894 0.0651784
0.9074074 0.5474860 0.0655982
0.9074074 0.5488827 0.0658759
0.9074074 0.5502793 0.0662799
0.9074074 0.5516760 0.0666421
0.9074074 0.5530726 0.0667700
0.9074074 0.5544693 0.0674268
0.9074074 0.5558659 0.0681341
0.9074074 0.5572626 0.0682234
0.9074074 0.5586592 0.0682662
0.9074074 0.5600559 0.0683380
0.8981481 0.5600559 0.0684609
0.8888889 0.5600559 0.0686782
0.8888889 0.5614525 0.0691575
0.8888889 0.5628492 0.0695029
0.8796296 0.5628492 0.0695395
0.8796296 0.5642458 0.0696205
0.8796296 0.5656425 0.0696688
0.8796296 0.5670391 0.0696758
0.8796296 0.5684358 0.0696930
0.8796296 0.5698324 0.0699118
0.8796296 0.5712291 0.0701208
0.8796296 0.5726257 0.0702923
0.8796296 0.5740223 0.0704694
0.8796296 0.5754190 0.0706020
0.8796296 0.5768156 0.0707297
0.8796296 0.5782123 0.0707450
0.8796296 0.5796089 0.0713665
0.8796296 0.5810056 0.0722140
0.8796296 0.5824022 0.0725831
0.8796296 0.5837989 0.0728100
0.8796296 0.5851955 0.0729302
0.8796296 0.5865922 0.0732329
0.8796296 0.5879888 0.0735122
0.8796296 0.5893855 0.0735610
0.8796296 0.5907821 0.0736328
0.8796296 0.5921788 0.0738373
0.8796296 0.5935754 0.0741748
0.8796296 0.5949721 0.0744054
0.8796296 0.5963687 0.0744959
0.8796296 0.5977654 0.0745473
0.8796296 0.5991620 0.0746662
0.8796296 0.6005587 0.0747736
0.8796296 0.6019553 0.0749464
0.8796296 0.6033520 0.0752942
0.8796296 0.6047486 0.0756752
0.8796296 0.6061453 0.0759504
0.8796296 0.6075419 0.0761573
0.8796296 0.6089385 0.0765787
0.8796296 0.6103352 0.0770616
0.8796296 0.6117318 0.0773741
0.8703704 0.6117318 0.0776875
0.8703704 0.6131285 0.0779546
0.8703704 0.6145251 0.0781027
0.8703704 0.6159218 0.0787918
0.8703704 0.6173184 0.0795321
0.8703704 0.6187151 0.0799273
0.8703704 0.6201117 0.0802615
0.8703704 0.6215084 0.0806363
0.8703704 0.6229050 0.0809921
0.8703704 0.6243017 0.0810499
0.8703704 0.6256983 0.0811502
0.8703704 0.6270950 0.0817710
0.8703704 0.6284916 0.0824910
0.8703704 0.6298883 0.0828632
0.8703704 0.6312849 0.0832874
0.8703704 0.6326816 0.0836019
0.8703704 0.6340782 0.0837011
0.8703704 0.6354749 0.0838503
0.8703704 0.6368715 0.0841572
0.8703704 0.6382682 0.0844756
0.8703704 0.6396648 0.0846337
0.8703704 0.6410615 0.0847397
0.8703704 0.6424581 0.0848660
0.8611111 0.6424581 0.0849872
0.8611111 0.6438547 0.0852355
0.8518519 0.6438547 0.0855727
0.8518519 0.6452514 0.0858839
0.8518519 0.6466480 0.0860253
0.8518519 0.6480447 0.0861065
0.8518519 0.6494413 0.0861888
0.8518519 0.6508380 0.0864161
0.8425926 0.6508380 0.0867869
0.8425926 0.6522346 0.0869554
0.8425926 0.6536313 0.0871298
0.8425926 0.6550279 0.0873829
0.8425926 0.6564246 0.0878774
0.8333333 0.6564246 0.0883262
0.8333333 0.6578212 0.0884969
0.8333333 0.6592179 0.0892907
0.8333333 0.6606145 0.0901739
0.8333333 0.6620112 0.0904217
0.8333333 0.6634078 0.0906260
0.8333333 0.6648045 0.0908695
0.8333333 0.6662011 0.0911154
0.8333333 0.6675978 0.0913501
0.8333333 0.6689944 0.0917547
0.8333333 0.6703911 0.0923210
0.8333333 0.6717877 0.0926503
0.8333333 0.6731844 0.0927765
0.8333333 0.6745810 0.0928342
0.8333333 0.6759777 0.0931307
0.8240741 0.6759777 0.0935037
0.8240741 0.6773743 0.0936360
0.8240741 0.6787709 0.0939762
0.8240741 0.6801676 0.0945373
0.8240741 0.6815642 0.0948570
0.8240741 0.6829609 0.0953215
0.8240741 0.6843575 0.0959154
0.8240741 0.6857542 0.0962507
0.8240741 0.6871508 0.0966905
0.8240741 0.6885475 0.0971365
0.8240741 0.6899441 0.0975427
0.8240741 0.6913408 0.0980481
0.8240741 0.6927374 0.0982828
0.8240741 0.6941341 0.0984950
0.8240741 0.6955307 0.0989465
0.8240741 0.6969274 0.0995859
0.8240741 0.6983240 0.1004816
0.8240741 0.6997207 0.1010760
0.8240741 0.7011173 0.1016792
0.8240741 0.7025140 0.1025677
0.8240741 0.7039106 0.1030415
0.8240741 0.7053073 0.1033679
0.8240741 0.7067039 0.1036023
0.8240741 0.7081006 0.1037176
0.8240741 0.7094972 0.1046576
0.8240741 0.7108939 0.1064553
0.8148148 0.7108939 0.1074742
0.8148148 0.7122905 0.1078276
0.8148148 0.7136872 0.1082000
0.8148148 0.7150838 0.1084244
0.8148148 0.7164804 0.1086568
0.8148148 0.7178771 0.1087362
0.8148148 0.7192737 0.1088499
0.8148148 0.7206704 0.1091051
0.8148148 0.7220670 0.1092674
0.8148148 0.7234637 0.1093250
0.8148148 0.7248603 0.1104154
0.8148148 0.7262570 0.1114685
0.8148148 0.7276536 0.1114843
0.8148148 0.7290503 0.1116004
0.8148148 0.7304469 0.1118553
0.8148148 0.7318436 0.1120079
0.8148148 0.7332402 0.1122558
0.8148148 0.7346369 0.1125047
0.8148148 0.7360335 0.1125949
0.8148148 0.7374302 0.1128832
0.8055556 0.7374302 0.1135989
0.8055556 0.7388268 0.1144907
0.7962963 0.7388268 0.1148777
0.7962963 0.7402235 0.1149173
0.7962963 0.7416201 0.1153598
0.7962963 0.7430168 0.1158231
0.7962963 0.7444134 0.1160316
0.7870370 0.7444134 0.1163615
0.7870370 0.7458101 0.1166135
0.7870370 0.7472067 0.1173490
0.7870370 0.7486034 0.1180363
0.7870370 0.7500000 0.1182007
0.7870370 0.7513966 0.1185094
0.7777778 0.7513966 0.1188462
0.7777778 0.7527933 0.1191038
0.7777778 0.7541899 0.1195956
0.7777778 0.7555866 0.1201054
0.7777778 0.7569832 0.1203664
0.7777778 0.7583799 0.1206765
0.7685185 0.7583799 0.1212359
0.7685185 0.7597765 0.1218382
0.7685185 0.7611732 0.1220959
0.7685185 0.7625698 0.1222215
0.7592593 0.7625698 0.1224630
0.7500000 0.7625698 0.1237196
0.7500000 0.7639665 0.1248868
0.7500000 0.7653631 0.1252329
0.7500000 0.7667598 0.1256741
0.7500000 0.7681564 0.1268133
0.7500000 0.7695531 0.1279537
0.7500000 0.7709497 0.1282132
0.7500000 0.7723464 0.1284525
0.7500000 0.7737430 0.1286055
0.7500000 0.7751397 0.1286989
0.7500000 0.7765363 0.1296937
0.7500000 0.7779330 0.1306297
0.7500000 0.7793296 0.1321829
0.7407407 0.7793296 0.1340435
0.7407407 0.7807263 0.1344118
0.7407407 0.7821229 0.1347621
0.7407407 0.7835196 0.1351132
0.7407407 0.7849162 0.1356053
0.7314815 0.7849162 0.1363084
0.7222222 0.7849162 0.1365868
0.7222222 0.7863128 0.1366723
0.7222222 0.7877095 0.1370474
0.7222222 0.7891061 0.1376644
0.7222222 0.7905028 0.1382253
0.7222222 0.7918994 0.1385252
0.7129630 0.7918994 0.1386257
0.7037037 0.7918994 0.1387591
0.7037037 0.7932961 0.1388899
0.6944444 0.7932961 0.1395032
0.6851852 0.7932961 0.1400742
0.6759259 0.7932961 0.1401589
0.6759259 0.7946927 0.1410249
0.6759259 0.7960894 0.1419534
0.6759259 0.7974860 0.1427305
0.6759259 0.7988827 0.1434974
0.6759259 0.8002793 0.1436368
0.6666667 0.8002793 0.1438016
0.6666667 0.8016760 0.1445911
0.6666667 0.8030726 0.1457497
0.6666667 0.8044693 0.1464927
0.6666667 0.8058659 0.1477903
0.6666667 0.8072626 0.1492150
0.6666667 0.8086592 0.1503484
0.6666667 0.8100559 0.1513064
0.6666667 0.8114525 0.1516640
0.6666667 0.8128492 0.1522565
0.6666667 0.8142458 0.1540540
0.6574074 0.8142458 0.1555106
0.6574074 0.8156425 0.1558143
0.6574074 0.8170391 0.1569101
0.6574074 0.8184358 0.1578901
0.6574074 0.8198324 0.1580612
0.6574074 0.8212291 0.1584957
0.6481481 0.8212291 0.1592299
0.6481481 0.8226257 0.1601219
0.6481481 0.8240223 0.1606712
0.6481481 0.8254190 0.1618294
0.6481481 0.8268156 0.1633235
0.6481481 0.8282123 0.1637147
0.6481481 0.8296089 0.1639772
0.6481481 0.8310056 0.1647300
0.6481481 0.8324022 0.1654294
0.6481481 0.8337989 0.1660804
0.6481481 0.8351955 0.1678352
0.6388889 0.8351955 0.1694023
0.6388889 0.8365922 0.1700670
0.6388889 0.8379888 0.1711701
0.6388889 0.8393855 0.1725301
0.6388889 0.8407821 0.1735065
0.6296296 0.8407821 0.1744769
0.6296296 0.8421788 0.1752711
0.6296296 0.8435754 0.1754526
0.6203704 0.8435754 0.1756536
0.6203704 0.8449721 0.1758483
0.6203704 0.8463687 0.1759320
0.6203704 0.8477654 0.1764475
0.6203704 0.8491620 0.1771021
0.6203704 0.8505587 0.1781300
0.6111111 0.8505587 0.1795457
0.6018519 0.8505587 0.1807153
0.6018519 0.8519553 0.1820563
0.6018519 0.8533520 0.1828315
0.6018519 0.8547486 0.1838730
0.6018519 0.8561453 0.1863661
0.6018519 0.8575419 0.1878720
0.5925926 0.8575419 0.1885129
0.5925926 0.8589385 0.1893973
0.5925926 0.8603352 0.1898574
0.5925926 0.8617318 0.1900412
0.5925926 0.8631285 0.1901371
0.5925926 0.8645251 0.1906874
0.5925926 0.8659218 0.1914689
0.5925926 0.8673184 0.1925788
0.5833333 0.8673184 0.1937246
0.5833333 0.8687151 0.1941017
0.5833333 0.8701117 0.1943259
0.5740741 0.8701117 0.1948884
0.5648148 0.8701117 0.1962594
0.5648148 0.8715084 0.1973749
0.5648148 0.8729050 0.1976453
0.5555556 0.8729050 0.1979242
0.5462963 0.8729050 0.1984425
0.5462963 0.8743017 0.1995141
0.5462963 0.8756983 0.2002233
0.5462963 0.8770950 0.2022781
0.5462963 0.8784916 0.2044989
0.5462963 0.8798883 0.2048790
0.5462963 0.8812849 0.2052916
0.5462963 0.8826816 0.2066199
0.5462963 0.8840782 0.2079737
0.5462963 0.8854749 0.2083559
0.5462963 0.8868715 0.2085237
0.5370370 0.8868715 0.2103890
0.5370370 0.8882682 0.2127604
0.5370370 0.8896648 0.2133181
0.5370370 0.8910615 0.2135264
0.5277778 0.8910615 0.2145110
0.5277778 0.8924581 0.2159126
0.5277778 0.8938547 0.2166584
0.5185185 0.8938547 0.2174637
0.5185185 0.8952514 0.2187621
0.5185185 0.8966480 0.2207391
0.5185185 0.8980447 0.2228441
0.5185185 0.8994413 0.2243689
0.5092593 0.8994413 0.2261028
0.5000000 0.8994413 0.2285689
0.5000000 0.9008380 0.2306026
0.5000000 0.9022346 0.2331140
0.4907407 0.9022346 0.2363744
0.4907407 0.9036313 0.2378093
0.4907407 0.9050279 0.2384391
0.4814815 0.9050279 0.2394336
0.4722222 0.9050279 0.2400992
0.4722222 0.9064246 0.2403467
0.4722222 0.9078212 0.2408508
0.4722222 0.9092179 0.2433231
0.4722222 0.9106145 0.2462138
0.4722222 0.9120112 0.2487347
0.4722222 0.9134078 0.2516584
0.4722222 0.9148045 0.2535458
0.4629630 0.9148045 0.2552090
0.4629630 0.9162011 0.2571185
0.4629630 0.9175978 0.2583259
0.4629630 0.9189944 0.2599990
0.4537037 0.9189944 0.2614327
0.4537037 0.9203911 0.2623824
0.4537037 0.9217877 0.2646370
0.4537037 0.9231844 0.2663946
0.4537037 0.9245810 0.2671137
0.4537037 0.9259777 0.2676472
0.4537037 0.9273743 0.2692065
0.4537037 0.9287709 0.2729021
0.4537037 0.9301676 0.2754968
0.4537037 0.9315642 0.2757550
0.4537037 0.9329609 0.2762810
0.4537037 0.9343575 0.2779407
0.4537037 0.9357542 0.2805052
0.4537037 0.9371508 0.2830431
0.4537037 0.9385475 0.2846391
0.4537037 0.9399441 0.2855055
0.4537037 0.9413408 0.2870610
0.4444444 0.9413408 0.2899445
0.4444444 0.9427374 0.2958070
0.4351852 0.9427374 0.3002428
0.4351852 0.9441341 0.3035697
0.4259259 0.9441341 0.3067280
0.4259259 0.9455307 0.3072620
0.4259259 0.9469274 0.3078996
0.4259259 0.9483240 0.3082479
0.4166667 0.9483240 0.3086216
0.4074074 0.9483240 0.3091763
0.3981481 0.9483240 0.3108454
0.3888889 0.9483240 0.3139844
0.3796296 0.9483240 0.3167722
0.3703704 0.9483240 0.3202161
0.3703704 0.9497207 0.3231861
0.3703704 0.9511173 0.3258123
0.3611111 0.9511173 0.3299876
0.3611111 0.9525140 0.3353128
0.3518519 0.9525140 0.3403605
0.3425926 0.9525140 0.3424329
0.3425926 0.9539106 0.3448654
0.3425926 0.9553073 0.3473933
0.3333333 0.9553073 0.3479380
0.3240741 0.9553073 0.3565350
0.3240741 0.9567039 0.3689705
0.3148148 0.9567039 0.3774879
0.3148148 0.9581006 0.3846729
0.3148148 0.9594972 0.3888390
0.3148148 0.9608939 0.3905506
0.3148148 0.9622905 0.3911532
0.3148148 0.9636872 0.3955479
0.3148148 0.9650838 0.4018269
0.3148148 0.9664804 0.4043010
0.3148148 0.9678771 0.4093402
0.3148148 0.9692737 0.4163311
0.3148148 0.9706704 0.4226030
0.3148148 0.9720670 0.4272646
0.3148148 0.9734637 0.4294852
0.3148148 0.9748603 0.4313937
0.3148148 0.9762570 0.4359355
0.3055556 0.9762570 0.4404056
0.2962963 0.9762570 0.4418899
0.2962963 0.9776536 0.4441801
0.2962963 0.9790503 0.4515982
0.2962963 0.9804469 0.4641858
0.2962963 0.9818436 0.4716339
0.2870370 0.9818436 0.4735439
0.2777778 0.9818436 0.4789191
0.2685185 0.9818436 0.4882778
0.2685185 0.9832402 0.4955360
0.2685185 0.9846369 0.4983144
0.2592593 0.9846369 0.5081453
0.2592593 0.9860335 0.5179049
0.2592593 0.9874302 0.5198317
0.2592593 0.9888268 0.5319616
0.2592593 0.9902235 0.5590029
0.2592593 0.9916201 0.5829809
0.2500000 0.9916201 0.5956139
0.2500000 0.9930168 0.6106063
0.2407407 0.9930168 0.6202620
0.2407407 0.9944134 0.6225191
0.2314815 0.9944134 0.6291133
0.2314815 0.9958101 0.6352765
0.2314815 0.9972067 0.6395305
0.2222222 0.9972067 0.6516041
0.2129630 0.9972067 0.6624216
0.2129630 0.9986034 0.6713439
0.2037037 0.9986034 0.6802261
0.1944444 0.9986034 0.6867283
0.1851852 0.9986034 0.6973292
0.1759259 0.9986034 0.7045980
0.1666667 0.9986034 0.7220796
0.1574074 0.9986034 0.7393574
0.1481481 0.9986034 0.7446376
0.1388889 0.9986034 0.7504800
0.1296296 0.9986034 0.7776848
0.1203704 0.9986034 0.8040946
0.1111111 0.9986034 0.8110297
0.1018519 0.9986034 0.8166431
0.0925926 0.9986034 0.8232126
0.0833333 0.9986034 0.8442889
0.0740741 0.9986034 0.8723522
0.0648148 0.9986034 0.8862540
0.0555556 0.9986034 0.8901735
0.0462963 0.9986034 0.9028583
0.0370370 0.9986034 0.9177235
0.0277778 0.9986034 0.9315832
0.0277778 1.0000000 0.9544762
0.0185185 1.0000000 0.9762402
0.0092593 1.0000000 0.9835666
0.0000000 1.0000000 Inf

11.4 Características operativas (chunk: ChatGPT).

data$prob_modelo <- predict(modelo_10, type = "response")
data$pred_binaria <- ifelse(data$prob_modelo > 0.13, 1, 0)
data$pred_binaria <- relevel(factor(data$pred_binaria), ref = "1")
data$newchd <- relevel(factor(data$died), ref = "1")
crosstab(data$pred_binaria, data$died, prop.c = TRUE)

##    Cell Contents 
## |-------------------------|
## |                   Count | 
## |          Column Percent | 
## |-------------------------|
## 
## ==========================================
##                      data$died
## data$pred_binaria        0       1   Total
## ------------------------------------------
## 1                     160      81     241 
##                      22.3%   75.0%        
## ------------------------------------------
## 0                     556      27     583 
##                      77.7%   25.0%        
## ------------------------------------------
## Total                 716     108     824 
##                      86.9%   13.1%        
## ==========================================
tabla <- table(Predicho = data$pred_binaria, Real = data$died)

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")
Medidas de rendimiento del modelo (%)
Medida Valor
Sensibilidad 75.0
Especificidad 77.7
VPP 33.6
VPN 95.4

12. Validación.

12.1 Cargar el dataset de validación externa con las modificaciones necesarias.

test <- read.csv("test_TH.csv")
str(test)
## 'data.frame':    352 obs. of  36 variables:
##  $ Died                    : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ age                     : int  83 89 89 82 82 79 73 86 40 89 ...
##  $ gender                  : int  2 1 2 1 1 1 1 2 1 1 ...
##  $ hypertension            : int  1 1 1 1 1 0 1 0 0 1 ...
##  $ a_fib                   : int  0 1 1 1 1 1 1 1 0 1 ...
##  $ CHD                     : int  0 0 1 0 0 0 0 0 0 0 ...
##  $ diabetes                : int  0 0 0 0 0 0 1 0 0 0 ...
##  $ anemia                  : int  1 0 1 1 0 0 1 0 0 0 ...
##  $ depression              : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ Hyperlipemia            : int  0 0 0 1 0 1 1 0 0 0 ...
##  $ CKD                     : int  1 0 0 1 0 0 0 1 0 0 ...
##  $ COPD                    : int  0 0 0 0 0 1 0 0 0 0 ...
##  $ heart.rate              : num  83.7 90.4 101 88 86.6 ...
##  $ Systolic.blood.pressure : num  157 107 118 113 120 ...
##  $ Diastolic.blood.pressure: num  58.2 40.8 48.9 49.5 62.9 ...
##  $ Respiratory.rate        : num  15.7 24.1 18.3 29.2 25.9 ...
##  $ temperature             : num  36.9 36.3 35.4 35.7 35.9 ...
##  $ SP.O2                   : num  99.8 96.1 97 93.7 96.5 ...
##  $ Urine.output            : num  1495 1370 998 770 1990 ...
##  $ hematocrit              : num  23.7 29.4 33.1 31.6 36.2 ...
##  $ Leucocyte               : num  10.7 5.9 11.4 20.9 9.9 ...
##  $ Platelets               : num  304 331 558 326 454 ...
##  $ INR                     : num  1.07 1.14 1.6 1.56 3.02 ...
##  $ NT.proBNP               : num  33773 2456 11192 2673 25750 ...
##  $ Creatinine              : num  2.05 1.211 0.967 1.589 0.789 ...
##  $ Urea.nitrogen           : num  54.7 24.9 19.7 38.2 32.1 ...
##  $ glucose                 : num  134 105 103 180 166 ...
##  $ Blood.potassium         : num  4.79 4.07 4.17 4.08 4.17 ...
##  $ Blood.sodium            : num  133 143 143 144 143 ...
##  $ Blood.calcium           : num  8.89 7.4 8.82 7.43 8.28 ...
##  $ Chloride                : num  94.7 111.6 110.8 113.3 103.2 ...
##  $ Magnesium.ion           : num  2.06 1.86 1.9 1.79 1.96 ...
##  $ PH                      : num  7.37 7.44 7.3 7.32 7.27 ...
##  $ Bicarbonate             : num  28.8 22.7 20 21.3 35.1 ...
##  $ Lactic.acid             : num  0.7 0.8 0.825 0.85 0.95 1.1 1.2 1.2 1.24 1.26 ...
##  $ PCO2                    : num  54.9 35 39.2 48 93 ...
names(test) <- tolower(names(test))
str(test)
## 'data.frame':    352 obs. of  36 variables:
##  $ died                    : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ age                     : int  83 89 89 82 82 79 73 86 40 89 ...
##  $ gender                  : int  2 1 2 1 1 1 1 2 1 1 ...
##  $ hypertension            : int  1 1 1 1 1 0 1 0 0 1 ...
##  $ a_fib                   : int  0 1 1 1 1 1 1 1 0 1 ...
##  $ chd                     : int  0 0 1 0 0 0 0 0 0 0 ...
##  $ diabetes                : int  0 0 0 0 0 0 1 0 0 0 ...
##  $ anemia                  : int  1 0 1 1 0 0 1 0 0 0 ...
##  $ depression              : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ hyperlipemia            : int  0 0 0 1 0 1 1 0 0 0 ...
##  $ ckd                     : int  1 0 0 1 0 0 0 1 0 0 ...
##  $ copd                    : int  0 0 0 0 0 1 0 0 0 0 ...
##  $ heart.rate              : num  83.7 90.4 101 88 86.6 ...
##  $ systolic.blood.pressure : num  157 107 118 113 120 ...
##  $ diastolic.blood.pressure: num  58.2 40.8 48.9 49.5 62.9 ...
##  $ respiratory.rate        : num  15.7 24.1 18.3 29.2 25.9 ...
##  $ temperature             : num  36.9 36.3 35.4 35.7 35.9 ...
##  $ sp.o2                   : num  99.8 96.1 97 93.7 96.5 ...
##  $ urine.output            : num  1495 1370 998 770 1990 ...
##  $ hematocrit              : num  23.7 29.4 33.1 31.6 36.2 ...
##  $ leucocyte               : num  10.7 5.9 11.4 20.9 9.9 ...
##  $ platelets               : num  304 331 558 326 454 ...
##  $ inr                     : num  1.07 1.14 1.6 1.56 3.02 ...
##  $ nt.probnp               : num  33773 2456 11192 2673 25750 ...
##  $ creatinine              : num  2.05 1.211 0.967 1.589 0.789 ...
##  $ urea.nitrogen           : num  54.7 24.9 19.7 38.2 32.1 ...
##  $ glucose                 : num  134 105 103 180 166 ...
##  $ blood.potassium         : num  4.79 4.07 4.17 4.08 4.17 ...
##  $ blood.sodium            : num  133 143 143 144 143 ...
##  $ blood.calcium           : num  8.89 7.4 8.82 7.43 8.28 ...
##  $ chloride                : num  94.7 111.6 110.8 113.3 103.2 ...
##  $ magnesium.ion           : num  2.06 1.86 1.9 1.79 1.96 ...
##  $ ph                      : num  7.37 7.44 7.3 7.32 7.27 ...
##  $ bicarbonate             : num  28.8 22.7 20 21.3 35.1 ...
##  $ lactic.acid             : num  0.7 0.8 0.825 0.85 0.95 1.1 1.2 1.2 1.24 1.26 ...
##  $ pco2                    : num  54.9 35 39.2 48 93 ...
names(test) <- gsub("\\.", " ", names(test))
str(test)
## 'data.frame':    352 obs. of  36 variables:
##  $ died                    : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ age                     : int  83 89 89 82 82 79 73 86 40 89 ...
##  $ gender                  : int  2 1 2 1 1 1 1 2 1 1 ...
##  $ hypertension            : int  1 1 1 1 1 0 1 0 0 1 ...
##  $ a_fib                   : int  0 1 1 1 1 1 1 1 0 1 ...
##  $ chd                     : int  0 0 1 0 0 0 0 0 0 0 ...
##  $ diabetes                : int  0 0 0 0 0 0 1 0 0 0 ...
##  $ anemia                  : int  1 0 1 1 0 0 1 0 0 0 ...
##  $ depression              : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ hyperlipemia            : int  0 0 0 1 0 1 1 0 0 0 ...
##  $ ckd                     : int  1 0 0 1 0 0 0 1 0 0 ...
##  $ copd                    : int  0 0 0 0 0 1 0 0 0 0 ...
##  $ heart rate              : num  83.7 90.4 101 88 86.6 ...
##  $ systolic blood pressure : num  157 107 118 113 120 ...
##  $ diastolic blood pressure: num  58.2 40.8 48.9 49.5 62.9 ...
##  $ respiratory rate        : num  15.7 24.1 18.3 29.2 25.9 ...
##  $ temperature             : num  36.9 36.3 35.4 35.7 35.9 ...
##  $ sp o2                   : num  99.8 96.1 97 93.7 96.5 ...
##  $ urine output            : num  1495 1370 998 770 1990 ...
##  $ hematocrit              : num  23.7 29.4 33.1 31.6 36.2 ...
##  $ leucocyte               : num  10.7 5.9 11.4 20.9 9.9 ...
##  $ platelets               : num  304 331 558 326 454 ...
##  $ inr                     : num  1.07 1.14 1.6 1.56 3.02 ...
##  $ nt probnp               : num  33773 2456 11192 2673 25750 ...
##  $ creatinine              : num  2.05 1.211 0.967 1.589 0.789 ...
##  $ urea nitrogen           : num  54.7 24.9 19.7 38.2 32.1 ...
##  $ glucose                 : num  134 105 103 180 166 ...
##  $ blood potassium         : num  4.79 4.07 4.17 4.08 4.17 ...
##  $ blood sodium            : num  133 143 143 144 143 ...
##  $ blood calcium           : num  8.89 7.4 8.82 7.43 8.28 ...
##  $ chloride                : num  94.7 111.6 110.8 113.3 103.2 ...
##  $ magnesium ion           : num  2.06 1.86 1.9 1.79 1.96 ...
##  $ ph                      : num  7.37 7.44 7.3 7.32 7.27 ...
##  $ bicarbonate             : num  28.8 22.7 20 21.3 35.1 ...
##  $ lactic acid             : num  0.7 0.8 0.825 0.85 0.95 1.1 1.2 1.2 1.24 1.26 ...
##  $ pco2                    : num  54.9 35 39.2 48 93 ...
test$oliguria_cat <- ifelse(test$`urine output` <= 400, 1, 0)
str(test)
## 'data.frame':    352 obs. of  37 variables:
##  $ died                    : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ age                     : int  83 89 89 82 82 79 73 86 40 89 ...
##  $ gender                  : int  2 1 2 1 1 1 1 2 1 1 ...
##  $ hypertension            : int  1 1 1 1 1 0 1 0 0 1 ...
##  $ a_fib                   : int  0 1 1 1 1 1 1 1 0 1 ...
##  $ chd                     : int  0 0 1 0 0 0 0 0 0 0 ...
##  $ diabetes                : int  0 0 0 0 0 0 1 0 0 0 ...
##  $ anemia                  : int  1 0 1 1 0 0 1 0 0 0 ...
##  $ depression              : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ hyperlipemia            : int  0 0 0 1 0 1 1 0 0 0 ...
##  $ ckd                     : int  1 0 0 1 0 0 0 1 0 0 ...
##  $ copd                    : int  0 0 0 0 0 1 0 0 0 0 ...
##  $ heart rate              : num  83.7 90.4 101 88 86.6 ...
##  $ systolic blood pressure : num  157 107 118 113 120 ...
##  $ diastolic blood pressure: num  58.2 40.8 48.9 49.5 62.9 ...
##  $ respiratory rate        : num  15.7 24.1 18.3 29.2 25.9 ...
##  $ temperature             : num  36.9 36.3 35.4 35.7 35.9 ...
##  $ sp o2                   : num  99.8 96.1 97 93.7 96.5 ...
##  $ urine output            : num  1495 1370 998 770 1990 ...
##  $ hematocrit              : num  23.7 29.4 33.1 31.6 36.2 ...
##  $ leucocyte               : num  10.7 5.9 11.4 20.9 9.9 ...
##  $ platelets               : num  304 331 558 326 454 ...
##  $ inr                     : num  1.07 1.14 1.6 1.56 3.02 ...
##  $ nt probnp               : num  33773 2456 11192 2673 25750 ...
##  $ creatinine              : num  2.05 1.211 0.967 1.589 0.789 ...
##  $ urea nitrogen           : num  54.7 24.9 19.7 38.2 32.1 ...
##  $ glucose                 : num  134 105 103 180 166 ...
##  $ blood potassium         : num  4.79 4.07 4.17 4.08 4.17 ...
##  $ blood sodium            : num  133 143 143 144 143 ...
##  $ blood calcium           : num  8.89 7.4 8.82 7.43 8.28 ...
##  $ chloride                : num  94.7 111.6 110.8 113.3 103.2 ...
##  $ magnesium ion           : num  2.06 1.86 1.9 1.79 1.96 ...
##  $ ph                      : num  7.37 7.44 7.3 7.32 7.27 ...
##  $ bicarbonate             : num  28.8 22.7 20 21.3 35.1 ...
##  $ lactic acid             : num  0.7 0.8 0.825 0.85 0.95 1.1 1.2 1.2 1.24 1.26 ...
##  $ pco2                    : num  54.9 35 39.2 48 93 ...
##  $ oliguria_cat            : num  0 0 0 0 0 0 0 0 0 0 ...
colSums(is.na(test))
##                     died                      age                   gender 
##                        0                        0                        0 
##             hypertension                    a_fib                      chd 
##                        0                        0                        0 
##                 diabetes                   anemia               depression 
##                        0                        0                        0 
##             hyperlipemia                      ckd                     copd 
##                        0                        0                        0 
##               heart rate  systolic blood pressure diastolic blood pressure 
##                        0                        0                        0 
##         respiratory rate              temperature                    sp o2 
##                        0                        0                        0 
##             urine output               hematocrit                leucocyte 
##                        0                        0                        0 
##                platelets                      inr                nt probnp 
##                        0                        0                        0 
##               creatinine            urea nitrogen                  glucose 
##                        0                        0                        0 
##          blood potassium             blood sodium            blood calcium 
##                        0                        0                        0 
##                 chloride            magnesium ion                       ph 
##                        0                        0                        0 
##              bicarbonate              lactic acid                     pco2 
##                        0                        0                        0 
##             oliguria_cat 
##                        0
test$anemia <- as.factor(test$anemia)
test$ckd <- as.factor(test$ckd)
test$copd <- as.factor(test$copd)

Ya cargamos correctamente el dataset test, transformamos los nombres de variables para que coincidan con el modelo original, creamos la variable categórica oliguria_cat y verificamos que no hay valores perdidos. Además, pasamos a factor las variables necesarias (anemia, ckd, copd).

12.2 Aplicar el modelo final (modelo_10) sobre el dataset de validación externa test.

all.vars(formula(modelo_10))[-1] %in% names(test)
##  [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
setdiff(all.vars(formula(modelo_10))[-1], names(test))
## character(0)
missing_vars <- setdiff(all.vars(formula(modelo_10))[-1], names(test))
print(missing_vars)
## character(0)
test$predicted_prob <- predict(modelo_10, newdata = test, type = "response")

12.3 Evaluar estabilidad estructural - comparación de coeficientes entre train y test.

modelo_test <- glm(formula(modelo_10), data = test, family = binomial)
coef_train <- coef(modelo_10)
ic_train <- confint(modelo_10)
## Waiting for profiling to be done...
coef_test <- coef(modelo_test)
comparacion_coef <- data.frame(
  Coeficiente = names(coef_train),
  Beta_train = round(coef_train, 3),
  IC95_inf = round(ic_train[, 1], 3),
  IC95_sup = round(ic_train[, 2], 3),
  Beta_test = round(coef_test, 3),
  Test_dentro_del_IC95 = coef_test >= ic_train[, 1] & coef_test <= ic_train[, 2]
)
comparacion_coef
##                                         Coeficiente Beta_train IC95_inf
## (Intercept)                             (Intercept)     18.815    6.987
## bicarbonate                             bicarbonate     -0.163   -0.241
## `urine output`                       `urine output`      0.000    0.000
## `urea nitrogen`                     `urea nitrogen`      0.014    0.004
## `blood calcium`                     `blood calcium`     -0.649   -1.100
## `lactic acid`                         `lactic acid`      0.490    0.240
## pco2                                           pco2      0.052    0.022
## `systolic blood pressure` `systolic blood pressure`     -0.019   -0.036
## leucocyte                                 leucocyte      0.057    0.016
## age                                             age      0.009   -0.009
## `sp o2`                                     `sp o2`     -0.143   -0.252
##                           IC95_sup Beta_test Test_dentro_del_IC95
## (Intercept)                 31.008    18.487                 TRUE
## bicarbonate                 -0.087    -0.105                 TRUE
## `urine output`               0.000     0.000                 TRUE
## `urea nitrogen`              0.024     0.020                 TRUE
## `blood calcium`             -0.212    -0.813                 TRUE
## `lactic acid`                0.751     0.485                 TRUE
## pco2                         0.082     0.053                 TRUE
## `systolic blood pressure`   -0.004     0.004                FALSE
## leucocyte                    0.098     0.055                 TRUE
## age                          0.029     0.024                 TRUE
## `sp o2`                     -0.036    -0.183                 TRUE
knitr::kable(comparacion_coef, caption = "Comparación de coeficientes entre Train y Test")
## 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")
Comparación de coeficientes entre Train y Test
Coeficiente Beta_train IC95_inf IC95_sup Beta_test Test_dentro_del_IC95
(Intercept) (Intercept) 18.815 6.987 31.008 18.487 TRUE
bicarbonate bicarbonate -0.163 -0.241 -0.087 -0.105 TRUE
urine output urine output 0.000 0.000 0.000 0.000 TRUE
urea nitrogen urea nitrogen 0.014 0.004 0.024 0.020 TRUE
blood calcium blood calcium -0.649 -1.100 -0.212 -0.813 TRUE
lactic acid lactic acid 0.490 0.240 0.751 0.485 TRUE
pco2 pco2 0.052 0.022 0.082 0.053 TRUE
systolic blood pressure systolic blood pressure -0.019 -0.036 -0.004 0.004 FALSE
leucocyte leucocyte 0.057 0.016 0.098 0.055 TRUE
age age 0.009 -0.009 0.029 0.024 TRUE
sp o2 sp o2 -0.143 -0.252 -0.036 -0.183 TRUE

12.4 Evaluar discriminación del modelo con la curva ROC y AUC.

roc_ext <- roc(test$died, test$predicted_prob)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
plot(roc_ext, main = "Curva ROC - Validacion externa", col = "blue", lwd = 3)
text(0.8, 0.2, paste("AUC ROC =", round(roc_ext$auc, 3)), adj = c(0, 1))

ci.auc(roc_ext)
## 95% CI: 0.6788-0.8329 (DeLong)

12.5 Calibración para validación externa

hl_1 <- HLtest(modelo_10, g = 10)
hl_df <- cbind(as.data.frame(hl_1$table), indice = as.factor(1:10))

ggplot(hl_df, aes(x = indice)) +
  geom_point(aes(y = exp, color = "Esperado")) +
  geom_point(aes(y = obs, color = "Observado")) +
  scale_color_manual(labels = c("Esperado", "Observado"),
                     values = c("blue", "red")) +
  labs(y = "Proporcion", color = "Leyenda") +
  theme_minimal()

print(hl_1)
## Hosmer and Lemeshow Goodness-of-Fit Test 
## 
## Call:
## glm(formula = died ~ bicarbonate + `urine output` + `urea nitrogen` + 
##     `blood calcium` + `lactic acid` + pco2 + `systolic blood pressure` + 
##     leucocyte + age + `sp o2`, family = binomial, data = data)
##  ChiSquare df   P_value
##   6.986609  8 0.5380781
hl_df <- cbind(as.data.frame(hl_1$table), indice = as.factor(1:10))
print(hl_df)
##                 cut total obs      exp          chi indice
## 1  [0.00266,0.0191]    83  82 82.05387 -0.005947062      1
## 2   (0.0191,0.0294]    82  78 80.00965 -0.224672027      2
## 3   (0.0294,0.0391]    82  80 79.17369  0.092864996      3
## 4    (0.0391,0.052]    83  81 79.18877  0.203536458      4
## 5    (0.052,0.0685]    82  80 77.11997  0.327954910      5
## 6   (0.0685,0.0909]    82  75 75.54573 -0.062787669      6
## 7    (0.0909,0.126]    83  74 74.03713 -0.004315636      7
## 8     (0.126,0.189]    82  65 69.33365 -0.520453179      8
## 9     (0.189,0.308]    82  64 62.55696  0.182449184      9
## 10    (0.308,0.984]    83  37 36.98058  0.003192646     10
kable(hl_df, caption = "Tabla de calibración por decil (Esperado vs Observado)")
## 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")
Tabla de calibración por decil (Esperado vs Observado)
cut total obs exp chi indice
[0.00266,0.0191] 83 82 82.05387 -0.0059471 1
(0.0191,0.0294] 82 78 80.00965 -0.2246720 2
(0.0294,0.0391] 82 80 79.17369 0.0928650 3
(0.0391,0.052] 83 81 79.18877 0.2035365 4
(0.052,0.0685] 82 80 77.11997 0.3279549 5
(0.0685,0.0909] 82 75 75.54573 -0.0627877 6
(0.0909,0.126] 83 74 74.03713 -0.0043156 7
(0.126,0.189] 82 65 69.33365 -0.5204532 8
(0.189,0.308] 82 64 62.55696 0.1824492 9
(0.308,0.984] 83 37 36.98058 0.0031926 10 
pred_ext <- predict(modelo_10, newdata = test, type = "response")
obs_ext <- as.numeric(as.character(test$died))
a <- valProbggplot(pred_ext, obs_ext)
a$ggPlot

12.6 Características operativas para validación externa

test$prob_modelo <- predict(modelo_10, newdata = test, type = "response")
test$pred_binaria <- ifelse(test$prob_modelo > 0.13, 1, 0)
test$pred_binaria <- relevel(factor(test$pred_binaria), ref = "1")
test$newchd <- relevel(factor(test$died), ref = "1")
crosstab(test$pred_binaria, test$died, prop.c = TRUE)

##    Cell Contents 
## |-------------------------|
## |                   Count | 
## |          Column Percent | 
## |-------------------------|
## 
## ==========================================
##                      test$died
## test$pred_binaria        0       1   Total
## ------------------------------------------
## 1                      71      31     102 
##                      23.6%   60.8%        
## ------------------------------------------
## 0                     230      20     250 
##                      76.4%   39.2%        
## ------------------------------------------
## Total                 301      51     352 
##                      85.5%   14.5%        
## ==========================================
tabla <- table(Predicho = test$pred_binaria, Real = test$died)

VP  <- tabla["1", "1"]
VN  <- tabla["0", "0"]
FP  <- tabla["1", "0"]
FN  <- tabla["0", "1"]

S   <- VP / (VP + FN)  # Sensibilidad
E   <- VN / (VN + FP)  # Especificidad
VPP <- VP / (VP + FP)  # Valor predictivo positivo
VPN <- VN / (VN + FN)  # Valor predictivo negativo

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 en el conjunto de testing (%)")
## 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")
Medidas de rendimiento del modelo en el conjunto de testing (%)
Medida Valor
Sensibilidad 60.8
Especificidad 76.4
VPP 30.4
VPN 92.0