inst/ubinc/templates/ubiquity_server.R

rm(list=ls())


require(shiny)
require(deSolve)
require(ggplot2)
require(foreach)
require(doParallel)
require(rhandsontable)
require(grid)          
require(gridExtra)

#
# If we're operating out of a "stand alone" directory we load the files from
# there. Otherwise we try to load the ubiquity package
#

if("ubiquity" %in% (.packages())){
  ubiquity_distribution = "package"
} else if(file.exists(file.path('library', 'r_general', 'ubiquity.R'))){
  source(file.path('library', 'r_general', 'ubiquity.R'))
  ubiquity_distribution = "stand alone"
} else { 
  library(ubiquity) 
  ubiquity_distribution = "package"
}

source(file.path("transient", "app_base", "auto_rcomponents.R"))

#-----------------------------------------
str2list = function(cfg, str){
    val = c();

   tryCatch(
    { 
    val = eval(parse(text=sprintf('c(%s)',str )))
    },
     warning = function(w) {
     # place warning stuff here
    },
     error = function(e) {
       GUI_log_entry(cfg, sprintf('unable to parse string (%s)', str))
    })
  return(val)}
#-----------------------------------------
#-----------------------------------------
user_log_entry = function(cfg, text, initialize=FALSE){
  logfile = cfg$gui$user_log_file

  # First we add it to the GUI log entry
  GUI_log_entry(cfg, text)

    # now we read in the contents of the gui log file
    current_file = file(logfile, open="r")
    lines = readLines(current_file)
    close(current_file)
    
    # appending the text to the log file
    lines = c(lines, text)
    
    # only pulling the last n lines
    lines = tail(lines, cfg$gui$user_log_length)
    
    # writing those back to the log file
    # Now we dump it to the log file:
    write(lines, file=logfile, append=FALSE)

}
#-----------------------------------------
#-----------------------------------------
system_trim_som_initialization = function(cfg, som, variability=FALSE, sstime=0){


   if(cfg$gui$check_variability){

     # boolean vector of times to keep:
     t_to_keep = som$times$time >sstime

     # first we trim all the initialization values from
     # the state information
     for(sname  in names(som$states)){
       som$states[[sname]]=som$states[[sname]][,t_to_keep]
     }

     # Next we do the same for the outputs
     for(oname  in names(som$outputs)){
       som$outputs[[oname]]=som$outputs[[oname]][,t_to_keep]
     }

     # Lastly we trim the initialization values 
     # from the summary table
     som$tcsummary = som$tcsummary[t_to_keep, ]

     # then we do the time information as well
     som$time = som$time[t_to_keep, ]
   
   }
   else{
     # if an individual simulation has been run we 
     # chop off the values before sstime
     som$simout = som$simout[som$simout$time > sstime, ] }

   return(som)
}
#-----------------------------------------
#-----------------------------------------
select_point  = function(input, output, session){

  output$text_selectpoint = renderText({
    # loading the gui state
    cfg=gui_fetch_cfg(session)
    input$plotfigure_click
    xval = input$plotfigure_click$x
    yval = input$plotfigure_click$y

    # After the first click reactive elements get called twice for some
    # reason. So we store the old clicks in the gui state and see if they
    # change

    # By default we have a new click
    value = ""
    tryCatch(
     { 
       newclick = TRUE
       # First we check to see if there are previous x and y alues
       if(!is.null(cfg$gui$click_x) & !is.null(cfg$gui$click_y)){
         # if they exist we check to see if they are the same 
         # as the current ones
         if((cfg$gui$click_x == xval) & (cfg$gui$click_y == yval) ){
           newclick = FALSE 
         }
       }
       value = toString(c(var2string(xval, 1, nsig_e = 2, nsig_f = 2), var2string(yval,1, nsig_e = 2, nsig_f = 2)))
       if(newclick){
        user_log_entry(cfg, sprintf("Point: %s", value)) 
       }
     },
      warning = function(w) {
      # place warning stuff here
     },
      error = function(e) {
        GUI_log_entry(cfg, sprintf('plotfigure_click: %s ', e$message))
        GUI_log_entry(cfg, sprintf('This can happen while switching y-scale'))
     })

    
    if(value != ""){
     # updating the clicked values
     cfg$gui$click_x = xval
     cfg$gui$click_y = yval
     
     # saving the gui state
     gui_save_cfg(cfg, session)
     }
      
     value})
}


fetch_save_string = function(input, output, session){
   cfg=gui_fetch_cfg(session)
   ss = ""
   # creating simulation save (ss) string
   
   # First we start with the save simlation text.
   # If it's blank then we just use the generic my_simulation
   # if it's not we strip out any white space
   if(is.null(cfg$gui$text_save_sim)){
     ss = 'my_simulation' }
   else{
     ss = gsub("[[:space:]]", "_", cfg$gui$text_save_sim) }
   
   # next we look for the timestamp
   if(cfg$gui$check_timestamp){
     ss = sprintf("%s_%s", ss, format(Sys.time(), format= "%Y_%m_%d_%H_%M_%S")) }

  return(ss)}
#-----------------------------------------
#
# zipping up the important bits and pushing it to the user
#
download_simulation = function(input, output, session){
    output$button_download <- downloadHandler(
      filename = function() {
        #
        # The file name of the zip file to download
        #
        cfg=gui_fetch_cfg(session)
           
        # pulling out the save string
        ss         = fetch_save_string(input, output, session)
        zip_fname  = sprintf('%s.zip', ss)

        # returning the zip file name
        zip_fname },
      content = function(fname) {
        #
        # The contents of the zip file
        #
        cfg      = gui_fetch_cfg(session)
        user_dir = find_user_dir(session)
        save_dir = fetch_save_dir(session)
        # loading the data 
        som=gui_fetch_som(session)

        # pulling out the save string
        ss         = fetch_save_string(input, output, session)

        #
        # Generate the file names to store the files that will be created
        #
        # general r libraries
        if(cfg$options$misc$distribution == "stand alone"){
          fname_ub_r     = file.path(cfg$gui$wd, "library", "r_general", "ubiquity.R")
        } else {
          fname_ub_r     = system.file("scripts", "ubiquity_fcns.R", package="ubiquity")
        }

        # system specific functions
        fname_arc_r      = file.path(cfg$gui$wd, "transient", "app_base", "auto_rcomponents.R")
        # export template
        fname_save_r     = file.path(cfg$options$misc$templates, "r_gui_save.R")
        

        # Library file
        fname_newlib_r_full = sprintf('%s%sanalysis_%s_lib.r',                save_dir, .Platform$file.sep, ss)
        fname_newlib_r_base = sprintf('analysis_%s_lib.r', ss)
        
        # Script file
        fname_newrun_r_full = sprintf('%s%sanalysis_%s.r',                    save_dir, .Platform$file.sep, ss)
        fname_newrun_r_base = sprintf('analysis_%s.r', ss)
        
        # CSV file
        fname_newcsv_r_full = sprintf('%s%sanalysis_%s.csv',                  save_dir, .Platform$file.sep, ss)
        fname_newcsv_r_base = sprintf('analysis_%s.csv', ss)

        # Beginning of html report file names
        fname_report_r_full = sprintf('%s%sanalysis_%s_report',               save_dir, .Platform$file.sep, ss)
        fname_report_r_base = sprintf('analysis_%s_report', ss)

        # Figure files
        fname_timecourse_full = sprintf('%s%sanalysis_%s_timecourse.png',     save_dir, .Platform$file.sep, ss)
        fname_timecourse_base = sprintf('analysis_%s_timecourse.png',                                       ss)
        fname_paramdist_full = sprintf('%s%sanalysis_%s_paramdist.png',       save_dir, .Platform$file.sep, ss)
        fname_paramdist_base = sprintf('analysis_%s_paramdist.png',                                         ss)


        # JMH Dont need these?
        # fname_newzip_r_full = sprintf('%s%sanalysis_%s.zip',                  save_dir, .Platform$file.sep, ss)
        # fname_newzip_r_base = sprintf('analysis_%s.zip', ss)


        # making the csv save command based on the type of simulation
        if(cfg$gui$check_variability){
          save_csv = sprintf('write.csv(file = "%s", x=som$tcsummary)', fname_newcsv_r_full )}
        else{
          save_csv = sprintf('write.csv(file = "%s", x=som$simout)', fname_newcsv_r_full) }
        


        # contents of save files
        lines_lib = c()
        lines_run = c()

        # reading in the data from library and run template files
        # lib files
        cfn = file(fname_ub_r, open="r")
        lines_lib = c(lines_lib, readLines(cfn))
        close(cfn)
        
        cfn = file(fname_arc_r, open="r")
        lines_lib = c(lines_lib, readLines(cfn))
        close(cfn)
        
        # run file
        cfn = file(fname_save_r, open="r")
        lines_run = c(lines_run, readLines(cfn))
        close(cfn)

        # loading user defined functions
        if(!is.null(cfg$gui$functions$user_def)){
          cfg$gui$sysel_simulate$user_def = sprintf('source("%s")',cfg$gui$functions$user_def)
        } else{
          cfg$gui$sysel_simulate$user_def = ''
        }
        # updating certain system elements
        cfg$gui$sysel_simulate$libfile     = fname_newlib_r_base
        cfg$gui$sysel_simulate$system_file = cfg$options$misc$system_file

        # constructing the header labels
        if(cfg$gui$sysel_simulate$iiv == ""){
          cfg$gui$sysel_simulate$iheader = "" }
        else{
          cfg$gui$sysel_simulate$iheader = "#\n# Specifying the IIV elements\n#\n" }

        if(cfg$gui$sysel_simulate$bolus == ""){
          cfg$gui$sysel_simulate$bheader = "" }
        else{
          cfg$gui$sysel_simulate$bheader = "#\n# Specifying the bolus injections \n#\n" }

        if(cfg$gui$sysel_simulate$infusion_rates == ""){
          cfg$gui$sysel_simulate$rheader = "" }
        else{
          cfg$gui$sysel_simulate$rheader = "#\n# Specifying the infusion rates \n#\n" }

        if(cfg$gui$sysel_simulate$covariates     == ""){
          cfg$gui$sysel_simulate$cheader = "" }
        else{
          cfg$gui$sysel_simulate$cheader = "#\n# Specifying the covariates     \n#\n" }



        # Substituting in the simulation script
        # First each simulation element
        for(sysel in names(cfg$gui$sysel_simulate)){
           token_str = sprintf("<%s>", sysel)
           lines_run = gsub(token_str, cfg$gui$sysel_simulate[[sysel]], lines_run)
        }
    
        # defaulting the save variables to false
        # will be updated to true of the save commands
        # are successful
        save_timecourse = FALSE
        save_paramdist  = FALSE

        # Generating the timecourse figure as a png file
        # saving the figure to a file
         tryCatch(
          { 
           PTC = generate_timecourse(input, output, session)
           ggsave(fname_timecourse_full, PTC)
           save_timecourse = TRUE
          },
           warning = function(w) {
           # place warning stuff here
          },
           error = function(e) {
             user_log_entry(cfg, sprintf('unable to save timecourse figure (%s)', fname_timecourse_base))
          })

        # Generating the parameter distribution figure as a png file
        # saving the figure to a file
         if(cfg$gui$check_variability){
           tryCatch(
            { 
             PPD = generate_paramdist(input, output, session)
             ggsave(fname_paramdist_full, PPD)
             save_paramdist = TRUE
            },
             warning = function(w) {
             # place warning stuff here
            },
             error = function(e) {
               user_log_entry(cfg, sprintf('unable to save parameter distribution figure (%s)', fname_paramdist_base))
            })
         }

         sysel_plot_timecourse = "";
         sysel_plot_paramdist  = "";

         # loading the generated plotting code
         if(file.exists(sprintf("%s%sgui_plot_timecourse.RData", user_dir, .Platform$file.sep))){
           load(sprintf("%s%sgui_plot_timecourse.RData", user_dir, .Platform$file.sep))}
         else{
           GUI_log_entry(cfg, 'Unable to find file: gui_plot_timecourse.RData') }

         if(cfg$gui$check_variability){
           if(file.exists(sprintf("%s%sgui_plot_paramdist.RData", user_dir, .Platform$file.sep))){
             load(sprintf("%s%sgui_plot_paramdist.RData", user_dir, .Platform$file.sep))}
           else{
             GUI_log_entry(cfg, 'Unable to find file: gui_plot_paramdist.RData') }
         }
         

         # making the csv save command based on the type of simulation
         if(cfg$gui$check_variability){
           save_csv      = sprintf('write.csv(file = "%s", x=som$tcsummary)', fname_newcsv_r_base )
           save_csv_full = sprintf('write.csv(file = "%s", x=som$tcsummary)', fname_newcsv_r_full )}
         else{
           save_csv      = sprintf('write.csv(file = "%s", x=som$simout)', fname_newcsv_r_base) 
           save_csv_full = sprintf('write.csv(file = "%s", x=som$simout)', fname_newcsv_r_full) }


         # getting the plotting commands
         lines_run = gsub("<plot_timecourse>", sysel_plot_timecourse, lines_run)
         lines_run = gsub("<plot_paramdist>",  sysel_plot_paramdist , lines_run)
         # getting the data save command
         lines_run = gsub("<save_csv>",        save_csv,           lines_run)
         
         # writing the contents of lib, run and csv files
         write(lines_run, file=fname_newrun_r_full, append=FALSE)
         write(lines_lib, file=fname_newlib_r_full, append=FALSE)
         eval(parse(text=save_csv_full)) 


         # generating the reports

         # By default we dont have any reports 
         fname_report_r_full_R1 = NULL
         fname_report_r_full_R2 = NULL
         fname_report_r_full_R3 = NULL
         fname_report_r_full_R4 = NULL
         fname_report_r_full_R5 = NULL
         # JMH delete
         # save_simulation = list()
         if(!is.null(cfg$gui$modelreport_files)){
            # For each specified report we create a tab
            for(report_name in names(cfg$gui$modelreport_files)){
             mg      = generate_model_report(cfg, session, report_name)
             if(mg$success){
               # copying the report for to be included in export
               file.copy(mg$htmlfile, sprintf('%s_%s.html', fname_report_r_full, report_name))
               eval(parse(text=sprintf('fname_report_r_full_%s = "%s_%s.html"', report_name, fname_report_r_full, report_name)))
               eval(parse(text=sprintf('fname_report_r_base_%s = "%s_%s.html"', report_name, fname_report_r_base, report_name)))
             }
           }
         }
        
        # 
        # Now we build up the contents of the zip file
        # 


        # reading in the content of the zip file
        zip_contents = c(fname_newlib_r_full,
                         fname_newcsv_r_full,
                         fname_newrun_r_full)

        
        if(cfg$gui$save$user_log){
           zip_contents = c(zip_contents, cfg$options$logging$file)
        }

        if(cfg$gui$save$system_txt){
           zip_contents = c(zip_contents, file.path(cfg$gui$wd , cfg$options$misc$system_file))
        }

        # if the report file isn't null then it exists and we add it
        # to the zip file
        if(!is.null(fname_report_r_full_R1)){
         zip_contents = c(zip_contents, fname_report_r_full_R1) }
        if(!is.null(fname_report_r_full_R2)){
         zip_contents = c(zip_contents, fname_report_r_full_R2) }
        if(!is.null(fname_report_r_full_R3)){
         zip_contents = c(zip_contents, fname_report_r_full_R3) }
        if(!is.null(fname_report_r_full_R4)){
         zip_contents = c(zip_contents, fname_report_r_full_R4) }
        if(!is.null(fname_report_r_full_R5)){
         zip_contents = c(zip_contents, fname_report_r_full_R5) }

        # same for the figures, if they're not null we add them
        if(!is.null(save_timecourse)){
         zip_contents = c(zip_contents, fname_timecourse_full) 
        }

        if(!is.null(cfg$gui$save_paramdist)){
         zip_contents = c(zip_contents, fname_paramdist_full) 
        }

        # Adding user defined files
        if(!is.null(cfg$gui$functions$user_def)){
          zip_contents = c(zip_contents, cfg$gui$functions$user_def)}

        user_log_entry(cfg, "Simulation saved")
        # writing zip file

        zip(fname, zip_contents, flags = "-j",  zip = Sys.getenv("R_ZIPCMD", "zip"))
      },
      contentType = "application/zip"
    )
}

#-----------------------------------------
fetch_save_dir = function(session){
   cfg=gui_fetch_cfg(session)
   user_dir = find_user_dir(session)
   # if we're deployed then we save these files
   # to the user directory
   if(cfg$gui$deployed){
     save_dir = user_dir
   } else{
   # otherwise we save them in the main working direcotry
     save_dir = cfg$gui$wd 
   }
}

#-----------------------------------------
gui_save_cfg = function(cfg, session){
  user_dir = find_user_dir(session)
  save(cfg, file=sprintf('%s%sgui_state.RData', user_dir, .Platform$file.sep))
}
#-----------------------------------------
gui_fetch_cfg  <-function(session){
  user_dir = find_user_dir(session)
  load(file=sprintf('%s%sgui_state.RData', user_dir, .Platform$file.sep))
  return(cfg)}
#-----------------------------------------
gui_save_som = function(som, session){
  user_dir = find_user_dir(session)
  save(som, file=sprintf('%s%sgui_som.RData', user_dir, .Platform$file.sep))
}
#-----------------------------------------
gui_fetch_som  <-function(session){
  user_dir = find_user_dir(session)
  load(file=sprintf('%s%sgui_som.RData', user_dir, .Platform$file.sep))
  return(som)}
#-----------------------------------------

#-----------------------------------------

simulation_state<- function(input, output, session){

  # flip touch state for tables
  observe({
    input$table_parameters
    cfg=gui_fetch_cfg(session)
    cfg$gui$table_parameters_touched = TRUE  
    GUI_log_entry(cfg, "table_parameters touched")
    gui_save_cfg(cfg, session)
    }, priority=10)
  
  observe({
    input$table_iiv
    cfg=gui_fetch_cfg(session)
    cfg$gui$table_iiv_touched = TRUE  
    GUI_log_entry(cfg, "table_iiv touched")
    gui_save_cfg(cfg, session)
    }, priority=10)

  observe({
    input$table_covariates
    cfg=gui_fetch_cfg(session)
    cfg$gui$table_covariates_touched = TRUE  
    GUI_log_entry(cfg, "table_covariates touched")
    gui_save_cfg(cfg, session)
    }, priority=10)


  #--------------------------------------------------
  # Changes to parameters, inputs, etc are caught here and
  # used to update the cfg variable
  output$text_status = renderText({
  user_dir = find_user_dir(session)
  # Reading int the GUI state
  cfg=gui_fetch_cfg(session)
  sim_status = cfg$gui$sim_status;

  input$button_update

  # needed to force the changes in parameters after a new 
  # parameter set has been selected
  input$table_parameters
  input$table_iiv
  input$table_covariates


  #--[ checkboxes ]---------------------------------------------
  if(!is.null(input$check_repeatdoses)){
    if(cfg$gui$check_repeatdoses !=  input$check_repeatdoses){
      user_log_entry(cfg, sprintf("Repeat doses: %s", toString(input$check_repeatdoses))) 

      # If the repeatdoses is checked before any changes have been made to the
      # bolus dosing then we need to populate those components of the gui
      # components
      if(is.null(cfg$gui$bolus)){
        cfg$gui$bolus$times = cfg$options$inputs$bolus$times$values 
        for(bstate in names(cfg$options$inputs$bolus$species)){
          cfg$gui$bolus$states[[bstate]] = cfg$options$inputs$bolus$species[[bstate]]$values
        }
      }
      GUI_log_entry(cfg, "Stale: check_repeatdoses")
      sim_status = 'Stale' }
    cfg$gui$check_repeatdoses =  input$check_repeatdoses }
  
  if(!is.null(input$check_variability)){
    if(cfg$gui$check_variability !=  input$check_variability){
      user_log_entry(cfg, sprintf("Simulate with variability: %s", toString(input$check_variability))) 
      GUI_log_entry(cfg, "Stale: check_variability")

      # if the plotting code for param dists exists, we delete it
      if(file.exists(sprintf("%s%sgui_plot_paramdist.RData", user_dir, .Platform$file.sep))){
        file.remove(sprintf("%s%sgui_plot_paramdist.RData", user_dir, .Platform$file.sep))}
      sim_status = 'Stale' }

    cfg$gui$check_variability =  input$check_variability }
  

  if(!is.null(input$check_grid)){
    if(cfg$gui$check_grid   !=  input$check_grid){
      user_log_entry(cfg, sprintf("Plot with grid lines: %s", toString(input$check_grid))) }
    cfg$gui$check_grid =  input$check_grid}

  if(!is.null(input$check_log)){
    if(cfg$gui$check_log    !=  input$check_log) {
      user_log_entry(cfg, sprintf("Log10 Y-Scale: %s", toString(input$check_log))) }
    cfg$gui$check_log =  input$check_log}


  if(!is.null(input$check_autox)){
    if(cfg$gui$check_autox    !=  input$check_autox) {
      user_log_entry(cfg, sprintf("Auto X-axis: %s", toString(input$check_autox))) }
    cfg$gui$check_autox =  input$check_autox}


  if(!is.null(input$check_autoy)){
    if(cfg$gui$check_autoy    !=  input$check_autoy) {
      user_log_entry(cfg, sprintf("Auto X-axis: %s", toString(input$check_autoy))) }
    cfg$gui$check_autoy =  input$check_autoy}

  if(!is.null(input$check_timestamp)){
    if(cfg$gui$check_timestamp   !=  input$check_timestamp){
      user_log_entry(cfg, sprintf("Include timestamp: %s", toString(input$check_timestamp))) 
      GUI_log_entry(cfg, "Stale: check_timestamp") }
    cfg$gui$check_timestamp   =  input$check_timestamp   }


  #--[ text boxes ]---------------------------------------------
  # Bolus
  if(!is.null(input$text_bolus_frequency)){
    if(!is.na(as.numeric(input$text_bolus_frequency))){
      if(cfg$gui$text_bolus_frequency !=  as.numeric(input$text_bolus_frequency)){
        user_log_entry(cfg, sprintf("Bolus frequency: %s", input$text_bolus_frequency)) 
        GUI_log_entry(cfg, "Stale: text_bolus_frequency")
        sim_status = 'Stale' }
      cfg$gui$text_bolus_frequency =  as.numeric(input$text_bolus_frequency) }
    }

  if(!is.null(input$text_bolus_number)){
    if(!is.na(as.numeric(input$text_bolus_number))){
      if(cfg$gui$text_bolus_number !=  as.numeric(input$text_bolus_number)){
        user_log_entry(cfg, sprintf("Bolus number: %s", input$text_bolus_number)) 
        GUI_log_entry(cfg, "Stale: text_bolus_number")
        sim_status = 'Stale' }
      cfg$gui$text_bolus_number =  as.numeric(input$text_bolus_number)    }
    }

  # IIV   
  if(!is.null(input$text_nsub)){
    if(!is.na(as.numeric(input$text_nsub))){
      if(cfg$gui$text_nsub !=  as.numeric(input$text_nsub)){
        user_log_entry(cfg, sprintf("Number of subjects: %s", input$text_nsub)) 
        GUI_log_entry(cfg, "Stale: text_nsub")
        sim_status = 'Stale' }
      cfg$gui$text_nsub =  as.numeric(input$text_nsub)}
    }

  if(!is.null(input$text_ci)){
    if(!is.na(as.numeric(input$text_ci))){
      if(cfg$gui$text_ci !=  as.numeric(input$text_ci)){
        user_log_entry(cfg, sprintf("Prediction interval: %s%%", input$text_ci)) 
        GUI_log_entry(cfg, "Stale: text_ci")
        sim_status = 'Stale' }
      cfg$gui$text_ci =  as.numeric(input$text_ci)}
    }

  if(!is.null(input$text_save_sim)){
    if(cfg$gui$text_save_sim !=  input$text_save_sim){
      user_log_entry(cfg, sprintf("Save string: %s", input$text_save_sim)) 
      }
    cfg$gui$text_save_sim =  input$text_save_sim}

  # plotting
  if(!is.null(input$text_autox)){
    # converting the text_autox into a vector
    good_text_autox = FALSE
    tryCatch(
     { 
      eval(parse(text= sprintf('num_autox = c(%s)', input$text_autox))) 
      good_text_autox = TRUE
     },
      warning = function(w) {
      # place warning stuff here
     },
      error = function(e) {
        GUI_log_entry(cfg, sprintf('eval error: %s ', e$message))
        user_log_entry(cfg, sprintf('unable to parse string (%s)', input$text_autox))
     })
     
     

    # if it was successful we then look at the vector to see if it 
    # is formatted correctly: length =2, and first entry less than second
    if(good_text_autox){
      if(length(num_autox) == 2){
        if(num_autox[1] < num_autox[2]){
          if(any(cfg$gui$text_autox  !=  num_autox)){
             user_log_entry(cfg, sprintf("Xlim set to: c(%s)", input$text_autox)) 
             GUI_log_entry(cfg, "Stale: text_autox")
             sim_status = 'Stale' 
             cfg$gui$text_autox = num_autox
           }
        }
        else{
          user_log_entry(cfg, sprintf('User specified x-limits: should be increasing (%s)', input$text_autox))
          good_text_autox = FALSE
        }
      }
      else{
        good_text_autox = FALSE
        user_log_entry(cfg, sprintf('User specified x-limits: length should be 2 (%s)', input$text_autox))
      }
    # whatever value good has we use it to update cfg
    cfg$gui$good_text_autox = good_text_autox
    }
  }


  if(!is.null(input$text_autoy)){
    # converting the text_autoy into a vector
    good_text_autoy = FALSE
    tryCatch(
     { 
      eval(parse(text= sprintf('num_autoy = c(%s)', input$text_autoy))) 
      good_text_autoy = TRUE
     },
      warning = function(w) {
      # place warning stuff here
     },
      error = function(e) {
        GUI_log_entry(cfg, sprintf('eval error: %s ', e$message))
        user_log_entry(cfg, sprintf('unable to parse string (%s)', input$text_autoy))
     })

    # if it was successful we then look at the vector to see if it 
    # is formatted correctly: length =2, and first entry less than second
    if(good_text_autoy){
      if(length(num_autoy) == 2){
        if(num_autoy[1] < num_autoy[2]){
          if(any(cfg$gui$text_autoy  !=  num_autoy)){
             user_log_entry(cfg, sprintf("Ylim set to: c(%s)", input$text_autoy)) 
             cfg$gui$text_autoy = num_autoy
           }
        }
        else{
          user_log_entry(cfg, sprintf('User specified y-limits: should be increasing (%s)', input$text_autoy))
          good_text_autoy = FALSE
        }
      }
      else{
        good_text_autoy = FALSE
        user_log_entry(cfg, sprintf('User specified y-limits: length should be 2 (%s)', input$text_autoy))
      }
    # whatever value good has we use it to update cfg
    cfg$gui$good_text_autoy = good_text_autoy
    }
  }

  #--[ select_outputs ]------------------------------------
  if(!is.null(input$select_outputs)){
    cfg$gui$outputs = input$select_outputs
  }
  #--[ select_outputs done ]-------------------------------

  

  #--[ table_parameters ]---------------------------------------
  # we only look at the parameters table if
  # pset hasn't changed
  if(!cfg$gui$pset_change){
    # If the table_parmaeters is not null then changes have been made
    # we need to go through and modfiy the values for this parameter set
    if(!is.null(input$table_parameters) & cfg$gui$table_parameters_touched){
      for (pidx in seq(1,length(input$table_parameters$data))){
        # If the current row has the string "NA" in the second column
        # then it's a row header/grouping row and we ignore it
        # If not then it's a parameter and we update that parameter
        # in the parameter valuess.
        if(!is.null(input$table_parameters$data[[pidx]][[2]])){
        if(!is.na(input$table_parameters$data[[pidx]][[2]])){
          # pulling out the parameter name
          pname = input$table_parameters$data[[pidx]][[1]] 
          pupdate = FALSE

          # If the user deletes the contents of the cell in the table and
          # reactive picks it up the as.numeric function will return NA nad
          # screw things up down below. This should prevent that
          if(!is.na(as.numeric(as.numeric(input$table_parameters$data[[pidx]][[2]]))) ){
            # if the parameter has already been over written 
            if(pname %in% names(cfg$gui$parameters)){
              # we check to see if it's changed
              if(cfg$gui$parameters[[pname]] != as.numeric(input$table_parameters$data[[pidx]][[2]])){
                pupdate=TRUE
              }
            }
            # if the is parameter hasn't been overwritten by the user already
            # we see if it's different from the default value
            else if(cfg$parameters$values[[pname]] != as.numeric(input$table_parameters$data[[pidx]][[2]])){
              # this is the first time the parameter has been overwritten
              pupdate=TRUE
              }
            
            
            # If a parameter update has been triggered by the above conditions
            if(pupdate){
              cfg$gui$parameters[[pname]] = as.numeric(input$table_parameters$data[[pidx]][[2]])
              GUI_log_entry(cfg, "Stale: table_parameters")
              user_log_entry(cfg, sprintf("Setting parameter: %s = %s", pname, var2string(as.numeric(input$table_parameters$data[[pidx]][[2]]),1)))
              sim_status = 'Stale' 
              }
          }
        }
        }
      }
    }
  }
  #--[ table_parameters done ]----------------------------------
    
  #--[ table_bolus ]---------------------------------------
  # If there are changes in the table_bolus input 
  # then we need to update bolus dosing
  if(!is.null(input$table_bolus)){
    # storing the bolus dosing information in 'bolus'
    bolus = c()

    # bgood is used to tell if the bolus information is formatted correctly
    bgood = TRUE
    # bupdate is used to tell if the bolus information in the table is
    # different than the information currently stored in cfg$gui$bolus
    bupdate = FALSE

    # extracting the bolus times
    bolus$times = str2list(cfg, input$table_bolus$data[[1]][[2]])
    if(is.null(cfg$gui$bolus$times)){
      # checking to see if any bolus times 
      # have been specified by the user
      bupdate = TRUE }
    else if(length(bolus$times) != length(cfg$gui$bolus$times)){
       # if they have we look to see if they are the same length as the
       # previously specified times
      bupdate = TRUE }
    else if(any(bolus$times != cfg$gui$bolus$times)){
      # if they are different from the previously specified times
      # then we look to see if any of them are different
      bupdate = TRUE }

    # Now we go through dosing information for each compartment
    for (bidx in seq(2,length(input$table_bolus$data))){

      # pulling out the bolus information for the current compartment
      bstate = input$table_bolus$data[[bidx]][[1]] 
      bvalue = str2list(cfg, input$table_bolus$data[[bidx]][[2]])
      
      
      # storing the bolus information for the state in bolus$states
      if(length(bolus$times) == length(bvalue)){
        bolus$states[[bstate]] = bvalue }
      else{
       user_log_entry(cfg, sprintf("Number of doses into %s (%d) and dosing times (%d) are not the same", bstate, length(bvalue),length(bolus$times)))
       bgood = FALSE}

      if(is.null(cfg$gui$bolus$states)){
        # checking to see if any bolus states
        # have been specified by the user
        bupdate = TRUE }
      else if(length(bolus$states[[bstate]]) != length(cfg$gui$bolus$states[[bstate]])){
         # if they have we look to see if they are the same length as the
         # previously specified times
        bupdate = TRUE }
      else if(any(bolus$states[[bstate]] != cfg$gui$bolus$states[[bstate]])){
        # if they are different from the previously specified times
        # then we look to see if any of them are different
        bupdate = TRUE }
    }

    # Saving the information from the bolus dosing table 
    if(bgood){
      if(bupdate){
        sim_status = 'Stale'
        user_log_entry(cfg, "Bolus injections updated.")
      }
      cfg$gui$bolus = bolus 
    }
    else{   
      # usermessage
      user_log_entry(cfg, "Bolus injections not set.") }
  }
  #--[ table_bolus done ]----------------------------------



  #--[ table_iiv ]-----------------------------------------
  # we only look at the iiv table if
  # pset hasn't changed
  if(!cfg$gui$pset_change){
   if(!is.null(input$table_iiv) & cfg$gui$table_iiv_touched){
     # iupdate is used to tell if _any_ information in the iiv table has
     # changed
     iupdate = FALSE
   
     for(iridx in (seq(1,length(input$table_iiv$params$rowHeaders)))){
       for(icidx in (seq(1,length(input$table_iiv$params$colHeaders)))){
         rname = input$table_iiv$params$rowHeaders[[iridx]]
         cname = input$table_iiv$params$colHeaders[[icidx]]
         # Checking the variance
         if(icidx <= iridx){
           # iiv information from gui (user input)
           iiv_gui = input$table_iiv$data[[iridx]][[icidx]] 

           # If the user deletes the contents of the cell in the table and
           # reactive picks it up the as.numeric function will return NA nad
           # screw things up down below. This should prevent that
           if(!is.na(as.numeric(iiv_gui))){
             # default iiv information from the system file
             iiv_sys = system_fetch_iiv(cfg, IIV1=rname, IIV2=cname)
             # iiv information from the gui (previously)
             iiv_gui_old = cfg$gui$iiv[[rname]][[cname]]
             
             # ciupdate is used to tell if the current iiv term has changed
             ciupdate = FALSE
             # if the old GUI entry is null we see if the current gui entry is
             # different from the value in the system file
             if(is.null(iiv_gui_old)){
               if(iiv_sys != iiv_gui){
                 ciupdate = TRUE
                 iupdate = TRUE
               }
             }
             
             else if(iiv_gui_old != iiv_gui){
             # if the old gui entry isn't null we see if it's different 
             # from the current one
               ciupdate = TRUE
               iupdate = TRUE
             }
             
             if(ciupdate){
               user_log_entry(cfg, sprintf("IIV: %s_%s  set to %3e", rname, cname, iiv_gui))
               eval(parse(text=paste(sprintf('cfg$gui$iiv$%s$%s = iiv_gui', rname, cname))))
             }
           }
         }
       }
     }
     # storing the iivs that are different from the default
     if(iupdate & cfg$gui$check_variability){
       sim_status = 'Stale'
     }
     if(iupdate){
       user_log_entry(cfg, "IIV information updated.")
     }
   }
  }
  #--[ table_iiv done ]------------------------------------

  #--[ table_rates ]---------------------------------------
  if(!is.null(input$table_rates)){
    rates  = c() 
    rgood  = TRUE
    rupdate = FALSE

    # There are three rows per rate
    for(ridx in seq(1,length(input$table_rates$data)/3)){
      # the offset here is used to jump from rate to rate
      roffset = (ridx-1)*3
      rname   = input$table_rates$data[[roffset + 1]][[1]]
      rtimes  = str2list(cfg, input$table_rates$data[[roffset+2]][[2]])
      rvalues = str2list(cfg, input$table_rates$data[[roffset+3]][[2]])
      # the length should be the same for each of these
      if(length(rtimes) == length(rvalues)){
        irupdate = FALSE
        # if the rate has not been defined in the gui before, we assign the 
        # values for the gui to the default
        if(is.null(cfg$gui$infusion_rates[[rname]])){
           cfg$gui$infusion_rates[[rname]]$times  = cfg$options$inputs$infusion_rates[[rname]]$times$values  
           cfg$gui$infusion_rates[[rname]]$values = cfg$options$inputs$infusion_rates[[rname]]$levels$values 
        }
        # if it's been defined in the gui before, we check to see if it's
        # changed
        else if(any(cfg$gui$infusion_rates[[rname]]$times != rtimes) |
                any(cfg$gui$infusion_rates[[rname]]$values!= rvalues)){
            rupdate  = TRUE
            irupdate = TRUE
        }

        # this individual rate has been updated
        if(irupdate){
          cfg$gui$infusion_rates[[rname]]$times  = rtimes
          cfg$gui$infusion_rates[[rname]]$values = rvalues 
          user_log_entry(cfg, sprintf("Rate set (%s)", rname))
          user_log_entry(cfg, sprintf(" -> Times:  %s ", toString(rtimes)))
          user_log_entry(cfg, sprintf(" -> Values: %s ", toString(rvalues)))
        }
      }
      else{
        user_log_entry(cfg, sprintf("Lengths do not match for rate %s", rname))
        user_log_entry(cfg, sprintf("Number of Times   (%d)",                length(rtimes)))
        user_log_entry(cfg, sprintf("Number of Values  (%d)",                length(rvalues)))
        rgood = FALSE }
    }

    if(rgood){
      if(rupdate){
        sim_status = 'Stale'
        user_log_entry(cfg, "Infusion rates updated.")
      }
    }
    else{
      # usermessage
      user_log_entry(cfg, "Unable to update rates perhaps the user is not done.")
    }
  }
  #--[ table_rates done ]----------------------------------

  #--[ table_covariates ]----------------------------------
  # we only look at the covariates table if
  # pset hasn't changed
  if(!cfg$gui$pset_change){
    if(!is.null(input$table_covariates)){
      cgood  = TRUE
      # There are three rows per rate
      for(cidx in seq(1,length(input$table_covariates$data)/3)){
        cupdate= FALSE
        # the offset here is used to jump from rate to rate
        coffset = (cidx-1)*3
        cname   = input$table_covariates$data[[coffset + 1]][[1]]
        ctimes  = str2list(cfg, input$table_covariates$data[[coffset+2]][[2]])
        cvalues = str2list(cfg, input$table_covariates$data[[coffset+3]][[2]])
        # the length should be the same for each of these
        if(length(ctimes) == length(cvalues)){
          # Populating covariates in the gui state variable with the default
          # values if they have not been changed by the user
          if(is.null(cfg$gui$covariates[[cname]])){
            if(all(cfg$options$inputs$covariates[[cname]]$times$values  == ctimes) |
               all(cfg$options$inputs$covariates[[cname]]$values$values == cvalues)){
              cfg$gui$covariates[[cname]]$times  = cfg$options$inputs$covariates[[cname]]$times$values
              cfg$gui$covariates[[cname]]$values = cfg$options$inputs$covariates[[cname]]$values$values
            }
            else{
              cupdate = TRUE
            }
          }
          # This covariate has been updated so we store those updated values
          else if(any(cfg$gui$covariates[[cname]]$times  != ctimes) |
                  any(cfg$gui$covariates[[cname]]$values != cvalues)){
            cupdate = TRUE
          }
    
          if(cupdate){
            sim_status = 'Stale' 
            cfg$gui$covariates[[cname]]$times  = ctimes
            cfg$gui$covariates[[cname]]$values = cvalues
            user_log_entry(cfg, sprintf("Covariate set (%s)", cname))
            user_log_entry(cfg, sprintf(" -> Times:  %s ", toString(ctimes)))
            user_log_entry(cfg, sprintf(" -> Values: %s ", toString(cvalues)))
            user_log_entry(cfg, "Covariates updated.")
          }
    
          
        }
        else{
          user_log_entry(cfg, sprintf("Lengths do not match for covariate %s", cname))
          user_log_entry(cfg, sprintf("Number of Times   (%d)",                length(ctimes)))
          user_log_entry(cfg, sprintf("Number of Values  (%d)",                length(cvalues)))
          cgood = FALSE }
      }
      if(!cgood){
        # usermessage
        user_log_entry(cfg, "Unable to update covariates perhaps the user is not done.")
      }
    }
  }
  #--[ table_covariates done ]-----------------------------


  # parameter set has changed
  # This is fliped in the update_parameters function
  #--[ pset ]---------------------------------------------------
  if(!is.null(input$pset)){
    if(cfg$gui$pset_change){
     # we set the simulation state to stale and 
     # zero out any changes made in parameters, covariates 
     # and IIV terms
     sim_status = 'Stale' 

     cfg$gui$parameters   = list()
     cfg$gui$covariates   = list()
     cfg$gui$iiv          = list()

     # Now we flip the pset_change state back to false
     cfg$gui$pset_change  = FALSE

     # setting the state of the table to untouched
     cfg$gui$table_parameters_touched = FALSE
     cfg$gui$table_iiv_touched        = FALSE
     cfg$gui$table_covariates_touched = FALSE
    }
  }
  #--[ pset done ]----------------------------------------------

  # Saving the simulation status
  cfg$gui$sim_status = sim_status;

  #
  # Writing the gui state back to a file
  #      
  GUI_log_entry(cfg, sprintf("Simulation status set: %s", sim_status))
  gui_save_cfg(cfg, session)


  #
  # If simulation state is 'stale' we clear out all of the 
  # generated reports. This will force the App to regenerate 
  # them when tabs are accessed or if an export is triggered
  #
  if(sim_status == "Stale"){
    # finding all of the reports
    # basically any files in the user's 
    # directory that end in R#.html
    # where # is a number from 1-5
    user_dir   = find_user_dir(session)
    user_files = list.files(user_dir)
    user_files = user_files[grepl('R\\d\\.html$', user_files)]
 
    # browser()

    for(rfile in user_files){
      # getting the full path to the file
      rfile = sprintf('%s%s%s',user_dir, .Platform$file.sep, rfile)
      file.remove(rfile)
    }
  }


  #is.null(input$text_status)
  status =sprintf(" Simulation  %s", sim_status)})
  #-----------------------------------------

}
#-----------------------------------------


#-----------------------------------------
# generates the parameter table and updates 
# it based on changes in the parameter set
update_parameters <-function(input, output, session){
  output$table_parameters = renderRHandsontable({
  cfg=gui_fetch_cfg(session);
  if(is.null(input$pset)){
    cfg=system_select_set(cfg, cfg$parameters$current_set)}
  else{
    if(cfg$parameters$current_set != input$pset){
      # Because the parameter set has been updated we need to zero out any
      # parameter changes that have been made
      cfg$gui$pset_change       = TRUE
    }
    cfg=system_select_set(cfg, input$pset)
    }

  user_log_entry(cfg, sprintf('Parameter set: %s', cfg$parameters$sets[[cfg$parameters$current_set]]$name))
  
  # Parameter values:
  types        = unique(cfg$parameters$matrix$type)
  parametersDF = data.frame("Description"=c(), "Value"=c(), 'Units'=c())

  for(CURRTYPE in (types)){

    if(any(
          (cfg$parameters$matrix$editable == "yes" | cfg$gui$admin_mode) 
          & cfg$parameters$matrix$type == CURRTYPE)){
      parametersDF = rbind(parametersDF, data.frame("Description"=c(CURRTYPE), "Value"=c(NA),     'Units'=c(NA)))
      for(PIDX in seq(1,length(cfg$parameters$matrix$name))){
        PNAME  = as.character(cfg$parameters$matrix$name[PIDX])
        PVALUE = as.character(cfg$parameters$values[PIDX])
        PEDIT  = as.character(cfg$parameters$matrix$editable[PIDX])
        PTYPE  = as.character(cfg$parameters$matrix$type[PIDX])
        PPTYPE = as.character(cfg$parameters$matrix$ptype[PIDX])
        PUNITS = as.character(cfg$parameters$matrix$units[PIDX])
      
        # adding parameters of the current type 
        if((PTYPE == CURRTYPE) & (cfg$gui$admin_mode | PEDIT == "yes")){
          parametersDF = rbind(parametersDF, data.frame("Description"=c(PNAME), "Value"=c(PVALUE), 'Units'=c(PUNITS)));
        }
      }
    }
  }

  

  # Now we save the new parameter set and the zeroed values
  gui_save_cfg(cfg, session)

  
  ptable     = 
  hot_col(rhandsontable(parametersDF, readOnly=TRUE, rowHeaders=NULL, width="100%"), 
          'Value', readOnly=FALSE)  # making the values column editable

  })
}
#-----------------------------------------
# Generates the table of bolus information
generate_bolus <-function(input, output, session){
  cfg=gui_fetch_cfg(session)
  if("bolus" %in% names(cfg$options$inputs)){
    output$table_bolus = renderRHandsontable({

     # Creating the bolus times row
     mybolus=data.frame("Description"=c("Dose Times"), 
                        "Value"=c(toString(cfg$options$inputs$bolus$times$values)), 
                        "Units"=c(as.character(cfg$options$inputs$bolus$times$units)), stringsAsFactors = FALSE)


     # adding each state to receive a dose
     for(SPIDX in  names(cfg$options$inputs$bolus$species)){
       mybolus = rbind(mybolus, data.frame("Description"=c(as.character(SPIDX)),  
                                           'Value'=c(toString(cfg$options$inputs$bolus$species[[SPIDX]]$values)),  
                                           'Units'=c(cfg$options$inputs$bolus$species[[SPIDX]]$units)))
     
     }

     rh_bolus_table = hot_col(rhandsontable(mybolus, readOnly=TRUE, rowHeaders = NULL, width="100%"), 
                              'Value', readOnly=FALSE)
     #rh_bolus_table = hot_cell(rh_bolus_table, 1, 2, "Injection times separated by a comma")
     })
  }
}
#-----------------------------------------
# Generates the table of infusions 
generate_rates <-function(input, output, session){
  cfg=gui_fetch_cfg(session)
  if("infusion_rates" %in% names(cfg$options$inputs)){
    output$table_rates = renderRHandsontable({
      myrates=data.frame("Description"=c(), 
                         "Value"=c(), 
                         "Units"=c(), stringsAsFactors = FALSE)
      for(rate_name in names(cfg$options$inputs$infusion_rates)){
        myrates=rbind(myrates, 
                data.frame("Description"=c(rate_name), 
                           "Value"=c(NA), 
                           "Units"=c(NA)))
        myrates=rbind(myrates, 
                data.frame("Description"=c('Time'), 
                           #"Value"=c(paste(c(cfg$options$inputs$infusion_rates[[rate_name]]$times$values), collapse=', ' )), 
                           "Value"=c(toString(cfg$options$inputs$infusion_rates[[rate_name]]$times$values)),
                           "Units"=c(as.character(cfg$options$inputs$infusion_rates[[rate_name]]$times$units))))
        myrates=rbind(myrates, 
                data.frame("Description"=c('Rate'), 
                           "Value"=c(toString(cfg$options$inputs$infusion_rates[[rate_name]]$levels$values)), 
                           "Units"=c(as.character(cfg$options$inputs$infusion_rates[[rate_name]]$levels$units))))
      }  
      hot_col(rhandsontable(myrates, readOnly=TRUE, rowHeaders = NULL, width="100%"), 
              'Value', readOnly=FALSE)
    })
  }
}
#-----------------------------------------

#-----------------------------------------
# Generates the table of covariates
generate_covariates <-function(input, output, session){
  cfg=gui_fetch_cfg(session)
  if("covariates" %in% names(cfg$options$inputs)){
    output$table_covariates = renderRHandsontable({
      mycovariates=data.frame("Description"=c(), 
                              "Value"=c(), 
                              "Units"=c(), stringsAsFactors = FALSE)
      for(covariate_name in names(cfg$options$inputs$covariates)){

        if(is.null(input$pset)){
          cfg=system_select_set(cfg, 'default')}
        else{
          cfg=system_select_set(cfg, input$pset)}

        time_values      =      paste(c(cfg$options$inputs$covariates[[covariate_name]]$times$values),  collapse=', ' ) 
        covariate_values =      paste(c(cfg$options$inputs$covariates[[covariate_name]]$values$values), collapse=', ' )
        time_units       = as.character(cfg$options$inputs$covariates[[covariate_name]]$times$units)
        covariate_units  = as.character(cfg$options$inputs$covariates[[covariate_name]]$values$units)
        covariate_type   = as.character(cfg$options$inputs$covariates[[covariate_name]]$cv_type)


        mycovariates=rbind(mycovariates, 
                data.frame("Description"=c(covariate_name), 
                           "Value"=c(NA), 
                           "Units"=c(paste('(', covariate_type, ')', sep=""))))
        mycovariates=rbind(mycovariates, 
                data.frame("Description"=c('Time'), 
                           "Value"=c(time_values), 
                           "Units"=c(time_units)))
        mycovariates=rbind(mycovariates, 
                data.frame("Description"=c('Value'), 
                           "Value"=c(covariate_values), 
                           "Units"=c(covariate_units)))
      }  
      hot_col(rhandsontable(mycovariates, readOnly=TRUE, rowHeaders = NULL, width="100%"), 'Value', readOnly=FALSE)
    })
  }
}
#-----------------------------------------

#-----------------------------------------
# generates the iiv table 
generate_iiv <-function(input, output, session){
  output$table_iiv = renderRHandsontable({
    cfg=gui_fetch_cfg(session);
    if(is.null(input$pset)){
      cfg=system_select_set(cfg, 'default')}
    else{
      cfg=system_select_set(cfg, input$pset)}

      iivnames = names(cfg$iiv$iivs)
      iivvalues = cfg$iiv$values

      # removing the upper triangular portion of the matrix
      for(IIVROW in seq(1,length(iivnames))){
        for(IIVCOL in seq(1,length(iivnames))){
          if(IIVCOL > IIVROW){
           iivvalues[IIVROW, IIVCOL] = NA
          }
        }
      }


      for(IIVIDX in seq(1,length(iivnames))){
        if(IIVIDX == 1){
          eval(parse(text=paste(sprintf("myiiv = data.frame(%s = iivvalues[,IIVIDX])",as.character(iivnames[[IIVIDX]]))))) 
        } else{
          eval(parse(text=paste(sprintf("myiiv = cbind(myiiv, %s = iivvalues[,IIVIDX])",as.character(iivnames[[IIVIDX]]))))) }
      }

      row.names(myiiv) = iivnames 
      htiiv = rhandsontable(myiiv, readOnly=FALSE, width="100%", digits=14)
      htiiv = hot_cols(htiiv, renderer = "
        function (instance, td, row, col, prop, value, cellProperties) {
          Handsontable.renderers.TextRenderer.apply(this, arguments);
          if (col > row) {
           td.style.background = 'grey';
           td.style.color = 'grey';
           cellProperties.readOnly = true;
          } 
        }")
      
      htiiv})

   # This forces the panel to be updated when 
   # the parameter set has been changed
   observe({updateTabsetPanel(session, 'panel_variability') })
  }

#-----------------------------------------
#'@title Collect Multiple Plots
#'@description:
#' Adapted from here:
#' http://www.cookbook-r.com/Graphs/Multiple_graphs_on_one_page_(ggplot2)/
#'
#'@param ... list of plot objects  
#'@param plotlist list of plot objects  
#'@param cols number of columns
#'@param layout of the multiplot
#'@return multiplot object 
multiplot <- function(..., plotlist=NULL, cols=1, layout=NULL) {
  require("grid")
  
  # Make a list from the ... arguments and plotlist
  plots <- c(list(...), plotlist)
  
  numPlots = length(plots)
  
  # If layout is NULL, then use 'cols' to determine layout
  if (is.null(layout)) {
    # Make the panel
    # ncol: Number of columns of plots
    # nrow: Number of rows needed, calculated from # of cols
    layout <- matrix(seq(1, cols * ceiling(numPlots/cols)),
                     ncol = cols, nrow = ceiling(numPlots/cols))
  }
  
  if (numPlots==1) {
    print(plots[[1]])
    
  } else {
    # Set up the page
    grid.newpage()
    pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))
    
    # Make each plot, in the correct location
    for (i in 1:numPlots) {
      # Get the i,j matrix positions of the regions that contain this subplot
      matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))
      
      print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row,
                                      layout.pos.col = matchidx$col))
    }
  }
}

#-----------------------------------------
  generate_paramdist  <-function(input, output, session){
   cfg = gui_fetch_cfg(session)
   # If variability is checked we load 
   # the simulation results and plot 
   # the parameter distribution
   pall = NULL
   if(cfg$gui$check_variability){

     #user_log_entry(cfg, "DBG: output: plotparamdist (before)")

       input$tabset_figures


       # loading the cfg and the simulated results 
       som = gui_fetch_som(session)
     
       piiv = names(cfg$iiv$parameters)

       # Determining the number of columns based
       # on the number of panels
       if(length(piiv) == 1){
         ncol = 1 }
       else if(length(piiv) <= 4){
         ncol = 2 }
       else{
         ncol = 3 }
       
       # Determining the number of bins
       if(cfg$gui$text_nsub <= 20){
         bins = 8  }
       else if(cfg$gui$text_nsub <= 100){
         bins = 20 }
       else{
         bins = 30 }

       plot_paramdist = "\n\n"
       
       ph_subs = c()
       for(pname in piiv){
         plot_paramdist = sprintf('%sps.%s = ggplot(som$subjects$parameters, aes(x=%s)) + \n', plot_paramdist, pname, pname)
         plot_paramdist = sprintf('%s        geom_histogram(colour="black", bins=%d) \n',      plot_paramdist, bins)
         plot_paramdist = sprintf('%s        ylab("")\n',                                      plot_paramdist)
         plot_paramdist = sprintf('%sps.%s =  prepare_figure(ps.%s, purpose="present")\n\n',   plot_paramdist, pname, pname)
         ph_subs = c(ph_subs, sprintf('ps.%s', pname))
       }

       tryCatch(
        { 
         eval(parse(text=paste(plot_paramdist)))
        },
         warning = function(w) {
         # place warning stuff here
        },
         error = function(e) {
           GUI_log_entry(cfg, sprintf('eval error: %s ', e$message))
           GUI_log_entry(cfg, sprintf('unable to parse string (%s)', plot_paramdist))
        })
       
       plot_paramdist_post = sprintf('pall = multiplot(%s, cols=%d)\n\n', paste(ph_subs, collapse = ", "), ncol)
     
       plot_paramdist = sprintf('%s\n%s', plot_paramdist, plot_paramdist_post)
     
       # saving the plotting strings
       cfg$gui$sysel_plot_paramdist = plot_paramdist

       sysel_plot_paramdist  = plot_paramdist
       save(sysel_plot_paramdist, file=sprintf("%s%sgui_plot_paramdist.RData", 
                                  find_user_dir(session), .Platform$file.sep))

       gui_save_cfg(cfg, session)

       eval(parse(text=paste(plot_paramdist_post)))
       }
}

#-----------------------------------------
#   update_paramdist  <-function(input, output, session){
# 
# 
#    cfg = gui_fetch_cfg(session)
#    # If variability is checked we load 
#    # the simulation results and plot 
#    # the parameter distribution
#    if(cfg$gui$check_variability){
# 
#      #user_log_entry(cfg, "DBG: output: plotparamdist (before)")
#      output$plotparamdist<- renderPlot({
# 
#        input$tabset_figures
# 
# 
#        # loading the cfg and the simulated results 
#        som = gui_fetch_som(session)
#      
#        piiv = names(cfg$iiv$parameters)
# 
#        # Determining the number of columns based
#        # on the number of panels
#        if(length(piiv) == 1){
#          ncol = 1 }
#        else if(length(piiv) <= 4){
#          ncol = 2 }
#        else{
#          ncol = 3 }
#        
#        # Determining the number of bins
#        if(cfg$gui$text_nsub <= 20){
#          bins = 8  }
#        else if(cfg$gui$text_nsub <= 100){
#          bins = 20 }
#        else{
#          bins = 30 }
# 
#        plot_paramdist = "\n\n"
#        
#        ph_subs = c()
#        for(pname in piiv){
#          plot_paramdist = sprintf('%sps.%s = ggplot(som$subjects$parameters, aes(x=%s)) + \n', plot_paramdist, pname, pname)
#          plot_paramdist = sprintf('%s        geom_histogram(colour="black", bins=%d) \n',      plot_paramdist, bins)
#          plot_paramdist = sprintf('%s        ylab("")\n',                                      plot_paramdist)
#          plot_paramdist = sprintf('%sps.%s =  prepare_figure(ps.%s, purpose="present")\n\n',   plot_paramdist, pname, pname)
#          ph_subs = c(ph_subs, sprintf('ps.%s', pname))
#        }
# 
#        tryCatch(
#         { 
#          eval(parse(text=paste(plot_paramdist)))
#         },
#          warning = function(w) {
#          # place warning stuff here
#         },
#          error = function(e) {
#            GUI_log_entry(cfg, sprintf('eval error: %s ', e$message))
#            GUI_log_entry(cfg, sprintf('unable to parse string (%s)', plot_paramdist))
#         })
#        
#        plot_paramdist_post = sprintf('multiplot(%s, cols=%d)\n\n', paste(ph_subs, collapse = ", "), ncol)
#      
#        plot_paramdist = sprintf('%s\n%s', plot_paramdist, plot_paramdist_post)
#      
#        # saving the plotting strings
#        cfg$gui$sysel_plot_paramdist = plot_paramdist
# 
#        sysel_plot_paramdist  = plot_paramdist
#        save(sysel_plot_paramdist, file=sprintf("%s%sgui_plot_paramdist.RData", 
#                                   find_user_dir(session), .Platform$file.sep))
# 
#        gui_save_cfg(cfg, session)
# 
#        eval(parse(text=paste(plot_paramdist_post)))}) 
#     }
#   }

#-----------------------------------------
  update_all_figures  <-function(input, output, session){

  cfg = gui_fetch_cfg(session)

  # Timecourse figure
  output$plotfigure<- renderPlot({
    generate_timecourse(input, output, session)}) 
  # Parameter distribution figure
  if(cfg$gui$check_variability){
   output$plotparamdist<- renderPlot({
     generate_paramdist(input, output, session)}) 
   }
}

#-----------------------------------------
generate_timecourse  <-function(input, output, session){
   cfg = gui_fetch_cfg(session)
   som = gui_fetch_som(session)

   # Loading user defined functions
   if(!is.null(cfg$gui$functions$user_def)){
     tryCatch(
      { 
       eval(parse(text=paste(sprintf('source("%s")',cfg$gui$functions$user_def))))
      },
       warning = function(w) {
       # place warning stuff here
      },
       error = function(e) {
         GUI_log_entry(cfg, sprintf('eval error: %s ', e$message))
      })
   }

   
   if(!is.null(cfg$gui$functions$plot_ind) & !cfg$gui$check_variability){
     # using custom individual plotting function
     pstr  = sprintf("p = %s\n", cfg$gui$functions$plot_ind)

     tryCatch(
      { 
       eval(parse(text=paste(pstr)))
      },
       warning = function(w) {
       # place warning stuff here
      },
       error = function(e) {
         GUI_log_entry(cfg, sprintf('eval error: %s ', e$message))
         GUI_log_entry(cfg, sprintf('unable to parse string (%s)', pstr))
      })
   

   } else if(!is.null(cfg$gui$functions$plot_var) & cfg$gui$check_variability){
   # using custom population function
     # using custom individual plotting function
     pstr  = sprintf("p = %s\n", cfg$gui$functions$plot_var)

     tryCatch(
      { 
       eval(parse(text=paste(pstr)))
      },
       warning = function(w) {
       # place warning stuff here
      },
       error = function(e) {
         GUI_log_entry(cfg, sprintf('eval error: %s ', e$message))
         GUI_log_entry(cfg, sprintf('unable to parse string (%s)', pstr))
      })


   } else{
   # Standard automated figure generation for the gui
     
     
     # Getting the TS
     if(is.null(cfg$options$misc$TS)){
       output_TS = "time"}
     else{
       output_TS = cfg$options$misc$TS }
     
     pstr = sprintf("p = ggplot() \n")
     
     # Storing all of the output information in the vector yall
     # to be used to identify the bounds at the end
     #yall = c()
     
     line_colors = "";
     
     
     octr = 1;
     for(output in cfg$gui$outputs){
     
       # With Variability
       if(cfg$gui$check_variability){
         if(cfg$gui$check_log){
           pstr = sprintf("%s p = p + geom_ribbon(data=som$tcsummary[(som$tcsummary$o.%s.lb_ci>0) & (som$tcsummary$o.%s.ub_ci > 0) ,], aes(x=ts.%s, ymin=o.%s.lb_ci, ymax=o.%s.ub_ci), fill='%s', alpha=0.6)\n",
                           pstr,                                                       output,                        output,                    output_TS, output,           output, cfg$gui$colors$region[octr]  )
         
           pstr = sprintf("%s p = p + geom_line(data=som$tcsummary[som$tcsummary$o.%s.median > 0,], aes(x=ts.%s, y=o.%s.median, color='%s'), linetype='solid', size=0.9) \n", 
                          pstr,                                                    output,             output_TS, output,         output) }
         else{
           pstr = sprintf("%s p = p + geom_ribbon(data=som$tcsummary, aes(x=ts.%s, ymin=o.%s.lb_ci, ymax=o.%s.ub_ci), fill='%s', alpha=0.6)\n",
                           pstr,                                                output_TS, output,           output, cfg$gui$colors$region[octr])
           pstr = sprintf("%s p = p + geom_line(data=som$tcsummary, aes(x=ts.%s, y=o.%s.median, color='%s'), linetype='solid', size=0.9) \n", 
                          pstr,                                       output_TS, output,           output) }
       }
       # Single simulation
       else{
         if(cfg$gui$check_log){
           pstr = sprintf("%s p = p + geom_line(data=som$simout[som$simout$%s > 0,], aes(x=ts.%s, y=%s, color='%s'), linetype='solid', size=0.9) \n", 
                   pstr, output, output_TS, output, output) }
         else{
           pstr = sprintf("%s p = p + geom_line(data=som$simout, aes(x=ts.%s, y=%s, color='%s'), linetype='solid', size=0.9) \n", 
                   pstr,  output_TS, output, output) }
       }
     
        #line_colors = c(line_colors, cfg$gui$colors$solid[octr])
        #line_colors = c(line_colors, sprintf(output=cfg$gui$colors$solid[octr])
        if(line_colors == ""){
          line_colors = sprintf('"%s"="%s"', output,cfg$gui$colors$solid[octr])
        }
        else{
          line_colors = sprintf('%s, "%s"="%s"', line_colors, output,cfg$gui$colors$solid[octr])
        }
     
       # now we construct the plot string
       octr = octr+1
       # if we have more outputs than colors then we repeat them
       if(octr > length(cfg$gui$colors$solid)){
         octr = 1 }
     }
     
     pstr = sprintf("%s p = p + xlab('Time (%s)')                     \n",pstr, output_TS )
     pstr = sprintf("%s p = p + ylab('Output')                        \n",pstr )
     pstr = sprintf("%s p = prepare_figure('present', fo=p, y_tick_major=%s, x_tick_major=%s)\n",pstr, toString(cfg$gui$check_grid), toString(cfg$gui$check_grid) )

     #pstr = sprintf("%s p = p + scale_colour_manual(values=c('%s'))   \n", pstr, paste(line_colors, collapse="', '"))
     pstr = sprintf("%s p = p + scale_colour_manual(values=c(%s))   \n", pstr, line_colors)
     pstr = sprintf("%s p = p + theme(legend.title = element_blank()) \n",pstr)
     pstr = sprintf("%s p = p + theme(legend.position = 'bottom')     \n",pstr)
     
     #pstr = sprintf("%s p = p + theme(legend.position='bottom')      \n",pstr )
     
     
     
     # evaling all of the plot strings up to this point
     # so we can create p and use that to determine the 
     # limits of the plot up to this point
     
     tryCatch(
      { 
       eval(parse(text=paste(pstr)))
      },
       warning = function(w) {
       # place warning stuff here
      },
       error = function(e) {
         GUI_log_entry(cfg, sprintf('eval error: %s ', e$message))
         GUI_log_entry(cfg, sprintf('unable to parse string (%s)', pstr))
      })
     
     # Next we look at the axis limits to see if they are user specified or
     # if they should be figured out automatically
     
     # If the user has unchecked autox and the text input is good
     # then we alter the axis based on what the user has selected
     pstr_post = ""
     if(!cfg$gui$check_autox & cfg$gui$good_text_autox  ){
       pstr_post = sprintf("%s p = p + xlim(%s)   \n",pstr_post, toString(cfg$gui$text_autox))
     }
     else{
     # otherwise we pull the range from the plot object p and update the GUI
     # with those values
       eval(parse(text=sprintf("cfg$gui$text_autox = c(%s,%s)", 
                  var2string(layer_scales(p)$x$range$range[1], maxlength = 1, nsig_e=2, nsig_f=4), 
                  var2string(layer_scales(p)$x$range$range[2], maxlength = 1, nsig_e=2, nsig_f=4))))
     
       updateTextInput(session, 'text_autox', value= 
         sprintf('%s, %s', 
             var2string(cfg$gui$text_autox[1] , maxlength = 1, nsig_e=2, nsig_f=4),
             var2string(cfg$gui$text_autox[2] , maxlength = 1, nsig_e=2, nsig_f=4)))
     }
     
     # now we repeat the same steps for the y axis
     if(!cfg$gui$check_autoy & cfg$gui$good_text_autoy  ){
        if(cfg$gui$check_log){
          # Changing the yscale to log 10 with user specified limits
          pstr_post = sprintf("%s p = gg_log10_yaxis(p, ylim_min = %s, ylim_max= %s)\n",pstr_post, toString(cfg$gui$text_autoy[1]), toString(cfg$gui$text_autoy[2]))

        }
        else{
          pstr_post = sprintf("%s p = p + ylim(%s)   \n",pstr_post, toString(cfg$gui$text_autoy))
        
        }
     }
     else{
        # Changing the yscale to log 10 using the default limits
        if(cfg$gui$check_log){
          pstr_post = sprintf("%s p = gg_log10_yaxis(p)  \n",pstr_post ) }
     
     
       eval(parse(text=sprintf("cfg$gui$text_autoy = c(%s,%s)", 
                  var2string(layer_scales(p)$y$range$range[1], maxlength = 1, nsig_e=2, nsig_f=4), 
                  var2string(layer_scales(p)$y$range$range[2], maxlength = 1, nsig_e=2, nsig_f=4))))
     
       updateTextInput(session, 'text_autoy', value= 
         sprintf('%s, %s', 
             var2string(cfg$gui$text_autoy[1] , maxlength = 1, nsig_e=2, nsig_f=4),
             var2string(cfg$gui$text_autoy[2] , maxlength = 1, nsig_e=2, nsig_f=4)))
     }
     
     # evalutating the "post" plot strings
     # to modify the axes
     tryCatch(
      { 
       eval(parse(text=paste(pstr_post)))
      },
       warning = function(w) {
       # place warning stuff here
      },
       error = function(e) {
         GUI_log_entry(cfg, sprintf('eval error: %s ', e$message))
         GUI_log_entry(cfg, sprintf('unable to parse string (%s)', pstr_post))
      })
     
     # concatenating them together to save 
     pstr = sprintf('%s\n%sprint(p)', pstr, pstr_post)
     
     
   }

   # saving the plotting strings
   cfg$gui$sysel_plot = pstr
   
   sysel_plot_timecourse = pstr
   save(sysel_plot_timecourse, file=sprintf("%s%sgui_plot_timecourse.RData", find_user_dir(session), .Platform$file.sep))
   gui_save_cfg(cfg, session)


p}


  

#--[ update_simulation ]---------------------------------
update_simulation <- function(input, output, session) {
   #loading the most up to date cfg variable
   cfg=gui_fetch_cfg(session);

   # Loading user defined libraries
   if(!is.null(cfg$gui$functions$user_def)){
     tryCatch(
      { 
       eval(parse(text=paste(sprintf('source("%s")',cfg$gui$functions$user_def))))
      },
       warning = function(w) {
       # place warning stuff here
      },
       error = function(e) {
         GUI_log_entry(cfg, sprintf('eval error: %s ', e$message))
      })
   }


  # Updating the simulation with the changes from the GUI
  if(cfg$gui$sim_status != 'Fresh'){
    sysel = c()

    #--[ options ]---------------------------------
    sysel$options = ""

    # output times
    ot = eval(parse(text=cfg$options$misc$output_times))
    tstart = min(ot)
    # used to calculate the step size
    tstart_step = min(ot)
    tstop  = max(ot)

    # If a start time has been specified then we use that one
    if(!is.null(cfg$gui$sim_starttime)){
      tstart = cfg$gui$sim_starttime } 
    
    minstep = cfg$gui$minstep
    
    # If the user has specified a stepsize for the steady state stabilization we use that, otherwise
    # we use the normal minstep
    if(!is.null(cfg$gui$ss_minstep)){
      ss_minstep = cfg$gui$ss_minstep}
    else{
      ss_minstep = minstep}
    
    if(!is.null(cfg$gui$sim_starttime)){
      tstart = cfg$gui$sim_starttime } 

    # adjusting the bounds on the time vector
    # for simulation purposes if autox is false
    if(!cfg$gui$check_autox){
      # text_autox is in the units of plotting
      # that needs to be converted to the simulation 
      # units to determine for defining the output times
      tstop = max(cfg$gui$text_autox)/(cfg$options$time_scales[[cfg$options$misc$TS]]) }
    
    if(tstart < 0){
      # SS initialization required
      sysel$options = sprintf('%soutput_times_ss_init = seq(%d, %d, %.4e)\n', sysel$options, tstart, 0,     ss_minstep*(0     - tstart))
      sysel$options = sprintf('%soutput_times_post_ss = seq(%d, %d, %.4e)\n', sysel$options, 0,      tstop,    minstep*(tstop - 0))
      sysel$options = sprintf('%soutput_times = sort(unique(c(output_times_ss_init, output_times_post_ss)))\n', sysel$options)
    }
    else{
      # SS not required
      sysel$options = sprintf('%soutput_times = seq(%d, %d, %.4e)\n ', sysel$options, tstart, tstop, cfg$gui$minstep*(tstop - tstart_step))}
    sysel$options = sprintf('%scfg = system_set_option(cfg, "simulation", "output_times", output_times)\n', sysel$options, tstart, tstop, cfg$gui$minstep*(tstop - tstart_step))

    #--[ parameters ]---------------------------------
    # Pulling out the default parameters for the current parameter set
    sysel$parameters = "parameters = system_fetch_parameters(cfg) \n "
    if(!is.null(cfg$gui$parameters)){
      for(pname in names(cfg$gui$parameters)){
        sysel$parameters = sprintf('%sparameters[["%s"]] = %s \n ', sysel$parameters, pname, toString(cfg$gui$parameters[[pname]]))
      }
    }

    #--[ bolus ]--------------------------------------
    sysel$bolus        = ""
    if(!is.null(cfg$gui$bolus)){
      btimes = cfg$gui$bolus$times;
      
      # adding the repeat dosing times to the end of the current btimes # vector
      if(cfg$gui$check_repeatdoses){
        btimes = c(btimes, seq(1,cfg$gui$text_bolus_number)*cfg$gui$text_bolus_frequency + tail(btimes, n=1)) }

      # clearing the default bolus information
      sysel$bolus = sprintf("cfg=system_zero_inputs(cfg, bolus=TRUE, rates=FALSE) \n\n")

      # setting the bolus information for each state
      for(sname in names(cfg$gui$bolus$states)){
        # pulling out the bolus values
        bvalues = cfg$gui$bolus$states[[sname]] 

        # adding the repeat dosing values to the end of the current bvalues vector
        if(cfg$gui$check_repeatdoses){
          bvalues = c(bvalues, rep(tail(bvalues, n=1), cfg$gui$text_bolus_number)) }
        sysel$bolus = sprintf('%s cfg = system_set_bolus(cfg, state  = "%s",  \n',   sysel$bolus, sname)
        sysel$bolus = sprintf('%s                             times  = c(%s), \n',   sysel$bolus, toString(btimes))
        sysel$bolus = sprintf('%s                             values = c(%s)) \n\n', sysel$bolus, toString(bvalues))
      
      }
    }

    #--[ iiv ]----------------------------------------
    sysel$iiv        = ""

    # these elements are added only if variability has been selected
    if(cfg$gui$check_variability){
      # IIV options first
      if(!is.null(cfg$gui$text_nsub)){
       sysel$iiv = sprintf('%s cfg = system_set_option(cfg, "stochastic", "nsub", %s)\n', sysel$iiv, toString(cfg$gui$text_nsub)) }
      if(!is.null(cfg$gui$text_ci)){
       sysel$iiv = sprintf('%s cfg = system_set_option(cfg, "stochastic", "ci",   %s)\n', sysel$iiv, toString(cfg$gui$text_ci)) }
      
      # Then we overwrite the values
      if(!is.null(cfg$gui$iiv)){
        for(iname1 in names(cfg$gui$iiv)){
          for(iname2 in names(cfg$gui$iiv[[iname1]])){
            sysel$iiv = 
            sprintf('%s cfg = system_set_iiv(cfg, IIV1="%s", IIV2="%s", %s)\n', 
                   sysel$iiv,
                   iname1, 
                   iname2, 
                   toString(cfg$gui$iiv[[iname1]][[iname2]]))
          }
        }
      }
    }



    #--[ rates ]--------------------------------------
    sysel$infusion_rates        = ""
    if(!is.null(cfg$gui$infusion_rates)){
      # clearing the default infusion rate information
      sysel$infusion_rates = sprintf("cfg=system_zero_inputs(cfg, bolus=FALSE, rates=TRUE) \n\n")

      # Now we dump definitions for each rate
      for(rname in names(cfg$gui$infusion_rates)){
        rtimes = cfg$gui$infusion_rates[[rname]]$times
        rvalues= cfg$gui$infusion_rates[[rname]]$values
        sysel$infusion_rates = sprintf('%s cfg = system_set_rate(cfg, rate   =  "%s",  \n', sysel$infusion_rates, rname)
        sysel$infusion_rates = sprintf('%s                            times  =  c(%s), \n', sysel$infusion_rates, toString(rtimes))
        sysel$infusion_rates = sprintf('%s                            levels =  c(%s)) \n\n', sysel$infusion_rates, toString(rvalues))
      }
    }

    #--[ covariates ]---------------------------------
    sysel$covariates = ""
    if(!is.null(cfg$gui$covariates)){
      # looping through each covariate and setting it in cfg
      for(cname in names(cfg$gui$covariates)){
        ctimes = cfg$gui$covariates[[cname]]$times
        cvalues = cfg$gui$covariates[[cname]]$value
        sysel$covariates = sprintf('%scfg = system_set_covariate(cfg, covariate = "%s",    \n', sysel$covariates, cname)
        sysel$covariates = sprintf('%s                                times     = c(%s),   \n', sysel$covariates, toString(ctimes))
        sysel$covariates = sprintf('%s                                values    = c(%s))   \n\n', sysel$covariates, toString(cvalues))
      }
    }

    # The strings built above will now be executed to populate
    # the elements of cfg that are different in the GUI
    for(ele in names(sysel)){
      tryCatch(
       { 
        eval(parse(text=paste(sysel[[ele]]))) 
       },
        warning = function(w) {
        # place warning stuff here
       },
        error = function(e) {
          GUI_log_entry(cfg, sprintf('eval error: %s ', e$message))
          GUI_log_entry(cfg, sprintf('unable to parse string (%s)', sysel[[ele]]))
       })}

    # Defining the parameter set
    # This is done _after_ the eval 
    # to be present in exporting
    sysel$pset = cfg$parameters$current_set

    # Running simulations
    # If check_variability is true
    # then we run stochastic simulations
    sim_tic  = proc.time()
    system_log_debug_save(cfg, 
       file_name = 'app_pre_sim',
       values    = list(cfg=cfg, parameters=parameters))
    if(cfg$gui$check_variability){
      user_log_entry(cfg, "Beginning simulations")
      user_log_entry(cfg,         " -> type: stochastic  ")
      user_log_entry(cfg, sprintf(" -> number of subjects: %d",cfg$options$stochastic$nsub))
      user_log_entry(cfg, sprintf(" -> integrating with %s", cfg$options$simulation_options$integrate_with))
      sysel$sim = sprintf("som = %s\n", cfg$gui$functions$sim_var)
      eval(parse(text=paste(sysel["sim"]))) 

    }
    else{
    #otherwise we just run an individual simulation
      user_log_entry(cfg, "Beginning simulation")
      user_log_entry(cfg,         " -> type: individual  ")
      user_log_entry(cfg, sprintf(" -> integrating with %s", cfg$options$simulation_options$integrate_with))
      sysel$sim = sprintf("som = %s\n", cfg$gui$functions$sim_ind)

      # Using progress indicator do tell the user what's going on
      
      pb <- shiny::Progress$new()
      pb$set(message = "Running Simulation, be patient", value = 0)
      eval(parse(text=paste(sysel["sim"]))) 
      pb$close()
    }
    system_log_debug_save(cfg, 
       file_name = 'app_post_sim',
       values    = list(cfg=cfg, parameters=parameters, som=som))

    # If we're not in admin mode we trim off any initialization times,
    # otherwise we include them
    if(!cfg$gui$admin_mode){
      som = system_trim_som_initialization(cfg, som, variability=cfg$gui$check_variability) }


    gui_save_som(som, session)
    sim_toc  = proc.time()
    telapsed =  (sim_toc - sim_tic)[["elapsed"]]
    user_log_entry(cfg, sprintf("Simulation complete (%s seconds)", var2string(telapsed, 1)))
    cfg$gui$sim_status = 'Fresh'
    # storing the sysel in the cfg variable
    # to be used when exporing
    cfg$gui$sysel_simulate = sysel
    
    # now we save the cfg variable with the system elements
    # as strings to be used for exporting 
    gui_save_cfg(cfg, session)


  }
}
#--[ update_simulation done ]----------------------------
user_log_init <- function(input, output, session) {
  cfg=gui_fetch_cfg(session)
  fileReaderData <- reactiveFileReader(500, session, cfg$gui$user_log_file, readLines)
  output$text_user_log <- renderText({
    # Read the text, and make it a consistent number of lines so
    # that the output box doesn't grow in height.
    text <- fileReaderData()
    length(text) <- cfg$gui$user_log_length
    text[is.na(text)] <- ""
    paste(text, collapse = '\n')
  })
}

# This function finds a place to store the user information for the current
# session. If the user variable is set, we use that to store the user session,
# otherwise we use the session token. If for some reason those fail we store
# them in 'default'
#
# If full is FALSE then we just get the name of the user specific directory.
# If full is TRUE we return the full path to that directory.
#
# To do this we need to figure out if the app is deployed. This is triggered
# by the looking at the file "DEPLOYING" in transient/app_base. If that file
# has the word TRUE, then we store everything in the session temporary
# directory. If the app isn't deployed then we store everything in the working
# directory to allow for debugging later.
find_user_dir <- function(session, full=TRUE) {
  
  # Trying to determine where to store the user information
  # First we see if the session$user exists, if not we look for the
  # session token, then we look for 
  if(!is.null(session$user)){
    user = session$user 
  } else if (!is.null(session$token)) {
    user = session$token 
  } else {
    user = 'default'  
  }

  # returning the full path to the user directory
  if(full){
    # First we set deploying to false
    DEPLOYING = FALSE
    # Next we try to open the file that contains the deploying switch. It's
    # created at the end of the ubiquity_app.R file:
    DEPINFO_file = file.path(getwd(), "transient", "app_base" ,"DEPLOYING")
    if(file.exists(DEPINFO_file)){
      # This file should contain a single line with either TRUE if the app is
      # being deployed and false if it's not
      DEPLOYINGConn<-file(file.path(getwd(), "transient", "app_base" ,"DEPLOYING"))
      if(readLines(DEPINFO_file)[1] == "TRUE"){
        DEPLOYING = TRUE
      }
      close(DEPLOYINGConn)
    } 
    
    if(DEPLOYING){
        # If we're deploying we store the user files in the temporary
        # directory:
        user = file.path(tempdir(),"transient", "app_base", "rgui", user) 
      } else {
        # otherwise we store them locally 
        user = file.path(getwd(),"transient", "app_base", "rgui", user) 
      }
    } 

  return(user)
}

initialize_session <- function(session) {

  # pulling the path to the user directory 
  user_dir = find_user_dir(session)

  # if the user directory exists we delete it
  if(dir.exists(user_dir)){
    unlink(user_dir, recursive=TRUE)}
  
  # now we create the user directory and copy the default 
  # cfg variable into it
  dir.create(user_dir, recursive=TRUE)

  file.copy(file.path(getwd(), "transient", "app_base", "rgui", "gui_state.RData"), file.path(user_dir, "gui_state.RData"))

  # loading the cfg variable
  cfg=gui_fetch_cfg(session)
  
  # initializing the general ubiquity log
  cfg = system_set_option(cfg, 
                        group="logging", 
                        option="file",
                        file.path(user_dir, "ubiquity_log.txt"))
                        # JMH del sprintf('%s%subiquity_log.txt', user_dir, .Platform$file.sep))
  cfg = system_log_init(cfg)
  GUI_log_entry(cfg, "server.R startup")
  
  # initialzing the user log
  cfg$gui$user_log_file =  sprintf('%s%suser_log.txt', user_dir, .Platform$file.sep)
  file.create(cfg$gui$user_log_file)


  # Default to integrating with r scripts
  cfg$options$simulation_options$integrate_with  = "r-file"
  # If the dynamic library exists we try to load it
  if(file.exists(file.path("transient","app_base",  paste("ubiquity_app_base", .Platform$dynlib.ext, sep = "")))){
    GUI_log_entry(cfg, "Found dynamic library attempting to load")
    dyn.load(file.path("transient", "app_base",  paste("ubiquity_app_base", .Platform$dynlib.ext, sep = ""))) }

  # If the library has been loaded we switch to C
  if(is.null(getLoadedDLLs()$ubiquity_app_base) == FALSE){
    if(getLoadedDLLs()$ubiquity_app_base[["dynamicLookup"]] == TRUE){
      GUI_log_entry(cfg, "Dynamic library seems to be loaded, setting")
      GUI_log_entry(cfg, "integration method to c-file")
      cfg$options$simulation_options$integrate_with  = "c-file"
    }
  }
  # saving the cfg variable
  gui_save_cfg(cfg, session)
}

apply_overwrite <- function(cfg){
  # pulling the default values for the currently selected parameterset
  parameters = cfg$parameters$values

  # if the user has specified different
  # parameters we update them here
  if(!is.null(cfg$gui$parameters)){
    for(pname in names(cfg$gui$parameters)){
      if(pname %in% names(parameters)){
        parameters[[pname]] = cfg$gui$parameters[[pname]]
      }
    }
  
  }
  return(parameters)
}


# generates the html report
# RID is the report ID R1, R2, ... or R5
generate_model_report <- function(cfg, session, RID){

    parameters = apply_overwrite(cfg)
    som=gui_fetch_som(session)

    params = c()
    params$cfg        = cfg
    params$parameters = parameters
    params$som        = som


    # getting the file names for the 
    user_dir = find_user_dir(session)
    Rmdfile  = sprintf('%s%s%s', cfg$gui$wd, .Platform$file.sep, cfg$gui$modelreport_files[[RID]]$file)
    htmlfile = sprintf('%s%smodel_report_%s.html', user_dir, .Platform$file.sep, RID)
    htmlfile_base = paste("model_report_", RID, ".html", sep="")

    # If the html file does not exits and the Rmd file ends in html then we 
    # just use that as the report instead of rendering it.
    if(!file.exists(htmlfile)){
    if(grepl("\\.html$", Rmdfile, ignore.case=TRUE)){
      file.copy(Rmdfile, htmlfile, overwrite=TRUE)
    }
    }

    success = FALSE
    message = "Unable to generate html report"
    # If the report has already been generated 
    if(file.exists(htmlfile)){
      success = TRUE
      message = "success: previous report" 
      user_log_entry(cfg, sprintf("Using previously generated report: %s", htmlfile)) 
    
    } 
    else{
      user_log_entry(cfg, sprintf("Generating report: %s", htmlfile)) 
      # rendering the markdown to a temporary html file
     tryCatch(
      { 
       suppressWarnings(
        rmarkdown::render(Rmdfile,
                          params        = params,
                          output_format = "html_document",
                          output_file   = htmlfile)
        )
        success = TRUE
        message = "success: report generated"
      },
       warning = function(w) {
       # place warning stuff here
      },
        error = function(e) {
      })
    }


    output = c()
    output$htmlfile      = htmlfile
    output$htmlfile_base = htmlfile_base
    output$success       = success
    output$message       = message
    return(output)
}


# generates the model report
update_uimodelreport <- function(input, output, session){

  output$uimodelreport_R1 = renderUI({
    # forcing an update when text_status has been updated
    input$button_update
    input$text_status  

    cfg = gui_fetch_cfg(session)
    if(cfg$gui$sim_status == "Fresh"){
      # generating the report in html
      mg      = generate_model_report(cfg, session, "R1")
      if(mg$success){
        result  = tags$iframe(seamless = "seamless",
                  src   = file.path(find_user_dir(session, full=FALSE), mg$htmlfile_base),
                  width = 600, height=700)
      } else {
        result = "Report generation failed"
        user_log_entry(cfg, "Unable to generate report") }

    } else{
      result = 'The simulation status is stale, you need to push the Update Plot Button before regenerating the report' }
  
  result})

  output$uimodelreport_R2 = renderUI({
    # forcing an update when text_status has been updated
    input$button_update
    input$text_status  

    cfg = gui_fetch_cfg(session)
    if(cfg$gui$sim_status == "Fresh"){
      # generating the report in html
      mg      = generate_model_report(cfg, session, "R2")
      if(mg$success){
        result  = tags$iframe(seamless = "seamless",
                  src   = file.path(find_user_dir(session, full=FALSE), mg$htmlfile_base),
                  width = 600, height=700)
      } else {
        result = "Report generation failed"
        user_log_entry(cfg, "Unable to generate report") }

    } else{
      result = 'The simulation status is stale, you need to push the Update Plot Button before regenerating the report' }
  
  result})

  output$uimodelreport_R3 = renderUI({
    # forcing an update when text_status has been updated
    input$button_update
    input$text_status  

    cfg = gui_fetch_cfg(session)
    if(cfg$gui$sim_status == "Fresh"){
      # generating the report in html
      mg      = generate_model_report(cfg, session, "R3")
      if(mg$success){
        result  = tags$iframe(seamless = "seamless",
                  src   = file.path(find_user_dir(session, full=FALSE), mg$htmlfile_base),
                  width = 600, height=700)
      } else {
        result = "Report generation failed"
        user_log_entry(cfg, "Unable to generate report") }

    } else{
      result = 'The simulation status is stale, you need to push the Update Plot Button before regenerating the report' }
  
  result})

  output$uimodelreport_R4 = renderUI({
    # forcing an update when text_status has been updated
    input$button_update
    input$text_status  

    cfg = gui_fetch_cfg(session)
    if(cfg$gui$sim_status == "Fresh"){
      # generating the report in html
      mg      = generate_model_report(cfg, session, "R4")
      if(mg$success){
        result  = tags$iframe(seamless = "seamless",
                  src   = file.path(find_user_dir(session, full=FALSE), mg$htmlfile_base),
                  width = 600, height=700)
      } else {
        result = "Report generation failed"
        user_log_entry(cfg, "Unable to generate report") }

    } else{
      result = 'The simulation status is stale, you need to push the Update Plot Button before regenerating the report' }
  
  result})

  output$uimodelreport_R5 = renderUI({
    # forcing an update when text_status has been updated
    input$button_update
    input$text_status  

    cfg = gui_fetch_cfg(session)
    if(cfg$gui$sim_status == "Fresh"){
      # generating the report in html
      mg      = generate_model_report(cfg, session, "R5")
      if(mg$success){
        result  = tags$iframe(seamless = "seamless",
                  src   = file.path(find_user_dir(session, full=FALSE), mg$htmlfile_base),
                  width = 600, height=700)
      } else {
        result = "Report generation failed"
        user_log_entry(cfg, "Unable to generate report") }

    } else{
      result = 'The simulation status is stale, you need to push the Update Plot Button before regenerating the report' }
  
  result})
}

server <- function(input, output, session) {

  # Initializing the the session for 
  # the current user
  initialize_session(session) 
  addResourcePath(find_user_dir(session, full=FALSE), find_user_dir(session))
  cfg=gui_fetch_cfg(session)
  user_log_init(input, output, session)

  # populating the GUI with the model information
  update_parameters(input, output, session)
  generate_bolus(input, output, session)
  generate_rates(input, output, session)
  generate_covariates(input, output, session)
  generate_iiv(input, output, session)

  output$my_plot_tabs = renderUI({

      # Creating the tab for the plot
      timecourse_tab =  tabPanel("Timecourse",  id="panel_timecourse",  
                                plotOutput('plotfigure', 
                                click  = "plotfigure_click", 
                                width  = cfg$gui$dims$timecourse$width, 
                                height = cfg$gui$dims$timecourse$height))
     
      # Creating subjects tab
      paramdist_tab =  tabPanel("System Parameters", id="panel_paramdist",  
                     plotOutput('plotparamdist', 
                                width  = cfg$gui$dims$paramdist$width, 
                                height = cfg$gui$dims$paramdist$height))
     
      # Tab for model diagram
      modeldiagram_tab =  NULL
     
      # If a file was found then we enable the diagram tab
      if(!is.null(cfg$gui$modeldiagram_file)){
        modeldiagram_tab = tabPanel("Model Diagram", id="panel_modeldiagram", 
                        imageOutput('diagramfigure', 
                                   width  = cfg$gui$dims$modeldiagram$width, 
                                   height = cfg$gui$dims$modeldiagram$height))
      }


      mpt=c('timecourse_tab')

      if(!is.null(input$check_variability)){
        if(input$check_variability){
          mpt=c(mpt, 'paramdist_tab') 
        }
      }
      
      if(!is.null(modeldiagram_tab)){
        mpt=c(mpt, 'modeldiagram_tab') 
      }

      # Creating model report tabs

      if(!is.null(cfg$gui$modelreport_files)){
        # For each specified report we create a tab
        for(report_name in names(cfg$gui$modelreport_files)){
          if(is.null(cfg$gui$modelreport_files[[report_name]]$title)){
            tab_title = "Model Report"
          } else {
            tab_title = cfg$gui$modelreport_files[[report_name]]$title }
            
          # making a string that contains the tab definition and evaluating it
          mr_str = sprintf('modelreport_tab_%s = tabPanel("%s", id="panel_modelreport_%s", htmlOutput("uimodelreport_%s"))',
                                               report_name,  tab_title,                report_name,                    report_name)
          eval(parse(text=mr_str))

          # appending the tab to the list of tabs
          mpt=c(mpt, sprintf('modelreport_tab_%s', report_name)) 
        }
      }


      mptstr = sprintf('tabsetPanel(type="tabs", id="tabset_figures", %s)', paste(mpt, collapse=", "))
      eval(parse(text=mptstr))
  })

  # updating the tabs in the GUI dynamically depending 
  # on what is present in this particular model
  output$my_parameter_tabs = renderUI({

    # Creating selections for parameter sets:
    PSETS = c()
    for(SETNAME in names(cfg$parameters$sets)){
      PSETS[[cfg$parameters$sets[[SETNAME]]$name]] = SETNAME }
    # Creating the tab for the parameters:
    parameter_tab = tabPanel("Parameters", 
               wellPanel(id = "PPanel",style = "overflow-y:scroll; max-height: 600px", 
               selectInput("pset", label = NULL, choices = PSETS, selected = cfg$parameters$current_set),
               rHandsontableOutput("table_parameters")))
    
    # Creating the tab for the variability
    variability_tab = NULL
    if(("iivs" %in% names(cfg[["iiv"]])) &  cfg$gui$display$iivtab ){
    variability_tab = tabPanel("Variability", 
                      wellPanel(id = "panel_variability",style = "overflow-y:scroll; max-height: 600px", 
                       checkboxInput('check_variability', "Simulate with variability", FALSE),
                       div(style="display:inline-block; max-width: 80px", textInput("text_nsub", "Number of Subjects", toString(as.integer(cfg$gui$text_nsub)))),
                       div(style="display:inline-block; max-width: 50px", ''),
                       div(style="display:inline-block; max-width: 80px", textInput("text_ci", "Prediction Interval (%)", toString(as.integer(cfg$gui$text_ci)))),
                       p(),
                       strong("Variance-Covariance Matrix"), 
                         rHandsontableOutput("table_iiv")))
    }


    if(("iivs" %in% names(cfg[["iiv"]])) &  cfg$gui$display$iivtab ){
      tabsetPanel(type="tabs", parameter_tab, variability_tab)}
    else{
      tabsetPanel(type="tabs", parameter_tab)}
  })


  output$my_input_tabs = renderUI({

    covariates_tab = 
    tabPanel("Covariates",
             wellPanel(id = "panel_covariates",style = "overflow-y:scroll; max-height: 450px", 
             rHandsontableOutput("table_covariates")))
    
    infusions_tab = 
    tabPanel("Infusions", 
             wellPanel(id = "panel_infusions",style = "overflow-y:scroll; max-height: 450px", 
             rHandsontableOutput("table_rates")))
    
    bolus_tab =  
    tabPanel("Injections",
             wellPanel(id = "panel_bolus",style = "overflow-y:scroll; max-height: 450px", 
             rHandsontableOutput("table_bolus"), 
             checkboxInput('check_repeatdoses', 'Repeat the last dose', value=cfg$gui$check_repeatdoses),
             div(style="display:inline-block", textInput('text_bolus_frequency', label=NULL, value=toString(as.integer(cfg$gui$text_bolus_frequency)))), "(Dosing Interval)",
             tags$style(type='text/css', "#text_bolus_frequency { width: 50px; }"), br(),
             div(style="display:inline-block", textInput('text_bolus_number', label=NULL, value=toString(as.integer(cfg$gui$text_bolus_number)))), "(Number of doses)", 
             tags$style(type='text/css', "#text_bolus_number    { width: 50px; }")))
    
    noinputs_tab = 
    tabPanel("Inputs", "No input information (bolus, infusion rates, or covariates) has been specified")

    input_tabs = c()
    
    # constructing the tabs based on whether the input type exists:
    if("bolus" %in% names(cfg$options$inputs)){
      input_tabs = append(input_tabs, 'bolus_tab') }
    if("infusion_rates" %in% names(cfg$options$inputs)){
      input_tabs = append(input_tabs, 'infusions_tab') }
    if("covariates" %in% names(cfg$options$inputs)){
      input_tabs = append(input_tabs, 'covariates_tab') }

    # if no inputs  exists we create a default tab
    if(length(input_tabs) == 0){
      input_tabs = append(input_tabs, 'noinputs_tab') }
      
     # tabsetPanel(type="tabs", bolus_tab, infusions_tab , covariates_tab)
     eval(parse(text=sprintf('tabsetPanel(type="tabs", %s)', paste(input_tabs, collapse = ', ') )))
  })

  # initializing the plot
  if(cfg$gui$sim_status == "Initialization"){
    user_log_entry(cfg, sprintf("Initial simulation based on default information (%s)", ubiquity_distribution))
    update_simulation(input,output, session)
    update_all_figures(input, output, session)
  }

  # only updating the plot when the button is clicked
  observeEvent(input$button_update,{
    update_simulation(input,output, session)})

  # Updating the simulation state based on user input
  simulation_state(input, output, session)
  update_uimodelreport(input,output,session)
  
  # Certain button clicks, checks, etc will force the plot to update
  # toggling grid
  observeEvent(input$check_grid,{
    update_all_figures(input, output, session) })
  # Toggling y scale
  observeEvent(input$check_log, {
    update_all_figures(input, output, session) })
  # Updating the plot 
  observeEvent(input$button_update,{
    update_all_figures(input, output, session) })

  # Updating the plot 
  observeEvent(input$plotfigure_click,{
    select_point(input, output, session)
  })

  # force figures to be updated when the tabs are selectd
  observeEvent(input$tabset_figures,{
    update_all_figures(input, output, session) })


  # Downloading the current simulation
  download_simulation(input, output, session)

  

  # Pushes the model diagram to the GUI
  if(!is.null(cfg$gui$modeldiagram_file)){
    output$diagramfigure = renderImage({ 
       list(src = cfg$gui$modeldiagram_file,
            height = 450,
            alt = "Model Diagram")}, deleteFile = FALSE)
  }

}

Try the ubiquity package in your browser

Any scripts or data that you put into this service are public.

ubiquity documentation built on Sept. 5, 2021, 5:15 p.m.