server.R

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

  ##############################################
  ##  Hide/Show : level 1
  ##--------------------------------------------

  ## Fatalities
  output$hide_fatalities <- eventReactive({
    input$button_fatalities
  },{
    if(input$button_fatalities%%2 == 1) TRUE else FALSE
  }, ignoreInit = TRUE)

  outputOptions(output, "hide_fatalities", suspendWhenHidden = FALSE)


  ## Population Size
  output$hide_pop_size <- eventReactive({
    input$button_pop_size
  },{
    if(input$button_pop_size%%2 == 1) TRUE else FALSE
  }, ignoreInit = TRUE)

  outputOptions(output, "hide_pop_size", suspendWhenHidden = FALSE)


  ## Population Growth
  output$hide_pop_growth <- eventReactive({
    input$button_pop_growth
  },{
    if(input$button_pop_growth%%2 == 1) TRUE else FALSE
  }, ignoreInit = TRUE)

  outputOptions(output, "hide_pop_growth", suspendWhenHidden = FALSE)


  ## Carrying capacity
  output$hide_carrying_cap <- eventReactive({
    input$button_carrying_cap
  },{
    if(input$button_carrying_cap%%2 == 1) TRUE else FALSE
  }, ignoreInit = TRUE)

  outputOptions(output, "hide_carrying_cap", suspendWhenHidden = FALSE)

  # Display Carrying capacity Unit Info
  output$carrying_cap_unit_info <- renderText({
    if(input$pop_size_unit == "Npair"){
      paste0("Nombre de couple")
    } else {
      paste0("Effectif total")
    }
  })


  ## Outputs / Results
  output$hide_results <- eventReactive({
    input$run
  },{
    if(input$run > 0) TRUE else FALSE
  }, ignoreInit = TRUE)

  outputOptions(output, "hide_results", suspendWhenHidden = FALSE)



  ##############################################
  ##  Hide/Show : level 2
  ##--------------------------------------------
  observe({

    #------------
    # Hide all
    #------------
    shinyjs::hide("fatalities_mean")
    shinyjs::hide("fatalities_se")
    shinyjs::hide("fatalities_lower")
    shinyjs::hide("fatalities_upper")
    shinyjs::hide("fatalities_number_expert")
    shinyjs::hide("fatalities_mat_expert")
    shinyjs::hide("fatalities_run_expert")
    shinyjs::hide("farm_number_cumulated")
    shinyjs::hide("fatalities_mat_cumulated")
    shinyjs::hide("fatalities_vec_scenario")

    shinyjs::hide("pop_size_lower")
    shinyjs::hide("pop_size_upper")
    shinyjs::hide("pop_size_mean")
    shinyjs::hide("pop_size_se")
    shinyjs::hide("pop_size_number_expert")
    shinyjs::hide("pop_size_mat_expert")
    shinyjs::hide("pop_size_run_expert")

    shinyjs::hide("pop_growth_lower")
    shinyjs::hide("pop_growth_upper")
    shinyjs::hide("pop_growth_mean")
    shinyjs::hide("pop_growth_se")
    shinyjs::hide("pop_growth_number_expert")
    shinyjs::hide("pop_growth_mat_expert")
    shinyjs::hide("pop_growth_run_expert")
    shinyjs::hide("pop_trend")
    shinyjs::hide("pop_trend_strength")

    shinyjs::hide("carrying_capacity_lower")
    shinyjs::hide("carrying_capacity_upper")
    shinyjs::hide("carrying_capacity_mean")
    shinyjs::hide("carrying_capacity_se")
    shinyjs::hide("carrying_cap_number_expert")
    shinyjs::hide("carrying_cap_mat_expert")
    shinyjs::hide("carrying_cap_run_expert")

    shinyjs::hide("mat_fill_vr")
    shinyjs::hide("vr_mat_number_age_classes")

    shinyjs::hide("age_class_show")

    #------------
    # Show some
    #------------
    # Show inputs for fatalities part
    if(input$button_fatalities%%2 == 1){
      #shinyjs::show("fatal_constant")

      # Show inputs for single farm option (non-cumulated impacts)
      if(input$analysis_choice == "single_farm"){
        shinyjs::show("fatalities_input_type")

        if(input$fatalities_input_type == "itvl"){
          shinyjs::show("fatalities_lower")
          shinyjs::show("fatalities_upper")
        }
        if(input$fatalities_input_type == "val"){
          shinyjs::show("fatalities_mean")
          shinyjs::show("fatalities_se")
        }
        if(input$fatalities_input_type == "eli_exp"){
          shinyjs::show("fatalities_number_expert")
          shinyjs::show("fatalities_mat_expert")
          shinyjs::show("fatalities_run_expert")
        }
      }

      # Show inputs for cumulated impacts option
      if(input$analysis_choice == "cumulated"){
        shinyjs::hide("fatalities_input_type")
        shinyjs::show("farm_number_cumulated")
        shinyjs::show("fatalities_mat_cumulated")
      }

      # Show inputs for multiple scenario
      if(input$analysis_choice == "multi_scenario"){
        shinyjs::hide("fatalities_input_type")
        shinyjs::show("fatalities_vec_scenario")
      }

    }

    # Show inputs for population size part
    if(input$button_pop_size%%2 == 1){
      shinyjs::show("pop_size_input_type")
      if(input$pop_size_input_type == "itvl"){
        shinyjs::show("pop_size_lower")
        shinyjs::show("pop_size_upper")
      }
      if(input$pop_size_input_type == "val"){
        shinyjs::show("pop_size_mean")
        shinyjs::show("pop_size_se")
      }
      if(input$pop_size_input_type == "eli_exp"){
        shinyjs::show("pop_size_number_expert")
        shinyjs::show("pop_size_mat_expert")
        shinyjs::show("pop_size_run_expert")
      }
    }

    # Show inputs for population trend/growth part
    if(input$button_pop_growth%%2 == 1){
      shinyjs::show("pop_growth_input_type")

      if(input$pop_growth_input_type == "itvl"){
        shinyjs::show("pop_growth_lower")
        shinyjs::show("pop_growth_upper")
      }
      if(input$pop_growth_input_type == "val"){
        shinyjs::show("pop_growth_mean")
        shinyjs::show("pop_growth_se")
      }
      if(input$pop_growth_input_type == "eli_exp"){
        shinyjs::show("pop_growth_number_expert")
        shinyjs::show("pop_growth_mat_expert")
        shinyjs::show("pop_growth_run_expert")
      }
      if(input$pop_growth_input_type == "trend"){
        shinyjs::show("pop_trend")
        if(input$pop_trend != "stable"){
          shinyjs::show("pop_trend_strength")
        }
      }
    }

    # Show inputs for carrying capacity part
    if(input$button_carrying_cap%%2 == 1){
      shinyjs::show("carrying_cap_input_type")
      if(input$carrying_cap_input_type == "itvl"){
        shinyjs::show("carrying_capacity_lower")
        shinyjs::show("carrying_capacity_upper")
      }
      if(input$carrying_cap_input_type == "val"){
        shinyjs::show("carrying_capacity_mean")
        shinyjs::show("carrying_capacity_se")
      }
      if(input$carrying_cap_input_type == "eli_exp"){
        shinyjs::show("carrying_cap_number_expert")
        shinyjs::show("carrying_cap_mat_expert")
        shinyjs::show("carrying_cap_run_expert")
      }
    }

    # Show inputs vital rates part
    if(input$button_vital_rates%%2 == 1){
      shinyjs::show("mat_fill_vr")
      shinyjs::show("vr_mat_number_age_classes")
    }


    # Show radiobutton (output) for plot_traj graph
    if(input$run > 0){
      shinyjs::show("age_class_show")
    }

  }) # en observe show/hide
  ###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###


  #####

  ##############################################
  ##  Reactive values
  ##--------------------------------------------
  out <- reactiveValues(run = NULL, run_time = NULL, msg = NULL, analysis_choice = NULL)

  rv <- reactiveValues(distAVG = NULL, dist = NULL)

  ready <- reactiveValues(fatalities = TRUE, pop_size = TRUE, pop_growth = TRUE, carrying_capacity = TRUE)

  param <- reactiveValues(N1 = NULL,
                          nsim = NULL,
                          cumulated_impacts = FALSE,

                          fatalities_mean = NULL,
                          fatalities_mean_nb = NULL,
                          fatalities_se = NULL,
                          fatalities_se_nb = NULL,
                          onset_time = NULL,
                          onset_year = NULL,
                          out_fatal = NULL,

                          pop_size_mean = NULL,
                          pop_size_se = NULL,
                          pop_size_unit = NULL,

                          pop_growth_mean = NULL,
                          pop_growth_mean_use = NULL,
                          pop_growth_se = NULL,

                          fecundities = NULL,
                          survivals = NULL,
                          s_calib0 = NULL,
                          f_calib0 = NULL,
                          s_calibrated = NULL,
                          f_calibrated = NULL,
                          vr_calibrated = NULL,

                          carrying_capacity_mean = NULL,
                          carrying_capacity_se = NULL,


                          theta = NULL,
                          rMAX_species = NULL,

                          model_demo = NULL,
                          time_horizon = NULL,
                          coeff_var_environ = NULL,
                          fatal_constant = NULL,

                          fatalities_eli_result = NULL,
                          pop_size_eli_result = NULL,
                          pop_growth_eli_result = NULL,
                          carrying_cap_eli_result = NULL
  )
  ###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###



  #####

  ##############################################
  ## Define some functions
  ##-------------------------------------------
  # Get lambda from +/-X% growth rate
  make_lambda <- function(pop_growth)  1 + (pop_growth/100)
  #####

  #####
  ##------------------------------------------
  ## Update elicitation matrices
  ##------------------------------------------

  ###############################
  ## Cumulated Impacts Matrix
  ##-----------------------------
  observeEvent({
    input$farm_number_cumulated
  }, {
    req(input$farm_number_cumulated > 0)
    current_mat <- input$fatalities_mat_cumulated
    n_farm <- input$farm_number_cumulated
    if(n_farm > nrow(current_mat)){
      fill_mat <- c(as.vector(t(current_mat)), rep(NA,(3*(n_farm-nrow(current_mat)))))
    }else{
      fill_mat <- as.vector(t(current_mat[1:n_farm,]))
    }
    updateMatrixInput(session, inputId = "fatalities_mat_cumulated",
                      value =  matrix(fill_mat, nrow = n_farm, ncol = 3, byrow = TRUE,
                                      dimnames = list(paste("Parc", c(1:n_farm)),
                                                      c("Moyenne",
                                                        "Erreur-type",
                                                        "Anne (dbut)"))))
  })
  #####

  ########################
  ## Fatalities Matrix
  ##----------------------
  observeEvent({
    input$fatalities_number_expert
  }, {
    req(input$fatalities_number_expert > 0)
    current_mat <- input$fatalities_mat_expert
    n_experts <- input$fatalities_number_expert
    if(n_experts > nrow(current_mat)){
      fill_mat <- c(as.vector(t(current_mat)), rep(NA,(5*(n_experts-nrow(current_mat)))))
    }else{
      fill_mat <- as.vector(t(current_mat[1:n_experts,]))
    }
    updateMatrixInput(session, inputId = "fatalities_mat_expert",
                      value = matrix(fill_mat, nrow = n_experts, ncol = 5, byrow = TRUE,
                                     dimnames = list(paste0("#", 1:n_experts),
                                                     c("Poids", "Min", "Best", "Max", "% IC" ))
                                     )
                      )
  })
  #####

  ########################
  ## Pop Size Matrix
  ##----------------------
  observeEvent({
    input$pop_size_number_expert
  }, {
    req(input$pop_size_number_expert > 0)
    current_mat <- input$pop_size_mat_expert
    n_experts <- input$pop_size_number_expert
    if(n_experts > nrow(current_mat)){
      fill_mat <- c(as.vector(t(current_mat)), rep(NA,(5*(n_experts-nrow(current_mat)))))
    }else{
      fill_mat <- as.vector(t(current_mat[1:n_experts,]))
    }
    updateMatrixInput(session, inputId = "pop_size_mat_expert",
                      value = matrix(fill_mat, nrow = n_experts, ncol = 5, byrow = TRUE,
                                     dimnames = list(paste0("#", 1:n_experts),
                                                     c("Poids", "Min", "Best", "Max", "% IC" ))
                      )
    )
  })
  #####

  ########################
  ## Pop Growth Matrix
  ##----------------------
  observeEvent({
    input$pop_growth_number_expert
  }, {
    req(input$pop_growth_number_expert > 0)
    current_mat <- input$pop_growth_mat_expert
    n_experts <- input$pop_growth_number_expert
    if(n_experts > nrow(current_mat)){
      fill_mat <- c(as.vector(t(current_mat)), rep(NA,(5*(n_experts-nrow(current_mat)))))
    }else{
      fill_mat <- as.vector(t(current_mat[1:n_experts,]))
    }
    updateMatrixInput(session, inputId = "pop_growth_mat_expert",
                      value = matrix(fill_mat, nrow = n_experts, ncol = 5, byrow = TRUE,
                                     dimnames = list(paste0("#", 1:n_experts),
                                                     c("Poids", "Min", "Best", "Max", "% IC" ))
                      )
    )
  })
  #####

  ############################
  ## Carrying Capacity Matrix
  ##--------------------------
  observeEvent({
    input$carrying_cap_number_expert
  }, {
    req(input$carrying_cap_number_expert > 0)
    current_mat <- input$carrying_cap_mat_expert
    n_experts <- input$carrying_cap_number_expert
    if(n_experts > nrow(current_mat)){
      fill_mat <- c(as.vector(t(current_mat)), rep(NA,(5*(n_experts-nrow(current_mat)))))
    }else{
      fill_mat <- as.vector(t(current_mat[1:n_experts,]))
    }
    updateMatrixInput(session, inputId = "carrying_cap_mat_expert",
                      value = matrix(fill_mat, nrow = n_experts, ncol = 5, byrow = TRUE,
                                     dimnames = list(paste0("#", 1:n_experts),
                                                     c("Poids", "Min", "Best", "Max", "% IC" ))
                      )
    )
  })
  #####



  #####
  ##--------------------------------------------
  ##  Run expert elicitation
  ##--------------------------------------------
  # Function to run the elication analysis
  func_eli <- function(mat_expert){
    t_mat_expert <- t(mat_expert)
    vals <- t_mat_expert[2:4,] %>% apply(., 2, sort)
    Cp <- t_mat_expert[5,] %>% sapply(., min, 0.99) %>% sapply(., max, 0.2)
    weights <- t_mat_expert[1,]

    out <- tryCatch(
      elicitation(vals, Cp, weights), error = function(e)
        return(NULL)
        #message("Erreur : certaines valeurs dans la matrice d'experts n'ont pas de sens")
      )

    if(!is.null(out)){
      OUT <- list(out = out, mean = out$mean_smooth, SE = sqrt(out$var_smooth))
    }else{
      OUT <- list(out = NA, mean = NA, SE = NA)
    }
    return(OUT)
  }

  # Function to plot the elication analysis output
  plot_expert <- function(out, show_se = TRUE, ...){
    plot_elicitation(out, ylab = "", xlab = "Valeur du paramtre", cex.lab = 1.2, yaxt = "n")
    mtext(text = "Densit de probabilit", side = 2, line = 2, cex = 1.2)

    y2 <- dgamma(x = out$mean_smooth, shape = out$shape_smooth, rate = out$rate_smooth)
    xx <- qgamma(p = c(0.01,0.99), shape = out$shape_smooth, rate = out$rate_smooth)
    clip(xx[1], xx[2], -100, y2)
    abline(v = out$mean_smooth, lwd = 3, col = "darkblue")

    mtext(text = paste("Moyenne = ", round(out$mean_smooth,2)), side = 3, line = 2.5, cex = 1.2, adj = 0)
    if(show_se) mtext(text = paste("Erreur-type = ", round(sqrt(out$var_smooth), 2)), side = 3, line = 1, cex = 1.2, adj = 0)
  }

  ########################
  ## Fatalities
  ##----------------------
  observeEvent({
    input$fatalities_run_expert
  }, {
    if( all(!is.na(input$fatalities_mat_expert)) ) {

      ## run elicitation analysis
      param$fatalities_eli_result <- func_eli(input$fatalities_mat_expert)

      ## plot distribution
      output$title_distri_plot <- renderText({ "Mortalits annuelles" })
      output$distri_plot <- renderPlot({ plot_expert(param$fatalities_eli_result$out) })

    } else {
      print("missing value")
    } # end if
  }) # end observeEvent

  ########################
  ## Population size
  ##----------------------
  observeEvent({
    input$pop_size_run_expert
  }, {
    if(all(!is.na(input$pop_size_mat_expert))) {

      ## run elicitation analysis
      param$pop_size_eli_result <- func_eli(input$pop_size_mat_expert)

      ## plot distribution
      output$title_distri_plot <- renderText({ "Taille de population" })
      output$distri_plot <- renderPlot({ plot_expert(param$pop_size_eli_result$out) })

    } else {
      print("missing value")
    } # end if
  }) # end observeEvent

  ########################
  ## Population growth
  ##----------------------
  observeEvent({
    input$pop_growth_run_expert
  },{
    if(all(!is.na(input$pop_growth_mat_expert))){

      lambda_mat_expert <- input$pop_growth_mat_expert
      lambda_mat_expert[,2:4] <- make_lambda(lambda_mat_expert[,2:4])

      ## run elicitation analysis
      param$pop_growth_eli_result <- func_eli(lambda_mat_expert)

      ## plot distribution
      output$title_distri_plot <- renderText({ "Taux de croissance de la population" })
      output$distri_plot <- renderPlot({ plot_expert(param$pop_growth_eli_result$out) })

    } else {
      print("missing value")
    } # end if
  }) # end observeEvent

  ########################
  ## Carrying capacity
  ##----------------------
  observeEvent({
    input$carrying_cap_run_expert
  },{
    if(all(!is.na(input$carrying_cap_mat_expert))) {

      ## run elicitation analysis
      param$carrying_cap_eli_result <- func_eli(input$carrying_cap_mat_expert)

      ## show output
      if(!is.na(param$carrying_cap_eli_result$out)){
        output$title_distri_plot <- renderText({ "Capacit de charge" })
        output$distri_plot <- renderPlot({ plot_expert(param$carrying_cap_eli_result$out, show_se = FALSE) })
      }else {
        output$title_distri_plot <- renderText({ "Erreur : certaines valeurs dans la matrice d'experts n'ont pas de sens" })
      }

    } else {
      param$carrying_cap_eli_result <- NULL
      print("missing value")
      output$title_distri_plot <- renderText({ "Des valeurs sont manquantes dans la table 'experts'" })
    } # end if
  }) # end observeEvent

  ###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###

  #####


  #####
  ##--------------------------------------------
  ##  Display parameter distribution
  ##--------------------------------------------

  # Function to plot a gamma distribution
  plot_gamma <- function(mu, se, show_mode = TRUE, show_mean = TRUE, show_se = TRUE, ...){

    ## Define shape and scale parameter of gamma distribution
    shape = (mu/se)^2
    scale = se^2/mu

    ## Plot the curve
    par(mar = c(5, 4, 6, 2))
    curve(dgamma(x, shape=shape, scale=scale), from = max(0,mu-3*se), to = mu+3*se, lwd = 3, col = "darkblue", yaxt = "n",
          ylab = "", xlab = "Valeur du paramtre", cex.lab = 1.2)
    mtext(text = "Densit de probabilit", side = 2, line = 2, cex = 1.2)

    # show mode
    MU <- (shape-1)*scale
    y_MU <- dgamma(x = MU, shape = shape, scale = scale)
    xx <- qgamma(p = c(0.01,0.99), shape = shape, scale = scale)
    clip(xx[1], xx[2], -100, y_MU)
    abline(v = MU, lwd = 3, col = "darkblue")

    # show mean
    y_mu <- dgamma(x = mu, shape = shape, scale = scale)
    clip(xx[1], xx[2], -100, y_mu)
    abline(v = mu, lwd = 2, col = "darkblue", lty = 2)

    if(show_mode) mtext(text = paste("Mode = ", round(MU, 2)), side = 3, line = 4, cex = 1.2, adj = 0)
    if(show_mean) mtext(text = paste("Moyenne = ", round(mu, 2)), side = 3, line = 2.5, cex = 1.2, adj = 0)
    if(show_se) mtext(text = paste("Erreur-type = ", round(se, 3)), side = 3, line = 1, cex = 1.2, adj = 0)
  } # end function plot_gamma

  plot_gamma_cumulated_impacts <- function(mu, se, nparc, ...){
    ## Define shape and scale parameter of gamma distribution
    shape = (mu/se)^2
    scale = se^2/mu

    ## Define x and y lim
    xx = yy = list()
    for(j in 1:nparc){
      xx[[j]] = seq(from = max(0,mu[j]-4*se[j]), to = mu[j]+4*se[j], length.out = 1e3)
      yy[[j]] = dgamma(xx[[j]], shape=shape[j], scale=scale[j])
    }

    ylim = c(min(unlist(yy)), max(unlist(yy))*1.4)
    xlim = c(min(unlist(xx)), max(unlist(xx)))

    ## Plot
    j=1
    curve(dgamma(x, shape=shape[j], scale=scale[j]),
          from = max(0,mu[j]-4*se[j]), to = mu[j]+4*se[j], n = 1e4,
          xlim = xlim, ylim = ylim,
          lwd = 3, col = j, yaxt = "n", xaxt = "n",
          #xaxp = c(round(xlim[1]), round(xlim[2]), n = 10),
          ylab = "", xlab = "Valeur du paramtre", cex.lab = 1.2)
    axis(side = 1, at = seq(round(xlim[1]), round(xlim[2]),
                            by = max(round((round(xlim[2])-round(xlim[1]))/10),1) ))
    mtext(text = "Densit de probabilit", side = 2, line = 2, cex = 1.2)

    y1 <- dgamma(x = mu[j], shape = shape[j], scale = scale[j])
    segments(x0 = mu[j], y0 = 0, y1 = y1, lty = 2, lwd = 3, col = j)
    points(x = mu[j], y = y1, pch = 19, cex = 1.5, col = j)

    for(j in 2:nparc){
      curve(dgamma(x, shape=shape[j], scale=scale[j]),
            from = max(0,mu[j]-4*se[j]), to = mu[j]+4*se[j], n = 1e4,
            lwd = 3, col = j, yaxt = "n",
            ylab = "", xlab = "Valeur du paramtre", cex.lab = 1.2, add = TRUE)

      y1 <- dgamma(x = mu[j], shape = shape[j], scale = scale[j])
      segments(x0 = mu[j], y0 = 0, y1 = y1, lty = 2, lwd = 3, col = j)
      points(x = mu[j], y = y1, pch = 19, cex = 1.5, col = j)
    }

    legend(x = xlim[1], y = ylim[2], legend = paste("Parc", 1:nparc),
           lwd = 3, col = 1:nparc, text.col = 1:nparc, cex = 1.5,
           bty = "n", horiz = TRUE)
  } # end function plot_gamma_cumulated_impacts

  ########################
  ## Fatalities
  ##----------------------
  observeEvent({
    input$analysis_choice
    input$button_fatalities
    input$fatalities_input_type
    input$fatalities_run_expert
    input$farm_number_cumulated
    input$fatalities_mat_cumulated
  },{

    ## 1. When analysis = single farm
    if(input$analysis_choice == "single_farm"){

      # Show from input values: if button is ON and input_type is set on "value" or "itvl" (thus not "eli_exp")
      if(input$button_fatalities%%2 == 1 & input$fatalities_input_type != "eli_exp"){
        output$title_distri_plot <- renderText({ "Mortalits annuelles" })

        output$distri_plot <- renderPlot({
          req(param$fatalities_mean, param$fatalities_se > 0)
          if(input$fatalities_input_type == "itvl"){
            req(input$fatalities_lower, input$fatalities_upper)
            plot_gamma(mu = tail(param$fatalities_mean, -1), se = tail(param$fatalities_se, -1))
          }else{
            req(input$fatalities_mean, input$fatalities_se)
            plot_gamma(mu = tail(param$fatalities_mean, -1), se = tail(param$fatalities_se, -1))
          }
        })

      } else {
        # Show from elicitation expert: if button is ON and input_type is set on "expert elicitation"
        if(input$button_fatalities%%2 == 1 & input$fatalities_input_type == "eli_exp"){
          if(!is.null(param$fatalities_eli_result)){
            output$title_distri_plot <- renderText({ "Mortalits annuelles" })
            output$distri_plot <- renderPlot({ plot_expert(param$fatalities_eli_result$out) })
          } else {
            output$title_distri_plot <- NULL
            output$distri_plot <- NULL
          }
          # Hide otherwise (when button is OFF)
        }else{
          output$title_distri_plot <- NULL
          output$distri_plot <- NULL
        }
      }

    ## 2. When analysis = cumulated impacts
    }else{
      if(input$analysis_choice == "cumulated"){
        output$title_distri_plot <- renderText({ "Mortalits annuelles par parc (impacts cumuls)" })
        # Plot: note we use the "NULL + delay" sequence only to avoid error message in R console
        output$distri_plot <- NULL
        delay(5,
              output$distri_plot <- renderPlot({
                req(all(!is.na(input$fatalities_mat_cumulated[,1])), all(input$fatalities_mat_cumulated[,2] > 0))
                plot_gamma_cumulated_impacts(mu = input$fatalities_mat_cumulated[,1],
                                             se = input$fatalities_mat_cumulated[,2],
                                             nparc = input$farm_number_cumulated)
              })
        )
      }else{
        ## 3. When analysis = multi_scenarios
        output$title_distri_plot <- renderText({ "Pas de graphe (pas d'incertitude dans le cas 'mulitple scnarios')" })
        output$distri_plot <- NULL
      } # end "else"

    } # end "if"
  }, ignoreInit = FALSE)


  ########################
  ## Population size
  ##----------------------
  observeEvent({
    input$button_pop_size
    input$pop_size_input_type
  },{
    # Show from input values: if button is ON and input_type is set on "value"
    if(input$button_pop_size%%2 == 1 & input$pop_size_input_type != "eli_exp"){
      output$title_distri_plot <- renderText({ "Taille initiale de la population" })

      output$distri_plot <- renderPlot({
        req(param$pop_size_mean, param$pop_size_se > 0)
        plot_gamma(mu = param$pop_size_mean, se = param$pop_size_se)
      })

    } else {
      # Show from elicitation expert: if button is ON and input_type is set on "expert elicitation"
      if(input$button_pop_size%%2 == 1 & input$pop_size_input_type == "eli_exp"){
        if(!is.null(param$pop_size_eli_result)){
          output$title_distri_plot <- renderText({ "Taille initiale de la population" })
          output$distri_plot <- renderPlot({ plot_expert(param$pop_size_eli_result$out) })
        } else {
          output$title_distri_plot <- NULL
          output$distri_plot <- NULL
        }
        # Hide otherwise (when button is OFF)
      }else{
        output$title_distri_plot <- NULL
        output$distri_plot <- NULL
      }
    }
  }, ignoreInit = FALSE)


  ########################
  ## Population growth
  ##----------------------
  observeEvent({
    input$pop_growth_input_type
    input$button_pop_growth
  },{

    # Show from input values: if button is ON and input_type is set on "value" or "interval"
    if(input$button_pop_growth%%2 == 1 & input$pop_growth_input_type != "eli_exp" & input$pop_growth_input_type != "trend"){
      output$title_distri_plot <- renderText({ "Taux de croissance de la population" })

      output$distri_plot <- renderPlot({
        req(param$pop_growth_mean, param$pop_growth_se > 0)
        plot_gamma(mu = param$pop_growth_mean, se = param$pop_growth_se)
      })

    } else {
      # Show from elicitation expert: if button is ON and input_type is set on "expert elicitation"
      if(input$button_pop_growth%%2 == 1 & input$pop_growth_input_type == "eli_exp"){
        if(!is.null(param$pop_growth_eli_result)){
          output$title_distri_plot <- renderText({ "Taux de croissance de la population" })
          output$distri_plot <- renderPlot({ plot_expert(param$pop_growth_eli_result$out) })
        } else {
          output$title_distri_plot <- NULL
          output$distri_plot <- NULL
        }
        # Hide otherwise (when button is OFF)
      }else{
        output$title_distri_plot <- NULL
        output$distri_plot <- NULL
      }
    }
  }, ignoreInit = FALSE)

  ########################
  ## Carrying capacity
  ##----------------------
  observeEvent({
    input$carrying_cap_input_type
    input$button_carrying_cap
  },{
    # Show from input values: if button is ON and input_type is set on "value"
    if(input$button_carrying_cap%%2 == 1 & input$carrying_cap_input_type != "eli_exp"){
      output$title_distri_plot <- renderText({ "Capacit de charge" })

      output$distri_plot <- renderPlot({
        req(param$carrying_capacity_mean, param$carrying_capacity_se > 0)
        plot_gamma(mu = param$carrying_capacity_mean, se = param$carrying_capacity_se)
      })

    } else {
      # Show from elicitation expert: if button is ON and input_type is set on "expert elicitation"
      if(input$button_carrying_cap%%2 == 1 & input$carrying_cap_input_type == "eli_exp"){
        if(!is.null(param$carrying_cap_eli_result)){
          if(!is.na(param$carrying_cap_eli_result$out)){
            output$title_distri_plot <- renderText({ "Capacit de charge" })
            output$distri_plot <- renderPlot({ plot_expert(param$carrying_cap_eli_result$out) })
          }else{
            output$title_distri_plot <- renderText({ "Erreur" })
            output$distri_plot <- NULL
          }
        } else {
          output$title_distri_plot <- NULL
          output$distri_plot <- NULL
        }

        # Hide otherwise (when button is OFF)
      }else{
        output$title_distri_plot <- NULL
        output$distri_plot <- NULL
      }
    }
  }, ignoreInit = FALSE)
  #####


  #####
  ##-------------------------------------------------
  ##  Display parameter values (on the side panel)
  ##-------------------------------------------------
  #################################
  ## Fatalities
  ##-------------------------------
  ## UNIT
  output$fatalities_unit_info <- renderText({
    if(!is.null(input$fatalities_unit)){
      if(input$fatalities_unit == "h"){
        paste0("Taux de mortalit")
      } else {
        paste0("Nombre de mortalits")
      }
    }
  })

  ## Values
  output$fatalities_mean_info <- renderText({
    if(input$fatalities_unit == "h") add_perc <- "%" else add_perc <- ""
    paste0(c("Moyenne : ",
             paste0(tail(param$fatalities_mean, -1), add_perc, collapse = ", ")
    ), collapse = "")
  })


  output$fatalities_se_info <- renderText({
    if(input$fatalities_unit == "h") add_perc <- "%" else add_perc <- ""
    paste0(c("Erreur-type : ",
             paste0(tail(param$fatalities_se, -1), add_perc, collapse = ", ")
    ), collapse = "")
  })


  #################################
  ## Poplutation size
  ##-------------------------------
  ## UNIT
  output$pop_size_unit_info <- renderText({
    if(!is.null(param$pop_size_unit)){
      if(param$pop_size_unit == "Npair"){
        paste0("Nombre de couple")
      } else {
        paste0("Effectif total")
      }
    }
  })

  ## VALUES
  output$pop_size_mean_info <- renderText({  paste0("Moyenne : ", param$pop_size_mean) })
  output$pop_size_se_info <- renderText({  paste0("Erreur-type : ", param$pop_size_se) })

  ## Show Popsize by age (table)
  # Function to create the table
  make_mat_popsizes <- function(data_sf, species, pop_size, pop_size_unit, survivals, fecundities){
    nam <- data_sf %>%
      filter(NomEspece == species) %>%
      select(classes_age) %>%
      unlist %>%
      as.vector

    matrix(round(pop_vector(pop_size = pop_size, pop_size_type = pop_size_unit, s = survivals, f = fecundities)),
           nrow = 1,
           dimnames = list("Effectifs", nam)
    )
  }

  # Display the table       (Note : the "delay" piece is just there to avoid an error message - time for parameters to be "loaded in")
  delay(ms = 200,
        output$pop_size_by_age <- renderTable({
          if(any(is.na(param$survivals)) | any(is.na(param$fecundities))){
            matrix("Valeurs de survies et/ ou de fcondits manquantes",
                   nrow = 1, dimnames = list(NULL, "Erreur"))
          }else{
            make_mat_popsizes(data_sf = data_sf, species = input$species_choice, pop_size = param$pop_size_mean,
                              pop_size_unit = input$pop_size_unit, s = param$s_calib0, f = param$f_calib0)
          } # end if
        },
        width = "500px",
        rownames = FALSE,
        digits = 0)
    )


  #################################
  ## Population growth
  ##-------------------------------
  output$pop_growth_mean_info <- renderText({  paste0("Moyenne : ", param$pop_growth_mean) })
  output$pop_growth_se_info <- renderText({  paste0("Erreur-type : ", param$pop_growth_se) })

  #################################
  ## Carrying capacity
  ##-------------------------------
  # UNIT (like pop size)
  ## UNIT
  output$carrying_capacity_unit_info <- renderText({
    if(!is.null(param$pop_size_unit)){
      if(input$carrying_cap_input_type == "no_K"){
        "Pas de capacit de charge (K = infini)"
      }else{
        if(param$pop_size_unit == "Npair"){
          paste0("Nombre de couple")
        } else {
          paste0("Effectif total")
        }
      }
    }
  })

  ## VALUES
  output$carrying_capacity_mean_info <- renderText({
    if(input$carrying_cap_input_type == "no_K"){
      NULL
    }else{
      paste0("Moyenne : ", param$carrying_capacity_mean)
    }
  })

  output$carrying_capacity_se_info <- renderText({
    if(input$carrying_cap_input_type == "no_K"){
      NULL
    }else{
      paste0("Erreur-type : ", param$carrying_capacity_se)
    }
  })



  #################################
  ## Vital rates
  ##-------------------------------
  # Function to create the matrix
  make_mat_vr <- function(data_sf, species){
    out_mat <- data_sf %>%
      filter(NomEspece == species) %>%
      select(classes_age, survie, fecondite)
    return(out_mat)
  }

  # Update the vital rate matrix (mat_fill_vr) when changing the number of age classes
  observeEvent({
    input$vr_mat_number_age_classes
  }, {
    req(input$vr_mat_number_age_classes)
    number_age_class <- input$vr_mat_number_age_classes
    updateMatrixInput(session, inputId = "mat_fill_vr",
                        value = matrix(data = NA,
                                       nrow = number_age_class,
                                       ncol = 2,
                                       dimnames = list(c(paste("Age", (1:number_age_class)-1)), c("Survie", "Fcondit"))))
  }) # end observeEvent



  # Update the vital rate matrix (mat_fill_vr) when changing species in the list
  observeEvent({
    input$species_choice
  }, {

    if(input$species_choice == "Espce gnrique") {

      number_age_class <- input$vr_mat_number_age_classes
      updateMatrixInput(session, inputId = "mat_fill_vr",
                        value = matrix(data = NA,
                                       nrow = number_age_class,
                                       ncol = 2,
                                       dimnames = list(c(paste("Age", (1:number_age_class)-1)), c("Survie", "Fcondit"))))
    } else {

      tab_species <- make_mat_vr(data_sf = data_sf, species = input$species_choice)

      if(all(is.na(tab_species))) {
        number_age_class <- input$vr_mat_number_age_classes
        updateMatrixInput(session, inputId = "mat_fill_vr",
                          value = matrix(data = NA,
                                         nrow = number_age_class,