Skip to content
Snippets Groups Projects
server.R 51.8 KiB
Newer Older
  • Learn to ignore specific revisions
  • Marie-Bocage's avatar
    Marie-Bocage committed
    server <- function(input, output, session){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
      ##############################################
    
    thierrychambert's avatar
    thierrychambert committed
      ##--------------------------------------------
    
    
      ## 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
    
    thierrychambert's avatar
    thierrychambert committed
      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")
        }
      })
    
    
    
      ##############################################
    
    thierrychambert's avatar
    thierrychambert committed
      ##--------------------------------------------
    
    thierrychambert's avatar
    thierrychambert committed
      observe({
    
        shinyjs::hide("fatalities_mean")
        shinyjs::hide("fatalities_se")
    
        shinyjs::hide("fatalities_lower")
        shinyjs::hide("fatalities_upper")
    
        shinyjs::hide("fatalities_number_expert")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        shinyjs::hide("fatalities_mat_expert")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        shinyjs::hide("fatalities_run_expert")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        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")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        shinyjs::hide("pop_size_mean")
        shinyjs::hide("pop_size_se")
    
        shinyjs::hide("pop_size_number_expert")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        shinyjs::hide("pop_size_mat_expert")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        shinyjs::hide("pop_size_run_expert")
    
        shinyjs::hide("pop_growth_lower")
        shinyjs::hide("pop_growth_upper")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        shinyjs::hide("pop_growth_mean")
        shinyjs::hide("pop_growth_se")
    
        shinyjs::hide("pop_growth_number_expert")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        shinyjs::hide("pop_growth_mat_expert")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        shinyjs::hide("pop_growth_run_expert")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        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")
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        shinyjs::hide("mat_fill_vr")
    
        shinyjs::hide("vr_mat_number_age_classes")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
        #------------
        # Show some
        #------------
        # Show inputs for fatalities part
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        if(input$button_fatalities%%2 == 1){
    
    thierrychambert's avatar
    thierrychambert committed
          #shinyjs::show("fatal_constant")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
          # Show inputs for single farm option (non-cumulated impacts)
          if(input$analysis_choice == "single_farm"){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
            shinyjs::show("fatalities_input_type")
    
            if(input$fatalities_input_type == "itvl"){
    
              shinyjs::show("fatalities_lower")
              shinyjs::show("fatalities_upper")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
            }
    
            if(input$fatalities_input_type == "val"){
              shinyjs::show("fatalities_mean")
              shinyjs::show("fatalities_se")
            }
    
    thierrychambert's avatar
    thierrychambert committed
            if(input$fatalities_input_type == "eli_exp"){
    
              shinyjs::show("fatalities_number_expert")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
              shinyjs::show("fatalities_mat_expert")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
              shinyjs::show("fatalities_run_expert")
    
          # Show inputs for cumulated impacts option
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          if(input$analysis_choice == "cumulated"){
    
            shinyjs::hide("fatalities_input_type")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
            shinyjs::show("farm_number_cumulated")
            shinyjs::show("fatalities_mat_cumulated")
    
    thierrychambert's avatar
    thierrychambert committed
          }
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
          # Show inputs for multiple scenario
          if(input$analysis_choice == "multi_scenario"){
            shinyjs::hide("fatalities_input_type")
            shinyjs::show("fatalities_vec_scenario")
          }
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        # 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")
          }
    
    thierrychambert's avatar
    thierrychambert committed
          if(input$pop_size_input_type == "val"){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
            shinyjs::show("pop_size_mean")
            shinyjs::show("pop_size_se")
          }
    
    thierrychambert's avatar
    thierrychambert committed
          if(input$pop_size_input_type == "eli_exp"){
    
            shinyjs::show("pop_size_number_expert")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
            shinyjs::show("pop_size_mat_expert")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
            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")
          }
    
    thierrychambert's avatar
    thierrychambert committed
          if(input$pop_growth_input_type == "val"){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
            shinyjs::show("pop_growth_mean")
            shinyjs::show("pop_growth_se")
          }
    
    thierrychambert's avatar
    thierrychambert committed
          if(input$pop_growth_input_type == "eli_exp"){
    
            shinyjs::show("pop_growth_number_expert")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
            shinyjs::show("pop_growth_mat_expert")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
            shinyjs::show("pop_growth_run_expert")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          }
    
    thierrychambert's avatar
    thierrychambert committed
          if(input$pop_growth_input_type == "trend"){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
            shinyjs::show("pop_trend")
    
            if(input$pop_trend != "stable"){
              shinyjs::show("pop_trend_strength")
            }
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          }
    
        # 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")
          }
        }
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        if(input$button_vital_rates%%2 == 1){
    
    thierrychambert's avatar
    thierrychambert committed
          shinyjs::show("mat_fill_vr")
    
          shinyjs::show("vr_mat_number_age_classes")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        }
    
    
      }) # en observe show/hide
    
      ###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
    
      ##############################################
    
    thierrychambert's avatar
    thierrychambert committed
      ##--------------------------------------------
    
      out <- reactiveValues(run = NULL, msg = NULL, analysis_choice = NULL)
    
      rv <- reactiveValues(distAVG = NULL, dist05p = NULL)
    
    
      ready <- reactiveValues(fatalities = TRUE, pop_size = TRUE, pop_growth = TRUE, carrying_capacity = TRUE)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      param <- reactiveValues(N1 = NULL,
    
                              cumulated_impacts = FALSE,
    
    Marie-Bocage's avatar
    Marie-Bocage committed
                              fatalities_mean = NULL,
    
                              onset_time = NULL,
                              onset_year = NULL,
    
                              out_fatal = NULL,
    
    
                              pop_size_mean = NULL,
                              pop_size_se = NULL,
    
    thierrychambert's avatar
    thierrychambert committed
                              pop_size_unit = NULL,
    
    
                              pop_growth_mean = NULL,
                              pop_growth_se = NULL,
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
                              fecundities = NULL,
                              survivals = NULL,
                              s_calibrated = NULL,
                              f_calibrated = NULL,
                              vr_calibrated = NULL,
    
                              carrying_capacity_mean = NULL,
                              carrying_capacity_se = NULL,
    
    
    
    thierrychambert's avatar
    thierrychambert committed
                              rMAX_species = NULL,
    
                              time_horizon = NULL,
    
                              coeff_var_environ = NULL,
                              fatal_constant = NULL,
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
                              fatalities_eli_result = NULL,
                              pop_size_eli_result = NULL,
                              pop_growth_eli_result = NULL,
    
                              carrying_cap_eli_result = NULL
    
      ###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
    
    
    
      ##############################################
    
      ##-------------------------------------------
    
      # 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",
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
      ########################
      ## 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,]
        Cp <- t_mat_expert[5,]
        weights <- t_mat_expert[1,]
    
        out <- elicitation(vals, Cp, weights)
        return(list(out = out, mean = out$mean_smooth, SE = sqrt(out$var_smooth)))
      }
    
      # 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)) ) {
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
          ## run elicitation analysis
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          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
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
      ########################
    
      ## Population size
      ##----------------------
    
      observeEvent({
        input$pop_size_run_expert
      }, {
        if(all(!is.na(input$pop_size_mat_expert))) {
    
          ## run elicitation analysis
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          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
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
      ########################
    
      ## 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)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
          ## 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) })
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
        } 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))) {
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          param$carrying_cap_eli_result <- func_eli(input$carrying_cap_mat_expert)
    
    
          ## run elicitation analysis
    
          output$title_distri_plot <- renderText({ "Capacit de charge" })
    
          output$distri_plot <- renderPlot({ plot_expert(param$carrying_cap_eli_result$out, show_se = FALSE) })
    
    thierrychambert's avatar
    thierrychambert committed
    
    
        } else {
          print("missing value")
        } # end if
      }) # end observeEvent
    
    thierrychambert's avatar
    thierrychambert committed
    
    
      ###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
    
    
      #####
      ##--------------------------------------------
      ##  Display parameter distribution
      ##--------------------------------------------
    
    thierrychambert's avatar
    thierrychambert committed
    
    
      # Function to plot a gamma distribution
    
      plot_gamma <- function(mu, se, show_mode = TRUE, show_mean = TRUE, show_se = TRUE, ...){
    
    thierrychambert's avatar
    thierrychambert committed
    
    
        ## Define shape and scale parameter of gamma distribution
        shape = (mu/se)^2
        scale = se^2/mu
    
    thierrychambert's avatar
    thierrychambert committed
    
    
        ## 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+4*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
      },{
    
        if(input$analysis_choice != "cumulated"){
    
          # 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({
              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
            }
          }
    
        }else{
          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({
              plot_gamma_cumulated_impacts(mu = input$fatalities_mat_cumulated[,1],
    
                                         se = input$fatalities_mat_cumulated[,2],
                                         nparc = input$farm_number_cumulated)
    
      }, ignoreInit = FALSE)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
      ########################
      ## 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)
            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)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
      ########################
      ## 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)
            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)){
              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 <- NULL
              output$distri_plot <- NULL
            }
            # Hide otherwise (when button is OFF)
          }else{
    
            output$title_distri_plot <- NULL
            output$distri_plot <- NULL
          }
        }
      }, ignoreInit = FALSE)
      #####
    
    thierrychambert's avatar
    thierrychambert committed
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
      #####
      ##-------------------------------------------------
      ##  Display parameter values (on the side panel)
      ##-------------------------------------------------
      #################################
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      ## 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(tail(param$fatalities_se, -1), add_perc, collapse = ", ")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
      #################################
      ## 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")
    
    thierrychambert's avatar
    thierrychambert committed
          } else {
    
    thierrychambert's avatar
    thierrychambert committed
          }
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        }
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      })
    
    
      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) })
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
      ## 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) %>%
    
    
        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")
    
            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$survivals, f = param$fecundities)
              } # 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) })
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
      #################################
    
      ##-------------------------------
      # UNIT (like pop size)
    
      ## UNIT
      output$carrying_capacity_unit_info <- renderText({
        if(!is.null(param$pop_size_unit)){
          if(input$carrying_cap_input_type == "unknown"){
            "Inconnue"
          }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 == "unknown"){
          NULL
    
          paste0("Moyenne : ", param$carrying_capacity_mean)
    
      output$carrying_capacity_se_info <- renderText({
        if(input$carrying_cap_input_type == "unknown"){
          NULL
        }else{
          paste0("Erreur-type : ", param$carrying_capacity_se)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        }
      })
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
      #################################
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      ## 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))), 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))), 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,
    
                                             dimnames = list(c(paste("Age", (1:number_age_class))), c("Survie", "Fcondit"))))
    
    
          } else {
            number_age_class <- nrow(tab_species)
            ages <- tab_species$classes_age
            survivals <- tab_species$survie
            fecundities <- tab_species$fecondite
    
            updateMatrixInput(session, inputId = "mat_fill_vr",
                              value = matrix(data = c(survivals, fecundities),
                                             nrow = number_age_class,
                                             ncol = 2,
                                             dimnames = list(ages, c("Survie", "Fcondit"))))
          } # end if 2
        } # end if 1
    
      }) # end observeEvent species_list
    
    
      # Display vital rates output table
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      output$vital_rates_info <- renderTable({
    
        input$mat_fill_vr
    
    thierrychambert's avatar
    thierrychambert committed
      }, rownames = TRUE)
    
      # Display intrinsic lambda (based solely on Leslie matrix)
    
      delay(ms = 300,
            output$lambda0_info <- renderUI({
              lam <- lambda(build_Leslie(s = input$mat_fill_vr[,1], f = input$mat_fill_vr[,2]))
              withMathJax(sprintf("$$\\lambda = %.02f$$", lam))
            })
      )
    
    
    
      #####
    
      #################################
      ## Dispersal
      ##-------------------------------
      observeEvent({
        input$species_choice
      }, {
        distAVG <- species_data %>%
          filter(NomEspece == input$species_choice) %>%
          select(DistDispMoyKM)
    
        rv$distAVG <- round(distAVG, 1)
    
        rv$dist05p <- round(-log(0.05)*rv$distAVG, 1)
      })