In road2stat/hdnom: Benchmarking and Visualization Toolkit for Penalized Cox Models

knitr::knit_hooks$set(pngquant = knitr::hook_pngquant)

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.path = "man/figures/README-",
  out.width = "100%",
  echo = FALSE,
  message = FALSE,
  warning = FALSE,
  dev = "ragg_png",
  dpi = 72,
  fig.retina = 2,
  fig.align = "center",
  out.width = "100%",
  pngquant = "--speed=1 --quality=50"
)

hdnom

hdnom creates nomogram visualizations for penalized Cox regression models, with the support of reproducible survival model building, validation, calibration, and comparison for high-dimensional data.

Installation

You can install hdnom from CRAN:

install.packages("hdnom")

Or try the development version on GitHub:

remotes::install_github("nanxstats/hdnom")

Browse the vignettes to get started.

Gallery

Nomogram

library("hdnom")
library("survival")
library("gridExtra")
library("cowplot")
library("ggplot2")

data(smart)

x <- as.matrix(smart[, -c(1, 2)])
time <- smart$TEVENT
event <- smart$EVENT
y <- Surv(time, event)

# Fit penalized Cox model with lasso penalty
lassofit <- fit_lasso(x, y, nfolds = 10, rule = "lambda.1se", seed = 11)

# Plot nomogram
nom <- as_nomogram(
  lassofit, x, time, event,
  pred.at = 365 * 2,
  funlabel = "2-Year Overall Survival Probability"
)

plot(nom)

Kaplan-Meier plot with number at risk table

# Internal calibration
cal.int <- calibrate(
  x, time, event,
  model.type = "lasso",
  alpha = 1, lambda = lassofit$"lambda",
  method = "repeated.cv", nfolds = 10, rep.times = 20,
  pred.at = 365 * 9, ngroup = 3,
  trace = FALSE
)

kmplot(
  cal.int,
  group.name = c("High risk", "Medium risk", "Low risk"),
  time.at = 1:8 * 365
)

Model validation and calibration

x <- as.matrix(smart[, -c(1, 2)])[1:500, ]
time <- smart$TEVENT[1:500]
event <- smart$EVENT[1:500]
y <- Surv(time, event)

# Fit penalized Cox model
lassofit <- fit_lasso(x, y, nfolds = 5, rule = "lambda.1se", seed = 11)

# Model validation by repeated cross-validation with time-dependent AUC
val.repcv <- validate(
  x, time, event,
  model.type = "lasso",
  alpha = 1, lambda = lassofit$"lambda",
  method = "repeated.cv", nfolds = 5, rep.times = 20,
  tauc.type = "UNO", tauc.time = seq(0.5, 2, 0.25) * 365,
  seed = 1010,
  trace = FALSE
)

# Model calibration by repeated cross-validation
cal.repcv <- calibrate(
  x, time, event,
  model.type = "lasso",
  alpha = 1, lambda = lassofit$"lambda",
  method = "repeated.cv", nfolds = 10, rep.times = 20,
  pred.at = 365 * 9, ngroup = 5,
  seed = 1010,
  trace = FALSE
)

invisible(capture.output(
  p1 <- plot(val.repcv, ylim = c(0.3, 0.9)) +
    theme_cowplot()
))
invisible(capture.output(
  p2 <- plot(cal.repcv) +
    theme_cowplot()
))

grid.arrange(p1, p2, ncol = 2)

Model comparison by validation or calibration

# Compare lasso and adaptive lasso by 5-fold cross-validation
cmp.val.cv <- compare_by_validate(
  x, time, event,
  model.type = c("lasso", "alasso"),
  method = "repeated.cv", nfolds = 10, rep.times = 20,
  tauc.type = "UNO",
  tauc.time = seq(1, 4, 0.5) * 365, seed = 1001,
  trace = FALSE
)

# Compare lasso and adaptive lasso by 5-fold cross-validation
cmp.cal.cv <- compare_by_calibrate(
  x, time, event,
  model.type = c("lasso", "alasso"),
  method = "fitting",
  pred.at = 365 * 9, ngroup = 5, seed = 1001,
  trace = FALSE
)

invisible(capture.output(
  p3 <- plot(cmp.val.cv, interval = TRUE) +
    theme_cowplot() +
    theme(legend.position = "bottom")
))
invisible(capture.output(
  p4 <- plot(cmp.cal.cv) +
    theme_cowplot() +
    theme(legend.position = "bottom")
))

grid.arrange(p3, p4, ncol = 2)

Shiny app

• Shiny app: https://github.com/nanxstats/hdnom-app
• Shiny app maker: https://github.com/nanxstats/hdnom-appmaker

Contribute

To contribute to this project, please take a look at the Contributing Guidelines first. Please note that the hdnom project is released with a Contributor Code of Conduct. By contributing to this project, you agree to abide by its terms.

road2stat/hdnom documentation built on March 14, 2024, 11:10 p.m.