inst/doc/phoenix.R

In phoenix: The Phoenix Pediatric Sepsis and Septic Shock Criteria

## ----label = "setup", include = FALSE-----------------------------------------

################################################################################
###                          !!! IMPORTANT NOTE !!!                          ###
###                                                                          ###
###          THIS FILE WAS GENERATED BY vignette-spinners/phoenix.R          ###
###                                                                          ###
###                         MAKE EDITS IN THAT FILE                          ###
################################################################################

library(qwraps2)
options(qwraps2_markup = "markdown")
knitr::opts_chunk$set(collapse = TRUE)

## -----------------------------------------------------------------------------
library(phoenix)
packageVersion("phoenix")

## ----echo = FALSE, results = "asis"-------------------------------------------
tab <-
  scan(file = system.file("phoenix_rubric.md", package = "phoenix"),
       what = character(),
       sep = "\n",
       quiet = TRUE)
cat(tab, sep = "\n")
cat("\n")

ftnt <-
  scan(file = system.file("phoenix_rubric_footnotes.md", package = "phoenix"),
       what = character(),
       sep = "\n",
       quiet = TRUE)
cat(ftnt, sep = "\n\n")

## ----echo = FALSE, results = "hide", fig.width = 7, fig.height = 4------------
resp_data <-
  expand.grid(pfr = seq(0, 450, by = 10), sfr = seq(0, 450, by = 10), imv = c(0, 1), o2 = c(0, 1))
resp_data$o2 <- pmax(resp_data$imv, resp_data$o2)
resp_data <- unique(resp_data)
resp_data$phoenix_respiratory_score <- factor(phoenix_respiratory(pfr, sfr, imv, o2, data = resp_data))

resp_data$oxygen_support <-
  factor(
    interaction(resp_data$imv, resp_data$o2),
    levels = c("0.0", "0.1", "1.1"),
    labels = c("No Oxygen Support", "Non-invasive Oxygen Support", "Invasive Oxygen Support")
  )

ggplot2::ggplot(data = resp_data) +
  ggplot2::theme_classic() +
  ggplot2::aes(x = sfr, y = pfr, fill = phoenix_respiratory_score) +
  ggplot2::geom_tile() +
  ggplot2::facet_wrap( ~ oxygen_support, nrow = 1) +
  ggplot2::scale_fill_brewer(name = "Phoenix Respiratory Score", palette = "Spectral", direction = -1) +
  ggplot2::ylab(expression(PaO[2] : FiO[2])) +
  ggplot2::xlab(expression(SpO[2] : FiO[2])) +
  ggplot2::theme(legend.position = "bottom")

## -----------------------------------------------------------------------------
phoenix_respiratory(
  sf_ratio = 87 / 0.40,
  other_respiratory_support = 1)

## -----------------------------------------------------------------------------
DF <- read.table(sep = "|", header = TRUE, text =
"
pfr | sfr | imv | o2
    | 438 |     |
    | 175 |     | 1
    | 175 |     | 1
186 |     |  1  | 0
300 | 277 |  0  | 1
    |     |     |
")

DF$resp_score <- phoenix_respiratory(pfr, sfr, imv, o2, DF)

DF

## -----------------------------------------------------------------------------
resp_example <- sepsis[c("pid", "fio2", "pao2", "spo2", "vent")]

## ----results = "hide"---------------------------------------------------------
resp_example$score <-
  phoenix_respiratory(
  pf_ratio = pao2 / fio2,
  sf_ratio = ifelse(spo2 <= 97, spo2 / fio2, NA_real_),
  imv = vent,
  other_respiratory_support = as.integer(fio2 > 0.21),
  data = sepsis
  )
resp_example

## ----echo = FALSE, results = "asis"-------------------------------------------
knitr::kable(resp_example)

## ----echo = FALSE, results = "hide", fig.width = 7, fig.height = 7------------
DF <- expand.grid(vasoactives = 0:2,
                  lactate = seq(0, 15, by = 1),
                  age = seq(0, 18 * 12, by = 1),
                  MAP = seq(00, 60, by = ))
DF$phoenix_cardiovascular_score <-
  factor(
    phoenix_cardiovascular(vasoactives, lactate, age, MAP, data = DF)
  )
DF$lactate_bin <- cut(DF$lactate, breaks = c(0, 5, 11, Inf), right = F)
levels(DF$lactate_bin) <- paste("Lactate", levels(DF$lactate_bin))

ggplot2::ggplot(DF) +
  ggplot2::theme_classic() +
  ggplot2::aes(x = age, y = MAP, fill = phoenix_cardiovascular_score) +
  ggplot2::geom_tile() +
  ggplot2::facet_grid(lactate_bin ~ paste("Vasoactive Medications:", vasoactives)) +
  ggplot2::scale_fill_brewer(name = "Phoenix Cardiovascular Score", palette = "Spectral", direction = -1) +
  ggplot2::ylab("Mean Arterial Pressure (mmHg)") +
  ggplot2::xlab("Age (months)") +
  ggplot2::guides(fill = ggplot2::guide_legend(nrow = 1)) +
  ggplot2::theme(legend.position = "bottom")

## ----results = "hide"---------------------------------------------------------
card_example <-
  sepsis[c("pid", "dobutamine", "dopamine", "epinephrine", "milrinone", "norepinephrine", "vasopressin", "lactate", "dbp", "sbp", "age")]

card_example$score <-
  phoenix_cardiovascular(
    vasoactives = dobutamine + dopamine + epinephrine + milrinone + norepinephrine + vasopressin,
    lactate = lactate,
    age = age,
    map = map(sbp = sbp, dbp = dbp),
    data = sepsis)

card_example

## ----results = "asis", echo = FALSE-------------------------------------------
knitr::kable(card_example)

## ----echo = FALSE, results = "hide", fig.height = 7, fig.width = 7------------
DF <- expand.grid(platelets = c(10, 150),
                  inr = c(1.0, 1.5),
                  d_dimer = c(1.2, 4.0),
                  fib = c(10, 150))
DF$plt_bin <-
  factor(DF$platelets, levels = c(150, 10), labels = c("Platelets >= 100", "Platelets < 100"))

DF$inr_bin <-
  factor(DF$inr, levels = c(1.0, 1.5), labels = c("INR <= 1.3", "INR > 1.3"))

DF$ddm_bin <-
  factor(DF$d_dimer, levels = c(1.2, 4.0), labels = c("D-dimer <= 2", "D-dimer > 2"))

DF$fib_bin <- factor(DF$fib, levels = c(150, 10),
                     labels = c("Fibrinogen >= 100", "Fibrinogen < 100"))

DF$phoenix_coagulation_score <-
  factor(
    phoenix_coagulation(platelets, inr, d_dimer, fib, data = DF)
  )

ggplot2::ggplot(DF) +
  ggplot2::theme_classic() +
  ggplot2::aes(x = plt_bin, y = fib_bin, fill = phoenix_coagulation_score) +
  ggplot2::geom_tile() +
  ggplot2::facet_grid(inr_bin ~ ddm_bin) +
  ggplot2::scale_fill_brewer(name = "Phoenix Coagulation Score", palette = "Spectral", direction = -1) +
  ggplot2::ylab("")+
  ggplot2::xlab("")+
  ggplot2::theme(legend.position = "bottom")

## ----results = "hide"---------------------------------------------------------
coag_example <- sepsis[c("pid", "platelets", "inr", "d_dimer", "fibrinogen")]
coag_example$score <-
  phoenix_coagulation(platelets, inr, d_dimer, fibrinogen, data = sepsis)
coag_example

## ----echo = FALSE, results = 'asis'-------------------------------------------
knitr::kable(coag_example)

## ----results = 'hide'---------------------------------------------------------
neuro_example <- sepsis[c("pid", "gcs_total", "pupil")]
neuro_example$score <-
  phoenix_neurologic(gcs = gcs_total, fixed_pupils = as.integer(pupil == "both-fixed"), data = sepsis)
neuro_example

## ----echo = FALSE, results = "asis"-------------------------------------------
knitr::kable(neuro_example)

## ----results = 'hide'---------------------------------------------------------
endo_example <- sepsis[c("pid", "glucose")]
endo_example$score <- phoenix_endocrine(glucose, data = sepsis)
endo_example

## ----echo = FALSE, results = "asis"-------------------------------------------
knitr::kable(endo_example)

## ----results = "hide"---------------------------------------------------------
immu_example <- sepsis[c("pid", "anc", "alc")]
immu_example$score <- phoenix_immunologic(anc, alc, sepsis)
immu_example

## ----echo = FALSE, results = "asis"-------------------------------------------
knitr::kable(immu_example)

## ----results = "hide"---------------------------------------------------------
renal_example <- sepsis[c("creatinine", "age")]
renal_example$score <- phoenix_renal(creatinine, age, sepsis)
renal_example

## ----echo = FALSE, results = "asis"-------------------------------------------
knitr::kable(renal_example)

## ----results = "hide"---------------------------------------------------------
hep_example <- sepsis[c("pid", "bilirubin", "alt")]
hep_example$score <- phoenix_hepatic(bilirubin, alt, sepsis)
hep_example

## ----echo = FALSE, results = "asis"-------------------------------------------
knitr::kable(hep_example)

## -----------------------------------------------------------------------------
phoenix_scores <-
  phoenix(
    # respiratory
      pf_ratio = pao2 / fio2,
      sf_ratio = ifelse(spo2 <= 97, spo2 / fio2, NA_real_),
      imv = vent,
      other_respiratory_support = as.integer(fio2 > 0.21),
    # cardiovascular
      vasoactives = dobutamine + dopamine + epinephrine + milrinone + norepinephrine + vasopressin,
      lactate = lactate,
      age = age,
      map = map(sbp, dbp),
    # coagulation
      platelets = platelets,
      inr = inr,
      d_dimer = d_dimer,
      fibrinogen = fibrinogen,
    # neurologic
      gcs = gcs_total,
      fixed_pupils = as.integer(pupil == "both-fixed"),
    data = sepsis
  )

str(phoenix_scores)

## ----echo = FALSE, results = "asis"-------------------------------------------
names(phoenix_scores) <- gsub("_", "\n", names(phoenix_scores))
knitr::kable(phoenix_scores, format = "html", align = "c")

## -----------------------------------------------------------------------------
phoenix8_scores <-
  phoenix8(
    # respiratory
      pf_ratio = pao2 / fio2,
      sf_ratio = ifelse(spo2 <= 97, spo2 / fio2, NA_real_),
      imv = vent,
      other_respiratory_support = as.integer(fio2 > 0.21),
    # cardiovascular
      vasoactives = dobutamine + dopamine + epinephrine + milrinone + norepinephrine + vasopressin,
      lactate = lactate,
      age = age, # Also used in the renal assessment.
      map = map(sbp = sbp, dbp = dbp),
    # coagulation
      platelets = platelets,
      inr = inr,
      d_dimer = d_dimer,
      fibrinogen = fibrinogen,
    # neurologic
      gcs = gcs_total,
      fixed_pupils = as.integer(pupil == "both-fixed"),
    # endocrine
      glucose = glucose,
    # immunologic
      anc = anc,
      alc = alc,
    # renal
      creatinine = creatinine,
      # no need to specify age again
    # hepatic
      bilirubin = bilirubin,
      alt = alt,
    data = sepsis
  )

str(phoenix8_scores)

## ----echo = FALSE, results = "asis"-------------------------------------------
names(phoenix8_scores) <- gsub("_", "\n", names(phoenix8_scores))
knitr::kable(phoenix8_scores, format = "html", align = "c")

## -----------------------------------------------------------------------------
phoenix(
  vasoactives = 1,  # norepinephrine drip
  map = 32 + (67 - 32) / 3, # 43.667 mmHg
  platelets = 95,
  gcs = 14, # irritability
  age = 3 * 12 # expected input for age is in months
  )

## -----------------------------------------------------------------------------
phoenix(
  gcs = 2 + 2 + 4, # eye + verbal + motor
  map = 52,
  imv = 1,
  sf_ratio = 92 / 0.45,
  platelets = 120,
  lactate = 2.9,
  inr = 1.7,
  d_dimer = 4.4,
  fibrinogen = 120)