RFate: FATE with R

####################################################################

output$UI.species.selected = renderUI({
  if (input$choice.dominant == "from file")
  {
    fileInput(inputId = "species.selected"
              , label = NULL
              , buttonLabel = param.style("species.selected")
              , multiple = FALSE
              , width = "100%")
  }
})

output$UI.opt.weights = renderUI({
  if (input$doRuleWeights)
  {
    tagList(
      sliderInput(inputId = "opt.weights"
                  , label = param.style("opt.weights [traits <---> overlap]")
                  , min = 0
                  , max = 1
                  , value = 0.5
                  , step = 0.05
                  , width = "100%")
    )
  }
})

####################################################################

get_traits = eventReactive(list(input$species.traits, input$compute.distance), {
  if (!is.null(input$species.traits) && is.data.frame(input$species.traits))
  {
    if (extension(input$species.traits$name) %in% c(".txt", ".csv"))
    {
      sp.traits = fread(input$species.traits$datapath)
      sp.traits = as.data.frame(sp.traits, stringsAsFactors = FALSE)
      
      if (length(which(colnames(sp.traits) == "species")) == 1)
      {
        shinyjs::show("table.traits.sp")
        output$table.traits.sp = renderDataTable({
          sp.traits
        })
        return(sp.traits)
      } else
      {
        shinyalert(type = "warning", text = "The species.traits must contain a column named 'species' !")
        return(NULL)
      }
    } else
    {
      shinyalert(type = "warning", text = "You must provide a text file for the species.traits !")
    }
  } else
  {
    shinyalert(type = "warning", text = "You must provide a text file for the species.traits !")
  }
})

get_dom_param = eventReactive(list(input$doRuleA
                                   , input$rule.A1
                                   , input$rule.A2_quantile
                                   , input$doRuleB
                                   , input$rule.B1_number
                                   , input$rule.B1_percentage
                                   , input$rule.B2
                                   , input$doRuleC
), {
  end_filename = end_filenameA = end_filenameB = end_filenameC = ""
  if (input$doRuleA) {
    end_filenameA = paste0("_A_", input$rule.A1
                           , "_", input$rule.A2_quantile)
  }
  if (input$doRuleB) {
    end_filenameB = paste0("_B_", input$rule.B1_number
                           , "_", input$rule.B1_percentage
                           , "_", input$rule.B2)
  }
  if (input$doRuleC) {
    end_filenameC = paste0("_C_", input$rule.A1
                           , "_", input$rule.A2_quantile)
  }
  end_filename = paste0(end_filenameA, end_filenameB, end_filenameC)
  return(end_filename)
})

get_dom = eventReactive(list(input$choice.dominant, input$compute.distance), {
  end_filename = ""
  if (input$choice.dominant == "from file")
  {
    if (!is.null(input$species.selected) && is.data.frame(input$species.selected))
    {
      if (extension(input$species.selected$name) %in% c(".txt", ".csv"))
      {
        end_filename = input$species.selected$datapath
      } else
      {
        shinyalert(type = "warning", text = "You must provide a text file (.txt or .csv) for the species.selected !")
      }
    } else
    {
      shinyalert(type = "warning", text = "You must provide a text file (.txt or .csv) for the species.selected !")
    }
  } else
  {
    end_filename = paste0("PRE_FATE_DOMINANT_TABLE_species"
                          , get_dom_param()
                          , ".csv")
  }
  if (file.exists(end_filename))
  {
    sp.select = fread(end_filename)
	
    if (ncol(sp.select) > 1)
    {
      warning(paste0("The file ", input$species.selected$name, " contains ", ncol(sp.select)
                     , " columns. Only the first, which should contain dominant species, will be used."))
    }
    
    sp.dom = as.data.frame(sp.select, stringsAsFactors = FALSE)[, 1]
    return(sp.dom)
  } else
  {
    shinyalert(type = "warning", text = "You must run the selection of dominant species or provide a text file (.txt or .csv) for species.selected !")
    return(NULL)
  }
})

####################################################################

observeEvent(input$compute.distance, {
  RV$pfg.graph <- c(RV$pfg.graph, "dist")
})

get_DIST = eventReactive(input$compute.distance, {
  ## GET species traits
  sp.traits = get_traits()
  if (!is.null(sp.traits) && length(grep("shinyalert", sp.traits)) == 0)
  {
    ## GET selected dominant species
    sp.dom = get_dom()
    if (!is.null(sp.dom) && length(grep("shinyalert", sp.dom)) == 0)
    {
      if (length(which(sp.traits$species %in% sp.dom)) > 0)
      {
        sp.traits = sp.traits[which(sp.traits$species %in% sp.dom), ]
        
        ## GET species niche distance
        if (!is.null(input$species.niche.distance) && is.data.frame(input$species.niche.distance))
        {
          if (extension(input$species.niche.distance$name) %in% c(".txt", ".csv"))
          {
            sp.niche = fread(input$species.niche.distance$datapath, header = TRUE)
			      sp.niche = as.data.frame(sp.niche, stringsAsFactors = FALSE)
			      rownames(sp.niche) = sp.niche[, 1]
			      sp.niche = sp.niche[, -1]
			      sp.niche = as.matrix(sp.niche)
          } else if (extension(input$species.niche.distance$name) == ".RData")
          {
            sp.niche = get(load(input$species.niche.distance$datapath))
          } else
          {
            shinyalert(type = "warning", text = "You must provide a text or a RData file for the species.niche.distance !")
          }
          if (unique(diag(sp.niche)) == 0)
          {
            sp.niche = 1 - sp.niche
            showNotification("species.niche.distance has been transformed into similarity matrix !", type = "warning")
          }
          
          if (length(which(colnames(sp.niche) %in% sp.dom)) > 0)
          {
            opt.weights = NULL
            if (!is.null(input$doRuleWeights)){
              opt.weights = c(as.numeric(input$opt.weights), 1 - as.numeric(input$opt.weights))
            }
            
            showModal(modalDialog(HTML(paste0("Compute distances between species based on traits and niche overlap, with parameters : <ul>"
                                              , ifelse(input$doRuleWeights
                                                       , paste0("<li><strong>opt.weights :</strong> "
                                                                , as.numeric(input$opt.weights), " (traits) / "
                                                                ,  1 - as.numeric(input$opt.weights), " (overlap) </li>")
                                                       , "")
                                              , "<li><strong>opt.maxPercent.NA :</strong> ", as.numeric(input$opt.maxPercent.NA), "</li>"
                                              , "<li><strong>opt.maxPercent.similarSpecies :</strong> ", as.numeric(input$opt.maxPercent.similarSpecies), "</li>"
                                              , "<li><strong>opt.min.sd :</strong> ", as.numeric(input$opt.min.sd), "</li>"
                                              , "</ul>"))
                                  , title = "Distance matrix between selected species"
                                  , footer = NULL))
            Sys.sleep(3)
            get_res = print_messages(as.expression(
                PRE_FATE.speciesDistance(mat.traits = sp.traits
                                         , mat.overlap.option = "dist"
                                         , mat.overlap.object = sp.niche
                                         , opt.weights = opt.weights
                                         , opt.maxPercent.NA = as.numeric(input$opt.maxPercent.NA)
                                         , opt.maxPercent.similarSpecies = as.numeric(input$opt.maxPercent.similarSpecies)
                                         , opt.min.sd = as.numeric(input$opt.min.sd)
                )
              ))
            removeModal()
            
            return(get_res)
          } else
          {
            shinyalert(type = "warning", text = "Species names between species.niche.distance and dominant species do not match !")
          }
        } else
        {
          shinyalert(type = "warning", text = "You must provide a text or a RData file for the species.niche.distance !")
        }
      } else
      {
        shinyalert(type = "warning", text = "Species names between species.traits and dominant species do not match !")
      }
    }
  }
})