Survival model




Define the hazard model as an equation 'h = ...', where h>0 hazard 'h' can be function of time 't'












            
shinyUI(fluidPage(
  titlePanel(
    list(HTML('<p style="color:#4C0B5F; font-size:24px" fontsize=14>Survival model</p>' )),
    windowTitle="Survival model"),
  
  fluidRow(
    br(),
    column(3,
           tabsetPanel(
             tabPanel("model",
                      br(),
                      br(),
                      helpText("Define the hazard model as an equation 'h = ...', where h>0"),                      
                      helpText("hazard 'h' can be function of time 't'"),                      
                      textInput("hazard","",  "h = 0.2 - 0.01*t"),
                      #                       tags$textarea(id="hazard", rows=3, cols=30,  "h = 0.2 + 0.1*t"),
                      actionButton("action1", label = "Run"),
                      br(),
                      br(),                     
                      checkboxInput("checksim", label = "Simulation", value = 0),
                      conditionalPanel(condition = "input.checksim == 1",
                                       selectInput("N", label = "Sample size",choices = c(10,50,100,500),selected = "50"),
                                       checkboxInput("checklevel", label = "Confidence interval", value = 0),
                                       conditionalPanel(condition = "input.checklevel == 1",
                                                        sliderInput("level", label="Level of the confidence interval (%)", min=5, max=95, value=90, step=5))
                      ), 
                      br(),
                      br(),
                      br(),
                      br()
             ),
             tabPanel("settings",
                      br(),
                      numericInput("tmax", label="max time", value=10),   
                      br(),
                      numericInput("ngp", "grid size", value = 100),
                      #                       br(),
                      #                       numericInput("lsize", "line width", value = 0.75),
                      br(),                     
                      actionButton("action2", label = "Run"),
                      #                       submitButton("Update"),
                      br(),
                      br()
             )        
           )
    ),
    column(8,
           tabsetPanel(
             tabPanel("Plot", plotOutput("plot",  height="500px")),
             tabPanel("Table", tableOutput("table")),
             tabPanel("Mlxtran", verbatimTextOutput("mlxtran")),
             tabPanel("ui.R", pre(includeText("ui.R"))),
             tabPanel("server.R", pre(includeText("server.R")))
             #      tabPanel("ReadMe", withMathJax(), includeMarkdown("ReadMe.Rmd"))
           )
    )
  )
))
source("../../initMlxR.R")  

shinyServer(function(input, output) {
  
  mlxtran.text1 <- ("
[LONGITUDINAL]
EQUATION:
t0  = 0
H_0 = 0
")
  mlxtran.text2 <- ("
ddt_H = h
S = exp(-H)
  ")
  mlxtran.text3 <- reactive({
    input$action2
    tmax <- isolate(input$tmax)
    txt <- paste0("DEFINITION:
e = {type=event, maxEventNumber=1, rightCensoringTime=",tmax,", hazard=h}")
    return(txt)  
  })
  
  vN <- c(10,50,100,500)
  r <- reactive({ 
    input$action1
    input$action2
    tmax <- isolate(input$tmax)
    ngp  <- isolate(input$ngp)
    h.text <- isolate({input$hazard})
    out1 <- list(name=c('h','S'), time=seq(0,tmax,length=ngp))
    mlxtran.text <- paste0(mlxtran.text1,h.text,mlxtran.text2)
    if (input$checksim==0){
      write(mlxtran.text,"temp_hazard.txt")
      res <- simulx(model="temp_hazard.txt", output=out1)      
    }else{
      mlxtran.text <- paste0(mlxtran.text,mlxtran.text3())
      write(mlxtran.text,"temp_hazard.txt")
      out2 <- list(name='e',time=0)
      g <- list(size=as.numeric(input$N))
      res <- simulx(model="temp_hazard.txt", output=list(out1, out2), group=g)
    }
    mlxtran.text <- includeText("temp_hazard.txt")
    p <- list(res, mlxtran.text)
    return(p)
  })
  
  output$plot <- renderPlot({
    res <- r()[[1]]
    if (min(res$h$h)>=0) {
    pl1=ggplot(data=res$h, aes(x=time, y=h))  + geom_line(size=0.75) 
    if (input$checksim==0){
      pl2=ggplot(data=res$S)  + geom_line(aes(x=time, y=S),size=0.75) 
    }else{
      if (input$checklevel==0){
        pl2 <- kmplotmlx(res$e) + geom_line(data=res$S, aes(x=time, y=S),size=0.75)
      }else{
        pl2 <- kmplotmlx(res$e, level=input$level/100) + geom_line(data=res$S, aes(x=time, y=S),size=0.75)
      }
    }
    grid.arrange(pl1,pl2,ncol=2)
    }else{
      plot(ggplot(data=res$h, aes(x=time, y=h))  + geom_line(size=0.75) + ggtitle("h should be >=0 !!!"))
    }
  })
  
  
  output$table <- renderTable({     
    res <- r()[[1]]
    S <- res$S$S
    r.table <- cbind(res$h,S)
    return(r.table)
  })
  output$mlxtran <- renderText(r()[[2]])
  
})