inst/shiny-examples/paramViewer/server.R

In jameshay218/antibodyKinetics: antibodyKinetics

library(shiny)
source("helpers.R",local=TRUE)
source("global_parameters.R",local=TRUE)
library(rhandsontable)
library(ggplot2)

#options(shiny.maxRequestSize=1000*1024^2)
shinyServer(
    function(inputs, output, session){
        parameters <- reactiveValues()
        ## Keep track of the currently selected 
        parameters$selectedID <- 1
        parameters$selectedType <- 1
        parameters$exposureTab <- NULL
        parameters$parTab <- NULL
        parameters$crTab <- data.frame(names=c("None","all",weak_types,strong_types),values=-Inf,stringsAsFactors=FALSE)
        tmp <- as.data.frame(unique(t(apply(expand.grid(exposure_strains,exposure_strains),1,sort))))
        colnames(tmp) <- c("Strain 1","Strain 2")
        parameters$antigenicDistTab <- data.frame(tmp,"Distance"=0,stringsAsFactors=FALSE)
        
        
        source("exposure_management.R",local=TRUE)
        source("cr_table.R",local=TRUE)
        source("cr_management.R",local=TRUE)
################################
        ## EXPOSURE TABLE MANAGEMENT
################################
        ## On initialisation, make the exposure table NULL
        output$exposure_table_id <- renderUI({
            out <- NULL
            if(inputs$typing_flags == 0){
                ids <- get_ids(parameters)
                out <- isolate(selectInput("exposure_select","Exposure",
                                   ids))
            } else {
                out <- "none"
                if(!is.null(parameters$parTab)){
                    #types <- get_types(inputs)
                    types <- unique(parameters$parTab$type)
                    out <- isolate(selectInput("exposure_select","Exposure",
                                       types))
                }
            }
            out
        })

        
################################
        ## EXPOSURE TYPE RESTRICTIONS
################################
        ## This is for displaying available exposure types when adding exposures.
        ## The exposures available depends on which analysis is being considered
        get_available_exposure_types <- reactive({get_types(inputs)})

        ## As above, but relating to sigma parameters. If not using cross reactivity, then no
        ## sigma. Otherwise, depends on if we are using typed cross reactivity of not.
        get_available_exposure_types_cr <- reactive({
            types <- NULL
            if(inputs$cr_flags == 0){
                types <- c("None"="none")
            } else if(inputs$cr_flags == 1){
                types <- c("all"="all")
            } else {
                types <- get_types(inputs)
            }
            return(types)
        })
        
        ## Related to the above, display the output select input based on
        ## availability
        output$choose_exposure_type_cr<- renderUI({
            selectInput("type_cr","CR Type:",
                        get_available_exposure_types_cr(),
                        selected=1)
        })
################################
        source("exposure_table.R",local=TRUE)
        source("exposure_table_management.R",local=TRUE)
        source("plots.R",local=TRUE)

        output$download_all <- downloadHandler(
            filename="parTab.csv",
            
            content=function(file){
                top_parTab <- data.frame(names=c("lower_bound","S","EA","MAX_TITRE"), id="all",
                                         values=c(inputs$lower_bound,0.79,0.2,inputs$max_titre),
                                         type="all",
                                         exposure=NA,strain=NA,order=NA,fixed=1,steps=0.1,
                                         lower_bound=c(-1000,0,0,0),upper_bound=c(0,1,1,100),stringsAsFactors=FALSE)

                if(inputs$cr_flags != 0){
                    tmpCrTab <- parameters$crTab[parameters$crTab$names %in% get_available_exposure_types_cr(),]
                    cr_values <- tmpCrTab$values
                    cr_names <- tmpCrTab$names
                    bot_parTab <- data.frame(names=c("beta","c",rep("sigma",length(cr_names)),"y0_mod","boost_limit","tau"),id="all",
                                             values=c(inputs$beta,inputs$c,cr_values,inputs$y0_mod, inputs$boost_limit, inputs$tau),
                                             type=c("all","all",cr_names,"all","all","all"),
                                             exposure=NA,strain=NA,order=NA,fixed=1,steps=0.1,
                                             lower_bound=c(0,0,rep(0,length(cr_names)),0, 0, 0),
                                             upper_bound=c(100,20,rep(100,length(cr_names)),500,12,1),stringsAsFactors=FALSE)
                } else {
                    bot_parTab <- data.frame(names=c("beta","c","sigma","y0_mod","boost_limit","tau"),id="all",
                                             values=c(inputs$beta,inputs$c,0,inputs$y0_mod, inputs$boost_limit, inputs$tau),
                                             type=c("all","all","all","all","all","all"),
                                             exposure=NA,strain=NA,order=NA,fixed=1,steps=0.1,
                                             lower_bound=c(0,0,0,0,0,0),upper_bound=c(100,20,100,500,12,1),stringsAsFactors=FALSE)
                }

                mod_parTab <- data.frame(names="mod",id=NA,values=c(1,1,1,1),
                                         type="all",exposure=NA,strain=NA,order=NA,fixed=1,steps=0.1,
                                         lower_bound=0,upper_bound=1,stringsAsFactors=FALSE)

                distance_parTab <- data.frame(names="x",id=NA,values=parameters$antigenicDistTab$Distance,
                                              type="all",exposure=parameters$antigenicDistTab$Strain.1,
                                              strain=parameters$antigenicDistTab$Strain.2,
                                              order=NA,fixed=1,steps=0.1,lower_bound=0,upper_bound=10000,
                                              stringsAsFactors=FALSE)
                tmpTab <- parameters$parTab
                tmpTab[tmpTab$names == "m","values"] <- exp(tmpTab[tmpTab$names == "m","values"])
                parTab <- rbind(top_parTab,tmpTab,bot_parTab,distance_parTab,mod_parTab)
                
                write.csv(parTab,file,row.names=FALSE)
            }
        )
    })