inst/shiny/design_ui.R

In olssol/tburden: Tumor burden based treatment effect evaluation

##-------------------------------------------------------------
##           FUNCTIONS
##-------------------------------------------------------------

## set
set_wrap <- function(rst, by_var) {
    if (length(by_var) > 0) {
        if (length(by_var) > 1) {
            s_fml <- paste(by_var[1], "~", paste(by_var[-1], collapse = "+"))
            rst   <- rst + facet_grid(as.formula(s_fml))
        } else {
            s_fml <- paste("~", paste(by_var, collapse = "+"))
            rst   <- rst + facet_wrap(as.formula(s_fml))
        }
    }

    rst
}


## get imputation survival data
get_imp_data <- function(dat_surv, fml_surv) {
    ## multistate survival data
    msm_surv <- tb_msm_set_surv(dat_surv) %>%
        mutate(time = max(time, 10))

    ## fit imputation model
    msm_fit <- tb_msm_fit(msm_surv, fml_surv)

    ## imputation
    imp_surv <- tb_msm_imp(msm_fit, imp_m = imp_m)

    imp_surv
}

## filter by ID
get_filter <- function(dat, filtered_id) {
    if (!is.null(filtered_id))
        dat <- dat %>%
            filter(SUBJID %in% filtered_id)
    dat
}

## set cap and tests
set_fmt_cap <- function(dat) {
    dat %>%
        mutate(CAP   = factor(ecap,
                              levels = c(0.5, 1.0, 2.0, 1000),
                              labels = c("Upper CAP 50%",
                                         "Upper CAP 100%",
                                         "Upper CAP 200%",
                                         "No Upper Cap")),
               CAP_LOW = factor(ecap_low,
                                levels = c(-1, -2, -1000),
                                labels = c("-100%",
                                           "-200%",
                                           "No Lower Cap"))
               )
}

set_cap_test <- function(dat) {
    dat %>%
        set_fmt_cap() %>%
        mutate(size  = paste("N = ", size, sep =""),
               Test  = recode(Test,
                              "pvalue"   = "LSCF",
                              "pval_os"  = "OS",
                              "pval_pfs" = "PFS",
                              "pval_or"  = "OR"),
               Test  = if_else(Test == "LSCF",
                               paste("LSCF(", CAP_LOW, ")", sep = ""),
                               Test))
}

##-------------------------------------------------------------
##           UI FUNCTIONS
##-------------------------------------------------------------

tab_upload <- function() {
    tabPanel("Upload Data",
             wellPanel(h4("Select R Data to Upload"),
                       fluidRow(
                           column(4,
                                  fileInput(inputId = 'inRdata',
                                            label   = 'Choose result R data file',
                                            accept  = '.Rdata')
                                  ))
                       ),
             conditionalPanel(condition = "output.loadcomplete",
                              wellPanel(h4("Results: Estimate and Confidence Interval"),
                                        DT::dataTableOutput("dt_rst")
                                        ),
                              wellPanel(h4("Settings"),
                                        verbatimTextOutput("txtSetting")))
             ## wellPanel(h4("Create Pseudo Study"),
             ##           numericInput("inFirstn",
             ##                        label = "Keep the first N patients",
             ##                        value = 999999,
             ##                        width = "400px"),
             ##           numericInput("inFudays",
             ##                        label = "Follow up days since the last enrollment",
             ##                        value = 999999,
             ##                        width = "400px"),
             ##           )
             )
}

panel_auc_options <- function() {
    wellPanel(h4("Options for Utility Plot"),
              fluidRow(
                  column(5,
                         radioButtons("inAnaTime",
                                      "Time for the Final Analysis",
                                      choices = c("Calendar Time" = 1,
                                                  "Fixed Time"    = 2)),
                         textInput("inDBL",
                                   label = "Date of Analysis for (Calendar Time",
                                   value = "2020-03-01"),
                         numericInput("inTana",
                                      label = "Time for Analysis in Months (Fixed Time)",
                                      value = 36)
                         ),
                  column(3,
                         numericInput("inGammaPFS",
                                      label = "Utility post PFS",
                                      value = 0.2),
                         numericInput("inGammaOS",
                                      label = "Utility post OS",
                                      value = 0.5),
                         checkboxInput("inLocf",
                                       label = "LOCF",
                                       value = FALSE)
                         )
              ))
}

tab_present <- function() {
    tabPanel("Individual Patient",
             fluidRow(
                 wellPanel(h4("Patient Survival Data"),
                           div(DT::dataTableOutput("dt_surv"),
                               style = "font-size:90%"))),
             fluidRow(column(6,
                             wellPanel(
                                 h4("Baseline"),
                                 DT::dataTableOutput("dt_cov")),
                             wellPanel(
                                 h4("Tumor Burden"),
                                 DT::dataTableOutput("dt_tb")),
                             wellPanel(
                                 h4("Survival Outcome"),
                                 DT::dataTableOutput("dt_impsurv")),
                             wellPanel(
                                 h4("Follow Up"),
                                 plotlyOutput("pltFUid"))
                             ),
                      column(6,
                             wellPanel(
                                 h4("History and AUC"),

                                 fluidRow(
                                     column(4,
                                            radioButtons("inUtiMtd",
                                                         "Utility Option",
                                                         choices =
                                                             c("Last Observation Carry Forward" = "locf",
                                                               "Last Slope Carry Forward"       = "extrap"
                                                              ## ,"Composite" = "composite"
                                                               ))
                                            ),
                                     column(4,
                                            numericInput("inExtraCap0",
                                                         label = "Cap Value for LSCF (Upper Bound)",
                                                         value = 2,
                                                         min   = 0)),
                                     column(4,
                                            numericInput("inExtraCapLow0",
                                                         label = "Cap Value for LSCF (Lower Bound)",
                                                         max   = -1,
                                                         value = -1)
                                            )
                                 ),

                                 sliderInput("inYlim0",
                                             label = "",
                                             value = c(-1, 5),
                                             min   = -50,
                                             max   = 50,
                                             step  = 1),
                                 plotOutput("pltPt", height = "500px"),
                                 sliderInput("inXlim",
                                             label = "",
                                             value = 0,
                                             min   = 0,
                                             max   = 2000,
                                             step  = 100)
                                 ## ,checkboxInput("inRegTb",
                                 ##               "By observed TB",
                                 ##               value = FALSE)
                             ))),
             fluidRow(
                 wellPanel(h4("Utility Details"),
                           verbatimTextOutput("txtHist"))
             ))
}


tab_results <- function() {
    tabPanel("Results",
             wellPanel(h4("Estimate and Confidence Interval"),
                       DT::dataTableOutput("dt_rst")
                       )
             )
}

tab_survival <- function() {
    tabPanel("TB and Survival",
             wellPanel(h4("Options for Tumor Burden and Survival Plot"),
                       selectInput(inputId = "inByvar",
                                   label   = "Group by",
                                   choices = c("ARM", "SEX",
                                               "STRATA1", "P1TERTL",
                                               "WITH EVENT" = "PFS",
                                               "RESPONSE"   = "OR"),
                                   multiple = TRUE,
                                   selected = "ARM",
                                   width    = "400px")
                       ),
             wellPanel(h4("Tumor Burden by Time"),
                       plotOutput("pltTb"),
                       sliderInput("inTbSub", "",
                                   value = 1,
                                   min = 0.1, max = 1, step = 0.05)),
             wellPanel(h4("Observed Survival"),
                       fluidRow(
                           column(6,
                                  h4("Progression Free Survival"),
                                  plotOutput("pltPFS")),
                           column(6,
                                  h4("Overall Survival")
                                  ## ,plotOutput("pltOS")
                                  )
                       )),
             wellPanel(h4("Imputed Survival"),
                       fluidRow(
                           column(4,
                                  selectInput(inputId = "inImpInx",
                                              label   = "Index of Imputation",
                                              choices = 1:5,
                                              width   = "400px")),
                           column(4,
                                  sliderInput("inSurvXlim",
                                              label = "",
                                              value = 0, min = 0,
                                              max = 8000, step = 100)
                                  )),
                       fluidRow(
                           column(6,
                                  h4("Imputed Progression Free Survival"),
                                  plotOutput("pltImpPFS")),
                           column(6,
                                  h4("Imputed Overall Survival"),
                                  plotOutput("pltImpOS"))
                       ),
                       DT::dataTableOutput("dt_impsurv_summary")
                       ),
             wellPanel(h4("MSM Model Fitting Results"),
                       verbatimTextOutput("txtMsm"))
             )
}

tab_corr <- function() {
    xx <- c("utility", "adj_utility",
            "uti_tb", "uti_event", "t_ana")

    tabPanel("Correlation",
             wellPanel(h4("Select Subject-Level Measurements"),
                       fluidRow(
                           column(3,
                                  selectInput(inputId = "inCorX",
                                              label   = "X",
                                              choices = xx,
                                              selected = "uti_tb")
                                  ),
                           column(3,
                                  selectInput(inputId = "inCorY",
                                              label   = "Y",
                                              choices = xx,
                                              selected = "uti_event")))
                       ),
             wellPanel(h4("Correlation"),
                       plotOutput("pltCorr", height = "800px"))
             )
}

## curves
tab_curves_panel <- function() {
    wellPanel(

        h4("Select Study"),
        selectInput("inStudy",
                    "Study No",
                    choices = c("R2810-ONC-1624"  = "1624",
                                "R2810-ONC-16113" = "16113")),
        ##"Composite" = "composite")),

        br(),
        h4("Present Curves"),
        radioButtons("inCurveType",
                     "Type of Curves",
                     choices =
                         c("Observed Tumor Burden"          = "obs",
                           "Last Observation Carry Forward" = "locf",
                           "Last Slope Carry Forward"       = "extrap")),

        selectInput(inputId = "inByvar2",
                    label   = "Group By",
                    choices = c("ARM", "SEX",
                                "STRATA1", "P1TERTL",
                                "PFS EVENT" = "PFS",
                                "RESPONSE"  = "OR"),
                    multiple = TRUE,
                    selected = "ARM"),

        conditionalPanel(
            condition = "input.inCurveType != 'obs'",
            conditionalPanel(
                condition = "input.inCurveType == 'extrap'",
                selectInput("inExtraCap",
                            "Cap Value for LSCF (Upper Bound)",
                            choices = c("50%"  = 0.5,
                                        "100%" = 1,
                                        "200%" = 2,
                                        "500%" = 5,
                                        "No Cap (V2.0)" = 1000)),
                selectInput("inExtraCapLow",
                            "Cap Value for LSCF (Lower Bound)",
                            choices = c("-100%"  = -1,
                                        "-200%"  = -2,
                                        "No Cap" = -1000))
            ),

            checkboxInput("inCutAna",
                          "Curves Up To Database Lock",
                          value = TRUE),

            conditionalPanel(
                condition = "input.inCutAna == false",
                radioButtons("inShowMean",
                             "Show Mean Curve",
                             choices = c("None"         = "none",
                                         "Mean"         = "mean",
                                         "Median"       = "median",
                                         "Mean with CI" = "mean_ci"))
            ),

            checkboxInput("inHlObs",
                          "Highlight Extrapolation",
                          value = FALSE)
        ),


        fluidRow(
            column(6,
                   numericInput("inYlimLB",
                                "Y-Lower Bound",
                                value = -1,
                                max   = -0.5,
                                step  = 0.5)
                   ),
            column(6,
                   numericInput("inYlimUB",
                                "Y-Upper Bound",
                                value = 0.5,
                                min   = 0,
                                step  = 0.5),
                   )
        ),

        br(),
        h4("Filter Subset"),

        radioButtons("inFilter",
                     "",
                     choices = c(
                         "No filtering"  = "none",
                         "Random subset" = "rndsub",
                         "PFS events" = "pfssub"),
                     inline = TRUE),

        conditionalPanel(
            condition = "input.inFilter == 'rndsub'",
            sliderInput("inTbSub2",
                        "Size of Random Subset",
                        value = 800,
                        min   = 50, max = 800, step = 50),

            numericInput("inSubSeed",
                         "Random Seed",
                         value = 1000, min = 100, step = 50)
        ),

        conditionalPanel(
            condition = "input.inFilter == 'pfssub'",
            uiOutput("uiSliderPfsId")
        ),

        br(),
        h4("Present Imputed Results"),
        checkboxInput("inImp",
                      "Show results with imputation",
                      value = FALSE)
    )
}

tab_curves_panel2 <- function() {
    tabsetPanel(type = "pills",
                tabPanel(
                    "TB Curves",
                    plotlyOutput("pltCurves", height = "900px")
                    ## conditionalPanel(
                    ##     condition = "input.inCurveType != 'obs'",
                    ##     h4("Estimate and Hypothesis Testing"),
                    ##     DT::dataTableOutput("tblRst"),
                    ##     checkboxInput("inTrimMean",
                    ##                   "Trimmed Mean Results",
                    ##                   value = FALSE))
                ),

                tabPanel(
                    "TB Curves (Overlay)",
                    div(uiOutput("uiChkCurveGrp"), style = "padding:15px"),
                    plotlyOutput("pltCurvesOverlay", height = "900px")
                ),

                tabPanel(
                    "Random Subset",
                    div(uiOutput("uiSubCurvSize"), style = "padding:15px"),
                    plotlyOutput("pltRndSubCurve", height = "700px")),

                tabPanel(
                    "AUC Density",
                    fluidRow(
                        column(4,
                               radioButtons("inAUCType",
                                            "Type of AUC",
                                            choices =
                                                c("AUC (Composite of TB and Event)" = "uti",
                                                  "AUC (TB Only)"                   = "tb",
                                                  "AUC (Event Only)"                = "event"))),
                        column(4,
                               radioButtons("inDenType",
                                            "Type of Density",
                                            choices =
                                                c("Density" = "pdf",
                                                  "Cumulative Density" = "cdf")))
                    ),
                    plotOutput("pltAUC", height = "900px")
                ),
                tabPanel(
                    "Last Slopes",
                    plotlyOutput("pltLastSlope", height = "900px")
                ),
                tabPanel(
                    "Survival Curves",
                    plotlyOutput("pltPFS", height = "400px"),
                    plotlyOutput("pltOS", height = "400px")
                ),
                tabPanel(
                    "Follow-up Time",
                    plotlyOutput("pltFU", height = "900px")
                ),

                tabPanel(
                    "TB Given Time",
                    div(sliderInput("inHistoDay",
                                    "Day",
                                    value = 22,
                                    min = 1, max = 800, step = 7,
                                    width = "100%"),
                        style = "padding:15px"),

                    plotlyOutput("pltCurvesHisto", height = "900px")
                ),
                selected = "TB Curves"
                )
}

tab_curves <- function() {
    tabPanel("Tumor Burden Curves",
             fluidRow(
                 column(3, tab_curves_panel()),
                 column(9, tab_curves_panel2())
             ))
}

tab_power <- function() {
    tabPanel(
        "Power Analysis",
        tabsetPanel(
            type = "pills",
            tabPanel(
                "By Study",
                wellPanel(
                    fluidRow(
                        column(3,
                               radioButtons("inPltSum",
                                            "Choose the value to plot",
                                            choices =
                                                c("P Value"        = "pvalue",
                                                  "Point Estimate" = "value",
                                                  "Standard Err"   = "bs_sd")
                                            )),
                        column(3,
                               checkboxInput("inChkTrimmed",
                                             "Include Trimmed Mean Results",
                                             value = FALSE),
                               checkboxInput("inChkImputed",
                                             "Include Multiple Imputation Results",
                                             value = FALSE)
                               )
                    ),
                    plotlyOutput("pltSummary", height = "500px")
                ),
                wellPanel(
                    h4("Summary of Results"),
                    DT::dataTableOutput("tblAllRst")
                )),

            tabPanel(
                "Random Subset",
                fluidRow(
                    column(2,
                           wellPanel(
                               uiOutput("uiChkPwrSubTest")
                           )),
                    column(10,
                           plotlyOutput("pltPwrRndSub", height = "500px"))
                )),

            tabPanel(
                "X Pts FU Y Days",
                fluidRow(
                    column(2,
                           wellPanel(
                               uiOutput("uiChkPwrXyTest")
                           )),
                    column(10,
                           plotlyOutput("pltPwrXY", height = "700px"))
                ))
        ))
}

##define the main tabset for beans
tab_main <- function() {
    tabsetPanel(type = "pills",
                id   = "mainpanel",
                ## tab_upload(),
                ## tab_corr(),
                tab_curves(),
                ## tab_survival(),
                tab_present(),
                ## ,tab_results(),
                tab_power(),
                selected = "Tumor Burden Curves"
                )
}


##-------------------------------------------------------------
##           LOAD/UPLOAD DATA
##-------------------------------------------------------------

## upload simulated results
observe({
    in_file <- input$inRdata

    if (!is.null(in_file)) {
        ss  <- load(in_file$datapath)
        print("load data...")
        isolate({
            userLog$data <- tb_extract_rst(rst_all)
        })
    }
})

## get study tumor burden, survival and imputed survival
get_study_data <- reactive({
    study_no <- get_study_no()
    fname    <- paste("www/data/bystudy/rst_study_",
                      study_no,
                      "_imp", as.numeric(input$inImp),
                      ".Rdata", sep = "")

    if (!file.exists(fname))
        return(NULL)
    else
        load(fname)

    list(dat_tb   = dat_tb,
         dat_surv = dat_surv,
         imp_surv = imp_surv,
         date_dbl = date_dbl)
})

## overall results
get_overall_rst <- reactive({
    fname <- paste("www/data/bystudy/overall.Rdata", sep = "")

    if (!file.exists(fname))
        return(NULL)

    load(fname)
    list(lst_rst_all = lst_rst_all,
         overall_rst = overall_rst,
         rst_auc     = rst_auc)
})

## get power x pts by y days
get_pwr_xy_rst <- reactive({
    fname <- paste("www/data/pwr/pwr_xy_all.Rdata", sep = "")

    if (!file.exists(fname))
        return(NULL)

    load(fname)
    rst
})


## get power x pts by y days
get_pwr_sub_inx <- reactive({
    fname <- paste("www/data/pwr/sub_curves_inx.Rdata", sep = "")
    if (!file.exists(fname))
        return(NULL)

    load(fname)
    inx_g_all
})

## get power by random subset
get_pwr_sub_rst <- reactive({
    fname <- paste("www/data/pwr/pwr_sub_all.Rdata", sep = "")
    if (!file.exists(fname))
        return(NULL)

    load(fname)
    rst_summary
})

## random subset curves
get_pwr_sub_dta <- reactive({

    inx_g_all <- get_pwr_sub_inx()
    if (is.null(inx_g_all))
        return(NULL)

        study_no <- get_study_no()
        vecap    <- as.numeric(input$inExtraCap)
        vecap_low<- as.numeric(input$inExtraCapLow)
        vimp     <- as.numeric(input$inImp)

        inx_g <- inx_g_all %>%
            filter(study    == study_no,
                   ecap     == vecap,
                   ecap_low == vecap_low,
                   imp      == vimp)

        if (1 != nrow(inx_g))
            return(NULL)

            fname <- paste("www/data/pwr/sub_curves_",
                           inx_g[1, "finx"],
                           ".Rdata", sep = "")

            if (!file.exists(fname))
                return(NULL)

                load(fname)
                rst
})


##-------------------------------------------------------------
##           GET INPUT FROM WEB PAGE
##-------------------------------------------------------------
get_study_no <- reactive({
    study_no <- input$inStudy
    print(study_no)

    study_no
})

## get result and curve file name
get_file_name <- reactive({
    study_no <- get_study_no()
    method   <- input$inCurveType
    ecap     <- as.numeric(input$inExtraCap)
    ecap_low <- as.numeric(input$inExtraCapLow)
    imp      <- as.numeric(input$inImp)

    if (is.null(study_no) |
        is.null(method)) {
        return(NULL)
    }

    if ("obs" == method) {
        return(NULL)
    }

    if ("extrap" != method) {
        ecap     <- NULL
        ecap_low <- NULL
    }

    trim <- "0"

    ## if (input$inTrimMean) {
    ##     trim <- "0.95"
    ## } else {
    ##     trim <- "0"
    ## }

    fname_curve <- paste("www/data/bystudy/rst_study_", study_no, "_curve_",
                         method, ecap, ecap_low,
                         "_imp", imp,
                         ".Rdata",
                         sep = "")

    ## fname_rst  <- paste("www/data/", study_no, "_rst_",
    ##                      method, ecap, trim, ".Rdata",
    ##                      sep = "")

    fname_rst <- paste(c(study_no, method, ecap, ecap_low, trim, imp),
                       collapse = ",")

    c(curve = fname_curve,
      rst   = fname_rst)
})

## get all ids
get_all_id <- reactive({
    dat <- get_study_data()
    if (is.null(dat))
        return(NULL)

    dat$dat_surv %>% select(SUBJID) %>% distinct()
})

## get all IDs with PFS
get_pfs_id <- reactive({
    dat <- get_study_data()
    if (is.null(dat))
        return(NULL)

    dat_surv <- dat$dat_surv
    if (is.null(dat_surv))
        return(NULL)

    rst <- dat_surv %>%
        filter(PFS == TRUE &
               PFS_DAYS == round(PFS_DAYS)) %>%
        arrange(PFS_DAYS) %>%
        select(SUBJID) %>%
        distinct()
})

## get filtered IDs
get_filtered_id <- reactive({
    if ("none" == input$inFilter)
        return(NULL)

    if ("pfssub" == input$inFilter) {
        id  <- get_pfs_id()
        if (is.null(id))
            return(NULL)
        inx <- input$inPfsID
        if (is.null(inx))
            return(NULL)

        rst <- id[inx[1]:inx[2], "SUBJID"]
    } else if ("rndsub" == input$inFilter) {
        id <- get_all_id()
        if (is.null(id))
            return(NULL)

        sub_n    <- input$inTbSub2
        sub_seed <- input$inSubSeed
        old_seed <- set.seed(sub_seed)
        inx      <- sample(seq_len(nrow(id)), min(sub_n, nrow(id)))
        set.seed(old_seed)

        rst <- id[inx, "SUBJID"]
        return(rst)
    }
    rst
})


##-------------------------------------------------------------
##           DATA FUNCTIONS
##-------------------------------------------------------------
get_data <- reactive({
    ## rst <- userLog$data

    overall <- get_overall_rst()
    if (is.null(overall))
        return(NULL)

    fname <- get_file_name()
    if (is.null(fname)) {
        return(NULL)
    }

    ## if (!file.exists(fname["rst"])) {
    ##     return(NULL)
    ## }

    ## load(fname["rst"])

    rst_all <- overall$lst_rst_all[[fname["rst"]]]
    if (is.null(rst_all))
        return()

    rst <- tb_extract_rst(rst_all)
    if (is.null(rst)) {
        return(NULL)
    }

    if (0) {
        first_n <- input$inFirstn
        days_fu <- input$inFudays
        if (!is.null(first_n) &
            !is.null(days_fu)) {

            ## only impute if smaller study created
            if (first_n < 1000 |
                days_fu < 10000) {
                ana_data <- tb_get_data(rst$raw_dat_rs,
                                        rst$raw_dat_te,
                                        first_n,
                                        days_fu)

                rst$dat_tb   <- ana_data$dat_tb
                rst$dat_surv <- ana_data$dat_surv
                rst$imp_surv <- get_imp_data(rst$dat_surv,
                                             rst$formula_surv)
            }
        }
    }
    rst
})


get_cur_imp_surv <- reactive({
    dat <- get_data()
    if (is.null(dat))
        return(NULL)

    id <- get_cur_id()
    if (is.null(id))
        return(NULL)

    dat$imp_surv %>%
        filter(SUBJID == id) %>%
        select(Imp, SUBJID, IT_PFS, IT_OS)
})

get_cur_id <- reactive({
    dat <- get_data()
    if (is.null(dat))
        return(NULL)

    s <- input$dt_surv_rows_selected
    if (is.null(s))
        return(NULL)

    id <- dat$dat_surv[s, "SUBJID"]

    id
})

get_cur_imp_inx <- reactive({
    dat <- get_cur_imp_surv()
    if (is.null(dat))
        return(NULL)

    s <- input$dt_impsurv_rows_selected
    if (is.null(s))
        return(NULL)

    id <- dat[s, "Imp"]

    id
})


get_cur_tb <- reactive({
    dat <- get_data()
    if (is.null(dat))
        return(NULL)

    id <- get_cur_id()
    if (is.null(id))
        return(NULL)

    dat$dat_tb %>%
        filter(SUBJID == id)
})

## get patient history
get_cur_hist <- reactive({
    id <- get_cur_id()

    if (is.null(id))
        return(NULL)

    imp_inx <- get_cur_imp_inx()
    if (is.null(imp_inx))
        imp_inx <- 1

    dat <- get_data()
    if (is.null(dat))
        return(NULL)

    if (0) {
        time_dbl  <- input$inDBL
        gamma_pfs <- input$inGammaPFS
        gamma_os  <- input$inGammaOS

        if (1 == input$inAnaTime) {
            t_ana <- NULL
        } else {
            t_ana <- input$inTana * 365.25 / 12
        }
    }

    ## if (input$inRegTb) {
    ##     reg_tb <- NULL
    ## } else {
    ##     reg_tb <- dat$reg_tb
    ## }
    reg_tb <- dat$reg_tb
    d_pt   <- tb_get_pt(id,
                        imp_surv       = dat$imp_surv,
                        dat_tb         = dat$dat_tb,
                        imp_inx        = imp_inx,
                        t_ana          = NULL,
                        date_dbl       = dat$date_dbl,
                        uti_gamma      = dat$uti_gamma,
                        reg_tb         = reg_tb,
                        method         = input$inUtiMtd,
                        extrap_cap     = as.numeric(input$inExtraCap0),
                        extrap_cap_low = as.numeric(input$inExtraCapLow0))

    d_pt
})

## history of a patient
get_cur_plt <- reactive({
    cur_his <- get_cur_hist()
    if (is.null(cur_his))
        return(NULL)

    rst   <- tb_plt_ind(cur_his,
                        type = "uti",
                        ylim = c(input$inExtraCapLow0 * 1.1,
                                 input$inExtraCap0 * 1.1))

    xlim  <- NULL
    ylim  <- NULL
    x_max <- input$inXlim
    if (!is.na(x_max)) {
        if (x_max > 0)
            xlim <- c(0, x_max)
    }

    ylim <- input$inYlim0
    rst  <- rst + coord_cartesian(ylim = ylim, xlim = xlim)
    rst
})


get_impsurv_summary <- reactive({
    dat <- get_data()
    if (is.null(dat))
        return(NULL)

    by_var <- input$inByvar
    if (is.null(by_var))
        return(NULL)

    inx_imp <- input$inImpInx
    tb_summary_imp(dat$imp_surv, dat$dat_surv, inx_imp, by_var)
})


## get curves data
get_curves_data <- reactive({
    study_no <- get_study_no()
    method   <- input$inCurveType
    ecap     <- as.numeric(input$inExtraCap)
    ecap_low <- as.numeric(input$inExtraCapLow)
    sdata    <- get_study_data()

    if ("obs" == method) {
        rst <- get_study_data()$dat_tb
        rst <- get_filter(rst, get_filtered_id())
        return(rst)
    }

    fname <- get_file_name()
    if (is.null(fname)) {
        return(NULL)
    }

    print(fname)
    if (file.exists(fname["curve"])) {
        load(fname["curve"])
        rst <- all_curves
    } else {
        return(NULL)
        if (is.null(sdata)) {
            rst <- NULL
        } else {
            rst <-  tb_get_all_curves(sdata$dat_tb, sdata$imp_surv,
                                      method        = method,
                                      date_dbl      = sdata$date_dbl,
                                      extrap_cap    = ecap,
                                      extrap_cap_low= ecap_low,
                                      ts            = seq(1, 1000, 7),
                                      trimmed_mean  = 0,
                                      covs          = c("ARM", "SEX",
                                                        "STRATA1", "P1TERTL",
                                                        "OR", "PFS"))
        }
    }

    rst$all_curves <- get_filter(rst$all_curves, get_filtered_id())
    rst
})

## get summary of all tests
get_study_rst <- reactive({
    rst <- get_overall_rst()

    if (is.null(rst))
        return(NULL)

    sno <- get_study_no()
    rst$overall_rst %>%
        filter(study == sno) %>%
        mutate(cap_value = factor(cap_value),
               imp       = factor(imp),
               trimmed   = factor(trimmed)
               )
})

## get last slope data
get_last_slope <- reactive({
    dat_tb <- get_study_data()$dat_tb
    if (is.null(dat_tb))
        return(NULL)

    dat_tb <- get_filter(dat_tb, get_filtered_id())
    tb_tb_obs_lastslope(dat_tb)
})

## get AUC data
get_auc_data <- reactive({
    ## fname <- paste("www/data/est_auc.Rdata")
    ## load(fname)
    ## rst

    get_overall_rst()$rst_auc
})

## get power x by y
get_pwr_xy_data <- reactive({
    dat <- get_pwr_xy_rst()
    if (is.null(dat))
        return(NULL)

    study_no <- get_study_no()
    imp      <- as.numeric(input$inImp)
    rst_plt  <- dat %>%
        filter(imputation == imp,
               study      == study_no) %>%
        gather(Test, Pval, pvalue, pval_os, pval_pfs) %>%
        set_cap_test()

    rst_plt
})


## get power subset
get_pwr_sub_data <- reactive({
    dat <- get_pwr_sub_rst()
    if (is.null(dat)) {
        return(NULL)
    }

    study_no <- get_study_no()
    imp      <- as.numeric(input$inImp)

    dat_0 <- dat %>%
        filter(Test %in% c("pval_pfs", "pval_os", "pval_or") &
               imputation == 1) %>%
        group_by(study, Test, size) %>%
        summarize(rejection = mean(rejection))

    dat_1 <- NULL
    for (vecap in unique(dat$ecap)) {
        for (vimp in 0:1) {
            dat_1 <- rbind(dat_1,
                           dat_0 %>% mutate(ecap       = vecap,
                                            imputation = vimp,
                                            ecap_low   = 0))
        }
    }

    dat %>%
        filter(!(Test %in% c("pval_pfs", "pval_os", "pval_or"))) %>%
        select(study, Test, size, rejection, imputation, ecap, ecap_low) %>%
        rbind(dat_1) %>%
        filter(study == study_no &
               imputation == imp) %>%
        set_cap_test()
})


##-------------------------------------------------------------
##           Plot function
##-------------------------------------------------------------

## plot tumor burden curves
get_plot_curves <- reactive({

    dta_curve <- get_curves_data()
    method    <- input$inCurveType

    if (is.null(dta_curve)) {
        return(NULL)
    }

    if ("obs" == method) {
        rst <- tb_plt_tb(dta_curve,
                         sel_ids  = get_cur_id(),
                         by_var   = input$inByvar2)
    } else {
        if (input$inCutAna) {
            ref_line <- "none"
        } else {
            ref_line <- input$inShowMean
        }

        rst <- tb_plt_all_curves(dta_curve,
                                 cut_ana       = input$inCutAna,
                                 by_var        = input$inByvar2,
                                 sel_ids       = get_cur_id(),
                                 ref_line      = ref_line,
                                 highlight_obs = input$inHlObs)
    }

    rst
})


## plot tumor burden curves
plot_curves_overlay <- reactive({
    dat <- get_plot_curves()$dat_ref
    if (is.null(dat))
        return(NULL)

    sel_grp <- input$inChkCurveGrp
    if (is.null(sel_grp))
        return(NULL)

    if (length(sel_grp) > 0) {
        dat <- dat %>%
            filter(Overlay_Group %in% sel_grp)
    }

    ggplot(data = dat, aes(x = DAY, y = ref_y)) +
        geom_line(aes(group = Overlay_Group,
                      col   = Overlay_Group)) +
        theme_bw() +
        labs(x = "DAYS", y = "PCHG") +
        theme(legend.position = "bottom")
})


## plot histogram at each day
plot_curves_histo <- reactive({

    dta_curve <- get_curves_data()
    method    <- input$inCurveType

    if (is.null(dta_curve)) {
        return(NULL)
    }

    if ("obs" != method) {
        rst <- tb_plt_all_curves(dta_curve,
                                 by_var   = input$inByvar2,
                                 day      = input$inHistoDay,
                                 f_plt    = tb_plt_tb_histogram)
    } else {
        rst <- NULL
    }

    rst
})

## plot histogram at each day
plot_last_slope <- reactive({

    dta_slope <- get_last_slope()
    if (is.null(dta_slope)) {
        return(NULL)
    }

    rst <- tb_plt_tb_slope(dta_slope,
                           by_var   = input$inByvar2) +
        geom_vline(xintercept = 0, col = "red", lty = 2)

    })

## plot AUC density
plot_auc_density <- reactive({
    dat <- get_overall_rst()$rst_auc
    if (is.null(dat))
        return(NULL)

    den_type <- input$inDenType
    study_no <- get_study_no()
    vecap    <- as.numeric(input$inExtraCap)
    vecap_low<- as.numeric(input$inExtraCapLow)
    vimp     <- as.numeric(input$inImp)

    dat <- dat %>%
        filter(study         == study_no,
               cap_value     == vecap,
               cap_value_low == vecap_low,
               imp           == vimp)

    if (0 == nrow(dat))
        return(NULL)

    dat     <- get_filter(dat, get_filtered_id())
    vname   <- paste("adj_", input$inAUCType, sep = "")
    dat$auc <- dat[[vname]]
    rst     <- ggplot(data = dat, aes(x = auc))

    if ("cdf" == den_type) {
        rst   <- rst + stat_ecdf(geom = "step", aes(group = ARM, col = ARM))
        y_lab <- "Cumulative Density"
    } else {
        rst   <- rst + geom_density(aes(group = ARM, col = ARM))
        y_lab <- "Density"
    }

    rst <- rst +
        theme_bw() +
        labs(x = "AUC", y = y_lab) +
        theme(legend.position = "bottom")

    ## group by
    by_var <- input$inByvar2
    inx    <- which(by_var == "ARM")
    if (length(inx) > 0)
        by_var <- by_var[-inx]

    set_wrap(rst, by_var)
})


##-------------------------------------------------------------
##           Plot function for power analysis
##-------------------------------------------------------------

## power by study
plot_pwr_bystudy <- reactive({

    rst <- get_study_rst()

    if (is.null(rst)) {
        return(NULL)
    }

    rst <- rst %>%
        filter(method == "LSCF")
    if (0 == nrow(rst)) {
        return(NULL)
    }
    vname <- input$inPltSum
    rst$y <- rst[[vname]]

    rst <- rst %>%
        mutate(Imputation = factor(imp, 0:1,
                                   c("Without MI",
                                     "Withe MI")),
               TrimmedMean = factor(trimmed,
                                    c(0, 0.95),
                                    c("Without Trimmed Mean",
                                      "With Trimmed Mean")))

    if (!input$inChkTrimmed) {
        rst <- rst %>% filter(0 == trimmed)
    }

    if (!input$inChkImputed) {
        rst <- rst %>% filter(0 == imp)
    }

    rst <- rst %>%
        mutate(ecap     = cap_value,
               ecap_low = cap_value_low) %>%
        set_fmt_cap()

    plt_rst <- ggplot(rst, aes(x = CAP, y = y)) +
        ## geom_bar(stat = "identity",
        ##          position = "dodge", aes(fill = Imputation)) +
        geom_line(aes(lty   = CAP_LOW,
                      group = CAP_LOW,
                      col   = CAP_LOW)) +
        geom_point(aes(pch   = CAP_LOW,
                       group = CAP_LOW)) +
        theme_bw() +
        facet_grid(Imputation ~ TrimmedMean) +
        labs(y = "Value", x = "CAP Value")

    ## if ("pvalue" == vname) {
    ##     plt_rst <- plt_rst +
    ##         scale_y_continuous(trans = "log")
    ## }

    plt_rst
})

## plot power for x pt followed up by y days
plot_pwr_xy <- reactive({
    dat <- get_pwr_xy_data()
    if (is.null(dat))
        return(NULL)

    if (is.null(input$inChkPwrXyTest))
        return(NULL)

    sel_test <- input$inChkPwrXyTest
    if (length(sel_test) > 0) {
        dat <- dat %>%
            filter(Test %in% sel_test)
    }

    ggplot(data = dat, aes(x = fu_day, y = Pval)) +
        geom_line(aes(group = Test, col = Test)) +
        geom_point(aes(group = Test, col = Test)) +
        geom_hline(yintercept = 0.05, lty = 2, col = "brown") +
        theme_bw() +
        theme(legend.position = "bottom") +
        facet_grid(CAP ~ size) +
        labs(y = "P-value", x = "Min FU Days") +
        scale_y_continuous(trans = 'log')
})


## power by random subsets
plot_pwr_sub <- reactive({
    dat <- get_pwr_sub_data()
    if (is.null(dat)) {
        return(NULL)
    }

    if (is.null(input$inChkPwrSubTest))
        return(NULL)

    sel_test <- input$inChkPwrSubTest
    if (length(sel_test) > 0) {
        dat <- dat %>%
            filter(Test %in% sel_test)
    }

    ggplot(data = dat, aes(x = size, y = rejection)) +
        geom_line(aes(group = Test, col = Test)) +
        geom_point(aes(group = Test, col = Test)) +
        theme_bw() +
        theme(legend.position = "bottom") +
        facet_grid( ~ CAP) +
        labs(y = "Power", x = "Size")
})


## plot power for x pt followed up by y days
plot_subset_curve <- reactive({
    dat <- get_pwr_sub_dta()
    if (is.null(dat))
        return(NULL)

    vsize <- as.numeric(input$inSubSize)
    if (is.null(vsize))
        return(NULL)

    ref_line <- input$inShowMean
    by_var   <- input$inByvar2

    f_ref <- mean
    if ("median" == ref_line) {
        f_ref <- median
    }

    dat_plt <- dat %>%
        filter(size == vsize) %>%
        group_by_at(c(by_var, "inx", "DAY")) %>%
        summarize(PCHG = f_ref(PCHG)) %>%
        mutate(inx = factor(inx))


    if (0 == nrow(dat))
        return(NULL)

    rst <- ggplot(data = dat_plt,
                  aes(x = DAY, y = PCHG, group = inx)) +
        geom_line(col = "brown") +
        theme_bw() +
        theme(legend.position = "none")

    set_wrap(rst, by_var)
})