if (TRUE) {    # header
  #/*soh*************************************************************************
  # Eli Lilly and Company - Global Statistical Sciences
  # CODE NAME             : server.r
  # CODE TYPE							: Program
  # DATE OF UPDATE:         1-Feb-2019
  # DESCRIPTION           : Server code for BEACH app
  # SOFTWARE/VERSION#     : R 3.3.0
  # INFRASTRUCTURE        :
  # LIMITED-USE MODULES   : N/A
  # BROAD-USE MODULES     : N/A
  # INPUT                 :
  # OUTPUT                :
  #   VALIDATION LEVEL      :
  #   REPLICATION PROGRAM   : N/A
  #   REGULATORY STATUS     : N/A
  #   REQUIREMENTS LOCATION : N/A
  #  -----------------------------------------------------------------------------
  #  Requirements:
  #  -----------------------------------------------------------------------------
  #  Ver#  Author &                   Program History Description
  #        Peer Reviewer
  #  ----  ---------------            --------------------------------------------
  #  001      Danni Yu                   Program    (2013-now)
  #  002      Chenchen Yu                Program    (2013 2014)
  #  -----------------------------------------------------------------------------
  # To enable RTF creation run:
  # remotes::install_github("DanniYuGithub/RTF2")
} #Header


rm(list=ls())
#source('global.r')

#install packages
if(TRUE){
  dep.packages <- c("shiny", "DT", "haven", "xtable", "plyr", "sas7bdat",
                    "WriteXLS",  #"rJava", "rtf",
                    "devtools");
  na.packages <- dep.packages[!dep.packages %in% installed.packages()]
  if (length(na.packages)>0) install.packages(na.packages);

  newWay<<-TRUE
  #if(!"sas7bdat.parso" %in% installed.packages())
  #devtools::install_github('BioStatMatt/sas7bdat.parso', force=TRUE)

  dPAI_load <<- 0
  #1 if dPAI is activated at least once.

  userActionLabel <<- 'user click'
  userdo_action <<- function(){return(NULL)}
  #predefined global value for user do action button.

}

#required libraries
if(TRUE){#load relative libraries safety analysis
  library(beanplot)

  library(corrplot)  #create heatmap for correlation matrix#

  library(grid)
  library(gridExtra)

  if(FALSE){
    if (!require("BiocManager", quietly = TRUE))
      install.packages("BiocManager")
    BiocManager::install("Heatplus")
  }
  library(Heatplus)  #creating customized heatmaps with covariate profile#
  library(Hmisc)

  library(lattice)
  library(latticeExtra)
  library(lmtest)

  if(FALSE){
    BiocManager::install("multtest")
  }
  library(multtest)

  library(plotrix)   #use 2D-heatmap#

  library(shiny)
  library(sp)
  library(survival)  #time to event analysis#

  library(vioplot)
}

if(TRUE){
  # devtools::install_version("shiny", version = "1.0.3",
  #   repos = "http://cran.us.r-project.org")

  library(DT)
  library(WriteXLS)
  library(plyr)
  library(xtable)
  library(xtable)
  library(shiny)
  library(animation)


  #load a libray not in cran
  if(T && "sas7bdat.parso" %in% installed.packages() ){
    library(sas7bdat.parso)
  }

  #library(WriteXLS)
  library(readxl)
  #library(SASxport)

  #a pre-defined function object for plotting functions when click a row in DT.
  click2plot.o<<-function(ids){
    x=0; y=0;
    plot(y~x,col='white',axes=F,ylab='', xlab='')
    leg<-paste0('please define a global function\n',
                'click2plot(ids=...)\nis not defined yet')
    legend('topleft', legend=leg, bty='n')
  }
  click2plot<-NULL


} #required libraries

#Key objects and functions
if (TRUE){
  use_haven<<-T
  tmpFig <<-"tmpFig.png"
  showBrush<<-FALSE
  click_data<<- near_points <<- brush_points <<-NULL
  currTabL <<- list()
  input0 <<- list()
  input0.code <<- new.code <<- NULL
  ault <<- '480, 480, NA'
  tfl.h <<- tfl.w <<- tfl.r <<- NA

  #keyword in widges
  wid.keywd<<-c('check','radio','dropdown','slide',
                'date', 'dateR', 'num', 'text', 'textbox')

  infilelab <<- 'Step 1 Upload data (csv, sas7bdat, xlsx, rdata, xpt)'
  infilenm <<- c('.csv', '.sas7bdat', '.xlsx', '.rdata', '.Rdata', '.xpt')

  na_sign <<- c('NA', '', '.', ' ', '-', 'NaN')

  #standard headers
  if(TRUE){
    sop_head<<-paste( paste(readLines("sopHead.txt"), collapse="\n "), "\n ")
  } else {
    data('sopHead')
  }

  if(!exists('muliHead.split')){
    muliHead.split <<- ";"
  }

  #get the current userid for usage track
  uids<<-NULL
  uid1<<-Sys.info()['user']

  #---------source code for shiny functions---------------#
  source(file=file.path(local.path1,'shinyFun.r'))
  source(file=file.path(local.path1,'RTF_functions_DY.r'))



  #function: read sas, csv or excel files.
  BeachRead<<-function(file, header=TRUE, nrow=-1,
                       name=NULL, comment.char="",
                       xlsx1=NULL,
                       na.string=c('NA', '', '.', ' ', '-', 'NaN'),
                       SF=FALSE, use_haven=T, ...){
    # require(haven)
    # require(readxl)
    hhhh<<-name
    ot<-NULL
    if(is.null(name)){name<-file}
    is.sas<-grepl('.sas7bdat', tolower(name), fixed=TRUE)
    is.csv<-grepl('.csv', tolower(name), fixed=TRUE)
    is.xlsx<-grepl('.xls', tolower(name), fixed=TRUE)
    is.rdat<-grepl('.rda', tolower(name), fixed=TRUE)
    is.xpt<-grepl('.xpt', tolower(name), fixed=TRUE)
    if(is.sas){
      ot.t <<- try(ot<-haven::read_sas(file))
      if(class(ot.t)[1]=='try-error' &&
         "sas7bdat.parso" %in% installed.packages() #&&
         # requireNamespace("sas7bdat.parso", quietly = TRUE)
      ) {
        library(sas7bdat.parso)
        print(ot.t)
        ot.kk<<-try(ot<<-sas7bdat.parso::read.sas7bdat.parso(file))
      }
      if(#class(ot.kk)[1]=='try-error' ||
        is.null(ot)){
        if("sas7bdat.parso" %in% installed.packages() ){
          return(paste("Error: fail to import", name))
        }else{
          return(paste("Error: fail to import", name,
                       ". Please import sas7bdat.parso at GitHub."))
        }
      }
      ot <- data.frame(ot)
      for(i in 1:ncol(ot)){
        if(is.factor(ot[,i]))
          ot[,i] <- as.character(ot[,i])
      }
      if(nrow==1)
        ot <- ot[1,]
      if(nrow==1 & !header)
        ot <- data.frame(matrix(colnames(ot), nrow=1))
    }else if (is.csv){
      tm<-try(ot<-read.csv(file=file, h=header, nrow=nrow,
                           na=na.string, stringsAsFactors=SF,
                           fileEncoding="UTF-8",
                           comment.char=comment.char,...))
      if(class(tm)=='try-error')
        tm<-try(ot<-read.csv(file=file, h=header, nrow=nrow,
                             na=na.string, stringsAsFactors=SF,
                             fileEncoding="Latin1",
                             comment.char=comment.char, ...))
      if(class(tm)=='try-error')
        tm<-try(ot<-readLines(con=file))
    }else if (is.xlsx){
      if(is.null(xlsx1))
        xlsx1 <-1
      tm<-try(ot<- readxl::read_excel(path=file, sheet=xlsx1, col_names=header, na=na.string, ...))
      if(class(tm)=='try-error')
        tm<-try(ot<-readLines(con=file))
    }else if (is.rdat){
      load(file, ot<-new.env())
      ot <- as.list(ot)
      names(ot) <- paste0(name, ".", names(ot))
    }else if (is.xpt){
      #ot.t <- try( ot <- SASxport::read.xport(file) )
      ot.t <- try( ot <- haven::read_xpt(file) )
    }else{
      ot<-NA
    }
    return(ot)
  }


  if(!'www'%in%dir(local.path2)) {dir.create(local.path3)}


  options(stringsAsFactors=FALSE, shiny.usecairo=FALSE, shiny.maxRequestSize=1024*1024^2)
  options(warn=0, error = NULL)
}#Key objects and functions


#-----------------------------------#
if(TRUE){#other setup#

  #define the users folder for Analysis Code
  cnt<-0
  user_folder<-c('users/')
  function_r<-dir(local.path1, ".r")
  function_r<-c(function_r, dir(local.path1, ".R"))

  tmConf<<-'configuration_empty_dy1.csv'

  #clean up open device
  if(TRUE){
    na_file<-dir()
    na_file<-na_file[substr(na_file,1,2)=='NA'|na_file=="Rplot.pdf"]
    na_file<-file.path(getwd(),na_file)
    if(length(na_file)>0){do.call(file.remove, as.list(na_file))}
    tm_png<-dir(local.path3)
    tm_png<-tm_png[substr(tm_png,1,3)=='tfl'|substr(tm_png,1,3)=='.nf'|
                     substr(tm_png,nchar(tm_png)-5,nchar(tm_png))=='.rdata']
    loatextf<-dir(local.path2)
    loatextf<-file.path(local.path2, loatextf)
    if(length(tm_png)>5 | length(loatextf)>5){
      if(length(loatextf)>0)
        try(do.call(file.remove, as.list(loatextf)))
      tm_png<-file.path(local.path3, tm_png)
      if(length(tm_png)>0)
        try(do.call(file.remove, as.list(tm_png)))
    }
  }


  #set up temporary tflfile names
  if(TRUE){
    randseed<-round(runif(1,1,10^7))
    loatext<<-tempfile(pattern=paste0("loa",randseed),
                       tmpdir=local.path2, fileext=".txt")
    tflfile<<-tempfile(pattern=paste0("tfl",randseed),
                       tmpdir=local.path2, fileext="_")
  }else{tflfile<-NULL}

  #save history of Rscript in expert
  text1<-'#For text output'
  text2<-'#For figure output'

}#other setup#

#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@#
BeachServer <- function(input,output, session){

  #close your app when the browser is closed
  session$onSessionEnded(function() {
    stopApp(NULL)
  })

  rawrow1<<-list() #for changing colnames with row 1 in a table data.
  indataset<<-list()
  indataR  <<-list()


  #------change the width of widget panel and the color------#
  output$beachColor <- renderUI({
    code0 <- selectInput_color(id='wpColor',
                               label='Background color',
                               choices=colors(),
                               selected='azure3'
    )
    return(shiny::HTML(code0))
  })

  output$wp.width <- renderUI({
    #width of the widgets panel
    widget.panel.width<-paste0(input$wpW, "%")

    wp.out <- paste0("<div class=\"panel panel-default draggable\" ",
                     "id=\"controls1\" ",
                     "style=\"top:50%;left:auto;right:0%;bottom:auto;width:",
                     widget.panel.width,
                     ";height:auto", #widget.panel.height,
                     ";position:absolute;cursor:move; ",
                     "background-color: ", HEXColors[input$wpColor],
                     ";z-index: 199;\">",
                     # "<div id=\"set.ncol.widg\" class=\"shiny-html-output\"></div>",
                     "<div id=\"widgetSide\" class=\"shiny-html-output\"></div>",
                     "</div> <script>$(\".draggable\").draggable();</script> ")
    return(shiny::HTML(wp.out))
  })


  #-------Webpage Title in the data input panel---------#
  output$setTitle<-renderUI( try( {
    VdicTitle<<-reactive({ #note: only one or two rows should be defined.
      if (is.null(input$config) & input$config.sel==" "){
        Vdic0<<-read.csv(file.path(tmConf),header=TRUE,check.names=FALSE, encoding='UTF-8')
      }else{
        if(!is.null(input$config)){
          isolate({Vdic0<<-read.csv((input$config)$datapath,
                                    header=TRUE,check.names=FALSE, encoding='UTF-8') })
        }
        if(input$config.sel!=" "){
          isolate({ Vdic0<<-read.csv(file.path(local.path1,
                                               cdpool[cdpool2==input$config.sel]),
                                     header=TRUE,check.names=FALSE, encoding='UTF-8') })
        }
      }
      ret<-Vdic0
      nCol<-ncol(ret)
      titleValue<-c("title_image","title_text")
      titleRowsID<-which((!is.na(ret$Type) & ret$Type%in%titleValue) | ret$Num==1)
      titleRows<-ret[titleRowsID,]
      return(titleRows)
    })

    if(nrow(r123<-VdicTitle())>0){
      r1<-r123[r123$Type=='title_image',]
      r2<-r123[r123$Type=='title_text',]
      r1c<-r2c<-''
      if(nrow(r1)>0&&grepl(".png", r1$Title, fixed=TRUE)){
        r1c<-as.character(img(src=r1$Title[1], height="10%",width="100%"))
      }
      if(nrow(r2)>0){
        r2c<-paste0('<h4 style="color:black; background-color:white; width:100%; height:10%;"> ',
                    #r2$Title[1], Sys.getlocale(), "</h4>")
                    r2$Title[1], "</h4>")
      }
      retTitle<-shiny::HTML(paste0(r1c,r2c))
      #run the getData source code
      s1s<-r123[ as.numeric(r123$Num)%in%c(0,1),'Source']
      for(s1 in s1s){
        if(length(s1)>0&&grepl('.r', tolower(s1), fixed=TRUE)){
          if(!grepl('users/', s1, fixed=TRUE)) s1<-file.path('users', s1)
          s1<-file.path(local.path0, s1)
          if(file.exists(s1)){
            source(s1)
          }
        }}
      s1<-r123[ as.numeric(r123$Num)==1,'Source']
      if(length(s1)>0&&grepl('.r', tolower(s1), fixed=TRUE)){
        if(!grepl('users/', s1, fixed=TRUE)) s1<-file.path('users', s1)
        s1<-file.path(local.path0, s1)
        if(file.exists(s1)){
          source(s1)
        }
      }
      #run the uesr-free functions
      eval(parse(text=r123[ as.numeric(r123$Num)==1,"PlotCode"]))

    }else{
      retTitle<-shiny::HTML('<h4 style="color:black;">  BEACH-PARTY </h4>')
    }

    return(retTitle)

  }) )

  #-------Update webpage accroding to user-defined CD---------#
  output$setconfig<-renderUI({
    Vdic<<-reactive({
      if (is.null(input$config) & input$config.sel==" "){
        Vdic0<<-read.csv(file.path(tmConf),header=TRUE,check.names=FALSE, encoding='UTF-8')
      }else{
        if(!is.null(input$config)){
          isolate({Vdic0<<-read.csv((input$config)$datapath,
                                    header=TRUE,check.names=FALSE, encoding='UTF-8') })
        }
        if(input$config.sel!=" "){
          isolate({ Vdic0<<-read.csv(file.path(local.path1,
                                               cdpool[cdpool2==input$config.sel]),
                                     header=TRUE,check.names=FALSE, encoding='UTF-8') })
        }
      }

      #Vdic0$Add<-unlist(lapply(Vdic0$Add,function(x){eval(parse(text=x))}))
      ret<-Vdic0[ as.numeric(Vdic0$Num)>0,]
      if(!'res'%in%colnames(ret)){
        ret$res <- NA
      }
      if(!'width'%in%colnames(ret)){
        ret$width <- NA
      }
      if(!'height'%in%colnames(ret)){
        ret$height <- NA
      }

      #insert user folders if it is not exist in the source function list
      for(i in 1:nrow(ret)){
        if(!is.na(ret$Source[i])&ret$Source[i]!=''&!ret$Source[i]%in%function_r){
          xSel<-sapply(user_folder, function(x){
            substr(ret$Source[i], 1, nchar(x))==x
          })
          if(sum(xSel)==0){
            ret$Source[i]<-paste0(user_folder[1],ret$Source[i])
          }
        }
      }
      runSource<-unique(ret$Source[!is.na(ret$select.label)&!is.na(ret$Source)])
      sapply(runSource,function(x){
        source(file=file.path(local.path0,x))})
      ret$Add<-unlist(lapply(ret$Add,function(x){eval(parse(text=x))}))
      ret<-ret[ret$Add,]
      return(ret)
    })#end Vdic
    UIdic<<-reactive( Vdic()[Vdic()$Add & !is.na(Vdic()$Request.Name),] )

    UInames<-names(UIdic())[grepl('uiInput',names(UIdic()))]
    UInames<<-UInames[!sapply(UInames,function(x){all(is.na(UIdic()[,x]))})]

    temp<-strsplit(names(UIdic())[grepl('.label',names(UIdic()))],'.label',fixed=TRUE)
    temp1<-sapply(temp,function(x){
      if(x[1] %in% wid.keywd){
        return(paste0(x,collapse=''))
      }else{
        return(NULL)
      }
    })

    #----params includes all the relative widgets----#
    params<<-sort(unlist(temp1))
    max.n<<-c(check=length(grep('check',params)),radio=length(grep('radio',params)),
              dropdown=length(grep('dropdown',params)),slide=length(grep('slide',params)),
              date=length(grep('date',params)),dateR=length(grep('dateR',params)),
              num=length(grep('num',params)),text=length(grep('text',params)),
              textbox=length(grep('textbox',params)) )

    max.n2<<-max.n#[max.n!=0]
    params.lab<<-paste0(params, '.lab')

    #--order params by its indes--#
    strsplit1 <- function(x, split){
      out1 <- NULL
      for(i in 1:length(x)){
        for(j in 1:length(split)){
          if(grepl(split[j], x[i], fixed=T)){
            t1 <- strsplit(x[i], split=split[j], fixed=TRUE)[[1]]
            if(length(t1)==1){
              out1 <- rbind(out1, data.frame(m1=split[j], m2=0))
              break
            }else{
              if(!is.na(as.numeric(t1[2]))){
                out1 <- rbind(out1, data.frame(m1=split[j], m2=as.numeric(t1[2])))
                break
              }
            }
          }
        }
      }
      return(out1)
    }
    params.id <<- strsplit1(params, names(max.n))
    params.ord <<- order(params.id$m1, params.id$m2)
    #params.ord <- order(params)
    #get a map between LOA and CD for widgets
    #slide.value  radio.choice  check.choice dropdown.choice
    #date.value   dateR.value    text.value
    m1<-params.id$m1; m2<-params.id$m2; m2[m2==0]<-'';
    m3<-rep('value', length(m1))
    m3[m1%in%c('check', 'radio', 'dropdown')]<-'choice'
    params.map<<-data.frame(loa_lab=params.lab,
                            cd_lab=paste0(m1,'.label', m2),
                            loa=paste0(m1,m2),
                            cd=paste0(m1,'.',m3,m2))

    #re-set the other tabs

    tmp<-readLines(file.path(local.path0,Vdic()$Source[1]))
    r.lib<-tmp[grepl('library(',tmp,fixed=TRUE)|grepl('require(',tmp,fixed=TRUE)]
    r.lib.temp<-gsub(' ', '', r.lib, fixed=TRUE)
    r.lib<-r.lib[!grepl('#library', r.lib.temp, fixed=TRUE)&!grepl('#require',r.lib.temp, fixed=TRUE)]
    r.lib<-sort(unique(r.lib))
    r.lib.alert<<-paste0( #'  #required packages: \n',
      paste0(r.lib, collapse='\n') )
    #Get the libraries needed for running the analysis

    if(!is.null(tflfile)){
      randseed<-round(runif(1,1,10^7))
      loatext<<-tempfile(pattern=paste0("loa",randseed),
                         tmpdir=local.path2, fileext=".txt")
      tflfile<<-tempfile(pattern=paste0("tfl",randseed),
                         tmpdir='', fileext="_")
    }

    write.table(t(c("Request.Name","Type","Titles", "height", "width", "res",
                    "Footnote", "Abbreviations.Footnote","Statistical.Analysis",
                    "Test.Statistic.Footnote", as.vector(rbind(params.lab, params)))),
                file=loatext,append=FALSE,col.names=FALSE,row.names=FALSE)

    fileInput(inputId='config', label='Step 2 Input configuration file',
              accept=c('.csv', 'text/csv', 'text/comma-separated-values,text/plain'),
              multiple=FALSE)
  })

  #----------Obtain number of analysis request for TFL------------#
  loaTF<<-reactive(eval(parse(
    text=paste0("c(",paste0("input$result_",1:400,collapse=','),")"))))
  AnalyN<<-reactive({
    if(is.null(input$analysis)){
      return(1)
    }else{
      return(which(Vdic()$Request.Name==input$analysis))
    }
  }) # Capture the corresponding configuration for the selected analysis
  AnalyC<<-reactive(which(Vdic()$Request.Name==input$analysis)[1])

  #----------Generate Tabs------------#
  output$tabs<-renderUI({
    tabset<-Vdic()[!is.na(Vdic()$Tab.label),c('Tab.value','Tab.label')]
    tabcode<-tabs(tab.id='Tabs',tab.label=tabset[,1],tab.value=tabset[,2])
    return(shiny::HTML(tabcode))
  })  # Generate the Tabs

  #----------Update webpage according to user-defined mock data------------#
  #indataset is a list object including all the uploaded dataset
  #indataset.i is a data.frame object, the 1st dataset in indataset.
  #indataR is a list obeject including all the elements in the uploaded R files
  output$file<-renderUI({
    if(is.null(input$infile)){
      return(conditionalPanel('true',
                              radioButtons('csv_enc', 'Encoding format for CSV file',
                                           choices=c('UTF-8', 'unkown'), inline=TRUE),
                              radioButtons('checknames',
                                           'Change " " or "-" in column names into "."',
                                           choices=c(FALSE, TRUE), inline=TRUE),
                              fileInput('infile', label=infilelab,
                                        accept=infilenm,
                                        multiple=TRUE)))
    }else{
      isolate({
        input_infile <<- input$infile

        ###import the files under a pre-specified location
        if(nrow(input_infile)==1 #& grepl('.csv', input_infile) &
           #grepl('File_Names', input_infile)
           ){

          input_infile_1 <- BeachRead(file=input_infile[1, 'datapath'],
                                      name=input_infile[1, 'name'])
          #check file name
          if(any(!colnames(input_infile_1)%in%c('datapath', 'name'))){
            print(paste0("Files in 'File_Names...csv' are not loaded.\n",
                  "The colum names must be 'datapath' and 'name'."))
          } else {
            input_infile_1$datapath <- file.path(input_infile_1$datapath,
                                                 input_infile_1$name)
            input_infile <<- input_infile_1[,c('name', 'datapath')]
          }

        }

        if(nrow(input_infile)>1 | length(indataset)>0){
          indataset0<-list()

          indataset0.wh <- NULL
          for(i in 1:nrow(input_infile)){
            tmpload <- BeachRead((input_infile[i, 'datapath']),
                                 header=TRUE, name=input_infile[i,'name'],
                                 encoding=isolate(input$csv_enc),
                                 comment.char=isolate(input$comm_chr),
                                 check.names=as.logical(input$checknames))
            if(is.list(tmpload) & grepl('.rda', tolower(input_infile[i,'name']))){
              indataR <<- c(indataR, tmpload)
            }else{
              indataset0.wh <- c(indataset0.wh, i)
              indataset0[[i]]<- tmpload
            }
          }
          indataset0 <- indataset0[!sapply(indataset0, is.null)]
          names(indataset0)<-input_infile[indataset0.wh, 'name']
          indataset0<<-indataset0
          wh1<<-names(indataset)[names(indataset)%in%names(indataset0)]
          if(length(wh1)>0){
            indataset[wh1]<<-indataset0[wh1]
            indataset0<-indataset0[!names(indataset0)%in%wh1]
          }
          if(length(indataset0)>0){
            indataset<<-c(indataset, indataset0)
          }
        }else{
          indataset0<-list()
          tmpload <- BeachRead((input_infile)$datapath, header=TRUE, name=input_infile[1,'name'],
                               encoding=isolate(input$csv_enc),
                               comment.char=isolate(input$comm_chr),
                               check.names=as.logical(input$checknames))
          if( is.list(tmpload) & grepl('.rda', tolower(input_infile[1,'name'])) ){
            indataR <<- c(indataR, tmpload)
            indataset.i <<- indataR[[1]]
          } else {
            indataset.i <<- tmpload
            indataset0[[1]]<-indataset.i
            names(indataset0)<-input_infile[,'name']
            indataset<<-indataset0
          }

        }
      }) # End of isolate

      if(length(indataR)>0){
        indataR <<- indataR[unique(names(indataR))]
        indataset <<- c(indataset, indataR)
        indataset <<- indataset[unique(names(indataset))]
      }
      rawrow1 <<- lapply(indataset, function(x){x[1,]})

      studyname1 <-na.omit(unique(unlist(lapply(indataset,function(x){
        unique(x$STUDYID) }))))
      if(!is.null(studyname1)) studyname1 <-paste(unique(studyname1), collapse=", ")
      tumortype1 <-unlist(lapply(indataset,function(x){
        unique(x$TUMOR_TYPE) }))
      if(is.null(studyname1)) studyname1 <- ""
      if(is.null(tumortype1)) tumortype1 <- ""
      if(!is.null(input$study)) studyname1 <- input$study
      if(!is.null(input$tumor)) tumortype1 <- input$tumor


      if(length(indataset)<2){
        stnm<-inlinetext(text.id='study',text.label='Study Name ',
                         text.value=studyname1)
        datanote<-paste0(input$infile$name,' has ', nrow(indataset.i),
                         ' rows, ',ncol(indataset.i),' columns.')
        tmtp<-inlinetext(text.id='tumor',text.label='Tumor Type ',
                         text.value=tumortype1)
        studyname <<- input$study
        tumortype <<- input$tumor
        datanote<-paste0('<h6>', datanote, ' </h6>')
        if(input$data_reload | (is.null(input$config) & input$config.sel==" ")){
          return(
            conditionalPanel(
              condition='true',
              fileInput('infile', label=infilelab,
                        accept=infilenm, multiple=TRUE),
              shiny::HTML(c(stnm, "<br>",
                            tmtp, datanote)) ) )
        }else{
          return(conditionalPanel(condition='true',
                                  shiny::HTML(c(stnm, "<br>", tmtp, datanote)) ) )
        }
      }else{
        if(!is.null(tumortype1)) tumortype1<-paste(tumortype1, collapse=", ")
        stnm<-inlinetext(text.id='study',text.label='Study Name ',
                         text.value=studyname1)
        datanote<-paste0(names(indataset),' has ',
                         sapply(indataset, nrow), ' rows, ',
                         sapply(indataset, ncol),' columns.')
        tmtp<-inlinetext(text.id='tumor',text.label='Tumor Type ',
                         text.value=tumortype1)
        studyname <<- input$study
        tumortype <<- input$tumor
        datanote<-paste0('<h6>', datanote, ' </h6>')
        if(input$data_reload | (is.null(input$config) & input$config.sel==" ")){
          return(
            conditionalPanel('true',
                             radioButtons('csv_enc', 'Encoding format for CSV file', choices=c('UTF-8', 'unkown'), inline=TRUE),
                             radioButtons('checknames', 'Change "_" in column names into "."', choices=c(FALSE, TRUE), inline=TRUE),
                             fileInput('infile', label=infilelab,
                                       accept=infilenm,
                                       multiple=TRUE),
                             shiny::HTML(c(stnm, "<br>", tmtp, datanote)) ))
        }else{
          return(conditionalPanel(condition='true',
                                  shiny::HTML(c(stnm, "<br>",
                                                tmtp, datanote)) ) )
        }
      }

    }
  })  # Widget to upload dataset

  #----------Get data.frame objects (subset of CD) only for widgets----------#
  output$getWidgets<-renderUI({
    #a row is a Request.name
    check.param<<-reactive({widgets.param(uidic=UIdic(),wid='check',max.n=max.n2)})
    radio.param<<-reactive({widgets.param(uidic=UIdic(),wid='radio',max.n=max.n2)})
    dropdown.param<<-reactive({widgets.param(uidic=UIdic(),wid='dropdown',max.n=max.n2)})
    slide.param<<-reactive({widgets.param(uidic=UIdic(),wid='slide',max.n=max.n2)})
    date.param<<-reactive({widgets.param(uidic=UIdic(),wid='date',max.n=max.n2)})
    dateR.param<<-reactive({widgets.param(uidic=UIdic(),wid='dateR',max.n=max.n2)})
    num.param<<-reactive({widgets.param(uidic=UIdic(), wid='num', max.n=max.n2)})
    text.param<<-reactive({widgets.param(uidic=UIdic(),wid='text',max.n=max.n2)})
    textbox.param<<-reactive({widgets.param(uidic=UIdic(),wid='textbox',max.n=max.n2)})
    return(NULL)
  })

  widgetOrd<<-reactive({
    widgets.order(analysis=input$analysis, UIdic1=UIdic(), UInames=UInames,
                  ncol.widg=as.numeric(input$ncol.widg.rd))
  })

  output$widgets<-renderUI({
    #HTML code of all the widgets
    eval(parse(text=unique(widgetOrd()$code)))
  })

  output$getData<-renderUI({#Declare global variables#
    #    if(!is.null(input$infile)|!is.null(input$infileR)){
    tm.Vdic<-Vdic()
    if(!is.na(tm.Vdic$select.label[1])) #load source code in 1st available row
      source(file.path(local.path0, tm.Vdic$Source[1]))
    #    }
    return(NULL)
  }) # Data manipulation for the uploaded dataset

  output$getTFL<-renderUI({
    #only table data is output to local.path3 (a temporary folder)
    if(F){
      tflname<-sapply(AnalyN(),function(x){
        ifelse(all(is.na(widgetOrd()$names)),               #Condition
               paste0(tflfile,Vdic()$Num[x]),    #if TRUE
               paste0(tflfile,Vdic()$Num[x],'x',        #if FALSE
                      paste0(#Paste all UIs together
                        sapply(widgetOrd()$names,function(y){
                          y0<-eval(parse(text=paste0('input$',y)))
                          if(!is.null(y0)){y0[is.na(y0)]<-''}
                          y0<-paste0(y0[length(y0):1],collapse='_')#Paste all Params for each UI
                          substring(y0, max(nchar(y0)-30,1))
                        }),collapse=''))
        )
      })
      tflname<-gsub(" ",'',tflname)
      tab.name<-file.path(local.path3,paste0(input$submitcode,gsub("[[:punct:]]","",tflname),'.rdata'))
    }
    if('Table' %in% Vdic()$Type[(AnalyN())] ){
      AnalyNt<-reactive(AnalyN()[Vdic()$Type[AnalyN()]=='Table'])
      tmp<-eval(parse(text=Vdic()$tmp[AnalyNt()[1]]))
      sapply(AnalyNt(),function(x){
        if (eval(parse(text=Vdic()$Condition[AnalyNt()[1]]))){
          tmptab<-NULL
        }else{
          tmptab<-eval(parse(text=Vdic()$PlotCode[x]))

        }
      })
    }

    return(NULL)
  }) # Generate png files if the output is plot

  output$status<-renderUI({
    if(is.null(input$infile)&is.null(input$infileR)){
      tmpcode<-'<span class=\"label label-important\" style=\"background-color:red; color:black;\">Data not loaded</span>'
    }else{
      tmpcode<-'<span class=\"label label-success\" style=\"color:black;\">Data loaded</span>'
    }
    return(shiny::HTML(tmpcode))
  }) # Status of data manipulation process

  output$select<-renderUI({
    selectN<-which(Vdic()$Tab.value==input$Tabs)
    if (all(is.na(Vdic()$select.label[selectN])))return(NULL)
    label<-unique(Vdic()$select.label[selectN])
    label<-label[!is.na(label)]
    selection<-unique(Vdic()$Request.Name[selectN])
    return(selectInput(inputId="analysis",label=strong(label),choices=selection, width="80%"))
  }) # Generate the downdrop list


  #-----Generate code for output$widgets
  widgetCode<-widgets.code(UInames=UInames,max.n=max.n1)
  eval(parse(text=widgetCode))

  #-------Output results to the current screen------------#

  output$save_data_ext<-renderUI({

    choiceN<-AnalyN()[Vdic()$Type[AnalyN()]=='Table']
    choiceP<-AnalyN()[Vdic()$Type[AnalyN()]=='Figure']
    if(length(choiceN)==0 & length(choiceP)==0)return(NULL)
    if(length(choiceN)==0 & length(choiceP)>0){
      return( conditionalPanel(condition='true',
                               div( downloadButton('getEPS','download EPS plot'),
                                    downloadButton('getPDF','download PDF plot') )
      ))
    }
    if(length(choiceN)>0 & length(choiceP)==0){
      choice<-sapply(choiceN,
                     function(x){
                       ifelse(substr(Vdic()$Title[x],1,5)=='paste',
                              eval(parse(text=Vdic()$Title[x])),
                              Vdic()$Title[x])
                     })
      return( conditionalPanel(condition='true',
                               checkboxGroupInput('multdat',
                                                  'Please Choose a table to save',
                                                  choices=choice,
                                                  selected=NULL, inline =TRUE),
                               radioButtons('multdat_ext',
                                            'Format',
                                            c('csv','rdata','xpt','xls','SAS code'='sas'),
                                            selected = NULL,
                                            inline = TRUE),
                               downloadButton("save_data","Save Data")
      ) )

    }

    if(length(choiceN)>0 & length(choiceP)>0){
      choice<-sapply(choiceN,
                     function(x){
                       ifelse(substr(Vdic()$Title[x],1,5)=='paste',
                              eval(parse(text=Vdic()$Title[x])),
                              Vdic()$Title[x])
                     })
      return( conditionalPanel(condition='true',
                               div( downloadButton('getEPS','download EPS plot'),
                                    downloadButton('getPDF','download PDF plot') ),
                               checkboxGroupInput('multdat',
                                                  'Please Choose a table to save',
                                                  choices=choice,
                                                  selected=NULL, inline =TRUE),
                               radioButtons('multdat_ext',
                                            'Format',
                                            c('csv','rdata','xpt','xls','SAS code'='sas'),
                                            selected = NULL,
                                            inline = TRUE),
                               downloadButton("save_data","Save Data")
      ) )

    }

  })
  output$TFL<-renderUI({
    plotcode <- NULL
    currTabL <<- list()
    currTabL_i <- 1


    #redefine fig size/resolution according to the text bar on top.
    if(is.null(input$hwr))
      hwr.c <- ''
    else
      hwr.c <- as.character(input$hwr)
    tfl.h<<-ifelse(is.na(as.numeric(strsplit(hwr.c,split=';')[[1]])[1]), 480,
                   as.numeric(strsplit(hwr.c, split=';')[[1]])[1])
    tfl.w<<-ifelse(is.na(as.numeric(strsplit(hwr.c,split=';')[[1]])[2]), 480,
                   as.numeric(strsplit(hwr.c, split=';')[[1]])[2])
    tfl.r<<-ifelse(is.na(as.numeric(strsplit(hwr.c,split=';')[[1]])[3]), 72,
                   as.numeric(strsplit(hwr.c, split=';')[[1]])[3])

    if (all(!Vdic()$Type[AnalyN()] %in% c('Figure','Table'))||
        all(eval(parse(text=Vdic()$Condition[AnalyN()])))){
      return(NULL)
    }

    for (i in AnalyN()){
      input0.code <- Vdic()$PlotCode[i]
      pdf.label <<- paste("H1", Vdic()$Tab.label[i],
                          "H2", Vdic()$Request.Name[i])

      myInput <<- Vdic()[i,UInames]
      mylab <<- Vdic()[i,gsub('Input', 'lab', UInames)]
      names(myInput) <<- mylab
      myInput <<- myInput[!is.na(myInput)]

      for(m0 in 1:length(myInput)){
        x <- myInput[m0]
        if(grepl('date', x))
          x <-paste0("paste(",x, ")")
        input0[[m0]] <- eval(parse(text=x))
      }
      if(length(myInput) == length(input0))
        names(input0) <- gsub("input$", "", myInput, fixed=TRUE)
      input0 <<- input0

      #date and dateR widgets have to be a character before running eval.
      for(m1 in 1:length(input0)){
        if(length(input0)>0 && grepl('date', names(input0)[m1], fixed=TRUE)){
          date.value <- paste("c(",
                              paste( paste0("\"", input0[[m1]], "\""), collapse=', '),
                              ")")
          input0.code<- gsub(paste0('input$',names(input0)[m1]),
                             date.value, input0.code, fixed=TRUE)
        }
      }
      new.code <<- input0.code
      input0.code <<- input0.code

      if(!is.na(Vdic()$Title[i])){
        title<-ifelse(substr(Vdic()$Title[i],1,5)=='paste',
                      eval(parse(text=Vdic()$Title[i])),Vdic()$Title[i])
        titlecode<-paste0('<h3><textarea name=\"titlebox\" rows=\"1\" style=\"width:80%\">',
                          title,'</textarea></h3>')
      }else{titlecode<-NULL}


      try( addResourcePath('images',local.path3) )
      if(Vdic()$Type[i]=='Figure'){
        if(length(input0.code)>0 && grepl("dynamicData", input0.code, fixed=TRUE)){
          dynamicCode<<-input0.code
          if(FALSE){
            tmpcode<-paste0("<div class=\"row\">", "\n",
                            "<div class=\"col-sm-12\">", "\n",
                            #"<div id=\"dynamicPlot\" class=\"shiny-plot-output\" style=\"width:",input$figSize*100,"% ; height:",100*input$figSize,"%\" ",
                            "<div id=\"dynamicPlot\" class=\"shiny-plot-output\" style=\"width:100%; height=400px\" ",
                            "data-click-id=\"dynamicPlot_click\" data-click-clip=\"TRUE\" ",
                            "data-brush-id=\"dynamicPlot_brush\" data-brush-fill=\"#9cf\" data-brush-stroke=\"#036\" ",
                            "data-brush-opacity=\"0.25\" data-brush-delay=\"300\" data-brush-delay-type=\"debounce\" ",
                            "data-brush-clip=\"TRUE\" data-brush-direction=\"xy\" data-brush-reset-on-new=\"FALSE\"></div>",
                            "\n", "</div></div>", "\n",
                            "<div class=\"row\">", "\n",

                            "<div class=\"col-sm-12\">", "\n",
                            "<a id=\"click_info_dl\" class=\"btn btn-default shiny-download-link\" href=\"\" target=\"_blank\">",
                            "\n",
                            "<i class=\"fa fa-download\"></i>", "\n",
                            "Save Clicked Data",
                            "</a>",
                            "<h4>Points near click</h4>",
                            "\n",
                            "<pre id=\"click_info_DT\" class=\"shiny-html-output\"></pre>", "\n",
                            "</div>", "\n",

                            "<div class=\"col-sm-12\">", "\n",
                            "<a id=\"brush_info_dl\" class=\"btn btn-default shiny-download-link \" href=\"\" target=\"_blank\">",
                            "\n",
                            "<i class=\"fa fa-download\"></i>",
                            "Save Brushed Data",
                            "</a>",
                            "<h4>Brushed points</h4>",
                            "\n",
                            "<pre id=\"brush_info_DT\" class=\"shiny-html-output\"></pre>", "\n",
                            "</div>", "\n", "</div>", "\n")
          }else{
            tmpcode <- paste0(plotOutput('dynamicPlot', click='dynamicPlot_click',
                                         brush="dynamicPlot_brush"),
                              #click data
                              "<h4>Points near click</h4>", "\n",
                              downloadButton('click_info_dl', 'save clicked data'),
                              uiOutput('click_info_DT'),
                              #brush data
                              "<h4>Brushed points</h4>",  "\n",
                              downloadButton('brush_info_dl', 'save brushed data'),
                              uiOutput('brush_info_DT')
            )
          }
        }else{
          tmpFig1 <- NULL
          for(k in 1:length(i)){
            tmpFig1 <- c(tmpFig1, tempfile(tmpdir=local.path3, fileext='.png'))

            png(tmpFig1[k],
                height=tfl.h,
                width=tfl.w,
                res=tfl.r )

            plottry<-try(eval(parse(text=input0.code[k])))
            if(class(plottry)[1]=='try-error') {
              plot(0,axes=F, col='white',ylab='',xlab='')
              legend('top', 'Plotting\nError', cex=5, bty='n', text.col='red')
            }
            dev.off()
          }
          tmpFig2 <- gsub(local.path3, "", tmpFig1, fixed=TRUE)
          tmpFig2 <- gsub('/', "", tmpFig2, fixed=TRUE)
          tmpcode<-paste0("<img src=\"images/",
                          tmpFig2,
                          "\" alt=\"Calculating...\" style=\"width:",
                          100*input$figSize,
                          "% ; height: ",
                          100*input$figSize,
                          "%\"/> \n")
        }
      }else if(Vdic()$Type[i]=='Table'){


        if(class(try(tmptab<<-eval(parse(text=input0.code))))[1]=='try-error'){
          tmptab<-''
        }
        #save(tmptab, file=tab.name)

        outTable<-tmptab

        #update the current table list in the parent environment
        currTabL[[currTabL_i]] <<- outTable
        currTabL_i <- currTabL_i+1

        if(class(try(tmpcode<-xtable::xtable(outTable)))[1]=='try-error'){
          tmpcode<-outTable
        }
        if(input$useDT){#if TRUE using render table
          tmpcode<-paste0(
            "<div id=\"outTbl_DT\" style=\"width:",input$figSize*100, "%;",
            "height:auto\" class=\"shiny-html-output\"></div>"
          )
        }else{
          tmpcode<-capture.output(print(tmpcode,type="html",
                                        include.rownames=FALSE,include.colnames=TRUE))
          if(is.na(tmpcode[2])){ tmpcode[2]<-''}
          tmpcode <- toMultH(tbc=tmpcode, split1=muliHead.split)
          tmpcode[3]<-paste0("<TABLE style=\'width:",
                             input$figSize*100,
                             "%;\' >")
        }
      }

      plotcode<-c(plotcode,titlecode,tmpcode)
    }

    return(shiny::HTML(plotcode))
  }) # Generate TFL with title

  output$footnote<-renderUI({
    footnote<-Vdic()$FootCode[AnalyC()]
    footnote<-gsub("\\\\n","\n",footnote)
    if(!is.na(footnote)&&gsub("", " ", footnote)!=''&&substr(footnote,1,5)=='paste')
      footnote<-eval(parse(text=footnote))
    #cat(footnote)
    fo1<-paste(footnote, collapse=' ')
    shiny::HTML(
      paste0("<textarea name=\"footnotebox\" rows=\"4\"
             style=\"width:80%\"\">",
             fo1,
             "</textarea>"))
  }) # Generate footnote

  #------Output for user input code------#
  output$userExp<-renderUI({
    isolate(input$expert)
    if(is.null(input$expert)||!(input$expert)){
      return(NULL)
    } else {
      return(
        conditionalPanel(
          condition="true",
          div(shiny::HTML(paste0("<textarea name=\"Rscript\" rows=\"2\"",
                                 "  style=\"width:100%\"",
                                 "  placeholder=\"#For text output \"></textarea>")),
              actionButton('submit','execute')),
          div(shiny::HTML(paste0("<textarea name=\"RscriptF\" rows=\"2\"",
                                 "  style=\"width:100%\"",
                                 "  placeholder=\"#For plot output \"></textarea>")),
              actionButton('submit2','execute')),
          div(downloadButton('save_Rhist', 'save expert code history'))
        ))
    }
  })
  output$Input_outExpert<-renderPrint({
    if(TRUE){
      myInput <<- Vdic()[AnalyN(),UInames]
      mylab <<- Vdic()[AnalyN(),gsub('Input', 'lab', UInames)]
      names(myInput) <<- mylab
      myInput <<- myInput[!is.na(myInput)]
      for(m0 in 1:length(myInput)){
        x <- myInput[m0]
        if(grepl('date', x))
          x <-paste0("paste(",x, ")")
        input0[[m0]] <- eval(parse(text=x))
      }
      names(input0) <- gsub("input$", "", myInput, fixed=TRUE)
      input0 <<- input0
    }
    input0
  })


  output$RoutExpert<-renderPrint({
    if(is.null(input$submit)||input$submit==0){
      return('For text output from Rscript')
    }
    isolate({
      text1<<-c(text1, input$Rscript)
      eval(parse(text=input$Rscript), env=sys.frame())
    })
  })
  output$RoutExpertF<-renderPlot({
    if(is.null(input$submit2)||input$submit2==0){
      return(NULL)
    }
    isolate({
      text2<<-c(text2, input$RscriptF)
      eval(parse(text=input$RscriptF), env=sys.frame())
    })
  })
  output$save_Rhist<-downloadHandler(
    filename=function(){paste0(input$study,"_",input$tumor,"_Rhist.r")},
    content=function(file){
      tmpout<-paste(text1,"\n#~~~~~~~~~~~~~~#\n", text2)
      colnames(tmpout)<-''
      write(tmpout,
            file=file, row.names=FALSE, col.names=FALSE)
    }
  ) # Download Source code

  #-----Text bar for figure size/resolution output -----#
  output$hwrCtrl <- renderUI({
    if(TRUE){
      h1 <- eval(parse(text=Vdic()$height[(AnalyN())]))
      w1 <- eval(parse(text=Vdic()$width[(AnalyN())]))
      r1 <- eval(parse(text=Vdic()$res[(AnalyN())]))
      h2 <- ifelse(is.null(h1), 480, as.numeric(eval(parse(text=h1))))
      w2 <- ifelse(is.null(w1), 480, paste(as.numeric(eval(parse(text=w1))), collapse=', ') )
      r2 <- ifelse(is.null(r1), 72, as.numeric(eval(parse(text=r1))) )
      hwr.default <<- paste(
        ifelse(is.na(h2)||h2==0, 480, h2),
        ifelse(is.na(w2)||w2==0, 480, w2),
        ifelse(is.na(r2)||r2==0, 72,  r2),
        sep='; ')
    }
    textInput('hwr',
              'Height(px for figure; #MaxRows/page for table: 1~35 or 1~50); width(px); resolution(px/inch).',
              value=hwr.default, width="50%" )
  })
  output$AnalysisTab<-renderUI({
    selN<-!is.na(Vdic()$Tab.label) & is.na(Vdic()$Request.Name)
    unAnalyTab<-unique(Vdic()$Tab.value[selN])
    cpCon<-paste0(paste0("input.Tabs!=","\'",unAnalyTab,"\'"), collapse='&&')

    selN.addbar<-!is.na(Vdic()$Tab.label) & grepl("dynamicData", Vdic()$PlotCode, fixed=TRUE)
    cpCon.addbar<-paste0(paste0("input.analysis!=","\'",
                                unique(Vdic()$Request.Name[selN.addbar]),"\'"), collapse='&&')
    print(cpCon.addbar)

    conditionalPanel(condition=cpCon, width='100%',
                     div(class='row'), div(class='span6', uiOutput('select')),
                     div(class='span2', actionButton(inputId="add_analysis",label="Add Analysis")),
                     sliderInput('figSize', label="Relative Size",
                                 min=0.1, max=1, value=0.3, step=0.1, animate=FALSE),
                     uiOutput('hwrCtrl'),
                     div(class='span12',
                         uiOutput("TFL"),
                         uiOutput("footnote"),
                         #actionButton("userdo", userActionLabel),
                         uiOutput('userdo_button'),
                         verbatimTextOutput("userdo_out"),
                         br(),
                         uiOutput("save_data_ext"),
                         conditionalPanel(condition="input.expert==true",
                                          div(verbatimTextOutput("Input_outExpert"), br(),
                                              verbatimTextOutput("RoutExpert"), br(),
                                              plotOutput("RoutExpertF") )),
                         conditionalPanel(condition="input.usage==true",
                                          verbatimTextOutput("counter"))
                     ))
  })
  output$widgetSide<-renderUI({
    selN<-!is.na(Vdic()$Tab.label) & is.na(Vdic()$Request.Name)
    unAnalyTab<-unique(Vdic()$Tab.value[selN])
    cpCon<-paste0(paste0("input.Tabs!=","\'",unAnalyTab,"\'"), collapse='&&')
    conditionalPanel(condition=cpCon, uiOutput("widgets"))
  })

  output$SpecialTab<-renderUI({
    selN<-!is.na(Vdic()$Tab.label) & is.na(Vdic()$Request.Name)
    unAnalyTab<-unique(Vdic()$Tab.value[selN])
    if (!is.null(input$Tabs) && (input$Tabs%in%unAnalyTab)){
      eval(parse(text=readLines(
        file.path(local.path0,Vdic()$Source[which(Vdic()$Tab.value==input$Tabs)])
      )))
    }
  })





  #-------List of Analysis, R code ------------#
  output$loa<-renderUI({


    loaAdd<-reactive({
      t.names <<- c("Request.Name","Type","Titles", "height","width", "res",
                    "Footnote",
                    "Abbreviations.Footnote","Statistical.Analysis",
                    "Test.Statistic.Footnote", as.vector(rbind(params.lab,params)) )

      if (is.null(input$add_analysis) || input$add_analysis==0){
        tmprow <- data.frame(matrix(NA, nrow=0, ncol=length(t.names)))
        colnames(tmprow) <- t.names
        return(tmprow)
      }
      isolate({

        tmp0<-sapply(params[1:length(params)],function(x){
          if (x %in% widgetOrd()$names){
            if(grepl('date', x)){
              tmp<-eval(parse(text=paste0('paste(input$',x, ")")))
            } else {
              tmp<-eval(parse(text=paste0('input$',x)))
            }
            tmp<-ifelse(is.null(tmp),'',tmp)
            tmp<-ifelse(length(eval(parse(text=paste0('input$',x))))>1,
                        paste0(eval(parse(text=paste0('input$',x))),collapse=','), tmp)
          }else{tmp<-NA}

          return(tmp)
        })

        tmp1<-rep(NA,length(params))
        names(tmp1) <- params
        tmp1.lab <- widgetOrd()$labs
        names(tmp1.lab) <- widgetOrd()$names
        tmp1.nm <- params[params %in% names(tmp1.lab)]
        tmp1[tmp1.nm]<-tmp1.lab[tmp1.nm]

        footnote<-input$footnotebox
        if(is.na(footnote)){
          footnote<-''
        }
        footnote<-gsub("\\\\n","\n",footnote)
        if(!is.na(footnote)&&gsub("", " ", footnote)!=''&&substr(footnote,1,5)=='paste'){
          footnote<-eval(parse(text=footnote))
        }
        footnote2<-paste0(substr(footnote,1,10),'...')

        #title<-Vdic()$Title[AnalyC()]
        title<-input$titlebox

        if(!is.na(title) && grepl(title, 'paste', fixed=TRUE)){
          title<-eval(parse(text=title))
        }

        my.hwr <<- strsplit(input$hwr,split=';')[[1]]

        w1<<-eval(parse(text=Vdic()$width[AnalyC()]))
        tmprow<-data.frame(t(c(input$analysis,Vdic()$Type[AnalyC()],title,
                               height=my.hwr[1],
                               width=my.hwr[2],
                               res=my.hwr[3],
                               footnote,
                               footnote2,Vdic()$StatModel[AnalyC()],
                               Vdic()$StatNote[AnalyC()],
                               as.vector(rbind(tmp1,tmp0)) )))
        colnames(tmprow)<-t.names

        return(tmprow)

      })
    }) # Add analysis by selection

    loaLoad<-reactive({
      if (input$load_analysis==0||is.null(input$upfile))
        return(NULL)
      isolate({
        tmp<-read.csv((input$upfile)$datapath,header=TRUE,
                      encoding='UTF-8', na = na_sign)
        if(!'height'%in%colnames(tmp)){
          tmp$height <- NA
        }
        if(!'width'%in%colnames(tmp)){
          tmp$width <- NA
        }
        if(!'res'%in%colnames(tmp)){
          tmp$res <- NA
        }

        return(tmp)
      })
    }) # Add analysis by upload
    myTTT <<- plyr::rbind.fill(loaAdd(),loaLoad())
    if(!is.null(nrow(myTTT)))  myTTT <<- myTTT[, colnames(loaAdd())]

    write.table(myTTT,
                loatext,append=TRUE,col.names=FALSE,row.names=FALSE)


    if((is.null(input$add_analysis)||is.null(input$load_analysis)) ||
       input$add_analysis+input$load_analysis==0){
      return(NULL)
    }else{
      ret<-read.table(loatext,header=TRUE,check.names=FALSE)
      ret<-unique(ret)
      write.table(ret,loatext,append=FALSE,row.names=FALSE,col.names=TRUE)
    }

    LOA<<-reactive({
      if((is.null(input$add_analysis)||is.null(input$load_analysis)) ||
         (input$add_analysis+input$load_analysis)==0){
        return(NULL)
      }else{
        return(ret)
      }
    })

    return(NULL)
  }) # Generate LOA

  output$LOA<-renderUI({
    if((is.null(input$add_analysis) || is.null(input$load_analysis)) ||
       input$add_analysis+input$load_analysis==0
    ){
      return(NULL)
    }else{
      tf<-reactive({
        tf<-isolate({loaTF()})
        #is a TRUE/FALSE vector checking the availability of input$result_i
        #see checkboxTableInput in shinyFun.r
        addrow<-nrow(LOA())-length(tf)
        if(addrow>0){
          tfb<-c(tf,rep(TRUE,addrow))
        }else{
          tfb<-tf
        }
        return(tfb)
      })  #TRUE/FALSE of LOA
      isolate({
        sel_Table<-tf()
        tmploaTable<-LOA()[,c('Titles','Abbreviations.Footnote')]
        tmploaTable<-data.frame(ID=1:nrow(tmploaTable), tmploaTable)
        input$delete_loa
      })
      if(nrow(tmploaTable)==0){return(NULL)}
      if(is.null(input$delete_loa)||!(input$delete_loa)){
        shiny::HTML(checkboxTableInput(
          tmploaTable,
          table.id="LOAtable",id.name="result",
          checked=sel_Table, check.name= " ",labels=c("Title","Stat.Method","Footnote")))
      }else{

        shiny::HTML(checkboxTableInput(
          tmploaTable,
          table.id="LOAtable",id.name="result",
          checked=sel_Table,
          check.name= " ",labels=c("Title","Stat.Method","Footnote"),
          showSelectedOnly=TRUE))
      }
    }
  }) # Display LOA

  output$rcode<-renderPrint({
    if (all(is.null(loaTF()))||length(which(loaTF()))==0){
      return(cat(''))
    }else{
      loalistT<-LOA()[loaTF(),]
      loalistT$order<-1:nrow(loalistT)
      if(!'width'%in%colnames(loalistT))  loalistT$width <- NA
      if(!'height'%in%colnames(loalistT)) loalistT$height <- NA
      if(!'res'%in%colnames(loalistT))    loalistT$res <- NA
      temp.vdic <- Vdic()
      temp.vdic <- temp.vdic[,!colnames(temp.vdic)%in%c('width', 'height','res')]
      codelist<-merge(loalistT,Vdic(),by=c('Request.Name'),all.x=TRUE)
      codelist<<-codelist[order(codelist$order,codelist$Layout,decreasing=FALSE),]

      if(is.null(input$tumor) || is.na(input$tumor))
        title0<-paste0("Study: ",input$study,"\t\t", "  ")
      else
        title0<-paste0("Study: ",input$study,"\t\t","Tumor Type: ",input$tumor)

      r_out<-runcode(codelist=codelist, datPath=input$datPath,
                     outPath=input$outPath,
                     libs=paste0(r.lib.alert,collapse='\n'),
                     sourceCode=Vdic()$Source[!is.na(Vdic()$Request.Name)&!is.na(Vdic()$Source)],
                     subCode=subRcode,
                     title=title0,devpath=devpath,
                     params1=params[params.ord], paramLabs1=params.lab[params.ord],
                     outBcode=Vdic()$PlotCode[Vdic()$Num==1] )
      rcode<<-r_out
      cat(r_out)
    }
  }) # Generate R code

  output$scode<-renderPrint({
    files<-file.path(local.path1,
                     unique(Vdic()$Source[!is.na(Vdic()$Source)]))
    f1<-files[tolower(substring(files, nchar(files)-1,))==".r"]
    if(length(f1)>1)
      f1<-f1[!grepl('rcode.r', f1)]

    rF<-fLoop<-f1
    while(length(fLoop)>0){
      f0<-NULL
      for(i in 1:length(f1)){
        f2<-file.path(local.path1, "users", checkSource(fnm=f1[i]))
        fLoop<-fLoop[fLoop!=f1[i]]
        if(length(f2)>0){
          f0<-c(f0, f2)
          rF<-c(rF, f2)
        }
      }
      if(length(f0)>0){
        fLoop<-f1<-f0
      }
    }
    f1<-unique(rF)
    f1<-f1[length(f1):1] #so that source files can be run first
    if(allSourceIn1||input$showAllSource){ #copy all the source code into one file
      code00<-lapply(f1,readLines)
      code00<-lapply(code00, function(x){gsub("source",
                                              "###Search the copied code in this file\n### source", x)})
      code00<-unlist(lapply(1:length(f1),
                            function(x){c(" ", " ",
                                          paste0('#---Source ',x,': "',f1[x],'"---#'),
                                          " ", code00[[x]])}))
      code00<-c(paste0("if(TRUE) { #list of ", length(f1), " R source files"),
                paste0("   # source(file=paste0(local.path1, \'", gsub(local.path1, '', f1), "\'))"),
                paste0("} #end of ", length(f1), " R source files."), code00)
    } else {#only list the source files
      code00<-c(paste0("if(TRUE) { #list of ", length(f1), " R source files"),
                paste0("    source(file=paste0(local.path1, \'", gsub(local.path1, '', f1), "\'))"),
                paste0("} #end of ", length(f1), " R source files.") )
    }
    code11<<-code00
    cat(paste0(code00,collapse='\n'))
  }, width=60) # Generate Source code

  #------ Download LOA, R code, RTF output ------#
  output$save_loa<-downloadHandler(
    filename=function(){paste0(input$study,"_", input$tumor,"_loa.csv")},
    content=function(file){
      write.csv(LOA()[loaTF(),],file,row.names=FALSE, fileEncoding = 'UTF-8')
    }) # Download LOA

  output$save_loa_cd<-downloadHandler(
    filename=function(){paste0(input$study,"_", input$tumor,"_loa_cd.csv")},
    content=function(file){
      f12<-function(d1,d2){
        n2<-nrow(d2)
        d2$FootCode <- d2$Footnote
        d2$StatNote <- d2$Test.Statistic.Footnote
        d2$StatModel <-d2$Statistical.Analysis
        d2m<-params.map[,c('loa_lab','cd_lab')]
        d2cm<-d2m$loa_lab; names(d2cm)<-d2m$cd_lab;
        d2mv<-params.map[,c('loa','cd')]
        d2cmv<-d2mv$loa; names(d2cmv)<-d2mv$cd;
        for(i in 1:length(d2cm)){
          colnames(d2)<-gsub(d2cm[i], names(d2cm)[i], colnames(d2), fixed=T)
          colnames(d2)<-gsub(d2cmv[i], names(d2cmv)[i], colnames(d2), fixed=T)
        }
        dcm<-colnames(d2)[colnames(d2)%in%colnames(d1)]
        dcm.txt<-dcm[grepl('text.value',dcm)]
        dcm.ntx<-dcm[!grepl('text.value',dcm)]
        d2$rn<-1:n2
        d2$rn2<-paste(d2$rn, d2$Request.Name)
        d12<-merge(d1, d2[,c('rn','Request.Name', 'rn2')],
                   by='Request.Name', all=T, sort=F)
        d12$Num[d12$Num!=0] <- NA
        d12$Num[d12$Tab.value=='cd']<-n2+1
        d12$Num[d12$Tab.value=='rcode']<-n2+2
        d12 <- d12[d12$Num%in%c(0, n2+1, n2+2)|!is.na(d12$rn),]
        d12$Num[!is.na(d12$rn)]<-d12$rn[!is.na(d12$rn)]
        for(i in d2$rn){
          d12[d12$Num==i, dcm.ntx]<-d2[d2$rn==i,dcm.ntx]
          dcm.txt.tmp <- d2[d2$rn==i,dcm.txt]
          d12[d12$Num==i, dcm.txt]<-ifelse(is.na(dcm.txt.tmp),
                                           NA,
                                           paste0('\"',dcm.txt.tmp,'\"'))
        }
        d12$Request.Name<-d12$rn2
        d12<-d12[,colnames(d1)]
        d12<-d12[order(d12$Num),]
        loc.wd<-grepl(',',d12$width, fixed=T)
        d12$width[loc.wd]<-paste0('\"c(',d12$width[loc.wd],')\"')
        rownames(d12)<-NULL
        return(d12)
      }
      tt1<<-Vdic0; tt2<<-LOA()[loaTF(),];
      #f12(Vdic0, tt2);
      write.csv(  f12(Vdic0, LOA()[loaTF(),]) ,
                  file,row.names=FALSE, fileEncoding = 'UTF-8')
    }) # Download LOA in cd

  #------ Download EPS plot ------#
  output$getEPS <- downloadHandler(
    filename="current_BEACH_EPS_Plot.eps",
    content =function(file){
      postscript(file,
                 title = paste("BEACH Output", pdf.label),
                 height=tfl.h/tfl.r,
                 width=tfl.w/tfl.r,
                 pointsize = 1/tfl.r )
      plottry<-try(eval(parse(text=input0.code[1])))
      if(class(plottry)[1]=='try-error') {
        plot(0,axes=F, col='white',ylab='',xlab='')
        legend('top', 'Plotting\nError', cex=5, bty='n', text.col='red')
      }
      dev.off()
    }
  )
  #------ Download PDF plot ------#
  output$getPDF <- downloadHandler(
    filename="current_BEACH_PDF_Plot.pdf",
    content =function(file){
      pdf(file,
          title = paste("BEACH Output", pdf.label),
          height=tfl.h/tfl.r,
          width=tfl.w/tfl.r,
          pointsize = 1/tfl.r )
      plottry<-try(eval(parse(text=input0.code[1])))
      if(class(plottry)[1]=='try-error') {
        plot(0,axes=F, col='white',ylab='',xlab='')
        legend('top', 'Plotting\nError', cex=5, bty='n', text.col='red')
      }
      dev.off()
    }
  )


  #--------save output as a RTF file------------#
  output$save_output<-downloadHandler(
    filename=function(){
      if(input$onefileRTF=='one file'){
        f1<-paste0(input$study,"_",input$tumor, "_", Sys.Date(), ".rtf")
      }else{
        f1<-paste0(input$study,"_",input$tumor, "_", Sys.Date(), ".zip")
      }
      return(f1)
    },
    content=function(file){
      if(is.null(input$tumor) || is.na(input$tumor) || gsub(" ", '', input$tumor)=='')
        title0<-c(paste0("Study: ",input$study), '')
      else
        title0<-c(paste0("Study: ",input$study), paste0("Tumor Type: ",input$tumor))
      loalistT<<-LOA()[loaTF(),]
      loalistT$order<-1:nrow(loalistT)
      codelist<-merge(loalistT, Vdic(),by='Request.Name',all.x=TRUE)
      codelist<-codelist[order(codelist$order,codelist$Layout,decreasing=FALSE),]
      codelist$width <- codelist$width.x
      codelist$height <- codelist$height.x
      codelist$res <- codelist$res.x
      codelist<<-codelist

      #define the page margin
      mag1<-1
      #define the font size on each page
      fs <<- 8

      if(input$landscp=="Landscape"){
        pageW<-11      #page width
        pageH<-8.5     #page height
        nline<-52      #number of lines on a page
        nline.max<- 35 #maximum number of table rows on a page
        nline.min<- 5  #minimum number of table rows on a page
      } else {
        pageW<-8.5       #page width
        pageH<-11        #page height
        nline<-68        #number of lines on a page
        nline.max <- 50  #maximum number of table rows on a page
        nline.min <- 5   #minimum number of table rows on a page
      }
      maxH<-pageH-4*mag1
      maxW<-pageW-2*mag1
      if(input$onefileRTF=='one file'){
        rtf<-RTF(file, width=pageW, height=pageH, font.size=fs,omi=rep(mag1, 4) )
        rtf$.rtf <- gsub('\\rtf1\\ansi', '\\rtf1\\ansi\\BEACHoutput',
                         rtf$.rtf, fixed=TRUE)
      }
      # rtf$.rtf <- gsub('Times New Roman', 'Courier New', rtf$.rtf)  # make "Courier New" as default

      npage<-1
      prd.status<-''
      nfile<-0
      zipfs<-NULL

      #reorder codelist according to heading levels
      all.tit <- codelist$Titles
      all.tit0<- strsplit(all.tit, split='HHH:', fixed=TRUE)
      all.tit0<-lapply(all.tit0, function(x){
        if(gsub(" ", "", x[1])==""){return(x[-1])} else{ return(x)}
      })
      totLayer<-max(sapply(all.tit0, length))
      all.tit0<-lapply(all.tit0, function(x){
        c(x, rep(NA, max(0, totLayer-length(x))))
      })
      mat.tit <-t( matrix(unlist(all.tit0), nrow=totLayer) )
      if(ncol(mat.tit)>1){
        wh.tit <- do.call(order, as.data.frame(mat.tit))
        codelist<-codelist[wh.tit,]
        mat.tit <-mat.tit[wh.tit, ]
      }
      if(is.vector(mat.tit)){
        mat.tit <- matrix(mat.tit, nrow=1)
      }

      mat.1<-matrix(TRUE, nrow=1, ncol=ncol(mat.tit))
      mat.tit[is.na(mat.tit)] <- ""
      nr.mat <- nrow(mat.tit)
      mat.1<- rbind(mat.1, !apply(mat.tit, 2, function(x){x[2:nr.mat]==x[1:(nr.mat-1)]}) )
      if(ncol(mat.1)>1){
        mat.1<-t( apply(mat.1, 1, function(x){
          wh.T<- which(x)
          if(length(wh.T)>0)
            x[wh.T[1]:length(x)] <- TRUE
          x
        }) )
      }


      for (i in 1:nrow(codelist)){
        if (!is.na(codelist[i,params.lab[1]])&&is.na(codelist[i,params[1]]))
          next
        if(!all(is.na(codelist[i,params]))){
          #k.list<-params[!is.na(codelist[i,params])]\
          k.list<-sort(params)
          for (k in k.list[length(k.list):1]){
            print(     tmp0<-unlist(strsplit(as.character(codelist[i,k]),',',fixed=TRUE))   )
            tmp<-ifelse(any(is.na(as.numeric(tmp0))),paste0('c(\"',paste0(tmp0,collapse='\",\"'),'\")'),
                        paste0('c(',codelist[i,k],')'))
            codelist$PlotCode[i]<- gsub(paste0('input$',k),tmp,codelist$PlotCode[i],fixed=TRUE)
          }
        }

        nfile<-nfile+1
        #if all TFLs are NOT saved to one RTF file, a zip file will be downloaded
        if(input$onefileRTF!='one file'){
          f2<-file.path(local.path2, paste0(input$study,"_",input$tumor, "_", Sys.Date(),'_', nfile, ".rtf"))
          zipfs<-c(zipfs, f2)
          rtf<-RTF(f2, width=pageW, height=pageH,font.size=fs, omi=rep(mag1, 4) )
          rtf$.rtf <- gsub('\\rtf1\\ansi', '\\rtf1\\ansi\\BEACHoutput',
                           rtf$.rtf, fixed=TRUE)
        }

        #Add Plot
        tmp<-eval(parse(text=codelist$tmp[i]))
        tflname<-ifelse(is.na(codelist[i,params[1]]),        #Condition
                        paste0(tflfile,codelist$Num[i]),     #if TRUE
                        paste0(tflfile,codelist$Num[i],'x',  #if FALSE
                               paste0(#Paste all UIs together
                                 sapply(params,function(y){
                                   y0<-codelist[i,y]
                                   if(!is.null(y0)){y0[is.na(y0)]<-''}
                                   y0<-paste0(y0[length(y0):1],collapse='_')
                                   #Paste all Params for each UI
                                   substring(y0, max(nchar(y0)-30,1))
                                 }),collapse=''))
        )
        fig.name<-paste0(gsub("[[:punct:]]","",tflname),'.png')
        fig.name<-gsub(" ", "", fig.name)
        fig.name.i<-file.path(local.path3,fig.name)
        tab.name<-paste0(gsub("[[:punct:]]","",tflname),'.rdata')
        tab.name<-gsub(" ", "", tab.name)
        tab.name.i<-file.path(local.path3,tab.name)

        if(codelist$Type.y[i]=='Figure'){
          figH<-eval(parse(text=codelist$height[i]))
          figW<-eval(parse(text=codelist$width[i]))
          figR<-eval(parse(text=codelist$res[i]))
          png(file=fig.name.i, height=figH, width=figW, res=figR)
          plottry<<-try(eval(parse(text=codelist$PlotCode[i])))
          if(class(plottry)[1]=='try-error') {
            plot(0,axes=F, col='white',ylab='',xlab='')
            legend('top', 'Plotting\nError', cex=5, bty='n', text.col='red')
          }else if(grepl('gg', class(plottry))){
            ggsave(fig.name.i, plottry, height=figH/100, width=figW/100, dpi=figR, limitsize=FALSE)
          } else {}
          dev.off()

          #Add Header
          title00<-title0
          title00[2]<-paste(title0[2],'    Page', npage, '     ',
                            format(Sys.time(), "%H:%M %d%b%Y"), "   ", prd.status)  # main header
          npage<-npage+1
          title<-codelist$Titles[i]

          for(t1 in 1:ncol(mat.tit)){
            if(mat.1[i,t1] && mat.tit[i,t1]!=""){
              addHeader(rtf, title=mat.tit[i,t1], font.size=10, TOC.level=t1)
            }else if (mat.tit[i,t1]!="") {
              addParagraph(rtf, mat.tit[i,t1])
            }else{}
          }
          #addParagraph(rtf, title)
          addParagraph(rtf, title00)
          rtf$.font.size <- fs

          tmW<- min(eval(parse(text=codelist$width[i]))/90, maxW)
          tmH<- min(eval(parse(text=codelist$height[i]))/90, maxH)
          tmR<- eval(parse(text=codelist$res[i]))
          addPng(rtf, fig.name.i, width=tmW, height=tmH, res=tmR, col.justify='L')

          #footnote for figures
          #addNewLine(rtf, n=1)
          footnote<-codelist$Footnote[i]
          addParagraph(rtf, footnote)
        }

        #Add Table
        if(codelist$Type.y[i]=='Table'){
          tab.h <<- codelist$height[i]
          tab.w <<- as.numeric( eval(parse(text=paste("strsplit(' ",
                                                      codelist$width[i], " ', split=',')")   ))[[1]] )

          tmp<-eval(parse(text=codelist$tmp[i]))

          codelist$PlotCode[i]
          print(  outTable <<- eval(parse(text= codelist$PlotCode[i]))  )
          print(outTable)
          tmptab <<- eval(parse(text= codelist$PlotCode[i]))



          #check colnames
          outTable.colNm<-colnames(outTable)
          ot1 <- strsplit(outTable.colNm, split=";", fixed=TRUE)

          ot1n<-sapply(ot1, length)

          if(max(ot1n)==1){
            multiHeader<-FALSE
          }else{
            multiHeader<-TRUE
            nheader <- max(ot1n)
            #add extra row if a column names' level is smaller than the others
            ot1ns <- ot1n < nheader
            outTable.colNm[ot1ns] <- paste0(outTable.colNm[ot1ns],
                                            sapply(nheader-ot1n[ot1ns],
                                                   function(x){paste(rep('; ',x), collapse = '')}) )
            colnames(outTable) <- outTable.colNm

            ot2 <- sapply(outTable.colNm, strsplit, split=';', fixed=TRUE)

            names(ot2) <- NULL
            ot2<-matrix( unlist(ot2), ncol=length(ot2))
            var.ul <- unique(as.vector(ot2[-nrow(ot2),]))
            var.ul0 <- gsub(' ', '', var.ul)
            var.ul0 <- var.ul[var.ul0!=""]


          }


          footnote<-codelist$Footnote[i]
          footnote<-ifelse(is.na(footnote), '', footnote)

          nrTab<-nrow(outTable)
          ncTab<-ncol(outTable)
          print(paste("footnote: ", footnote))
          if(is.null(footnote)) footnote<-" "
          if(!is.character(footnote)) footnote <- " "
          nrFoot<-1+length(strsplit(footnote, split='\n', fixed=TRUE)[[1]])
          nline1<-max(1, nline-nrFoot - 10) #header lines

          tWidth<-pageW-mag1*2

          nc<-nchar(as.character(outTable[,1]))
          #use the 1st column width for table width
          c1W<-pmax(max(nc)*0.079/2, 20*0.1)
          caW<-nc*0.1

          if(pageW < 9){
            lcW<-.711
            if(ncol(outTable)>2){
              othW<-(tWidth-c1W-lcW)/(ncol(outTable)-2)
              centW<-rep(othW,ncol(outTable)-2)
              cWs<-c(c1W,centW,lcW)
            }else{
              cWs<-c(c1W, lcW)
              othW<-1
            }
          } else{
            if(ncol(outTable)>1){
              othW<-(tWidth-c1W)/(ncol(outTable)-1)
              centW<-rep(othW,ncol(outTable)-1)
              cWs<-c(c1W,centW)
            }else{
              cWs<-c(c1W,0)
              othW<-1
            }
          }
          max_cW<-max(apply(outTable,2, function(x){max(nchar(x))}))
          max_rW1<-ceiling(max_cW/othW)

          if(multiHeader)
            nline1 <- nline.max
          else
            nline1<-max(min(nline1-max_rW1+1, nline.max), nline.min)

          #nline1 is the max number Table rows shown on each page
          if(tab.h<=nline.max & tab.h>=1){
            nline1 <- tab.h
          }
          if(length(tab.w) == length(cWs) ){
            cWs <- tab.w
          }
          nline1 <<- nline1
          nrTab <<- nrTab

          for(j in 1:ceiling(nrTab/(nline1))){ #j matches the page number of the table
            #Add Header
            title00<-title0
            title00[2]<-paste0(title0[2], '    Page ', npage, '     ',
                               format(Sys.time(), "%H:%M %d%b%Y"), "   ", prd.status)  # main header
            npage<-npage+1
            title<-codelist$Titles[i]

            for(k in 1:length(title00))
              title00[k]<-paste0(title00[k], paste(rep(' ', max(0, pageW*7-nchar(title00[k]))), collapse=''))
            title00<-paste(c(title00, "\n"), collapse=' ')
            #add heading sections or bookmark
            for(t1 in 1:ncol(mat.tit)){
              if(j==1 && mat.1[i,t1] && mat.tit[i,t1]!=""){
                addHeader(rtf, title=mat.tit[i,t1], font.size=10, TOC.level=t1)
              }else if (mat.tit[i,t1]!="") {
                addParagraph(rtf, mat.tit[i,t1])
              }else{}
            }
            #addParagraph(rtf, title)
            rtf$.font.size <- 10   #define the font size of titles
            addParagraph(rtf, title00)
            rtf$.font.size <- fs   #redefine the font size of text

            bottLine<-min(nline1*j, nrTab)
            if(TRUE){#the table structure previously used.
              tableBL<- bottLine-((j-1)*nline1)
              tb1<-outTable[((j-1)*nline1+1):bottLine,]
              if(is.null(nrow(tb1))){
                tb1<-data.frame(` `=tb1)
              }

              if(multiHeader){# 17-Mar-2016
                rtf.table.out(rtf,  tb=tb1,
                              cell1=max(nheader+1,3), #number of levels in header and then plus 1
                              nheader=max(nheader,2), #number of levels in header
                              colFormat=c("L", rep("C",ncol(outTable)-1)),
                              nline.body= nline1, #min(tableBL, ncol(tb1)), #number of lines per page
                              height=pageH,
                              width=pageW,
                              omi=rep(mag1, 4),
                              cw=cWs,      #column width
                              var.ul=var.ul0 #key string for underline, must be the entire string
                              #eg. if changing " X1" to "X1", then it will not have the underline
                )
                if( exists("outTable") ) {rm('outTable'); outTable <<- tmptab}
                addParagraph(rtf,footnote)
              } else {
                rtf<-rtf_table_out_as_sas(rtf, tb1,
                                          cw=cWs, colFormat=c("L", rep("J",ncol(outTable)-1)),
                                          nline.body=tableBL,
                                          width=maxW, height=maxH, omi=rep(mag1, 4) )
                addParagraph(rtf,footnote)
              }
            }

            if(bottLine<nrTab )
              addPageBreak(rtf, width=pageW, height=pageH, font.size=fs, omi=rep(mag1, 4) )
          }

        }

        #get a new RTF page for the next analysis
        if(i < nrow(codelist))
          addPageBreak(rtf, width=pageW, height=pageH, font.size=fs, omi=rep(mag1, 4) )

        #one file is for one analysis
        if(input$onefileRTF!='one file'){
          done(rtf)
          print(paste(f2, 'is saved.'))
        }
      }

      if(input$onefileRTF=='one file'){
        done(rtf)
      }else{
        zipfs.gb<<-zipfs
        zip(zipfile=file, files=zipfs)
      }
    }) # Download rtf output
  #---------End of save output as a RTF file---------------#

  #---------run user defined action button-----------------#
  output$userdo_button<-renderUI({
    AnalyN()
    but_code<-paste0(
      '<button id="userdo" type="button" class="btn btn-default action-button">',
      userActionLabel, '</button>')
    return(shiny::HTML(but_code))
  })
  #observeEvent(input$userdo, {userdo_action()})
  userdo_out_reac<-eventReactive(input$userdo, {AnalyN(); userdo_action()})
  output$userdo_out<-renderPrint({
    if(!is.character(userdo_out_reac())){
      return(NULL)
    }else{return(userdo_out_reac())}
  })
  #---------End of run user defined action button-----------------#

  #--------save output as a shiny::HTML file------------#
  output$save_outputH<-renderUI({
    if(is.null(input$outputH)||input$outputH==0){
      return(NULL)
    }
    if(!dir.exists(htmlPath)){
      return(shiny::HTML('Please input an existing director for HTML output!'))
    }

    isolate({
      curP0<-getwd()

      tp<-try(setwd(input$hPath))
      if(class(tp)[1]=="try-error"){
        return(shiny::HTML('<h6>The path for HTML file output is not working.</h6>'))
      }else{setwd(curP0)}
      file00<-paste0(input$study,"_",input$tumor,"_", Sys.Date())
      file0<-file.path(input$hPath, file00)
      file01<-file.path(file0, file00)
      if(file.exists(file0)){
        setwd(file0)
        try(file.remove(dir()))
        if(file.exists(file00)){
          setwd(file00)
          try(file.remove(dir()))
        }else{dir.create(file00, showWarnings=FALSE, recursive=TRUE)}
      }else{ #create a folder for linked files
        dir.create(file0, showWarnings=FALSE, recursive=TRUE)
        dir.create(file.path(file0, file00), showWarnings=FALSE, recursive=TRUE)
      }

      title0<-paste0("Study: ",input$study,"\t\t","Tumor Type: ",input$tumor)
      loalistT<-LOA()[loaTF(),]
      loalistT$order<-1:nrow(loalistT)
      codelist<-merge(loalistT, Vdic(),by='Request.Name',all.x=TRUE)
      codelist<-codelist[order(codelist$order,codelist$Layout,decreasing=FALSE),]
      ind<-0

      #start HTML

      #remember to create a folder under htmlPath
      setwd(curP0)
      indexH<-readLines(con=file.path(htmltem, 'index.htm'))
      bodyH<-readLines(con=file.path(htmltem, 'body.htm'))
      bodyH<-gsub("Biomarker Analyses Output From BEACH Platform",
                  title0, bodyH)
      contH<-readLines(con=file.path(htmltem, 'content.htm'))
      #one row in one codelist is one page in the study report
      for (i in 1:nrow(codelist)){#update source code in codelist$PlotCode
        if (!is.na(codelist[i,params.lab[1]])&&is.na(codelist[i,params[1]]))next
        if(!all(is.na(codelist[i,params]))){
          k.list<-params[!is.na(codelist[i,params])]
          for (k in k.list[length(k.list):1]){
            tmp0<-unlist(strsplit(as.character(codelist[i,k]),',',fixed=TRUE))
            tmp<-ifelse(any(is.na(as.numeric(tmp0))),
                        paste0('c(\"',paste0(tmp0,collapse='\",\"'),'\")'),
                        paste0('c(',codelist[i,k],')'))
            codelist$PlotCode[i] <- gsub(paste0('input$',k),
                                         tmp,codelist$PlotCode[i], fixed=TRUE)
          }
        }
        #Add Header
        title<-codelist$Titles[i]
        tmpTit<-paste(title0, "/n", title)

        #Add Plot&Table
        tmp<-eval(parse(text=codelist$tmp[i]))
        tflname<-ifelse(is.na(codelist[i,params[1]]),             #Condition
                        paste0(tflfile, codelist$Num[i]),         #if TRUE
                        paste0(tflfile, codelist$Num[i],'x',      #if FALSE
                               paste0(#Paste all UIs together
                                 sapply(params,function(y){
                                   y0<-codelist[i,y]
                                   if(!is.null(y0)){y0[is.na(y0)]<-''}
                                   y0<-paste0(y0[length(y0):1], collapse='_')
                                   #Paste all Params for each UI
                                   substring(y0, max(nchar(y0)-30,1))
                                 }),collapse=''))
        )
        tflname<-gsub('tfl', paste0('t',i,'fl'),tflname, fixed=TRUE)
        fig.name<-paste0(gsub("[[:punct:]]","",tflname),'.png')
        fig.name.i<-file.path(local.path3, fig.name)
        tab.name<-paste0(gsub("[[:punct:]]","",tflname),'.rdata')
        tab.name.i<-file.path(local.path3, tab.name)

        #insert figure
        if(codelist$Type.y[i]=='Figure'){
          myres<-ifelse(is.null(codelist$res[i])||is.na(codelist$res[i]), 150,
                        eval(parse(text=codelist$res[i])))

          png(fig.name.i, height=eval(parse(text=codelist$height[i])),
              width=eval(parse(text=codelist$width[i])), res=myres)
          plottry<-try(eval(parse(text=codelist$PlotCode[i])))
          if(class(plottry)[1]=='try-error') {
            plot(0,axes=F, col='white',ylab='',xlab='')
            legend('top', 'Plotting\nError', cex=5, bty='n', text.col='red')
          }
          dev.off()

          fig.name.1<-strsplit(fig.name.i, split="www/",fixed=TRUE)[[1]][2]
          file.copy(from=fig.name.i, file01)
          ind<-ind+1
          bodyH<-c(bodyH, fig2html(figNm=fig.name.1, figTit=codelist$Titles[i],
                                   figH=eval(parse(text=codelist$height[i])),
                                   figW=eval(parse(text=codelist$width[i])) ,
                                   fnote=codelist$Footnote[i], ind=ind ))
          contH<-c(contH, cLink(tit=codelist$Titles[i], ind=ind))
        }

        #Insert Table
        if(codelist$Type.y[i]=='Table'){
          #generate the temporary table
          tmp<-eval(parse(text=codelist$tmp[i]))
          tmptab<-eval(parse(text=codelist$PlotCode[i]))
          save(tmptab,file=tab.name.i)

          #load(tab.name.i)
          outTable<-tmptab
          if(FALSE){
            tWidth<-9
            nc<-nchar(as.character(outTable[,1]))
            c1W<-pmax(max(nc)*0.079/2, 20*0.079)
            caW<-nc*0.079
            lcW<-.711
            othW<-(tWidth-c1W-lcW)/(ncol(outTable)-2)
            centW<-rep(othW,ncol(outTable)-2)
            cWs<-c(c1W,centW,lcW)
          }

          ind<-ind+1
          bodyH<-c(bodyH, df2html(datF=outTable, tabTit=tmpTit,
                                  fnote=codelist$Footnote[i], ind=ind))
          contH<-c(contH, cLink(tit=codelist$Titles[i], ind=ind))
        }
      }
      bodyH<-c(bodyH, '<br>', '</div>', '</body>', '</html>')
      contH<-c(contH, '<br>', '</ol>', '</body>', '</html>')

      write(bodyH, file=file.path(file01, 'body.htm'))
      write(contH, file=file.path(file01, 'content.htm'))

      indexH<-gsub("tmpfolder", file00, indexH, fixed=TRUE)
      file1<-paste0(file00,".htm")
      write(indexH, file=file.path(file0, file1))

      setwd(curP0)
      return(shiny::HTML(paste('<h6>', file.path(file0, file1),
                               'and its folder are successfully downloaded.</h6>')))
    }) })  # Download HTML output
  #---------End of save output as a HTML file---------------#

  output$save_data<-downloadHandler(
    filename=function(){
      tt <- paste0('download_tmpData.', input$multdat_ext)
      return(tt)
    },
    content=function(file){
      #      if (is.null(input$infile)&&is.null(input$infileR))
      #        return(NULL)

      choice<-sapply(AnalyN(),function(x){
        ifelse(substr(Vdic()$Title[x],1,5)=='paste',
               eval(parse(text=Vdic()$Title[x])),
               Vdic()$Title[x])
      })

      outList <<- currTabL
      outdata <<- outList[[1]]

      sapply(1:length(currTabL),
             function(x){
               assign(paste0('outmplkhdnttawr',x),currTabL[[x]],envir=globalenv() )
             } )

      if(input$multdat_ext=='rdata'){
        save(currTabL,file=file)
      } else if(input$multdat_ext=='xls'){
        WriteXLS::WriteXLS(paste0('outmplkhdnttawr',1:length(currTabL)),
                 ExcelFileName=file,SheetNames=1:length(input$multdat))
      }  else if(input$multdat_ext=='sas'){
        if(!is.vector(currTabL[[1]])){
          o1<-apply(currTabL[[1]], 2, paste, collapse='\t\t\t')
        }else{
          o1 <- currTabL[[1]]
        }
        writeLines(o1,con=file)

      } else if(input$multdat_ext=='csv'){
        write.csv(currTabL[[1]], file=file, row.names=FALSE, fileEncoding='UTF-8')
      } else if(input$multdat_ext=='xpt'){
        #write.xport(currTabL[[1]], file=file, autogen.formats=FALSE)
        haven::write_xpt(currTabL[[1]], path=file)
      }

    }) # Download data output


  output$save_rcode<-downloadHandler(
    filename=function(){paste0(input$study,"_",input$tumor,".r")},
    content=function(file){
      writeLines(rcode,file)}) # Download R code

  output$save_scode<-downloadHandler(
    filename=function(){paste0(input$study,"_",input$tumor,"_source.r")},
    content=function(file){
      writeLines(code11,file)
    }) # Download Source code

  output$delete<-renderUI({#remove temporary files
    if(input$delete_tmpfile==0){
      return(NULL)
    } else {
      cnt<-cnt+input$delete_tmpfile
      #for files under the tmpfile folder
      loatextf<-dir(local.path2)
      loatextf<-loatextf[nchar(loatextf)>3]
      if(length(loatextf)>0)
        loatextf<-loatextf[substr(loatextf,1,3)=='loa']
      #for files under the www folder
      tm_png<-dir(local.path3)
      tm_png<-tm_png[nchar(tm_png)>3]
      if(length(tm_png)>0){
        tmsel<-substr(tm_png,1,3)=='tfl'|substr(tm_png,2,4)=='tfl'|substr(tm_png,1,2)=='.n'|
          substr(tm_png,3,4)=='fl'|
          substr(tm_png,nchar(tm_png)-6,nchar(tm_png))=='.rdata'
        tm_png<-tm_png[tmsel]
      }
      if(length(tm_png)==0 & length(loatextf)==0){
        return('Empty now.')
      }else{
        if(length(loatextf)>0){
          loatextf<-file.path(local.path2, loatextf)
          do.call(file.remove, as.list(loatextf))
        }
        if(length(tm_png)>0){
          tm_png<-file.path(local.path3,tm_png)
          do.call(file.remove, as.list(tm_png))
        }
        return(paste('Done',cnt))
      }
    }
  })

  #define data subset
  output$subsetcode1<-renderUI({
    if(is.null(input$submitcode)||input$submitcode==0){
      subRcode<<-NULL
    }else{subRcode<<-isolate(input$subRcode)}
    return(conditionalPanel(condition='true',
                            shiny::HTML("<textarea name=\"subRcode\" rows=\"4\"  style=\"width:100%\"
                                        placeholder=\"#drag the right bottom corner to make this larger.
                                        #indataset is a list object including all the uploaded csv files.
                                        #indataset.i is indataset[[1]] by default. indataR is a list object including
                                        #all the objects in the uploaded R file.
                                        #Input your R code here to re-define indataset.i, for example
                                        indataset.i<<-indataset[[1]]
                                        indataset.i<<-indataset.i[1:10,]
                                        #or
                                        indataset.i<<-indataset[[1]]; indataset.i<<-indataset.i[1:10,]\"></textarea>") ))
  })
  output$subsetcode2<-renderPrint({
    if(input$submitcode==0 && length(indataset)>0){
      indataset.i<<-indataset[[1]]
      return(NULL)
    }else if(input$submitcode!=0 && length(indataset)>0){
      rpt.cls<-class(try(rpt<-eval(parse(text=subRcode))))
      if(rpt.cls!='try-error'){
        n.row<-nrow(indataset.i)
        n.col<-ncol(indataset.i)
      }
      rpt
    }else{}
  })

  output$showAS<-renderUI({#show all source code or not
    if(input$showAllSource){
      allSourceIn1<<-TRUE
    }else{
      allSourceIn1<<-FALSE
    }
  })

  #######for dynamic output########
  output$dynamicPlot <- renderPlot({
    eval(parse(text=dynamicCode))
  } )

  output$click_info_DT<-renderUI({
    return(DT::dataTableOutput('click_info'))
  })

  output$click_info <- DT::renderDataTable({
    # Because it's a ggplot2, we don't need to supply xvar or yvar; if this
    # were a base graphics plot, we'd need those.
    near_points <<- nearPoints(dynamicData, input$dynamicPlot_click,
                               xvar=dynamicData.xvar, yvar=dynamicData.yvar,
                               addDist = TRUE)
    near_points
  },  rownames = FALSE)


  output$click_info_dl<-downloadHandler(
    filename=function(){paste0(input$study,"_",input$tumor,"_clicked_dynamicData.csv")},
    content=function(file){
      tmpout<-nearPoints(dynamicData, input$dynamicPlot_click,
                         xvar=dynamicData.xvar, yvar=dynamicData.yvar,
                         addDist = TRUE)
      write.csv(tmpout, file=file, row.names=FALSE, fileEncoding='UTF-8')
    }
  ) # Download clicked data


  output$brush_info_DT<-renderUI({
    return(DT::dataTableOutput('brush_info'))
  })

  output$brush_info <- DT::renderDataTable({
    if(showBrush)
      #     print(trytry<<-input$dynamicPlot_brush)
      brush_points<<-brushedPoints(dynamicData, input$dynamicPlot_brush,
                                   xvar=dynamicData.xvar, yvar=dynamicData.yvar)
    brush_points
  }, rownames = FALSE)

  ####End for dynamic output########


  output$brush_info_dl<-downloadHandler(
    filename=function(){paste0(input$study,"_",input$tumor,"_brushed_dynamicData.csv")},
    content=function(file){
      tmpout<-brushedPoints(dynamicData, input$dynamicPlot_brush,
                            xvar=dynamicData.xvar, yvar=dynamicData.yvar)
      write.csv(tmpout, file=file, row.names=FALSE, fileEncoding='UTF-8')
    }
  ) # Download clicked data



  ####Dynamic data table####
  output$outTbl_DT<-renderUI({
    return(DT::dataTableOutput('outTbl'))
  })
  output$outTbl<-DT::renderDataTable({
    if (all(!Vdic()$Type[AnalyN()] %in% c('Figure','Table'))||
        all(eval(parse(text=Vdic()$Condition[AnalyN()])))){
      return(NULL)
    }
    for (i in AnalyN()[1]){#only render the first table
      if(!is.na(Vdic()$Title[i])){
        title<-ifelse(substr(Vdic()$Title[i],1,5)=='paste',
                      eval(parse(text=Vdic()$Title[i])),Vdic()$Title[i])
        titlecode<-paste0('<h3><textarea name=\"titlebox\" rows=\"1\" style=\"width:80%\">',
                          title,'</textarea></h3>')}else{titlecode<-NULL}

      tflname<-ifelse(all(is.na(widgetOrd()$names)),               #Condition
                      paste0(tflfile,Vdic()$Num[i]),    #if TRUE
                      paste0(tflfile,Vdic()$Num[i],'x',        #if FALSE
                             paste0(#Paste all UIs together
                               sapply(widgetOrd()$names,function(y){
                                 y0<-eval(parse(text=paste0('input$',y)))
                                 if(!is.null(y0)){y0[is.na(y0)]<-''}
                                 y0<-paste0(y0[length(y0):1],collapse='_') #Paste all Params for each UI
                                 substring(y0, max(nchar(y0)-30,1))
                               }),collapse=''))
      )
      tflname<-gsub(' ', '',tflname)
      fig.name<-paste0(input$submitcode,gsub("[[:punct:]]", "",tflname),'.png')
      tab.name<-file.path(local.path3,paste0(input$submitcode,gsub("[[:punct:]]", "",tflname),'.rdata'))


      if(Vdic()$Type[i]=='Table'){
        if(!file.exists(tab.name)){
          if(class(try(tmptab<-eval(parse(text=input0.code))))[1]=='try-error'){
            tmptab<-''
          }
          save(tmptab, file=tab.name)
        }else{
          load(tab.name)
        }
        rd_tmptab <<- tmptab
        return(tmptab)
      }else{return(NULL)}
    }
  }, rownames = FALSE)


  output$getDataSelected <- renderUI({
    data_selected_col1 <<- unique(c(
      input$click_info_rows_selected,
      input$brush_info_rows_selected  ))

    if(is.null(input$outTbl_rows_selected)){
      data_selected <<- rbind(
        near_points[!is.na(near_points[,1]) & near_points[,1]%in%data_selected_col1,],
        brush_points[!is.na(brush_points[,1]) & brush_points[,1]%in%data_selected_col1,]
      )
    } else{
      #input$outTbl_rows_selected is shiny internal widget indicate row id(s)
      data_selected <<- rd_tmptab[!is.na(rd_tmptab[,1]) &
                                    rd_tmptab[,1] %in% input$outTbl_rows_selected,]
    }
    return(NULL)
  })

  output$pumpPlotOut<-renderPlot({
    if(is.null(input$outTbl_rows_selected)||input$outTbl_rows_selected==0){
      return(NULL)
    }
    isolate({
      if(is.null(click2plot) || !is.function(click2plot)){
        click2plot.o(input$outTbl_rows_selected)
      }else{
        click2plot();#input$outTbl_rows_selected needs inside
      }
    })
  })

  ##########################
}  #close Shiny server#


shinyServer(BeachServer)
