R/server_elston.R

In CIP-RIU/fbanalysis: Statistical Analysis for Breeding Data in HiDAP

#' Server Elston Analysis
#' 
#' @param input elston shiny server input 
#' @param output elston shiny server output
#' @param session elston shiny server session
#' @param values elston 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
#' @export
#' 

elston_server <- function(input, output, session, values){
  
  
  volumes <- shinyFiles::getVolumes()
  shinyFiles::shinyFileChoose(input, 'file_elston', roots=volumes, session=session,
                              restrictions=system.file(package='base'),filetypes=c('xlsx'))
   
  
  hot_path <- reactive ({

    if(length(input$file_elston)==0){return (NULL)}
    if(length(input$file_elston)>0){
      hot_file <- as.character(parseFilePaths(volumes, input$file_elston)$datapath)
    }
  })
  
  elston_bdata <- reactive({
    hot_file <- hot_path()
    if(length(hot_file)==0){return (NULL)}
    if(length(hot_file)>0){
      
      cropfiles_list <- hot_file 
      
      n <- length(hot_file)
      combine <- list() 
      
      ENVIRONMENT <- vector(mode = "character", length = n )
      
      for(i in 1:n){  
        combine[[i]] <- readxl::read_excel(cropfiles_list[i], sheet = "Fieldbook") 
        
        Minimal <- readxl::read_excel(cropfiles_list[i], sheet = "Minimal") 
        
        #BOOK <- traittools::get_fb_param(Minimal,"Short_name")
        BOOK <- traittools::get_fb_param(Minimal,"Trial_name")
        DATE <- traittools::get_fb_param(Minimal,"Begin_date")
        #MONTH <- traittools::get_fb_param()
        #ENVIRONMENT <- traittools::get_fb_param(Minimal,"Site_short_name")
        
        ENVIRONMENT <- paste(traittools::get_fb_param(Minimal,"Site_short_name"), "_env_", i, sep = "")
        #BOOK <- getfilename_book(ammiafiles_list[i])
        #YEAR <- getdate_file(BOOK)$year
        #MONTH <- getdate_file(BOOK)$month
        #LOCATION <- getlocation_file(BOOK)
        
        #combine[[i]] <- cbind(BOOK,YEAR,MONTH,LOCATION,combine[[i]])
        combine[[i]] <- cbind(BOOK, DATE, ENVIRONMENT, combine[[i]])
      } 
      
      join_books <- data.table::rbindlist(combine,fill = TRUE)
      join_books <- as.data.frame(join_books)
      #write.csv(join_books,"join_books.csv")
      # join_books    
      
      #elston_bdata <- readxl::read_excel(path=hot_file , sheet = "Fieldbook")
      elston_bdata <- join_books
    }
  })
  
  output$genotypes_elston  <- renderUI({
    selectInput('genotypes_elston', 'Select Genotypes', c(Choose='', select_options(elston_bdata())), 
                selectize=TRUE)
  })
  
  output$env_elston  <- renderUI({
    selectInput('env_elston', 'Select Environments', c(Choose='', select_options(elston_bdata())),
                selectize=TRUE)
  })
  
  output$rep_elston  <- renderUI({
    selectInput('rep_elston', 'Select Replications', c(Choose='', select_options(elston_bdata())),
                selectize=TRUE)
  })
  
  output$trait_posElston <- renderUI({
    selectInput('trait_pos_elston', 'Select Positive Trait(s)', c(Choose='', select_options(elston_bdata())),
                selectize=TRUE, multiple = TRUE)
  })
  
  output$trait_negElston <- renderUI({
    selectInput('trait_neg_elston', 'Select Negative Trait(s)', c(Choose='', select_options(elston_bdata())),
                selectize=TRUE, multiple = TRUE)
  })
  
  ###
  # hot_check_elston_fb <- reactive({
  # 
  # req(input$trait_single)
  # req(input$rep_single)
  # req(input$genotypes_single)
  # 
  # })
  
  ### 
  # output$model_elston <- renderUI({
  #   selectInput('model_elston', 'Select Model', c('gxe (interaction)'='gxe', 
  #                                                          "g+e (no-interaction)"='g+e'),
  #               selectize=TRUE, multiple = FALSE)
  # })
  # 

  output$file_message_elston <- renderInfoBox({

    hot_file <- hot_path()
    print(hot_file)
    if(is.null(hot_file)){
      infoBox(title="Select File", subtitle=
                paste("Choose your Fieldbook(s) File"), icon = icon("upload", lib = "glyphicon"),
              color = "blue",fill = TRUE, width = NULL)
     } else {
      hot_file <- basename(hot_file)
      
      infoBox(title="GREAT!", subtitle =
                paste("Fieldbook(s) Selected: ", hot_file),  icon = icon("ok", lib = "glyphicon"),
              color = "green",fill = TRUE, width = NULL)
    }
  })
 
  shiny::observeEvent(input$elston_button, {
    shiny::withProgress(message = "Opening Elston  Index Report...",value= 0,{
  
      fieldbook <- as.data.frame(elston_bdata())
      
      trait_pos <- input$trait_pos_elston
      #print(trait_pos)
      trait_neg <- input$trait_neg_elston
      #print(trait_neg)
      trait <- c(trait_pos,trait_neg)
      trait <- trait[trait!=""]
      #trait <- input$trait_elston
      env <- input$env_elston
      rep <- input$rep_elston

      genotypes <- input$genotypes_elston
      model <- gsub(pattern = "[[:space:]]\\(.*", replacement = "", input$model_elston)
 
      means <- input$means_elston
      model <- input$model_elston
#     print(input$means_elston)
#     print(input$model_elston)
#       
      if(length(trait_neg)>0){
        fieldbook[,trait_neg] <- -fieldbook[,trait_neg]
      }
      
      
      #format <- paste(input$format_elston,"_document",sep="")
      format <- paste(input$format_elston, sep="")
      
      try(pepa::pty.elston(traits = trait, geno = genotypes, env= env, rep = rep, means = means,
                           data = fieldbook, format = format))
      
      if(env!="" && means=="fitted"){
        #env <- NULL
        try(pepa::pty.elston(traits = trait, geno = genotypes, env = env,  means = means, data = fieldbook, format = format))
      }
      
      if(env=="" && means=="single"){
        # If means = "single" and env is not specified, then single arithmetic means are computed over all 
        # the observations for each genotype.
        
        #env <- NULL
        try(pepa::pty.elston(traits = trait, geno = genotypes, env = NULL,  means = means, data = fieldbook, format = format))
      }
      
      if(env!="" && means=="single"){
        
        # If means = "single" and env is specified, then single arithmetic means are computed 
        # over the replications for each genotype at each environment and then for each genotype over environments.
        
        try(pepa::pty.elston(traits = trait, geno = genotypes, env = env, means = means, data = fieldbook, format = format))
      } 
      
#       if(env=="" && model=="g+e" && means=="single"){
#         try(pepa::pty.elston(traits = trait, geno = genotypes, model = model, means = means, data = fieldbook))
#       } 
      
      
      
      
    })
  })
  
}