fbanalysis: Statistical Analysis for Breeding Data in HiDAP

Documented in single_server_base

#' Server for Single Environment analysis
#'
#' @param input shinyserver input
#' @param output shinyserver output
#' @param session shinyserver session
#' @param values reactive values
#' @importFrom shiny reactive tabPanel renderUI selectInput icon h2 uiOutput radioButtons actionButton br column fluidRow
#' @importFrom shinydashboard infoBox tabBox infoBoxOutput renderInfoBox
#' @importFrom shinyFiles parseFilePaths
#' @import pepa
#' @import st4gi
#' @author Omar Benites
#' @export

single_server_base <- function(input, output, session, values){
  
  
  values <- reactiveValues(fileInput = NULL)
  
  observe({
    
    shiny::withProgress(message = "Connecting to SweetPotatoBase",value= 0,{
      
      #NOTE: To use pepa report package we need R 3.3.0 or more.
      #NOTE Finally, we always need pandoc installer.
      #ToDo: In case of poor conection print a message and do not show anything
      
      incProgress(1/5, detail = paste("Connecting to SweetPotatoBase via brapiR..."))
      
      # validate(
      #  need(input$connect_single_sbase != "", label = "Please connect to SweetPotato Base")
      # )
      
      white_list <- brapi::ba_db()
      #establish connection
      incProgress(3/5, detail = paste("Ready for connection..."))
      sp_base_credentials <- white_list$sweetpotatobase
      trial_table <- brapi::ba_trials(con = sp_base_credentials)
      
      out <- list(sp_base_credentials  = sp_base_credentials , trial_table = trial_table)
      incProgress(5/5, detail = paste("Ready for connection..."))
      
      
      values$hot_bdata <- out
    })
    
  })
  
  output$show_single_sbase <- reactive({
    return(!is.null(values$hot_bdata))
  })
  
  output$show_single_sbase_len <- reactive({
    fb <- hot_fb_sbase()$fb
    design<-  hot_fb_sbase()$stat_design
    #fb <- fb$fb 
    
    
    return(!is.null(hot_fb_sbase()))
    #return(!is.null(fb) & length(design)>0)
  })
  
  
  outputOptions(output, 'show_single_sbase', suspendWhenHidden=FALSE)
  
  outputOptions(output, 'show_single_sbase_len', suspendWhenHidden=FALSE)
  
  # program name for single trial in sbase
  output$programName_single_sbase  <- renderUI({
    
    #req(input$connect_single_sbase)
    
    sbase_data <- values$hot_bdata
    sbase_data <- sbase_data$trial_table
    program_name <- sbase_data  %>% dplyr::select(programName)
    program_name <- program_name %>% unique()
    
    selectInput('single_selProgram_sbase', 'Select program', c(Choose='', program_name), selectize=TRUE)
    
  })
  
  #select trial name
  output$trialName_single_sbase  <- renderUI({
    
    #req(input$connect_single_sbase)
    req(input$single_selProgram_sbase)
    
    sel_programName <- input$single_selProgram_sbase
    
    #sbase_data <- hot_bdata() #using button for connecting to SBASE
    sbase_data <- values$hot_bdata
    sbase_data <- sbase_data$trial_table
    
    sbase_data <- sbase_data %>% dplyr::filter(programName == sel_programName)
    
    trial_name <- sbase_data %>% dplyr::select(trialName)
    trial_name <- trial_name[[1]] %>% unique()
    
    selectInput('single_sbase_trialName', 'Select trial', c(Choose='', trial_name), selectize=TRUE)
    
  })
  
  
  # select study name
  output$studyName_single_sbase  <- renderUI({
    
    # req(input$connect_single_sbase)
    req(input$single_selProgram_sbase)
    req(input$single_sbase_trialName)
    sel_trialName <- input$single_sbase_trialName
    
    #sbase_data <- hot_bdata() #using button for connecting to SBASE
    sbase_data <- values$hot_bdata #reactive data
    sbase_data <- sbase_data$trial_table
    
    sbase_data <- sbase_data %>% dplyr::filter(trialName == sel_trialName)
    
    study_name <- sbase_data %>% dplyr::select(studyName)
    study_name <- study_name[[1]] %>% unique()
    
    selectInput('single_sbase_studyName', 'Select study', c(Choose='', study_name), selectize=TRUE)
    
  })
  
  output$show_single_sbase_params <- reactive({
    #return(!is.null(gmtl_data()))
    p <- input$single_sbase_studyName
    #print(p)
    # p <- p ==""
    if(is.null(p)){ 
      val_logic <- FALSE 
    } else if(p==""){
      val_logic <- FALSE
    } else{
      val_logic <- TRUE
    }
    
    return(val_logic)
    
  })
  
  #set options for show_mtable
  outputOptions(output, 'show_single_sbase_params', suspendWhenHidden=FALSE)
  
  
  output$show_studyName_status <- reactive({
    return(length(input$single_sbase_studyName)>0)
  })
  
  
  #get information from sbase 
  hot_fb_sbase <- reactive({
    
    req(input$single_sbase_trialName)
    req(input$single_sbase_studyName)
    
    
    #sbase_data <- hot_bdata() #extracting informatin from sbase (credentials and fieldbook) #using button for connecting to SBASE
    sbase_data <- values$hot_bdata
    
    sbase_fb <- sbase_data$trial_table
    credentials <- sbase_data$sp_base_credentials
    
    col_fb_sbase <- sbase_fb %>% dplyr::filter(programName== input$single_selProgram_sbase, trialName == input$single_sbase_trialName, studyName == input$single_sbase_studyName)
    fb <-  try(ba_studies_table(credentials , studyDbId = as.character(col_fb_sbase$studyDbId)))
    #print(fb)
    design <- try(unique(fb$studyDesign))
    
    if(str_detect(design,"error")){
      design <- NULL
    }
    
    out <- list(fb = fb , stat_design = design)
    
  })
  
  
  observe({
    
    # <- hot_fb_sbase()
    design <- try(hot_fb_sbase()$stat_design) #the statistical design from the SweetPotatoBase
    nrow_fb <- try(nrow(hot_fb_sbase()$fb))
    
    if(str_detect(design,"error")){
      design <- NULL
    }
    x <- input$design_single_sbase #the statistical design from the single env UI
    
    # Can use character(0) to remove all choices
    #if (is.null(x)|| length(design)==0){
    if (is.null(x) || length(design)==0 ){
      
      x <- "Completely Randomized Design (CRD)"
      shinysky::showshinyalert(session, "alert_single_sbase_done", paste("This study does not have data."), styleclass = "danger")
      
    } else {
      
      if(design == "CRD")  {x <- "Completely Randomized Design (CRD)"}
      if(design == "RCBD") {x <- "Randomized Complete Block Design (RCBD)"}
      if(design == "ABD")  {x <-"Augmented Block Design (ABD)"}
      if(design == "Alpha")   {x <-"Alpha design"}
      #if(design == "CRD")  {choice_design<-"Factorial Two-Way Design in CRD (F2CRD)"}
      #if(design == "CRD")  {choice_design<-"Factorial Two-Way Design in RCBD (F2RCBD)"}
      
    }
    x <- x
    
    # Can also set the label and select items
    updateSelectInput(session, "design_single_sbase",
                      label = 'Select statistical design of your experiment',
                      choices = x,
                      #"Split Plot with Plots in CRD (SPCRD)",
                      #"Split Plot with Plots in RCBD (SPRCBD)"),
                      selected = x
    )
  })
  
  
  #select genotypes
  
  output$genotypes_single_sbase  <- renderUI({
    
    #req(input$connect_single_sbase)
    req(input$single_selProgram_sbase)
    req(input$single_sbase_trialName)
    
    selectInput('genotypes_single_sbase', 'Select Genotypes', c(Choose='', names(hot_fb_sbase()$fb)),
                selectize=TRUE)
    
  })
  
  #select repetition or blocks
  output$rep_single_sbase  <- renderUI({
    
    fb <- hot_fb_sbase()
    fb <- fb$fb 
    # selectInput('rep_single_sbase', 'Select Replications', c(Choose='', names(hot_fb_sbase()$fb)),
    #             selectize=TRUE)
    label_string <- 'Select Replications or Blocks'
    if(input$design_single_sbase=="Alpha design"){label_string <- "Select Replications"}
    
    
    #selectInput('rep_single_sbase', 'Select Replications or Blocks', c(Choose='', names(fb)),
    selectInput('rep_single_sbase', label = label_string , c(Choose='', names(fb)),
                selectize=TRUE)
  })
  
  #select triats
  output$trait_single_sbase <- renderUI({
    # selectInput('trait_single_sbase', 'Select Trait(s)', c(Choose='', names(hot_fb_sbase()$fb)),
    #             selectize=TRUE, multiple = TRUE)
    fb <- hot_fb_sbase()
    fb <- fb$fb 
    selectInput('trait_single_sbase', 'Select Trait(s)', c(Choose='', names(fb)),
                selectize=TRUE, multiple = TRUE)
    
  })
  
  #select factors
  output$factor_single_sbase  <- renderUI({
    selectInput('factor_single_sbase', 'Select Factor', c(Choose='', names(hot_fb_sbase()$fb)),
                selectize=TRUE)
  })
  
  #select block
  output$block_single_sbase  <- renderUI({
    selectInput('block_single_sbase', 'Select Block', c(Choose='', names(hot_fb_sbase()$fb)),
                selectize=TRUE)
  })
  
  #block size
  output$k_single_sbase  <- renderUI({
    shiny::numericInput('k_single_sbase', 'Select Block Size',   value =2, min=2, max = 100)
  })
  
  
  output$file_message_single_sbase <- renderInfoBox({
    
    sbase_data <- values$hot_bdata
    sbase_data <- sbase_data$fb
    
    sbase_data <- sbase_data["trial_table"]
    print(sbase_data)
    #shiny::withProgress(message = "Checking connection to SweetPotatoBase",value= 0,{

    #  incProgress(2/5, detail = paste("Validating..."))
    
    if(!is.null(sbase_data)){
      infoBox(title="Select fieldbook file", subtitle=
                paste("Now you are NOT connected to SweetPotatoBase. Check whether the database is under maintenance"), icon = icon("plug"),
              color = "yellow", fill = TRUE, width = NULL)
      #
    } else {
      hot_file <- sbase_data
      #hot_file <- paste(hot_file, collapse = ", ")
      infoBox(title="GREAT!", subtitle =
                paste("Now you are connected to SweetPotatoBase using BrAPI"),  icon = icon("ok", lib = "glyphicon"),
              color = "green",fill = TRUE, width = NULL)
    }
      #incProgress(5/5, detail = paste("Validating"))
    
    #})
    
  })
  
  
  output$downloadSbase_single_report <- downloadHandler(
    # filename = function() {
    #   paste("report", Sys.Date(), 'docx', sep='.')
    # },
    filename =  paste0("report", "_", as.character(Sys.time(), "%Y%m%d%H%M%S"), '.docx'),
    content = function(con) {
    #content = function(file) {  
      
      shiny::withProgress(message = "Opening single Report...",value= 0,{
        
        incProgress(1/5, detail = paste("Downloading Analysis..."))  
        
        fieldbook <- hot_fb_sbase()
        fieldbook <- as.data.frame(fieldbook$fb)
        
        
        trait <- input$trait_single_sbase
        rep <- input$rep_single_sbase
        genotypes <- input$genotypes_single_sbase
        block <- input$block_single_sbase
        k <- input$k_single_sbase
        factor_single <- input$factor_single_sbase
        
        
        format <- paste(input$format_single_sbase, sep="")
        design <- input$design_single_sbase
        
        
        incProgress(2/5, detail = paste("Downloading Analysis..."))
        
        if(design == "Randomized Complete Block Design (RCBD)"){
          
          
          servName =   "rcbd"
          serverFileDir <-"https://research.cip.cgiar.org/gtdms/hidap/hidap_sbase_reports/files/"
          serverService <-"https://research.cip.cgiar.org/gtdms/hidap/hidap_sbase_reports/getFileUpload.php"
          
          uploadDate  <- as.character(Sys.time(), "%Y%m%d%H%M%S")
          ranStr <-  stri_rand_strings(1, 15,  '[a-zA-Z0-9]')
          servName <- paste(uploadDate, ranStr, servName , sep= "-") #nombre sin extensions!!!!
          
          #dirfiles <- system.file(package = "pepa")
          
          dirName <- fbglobal::get_base_dir()
          path <- paste0(dirName, servName, ".docx")
          
          print(path)
          
          try(pepa::repo.rcbd(traits = trait, geno = genotypes, rep = rep, format = format, dfr=fieldbook,
                              server =TRUE, server_dir_name = dirName, 
                              server_file_name = servName))
          #path<- "~/R/x86_64-pc-linux-gnu-library/3.4/pepa/rmd/rcbd.docx" #rsconnect cip
 
          params <- list(
            dataRequest = "uploadFile",
            fileServerName = paste0(servName, ".docx"),
            filedata=upload_file(path, "text/csv")
          )
          
          var <- POST(serverService, body=params)
          code <- content(var, "text")
          
          
          
          if (code == "200")
            print("uploaded")
          else
            print("Not uploaded")
          
          
        }
    
      
        
        
        if(design == "Completely Randomized Design (CRD)"){
         
          
          #servName =   "crd.docx"
          servName =   "crd"
          serverFileDir <-"https://research.cip.cgiar.org/gtdms/hidap/hidap_sbase_reports/files/"
          serverService <-"https://research.cip.cgiar.org/gtdms/hidap/hidap_sbase_reports/getFileUpload.php"
          
          uploadDate  <- as.character(Sys.time(), "%Y%m%d%H%M%S")
          ranStr <-  stri_rand_strings(1, 15,  '[a-zA-Z0-9]')
          servName <- paste(uploadDate, ranStr, servName , sep= "-") #nombre sin extensions!!!!
          
          #dirfiles <- system.file(package = "pepa")
        
          dirName <- fbglobal::get_base_dir()
          path <- paste0(dirName, servName, ".docx")
          
          print(path)
          
          try(pepa::repo.crd(traits = trait, trt = genotypes, format = format, 
                             dfr = fieldbook, server =TRUE, server_dir_name = dirName, 
                             server_file_name = servName
                             ))
          
          params <- list(
            dataRequest = "uploadFile",
            fileServerName = paste0(servName, ".docx"),
            filedata=upload_file(path, "text/csv")
          )
          
          var <- POST(serverService, body=params)
          code <- content(var, "text")
          
          

          if (code == "200")
            print("uploaded")
          else
            print("Not uploaded")
  
        }
        
        
        if(design == "Augmented Block Design (ABD)"){
          
          
          servName =   "abd"
          serverFileDir <-"https://research.cip.cgiar.org/gtdms/hidap/hidap_sbase_reports/files/"
          serverService <-"https://research.cip.cgiar.org/gtdms/hidap/hidap_sbase_reports/getFileUpload.php"
          
          uploadDate  <- as.character(Sys.time(), "%Y%m%d%H%M%S")
          ranStr <-  stri_rand_strings(1, 15,  '[a-zA-Z0-9]')
          servName <- paste(uploadDate, ranStr, servName , sep= "-") #nombre sin extensions!!!!
          
          #dirfiles <- system.file(package = "pepa")
          
          dirName <- fbglobal::get_base_dir()
          path <- paste0(dirName, servName, ".docx")
          
          print(path)
          
          
          
          try(pepa::repo.abd(traits = trait, geno = genotypes, rep = rep, format = format, dfr = fieldbook, server =TRUE, server_dir_name = dirName, 
                             server_file_name = servName))
          
          
          params <- list(
            dataRequest = "uploadFile",
            fileServerName = paste0(servName, ".docx"),
            filedata=upload_file(path, "text/csv")
          )
          
          var <- POST(serverService, body=params)
          code <- content(var, "text")
          
          
          
          if (code == "200")
            print("uploaded")
          else
            print("Not uploaded")
          
          
          #try(pepa::repo.abd(traits = trait, geno = genotypes, rep = rep, format = format, data = fieldbook))
          #path <- "/usr/local/lib/R/site-library/pepa/rmd/abd.docx" # # former shiny server CIP-RIU
          #path<- "~/R/x86_64-pc-linux-gnu-library/3.4/pepa/rmd/abd.docx" #rsconnect cip
          #tempReport <- file.path(tempdir(), "abd.docx") 
          #file.copy("/usr/local/lib/R/site-library/pepa/rmd/abd.docx", con)
          
          
          
        }
        # 
        # 
        if(design == "Alpha design"){
          
          
          servName =   "a01d"
          serverFileDir <-"https://research.cip.cgiar.org/gtdms/hidap/hidap_sbase_reports/files/"
          serverService <-"https://research.cip.cgiar.org/gtdms/hidap/hidap_sbase_reports/getFileUpload.php"
          
          uploadDate  <- as.character(Sys.time(), "%Y%m%d%H%M%S")
          ranStr <-  stri_rand_strings(1, 15,  '[a-zA-Z0-9]')
          servName <- paste(uploadDate, ranStr, servName , sep= "-") #nombre sin extensions!!!!
          
          #dirfiles <- system.file(package = "pepa")
          
          dirName <- fbglobal::get_base_dir()
          path <- paste0(dirName, servName, ".docx")
          
          print(path)
          
          
          
          
          #try(pepa::repo.abd(traits = trait, geno = genotypes, format = format, data = fieldbook))
          try(pepa::repo.a01d(traits = trait, geno = genotypes, rep = rep, block = block, k = k, dfr = fieldbook, format = format, server =TRUE, server_dir_name = dirName, 
                              server_file_name = servName))
          
          #path<- "~/R/x86_64-pc-linux-gnu-library/3.4/pepa/rmd/a01d.docx"
          #tempReport <- file.path(tempdir(), "a01d.docx")
          #path <- "/usr/local/lib/R/site-library/pepa/rmd/a01d.docx"
          #file.copy("/usr/local/lib/R/site-library/pepa/rmd/a01d.docx", con)
          
          params <- list(
            dataRequest = "uploadFile",
            fileServerName = paste0(servName, ".docx"),
            filedata=upload_file(path, "text/csv")
          )
          
          var <- POST(serverService, body=params)
          code <- content(var, "text")
          
          
          
          if (code == "200")
            print("uploaded")
          else
            print("Not uploaded")
          
          
        }
        # 
        # 
        # if(design == "Split Plot with Plots in CRD (SPCRD)"){
        #   title <- paste("Automatic report for ", design, sep= "")
        #   try(pepa::repo.2f(traits = trait, A = genotypes, B = factor_single, rep = rep, design = "crd",  title= title, data = fieldbook, format = format))
        #   path <- "/usr/local/lib/R/site-library/pepa/rmd/2fcrd.docx"
        #   #file.copy("/usr/local/lib/R/site-library/pepa/rmd/2fcrd.docx", con)
        # }
        # 
        # 
        # if(design == "Factorial Two-Way Design in CRD (F2CRD)"){
        #   title <- paste("Automatic report for ", design, sep= "")
        #   try(pepa::repo.2f(traits = trait, A = genotypes, B = factor_single, rep = rep, design = "crd",  title= title, data = fieldbook, format = format))
        #   path <- "/usr/local/lib/R/site-library/pepa/rmd/2fcrd.docx"
        #   #file.copy("/usr/local/lib/R/site-library/pepa/rmd/2fcrd.docx", con)
        # }
        # 
        # 
        # if(design == "Split Plot with Plots in RCBD (SPRCBD)"){
        #   title <- paste("Automatic report for ", design, sep= "")
        #   try(pepa::repo.2f(traits = trait, A = genotypes, B = factor_single, rep = rep, design = "rcbd", title= title, data = fieldbook, format = format))
        #   path <- "/usr/local/lib/R/site-library/pepa/rmd/2frcbd.docx"
        #   #file.copy("/usr/local/lib/R/site-library/pepa/rmd/2frcbd.docx", con)
        # }
        # 
        # 
        # if(design == "Factorial Two-Way Design in RCBD (F2RCBD)"){
        #   
        #   title <- paste("Automatic report for ", design, sep= "")
        #   try(pepa::repo.2f(traits = trait, A = genotypes, B = factor_single, rep = rep, design = "rcbd", title= title, data = fieldbook, format = format))
        #   path <- "/usr/local/lib/R/site-library/pepa/rmd/2frcbd.docx"
        #   #file.copy("/usr/local/lib/R/site-library/pepa/rmd/2frcbd.docx", con)
        # }
        # 

        
        Sys.chmod(path, mode = "0777", use_umask = TRUE)
        
        #print(paste0(serverFileDir, servName, ".docx"))
        print(servName)
        # file.copy(paste0(serverFileDir, servName) , con, overwrite = TRUE)
        download.file(paste0(serverFileDir, servName, ".docx"), con, method = "curl")

        incProgress(4/5, detail = paste("Formattting in ", "MS Word",sep= ""))
        incProgress(5/5, detail = paste("Downloading Analysis..."))
        
      })
      
    }
  )
  
  
  
  
  
  # shiny::observeEvent(input$single_button_sbase, {
  #   shiny::withProgress(message = "Opening single Report...",value= 0,{ #begin progress bar
  #     
  #     #NOTE: To use pepa report package we need R 3.3.0 or more.
  #     #NOTE Finally, we always need pandoc installer.
  #     incProgress(3/5, detail = paste("Analyzing..."))
  #     
  #     design <- input$design_single_sbase
  #     
  #     incProgress(2/5, detail = paste("Processing..."))
  #     #fieldbook <- as.data.frame(hot_bdata()$trial_table)
  #     
  #     #fieldbook <-  as.data.frame(hot_fb_sbase())
  #     
  #     fieldbook <- hot_fb_sbase()
  #     fieldbook <- as.data.frame(fieldbook$fb)
  #     
  #     #saveRDS(fieldbook,"res.rds")
  #     trait <- input$trait_single_sbase
  #     rep <- input$rep_single_sbase
  #     genotypes <- input$genotypes_single_sbase
  #     block <- input$block_single_sbase
  #     k <- input$k_single_sbase
  #     factor_single <- input$factor_single_sbase
  #     
  #     incProgress(3/5, detail = paste("Passing parameters..."))
  #     
  #     #format <- paste(input$format_single,"_document",sep="")
  #     format <- paste(input$format_single_sbase)
  #     
  #     print(trait)
  #     print(design)
  #     
  #     
  #     
  #     incProgress(4/5, detail = paste("Formatting in ", format, sep=""))
  #     
  #     if(design == "Randomized Complete Block Design (RCBD)"){
  #       try(pepa::repo.rcbd(traits = trait, geno = genotypes, rep = rep, format = format, data = fieldbook))
  #     }
  #     
  #     if(design == "Completely Randomized Design (CRD)"){
  #       try(pepa::repo.crd(traits = trait, geno = genotypes, format = format, data = fieldbook))
  #       #try(pepa::repo.crd(traits = trait, geno = genotypes, rep = rep, format = format, data = fieldbook))
  #     }
  #     
  #     # if(design == "Augmented Block Design (ABD)"){
  #     #   #try(pepa::repo.abd(traits = trait, geno = genotypes, format = format, data = fieldbook))
  #     #   try(pepa::repo.abd(traits = trait, geno = genotypes, rep = rep, format = format, data = fieldbook))
  #     # }
  #     # 
  #     # if(design == "Alpha Design(0,1) (AD)"){
  #     #   #try(pepa::repo.abd(traits = trait, geno = genotypes, format = format, data = fieldbook))
  #     #   try(pepa::repo.a01d(traits = trait, geno = genotypes, rep = rep, block = block, k = k, data = fieldbook, format = format))
  #     # }
  #     # 
  #     # if(design == "Split Plot with Plots in CRD (SPCRD)"){
  #     #   
  #     #   title <- paste("Automatic report for ", design, sep= "")
  #     #   try(pepa::repo.2f(traits = trait, A = genotypes, B = factor_single, rep = rep, design = "crd",  title= title, data = fieldbook, format = format))
  #     # }
  #     # 
  #     # if(design == "Factorial Two-Way Design in CRD (F2CRD)"){
  #     #   
  #     #   title <- paste("Automatic report for ", design, sep= "")
  #     #   try(pepa::repo.2f(traits = trait, A = genotypes, B = factor_single, rep = rep, design = "crd",  title= title, data = fieldbook, format = format))
  #     # }
  #     # 
  #     # if(design == "Split Plot with Plots in RCBD (SPRCBD)"){
  #     #   
  #     #   title <- paste("Automatic report for ", design, sep= "")
  #     #   try(pepa::repo.2f(traits = trait, A = genotypes, B = factor_single, rep = rep, design = "rcbd", title= title, data = fieldbook, format = format))
  #     # }
  #     # 
  #     # if(design == "Factorial Two-Way Design in RCBD (F2RCBD)"){
  #     #   title <- paste("Automatic report for ", design, sep= "")
  #     #   try(pepa::repo.2f(traits = trait, A = genotypes, B = factor_single, rep = rep, design = "rcbd", title= title, data = fieldbook, format = format))
  #     # }
  #     
  #     incProgress(5/5, detail = paste("Formatting in ", format, sep="")) #end progress bar
  #     
  #     
  #   })
  # })
  # 
  # 
  
  
}