Nomogram and online tool

Dowmload libraries

library(survival)
library(survminer)
library(rms)
library(shiny)
library(readxl)
library(DynNom)
# You need to create an account in Shinyapps- they host DynNom apps. https://www.shinyapps.io/admin/#/login?redirect=%2Fdashboard
# DynNom documentation https://cran.r-project.org/web/packages/DynNom/DynNom.pdf

Nomogram

data <- read.csv("user/documents/data.csv")

ddist <- datadist(data)
options(datadist = 'ddist')

model <-
  cph(
    Surv(time = time, event = event) ~ 
      x1 + 
      x2 + 
      x3,
    data = data,
    x = TRUE,
    y = TRUE,
    surv = TRUE,
    time.inc = 5 ## time frame to evaluate 
)

model$Design$label <-
  c(
    "Variable 1",
    "Variable 2",
    "Variable 3",
  )

surv.model <- Survival(model)

nomogram <-
  nomogram(
    model,
    fun = list(function(x)
      surv.model(2, x), #add as many time frames as needed
      funlabel = c(
      "2-year risk"),
      lp = F,
      fun.at = c(0.9, 0.8, 0.7, 0.6, 0.5, 0.4, 0.3, 0.2)
      )
    
# to export as pdf 

pdf(
  "nomogram.pdf",
  width = cm(17),
  height = cm(10)
)

plot(
  nomogram,
  cex.axis = 4 ,
  cex.var = 4.5 ,
  col.grid = gray(c(0.8, 0.95)),
  theme(text = element_text(
    family = "Times New Roman",
    face = "bold",
    size = 20)
    )
  )

dev.off

Dynamic Nomogram

data <- read.csv("user/documents/data.csv")
ddist <- datadist(data)
options(datadist = 'ddist')

tool <- cph(
  Surv(time = time, event = event) ~ 
      x1 + 
      x2 + 
      x3,
  data = data
  )

DNbuilder( #this uses DynNom and will create 3 new files: ui.R, server.R, global.R. These will be the scripts needed to run the app. 
  tool, 
  data = data, 
  clevel = 0.95, 
  covariate = c("numeric"),
  ptype = c("1-st") # or st
  )

Example of DynNom scripts

GLOBAL.R

library(ggplot2)
library(shiny)
library(shinythemes)
library(plotly)
library(stargazer)
library(compare)
library(prediction)
library(rms)
library(shinythemes)

#######################################################
#### Before publishing your dynamic nomogram:
####
#### - You may need to edit the following lines if
#### data or model objects are not defined correctly
#### - You could modify ui.R or server.R for
#### making any required changes to your app
#######################################################

load('data.RData')  
source('functions.R') 
data=data
t.dist <- datadist(data)
options(datadist = 't.dist')
model <- coxph(Surv(Time, event) ~ x1 +x2 +x3 , data = data)

modellabels <- c("variable 1", "variable 2", "variable 3")
m.summary <- 'raw'
covariate <- 'numeric'
clevel <- 0.95


UI.R 


ui = bootstrapPage(fluidPage(
  theme=shinytheme("cyborg"),
  titlePanel(
    'gf'
  ),
  p("This is an example.", style=" padding:10px; color: lightgrey; height: 60px",
  br(),
  br(),
  "This is an example how to use it :", style="padding:20px; " ),
  actionButton('showEligibility', 'Eligibility', style="color: black; background-color: lightblue; border-color: white"),
  actionButton('showLimitations', 'Limitations', style="color: black; background-color: lightblue; border-color: white"),
  actionButton('showPerformance', 'Performance', style="color: black; background-color: lightblue; border-color: white"),
  actionButton('readArticle', 'Reference Manuscript', style="color: black; background-color: lightblue; border-color: white", onclick="window.open('https://drive.google.com/file/dk6UQT/view?usp=sharing', '_blank')"),
  p("Instructions on how to use this tool can be found here:", style=" padding:20px; color: lightgrey;"),
  actionButton('showHowtouse', "How to use",style="color: white; background-color:green; border-color: white"),
  br(),
  br(), 
  sidebarLayout(
    sidebarPanel( 
      uiOutput('manySliders.f'),
      uiOutput('manySliders.n'),
      checkboxInput('trans', 'Ready!', value = FALSE),
      actionButton('add', 'Predict', style="color: white; background-color: green;,  border-color: white"),
      style="color: black; background-color:    #298AAE ; border-color: black"),
    mainPanel(
      tabsetPanel(
        id = 'tabs',
        tabPanel('Predicted Survival', plotOutput('plot')),
        tabPanel('95% Confidence Interval', plotlyOutput('plot2')),
        tabPanel('Numerical Summary', verbatimTextOutput('data.pred')),
    sidebarPanel( 
      p("How to interpret the results?", style="color: lightgrey;"),
      actionButton('showInterpret', "Interpret",style="color: white; background-color:green; border-color: white")

      )
    )
  )
)))



Server.R

server = function(input, output) {
  observeEvent(input$showPerformance, {
    showModal(modalDialog(
      title = "Performance",
      p(
        "This is an example."
      ),
      easyClose = TRUE
    ))
  })
  
  observeEvent(input$showHowtouse, {
    showModal( 
      modalDialog( 
        title = "How to use", style="color: white; background-color: black; border-color: black",
        p(
          "This is a step-by-step guide on how to use this interactive clinical tool.",
          tags$br(),
          tags$br(),
          "Once",tags$strong("all"), "the boxes are filled-in, check the", tags$strong("'Ready!'"), "box and click",
          tags$strong("'Predict.'")),
    easyClose = TRUE
    ))
    
  })
  

  

  
  neededVar <- n.mterms[-1]
  if (length(mtermslab) == 1) {
    input.data <<- data.frame(data[1, neededVar])
    names(input.data)[1] <<- n.mterms[-1]
  } else {
    input.data <<- data[1, neededVar]
  }
  
  input.data[1, ] <<- NA
  b <- 1
  i.factor <- NULL
  i.numeric <- NULL
  for (j in 2:length(mterms)) {
    for (i in 1:length(data)) {
      if (n.mterms[j] == names(data)[i]) {
        if (mterms[[j]] == 'factor' |
            mterms[[j]] == 'ordered' |
            mterms[[j]] == 'logical') {
          i.factor <- rbind(i.factor, c(n.mterms[j], j, i, b))
          (break)()
        }
        if (mterms[[j]] == 'numeric') {
          i.numeric <- rbind(i.numeric, c(n.mterms[j], j, i))
          b <- b 
          (break)()
        }

#etc etc