Skip to content
Snippets Groups Projects
server.R 26 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
      ##--------------------------------------------
    
    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
      ##--------------------------------------------
    
    thierrychambert's avatar
    thierrychambert committed
      observe({
    
    thierrychambert's avatar
    thierrychambert committed
    
        #shinyjs::hide("fatal_constant")
    
        #shinyjs::hide("fatalities_input_type")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        shinyjs::hide("fatalities_mean")
        shinyjs::hide("fatalities_se")
        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")
    
    thierrychambert's avatar
    thierrychambert committed
    
        #shinyjs::hide("pop_size_unit")
    
        #shinyjs::hide("pop_size_input_type")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        shinyjs::hide("pop_size_mean")
        shinyjs::hide("pop_size_se")
        shinyjs::hide("pop_size_mat_expert")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        shinyjs::hide("pop_size_run_expert")
    
        #shinyjs::hide("pop_growth_input_type")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        shinyjs::hide("pop_growth_mean")
        shinyjs::hide("pop_growth_se")
        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_cap_input_type")
        shinyjs::hide("carrying_capacity")
        shinyjs::hide("carrying_cap_mat_expert")
        shinyjs::hide("carrying_cap_run_expert")
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        shinyjs::hide("mat_fill_vr")
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        # Show fatalities part
    
        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 none cumulated impacts scenario
    
          if(input$analysis_choice == "scenario"){
            shinyjs::show("fatalities_input_type")
    
    thierrychambert's avatar
    thierrychambert committed
            if(input$fatalities_input_type == "val"){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
              shinyjs::show("fatalities_mean")
              shinyjs::show("fatalities_se")
            }
    
    thierrychambert's avatar
    thierrychambert committed
            if(input$fatalities_input_type == "eli_exp"){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
              shinyjs::show("fatalities_mat_expert")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
              shinyjs::show("fatalities_run_expert")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
            }
          }
    
          # Show inputs for cumulated scenario
    
          if(input$analysis_choice == "cumulated"){
            shinyjs::show("farm_number_cumulated")
            shinyjs::show("fatalities_mat_cumulated")
    
    thierrychambert's avatar
    thierrychambert committed
          }
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        # Show inputs for population size part
    
        if(input$button_pop_size%%2 == 1){
    
    thierrychambert's avatar
    thierrychambert committed
          #shinyjs::show("pop_size_unit")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          shinyjs::show("pop_size_input_type")
    
    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"){
    
    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")
    
    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")
    
    thierrychambert's avatar
    thierrychambert committed
          if(input$carrying_cap_input_type == "val"){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
            shinyjs::show("carrying_capacity")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          }
    
    thierrychambert's avatar
    thierrychambert committed
          if(input$carrying_cap_input_type == "eli_exp"){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
            shinyjs::show("carrying_cap_mat_expert")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
            shinyjs::show("carrying_cap_run_expert")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          }
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        # Show inputs for population trend part
    
    
        if(input$button_pop_growth%%2 == 1){
    
          shinyjs::show("pop_growth_input_type")
    
    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"){
    
    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")
            shinyjs::show("pop_trend_strength")
          }
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        # Show inputs vital rates part
    
        if(input$button_vital_rates%%2 == 1){
    
    thierrychambert's avatar
    thierrychambert committed
          shinyjs::show("mat_fill_vr")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        }
    
    
      }) # en observe show/hide
    
      ###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
    
      ##----------------------------------------------
      ##  Function to run the elicitation analysis  --
      ##----------------------------------------------
    
    thierrychambert's avatar
    thierrychambert committed
      # Function to extract value from elicitation matrix and run the elication analysis
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      func_eli <- function(mat_expert){
        t_mat_expert <- t(mat_expert)
    
    thierrychambert's avatar
    thierrychambert committed
        vals <- t_mat_expert[2:4,]
        Cp <- t_mat_expert[5,]
        weights <- t_mat_expert[1,]
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
        out <- elicitation(vals, Cp, weights)
        return(list(out = out, mean = out$mean_smooth, SE = sqrt(out$var_smooth)))
      }
    
      ###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
    
    thierrychambert's avatar
    thierrychambert committed
    
      ##--------------------------------------------
    
      ##  Reactive value : simulation inputs      --
    
    thierrychambert's avatar
    thierrychambert committed
      ##--------------------------------------------
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      param <- reactiveValues(N1 = NULL,
    
                              nsim = NULL,
                              cumulated_impacts = NULL,
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
                              fatalities_mean = NULL,
    
                              fatalities_se = NULL,
                              onset_time = NULL,
                              onset_year = 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,
    
    Marie-Bocage's avatar
    Marie-Bocage committed
                              carrying_capacity = NULL,
    
    thierrychambert's avatar
    thierrychambert committed
                              rMAX_species = NULL,
    
    
                              model_demo = NULL,
                              time_horzion = 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
    
      ###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
    
    
      ##----------------------------------------------------------
      ## Observe parameter values to be used in simulations run --
      ##----------------------------------------------------------
      observe({
        param # required to ensure up-to-date values are run
    
        # simple inputs
        param$nsim <- input$nsim
        param$fatal_constant <- input$fatal_constant
    
        # fixed in global environment (for now)
        param$theta = theta
        param$time_horzion = time_horzion
        param$coeff_var_environ = coeff_var_environ
    
    
    thierrychambert's avatar
    thierrychambert committed
      }) # end observe
    
      ###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
    
    
      ##--------------------------------------------
      ##  Display parameter distribution          --
      ##--------------------------------------------
    
    
      ## Function to plot a gamma distribution
      plot_gamma <- function(mu, se, show_se = TRUE, ...){
    
        ## Define shape and scale parameter of gamma distribution
        shape = (mu/se)^2
        scale = se^2/mu
    
        ## Plot the curve
        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)
    
        y2 <- 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, y2)
        abline(v = mu, lwd = 3, col = "darkblue")
    
        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, 2)), side = 3, line = 1, cex = 1.2, adj = 0)
      }
    
    
      ## Fatalities ###~~~~~~~~~~~~~~~~~~~~~~~~~~###
      observeEvent({
        input$fatalities_input_type
      },{
    
    thierrychambert's avatar
    thierrychambert committed
        output$fatalities_distri_plot <- renderPlot({ plot_gamma(mu = input$fatalities_mean, se = input$fatalities_se) })
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
      ## Population size ###~~~~~~~~~~~~~~~~~~~~~~~~~~###
      observeEvent({
        input$pop_size_input_type
      },{
    
        output$pop_size_distri_plot <- renderPlot({ plot_gamma(mu = input$pop_size_mean, se = input$pop_size_se) })
    
    thierrychambert's avatar
    thierrychambert committed
    
    
      ## Population growth ###~~~~~~~~~~~~~~~~~~~~~~~~~~###
      observeEvent({
        input$pop_growth_input_type
      },{
    
        output$pop_growth_distri_plot <- renderPlot({ plot_gamma(mu = input$pop_growth_mean, se = input$pop_growth_se) })
    
      })
      ###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
      ##--------------------------------------------
      ##  Run expert elicitation                  --
      ##--------------------------------------------
    
      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$fatalities_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
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          param$pop_size_eli_result <- func_eli(input$pop_size_mat_expert)
    
    
          ## plot distribution
    
          output$pop_size_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))) {
    
          ## run elicitation analysis
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          param$pop_growth_eli_result <- func_eli(input$pop_growth_mat_expert)
    
    
          ## plot distribution
    
          output$pop_growth_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
    
          param$carrying_cap_eli_result <- func_eli(input$carrying_cap_mat_expert)
    
    
          ## run elicitation analysis
    
          output$carrying_cap_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
    
    
    
    
      ##--------------------------------------------
    
    thierrychambert's avatar
    thierrychambert committed
      ## Select parameter values for simulations  --
    
      ##--------------------------------------------
    
    thierrychambert's avatar
    thierrychambert committed
    
      ## Cumulated impacts or not ? ###~~~~~~~~~~~~~~~~~~~~~~~~~~###
    
      observeEvent({
        input$run
      }, {
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        if(input$analysis_choice == "scenario"){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          param$cumulated_impacts = FALSE
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        } else {
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          param$cumulated_impacts = TRUE
    
        } # end if
      }) # end observeEvent
    
    thierrychambert's avatar
    thierrychambert committed
      ###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
    
      ## Fatalities ###~~~~~~~~~~~~~~~~~~~~~~~~~~###
      observeEvent({
        input$run
      }, {
        # Case 1 : Not cumulated effects (if1)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        if(input$analysis_choice == "scenario"){
    
    
          # Case 1.1 : Values from expert elicitation (if2)
    
    thierrychambert's avatar
    thierrychambert committed
          if(input$fatalities_input_type == "eli_exp"){
    
            param$fatalities_mean <- c(0, round(param$fatalities_eli_result$mean))
            param$onset_time <- NULL
            param$fatalities_se <- c(0, round(param$fatalities_eli_result$SE))
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          } else {
    
    
            # Case 1.2 : Values directly provided (i.e., not from expert elicitation)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
            param$fatalities_mean <- c(0, input$fatalities_mean)
            param$onset_time = NULL
            param$fatalities_se <- c(0, input$fatalities_se)
    
          } # end (if2)
    
          # Case 2 : Cumulated effects (if-else 1)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        } else {
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          param$fatalities_mean <- c(0, input$fatalities_mat_cumulated[,1])
    
          param$fatalities_se <- c(0, input$fatalities_mat_cumulated[,2])
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          param$onset_year <- c(min(input$fatalities_mat_cumulated[,3]), input$fatalities_mat_cumulated[,3])
          param$onset_time <- param$onset_year - min(param$onset_year) + 1
    
        } # end (if1)
    
      }) # end observeEvent
    
    thierrychambert's avatar
    thierrychambert committed
      ###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
    
    thierrychambert's avatar
    thierrychambert committed
      ###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
      ## Population size ###~~~~~~~~~~~~~~~~~~~~~~~~~~###
      observeEvent({
        input$run
      },{
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
    thierrychambert's avatar
    thierrychambert committed
        # Case 1 : Values from expert elicitation
        if(input$pop_size_input_type == "eli_exp"){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          if(!(is.null(param$pop_size_eli_result))){
            param$pop_size_mean <- round(param$pop_size_eli_result$mean)
            param$pop_size_se <- round(param$pop_size_eli_result$SE)
          } else {
    
    thierrychambert's avatar
    thierrychambert committed
            print("Erreur: Vous n'avez pas lancer l'analyse 'valeurs experts'")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          }
    
    thierrychambert's avatar
    thierrychambert committed
    
    
    thierrychambert's avatar
    thierrychambert committed
          # Case 2 : Values directly provided (i.e., not from expert elicitation)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        } else {
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          param$pop_size_mean <- input$pop_size_mean
          param$pop_size_se <- input$pop_size_se
        }
    
    thierrychambert's avatar
    thierrychambert committed
        param$pop_size_unit <- input$pop_size_unit
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      })
    
    
    thierrychambert's avatar
    thierrychambert committed
    
    
    thierrychambert's avatar
    thierrychambert committed
      ###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~##
      ## Survivals, fecundities and rMAX_species ###~~~~~~~~~~~~~~~~~~~~~~~~~~###
      observeEvent({input$run}, {
        param$survivals <- input$mat_fill_vr[,1]
        param$fecundities <- input$mat_fill_vr[,2]
        param$rMAX_species <- rMAX_spp(surv = tail(param$survivals,1), afr = min(which(param$fecundities != 0)))
      }) # end observeEvent
    
    
    
    
    
    thierrychambert's avatar
    thierrychambert committed
      ###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~##
      ## Population growth ###~~~~~~~~~~~~~~~~~~~~~~~~~~###
      observeEvent({
        input$run
      }, {
    
        # Case 1 : Values from expert elicitation
        if(input$pop_growth_input_type == "eli_exp"){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          if(!(is.null(param$pop_growth_eli_result))){
            param$pop_growth_mean <- round(min(1 + param$rMAX_species, round(param$pop_growth_eli_result$mean, 2)), 2)
            param$pop_growth_se <- round(param$pop_growth_eli_result$SE, 2)
          } else {
    
    thierrychambert's avatar
    thierrychambert committed
            print("Erreur: Vous n'avez pas lancer l'analyse 'valeurs experts'")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          }
    
    thierrychambert's avatar
    thierrychambert committed
    
    
    thierrychambert's avatar
    thierrychambert committed
          # Case 2 : Trend information
    
    thierrychambert's avatar
    thierrychambert committed
        } else if(input$pop_growth_input_type == "trend"){
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          if(input$pop_trend == "Croissance") {
            if(input$pop_trend_strength == "Faible") {
              param$pop_growth_mean <- 1.01
            } else if(input$pop_trend_strength == "Moyen"){
              param$pop_growth_mean <- 1.03
            } else {
              param$pop_growth_mean <- 1.06
            }
    
          } else if(input$pop_trend == "Dclin"){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
            if(input$pop_trend_strength == "Faible") {
              param$pop_growth_mean <- 0.99
            } else if(input$pop_trend_strength == "Moyen"){
              param$pop_growth_mean <- 0.97
            } else {
              param$pop_growth_mean <- 0.94
            }
          } else {
            param$pop_growth_mean <- 1
          }
          param$pop_growth_se <- 0.03
    
    thierrychambert's avatar
    thierrychambert committed
    
    
    thierrychambert's avatar
    thierrychambert committed
          # Case 3 : Values directly provided (i.e., not from expert elicitation)
    
    thierrychambert's avatar
    thierrychambert committed
        } else {
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          param$pop_growth_mean <- round(min(1 + param$rMAX_species, input$pop_growth_mean), 2)
          param$pop_growth_se <- input$pop_growth_se
    
      # Survival and fecundity calibration
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      observeEvent({
        input$run
      },{
        param$vr_calibrated <- calibrate_params(
          inits = init_calib(s = param$survivals, f = param$fecundities, lam0 = param$pop_growth_mean),
          f = param$fecundities, s = param$survivals, lam0 = param$pop_growth_mean
        )
        param$s_calibrated <- head(param$vr_calibrated, length(param$survivals))
        param$f_calibrated <- tail(param$vr_calibrated, length(param$fecundities))
      })
    
    
      # Observe carrying capacity
    
    thierrychambert's avatar
    thierrychambert committed
      observeEvent({
        input$run
      }, {
    
    thierrychambert's avatar
    thierrychambert committed
        if(input$carrying_cap_input_type == "eli_exp"){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          if(!(is.null(param$carrying_cap_eli_result))){
            param$carrying_capacity <- round(param$carrying_cap_eli_result$mean)
          } else {
    
            print("#intgrer un message d'erreur")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          }
        } else {
          param$carrying_capacity <- input$carrying_capacity
        }
      })
    
    
    thierrychambert's avatar
    thierrychambert committed
      observeEvent({
        input$run
      }, {
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        print(param$pop_growth_mean)
        print(param$pop_growth_se)
      })
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
      # End of reactive
    
      # Simulations
    
      observeEvent({
        input$run
      }, {
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
        withProgress(message = 'Simulation progress', value = 0, {
    
    
          param$N1 <- run_simul_shiny(nsim = param$nsim,
    
    thierrychambert's avatar
    thierrychambert committed
                                      cumulated_impacts = param$cumulated_impacts,
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
                                      fatalities_mean = param$fatalities_mean,
                                      fatalities_se = param$fatalities_se,
                                      onset_time = param$onset_time,
    
                                      pop_size_mean = param$pop_size_mean,
                                      pop_size_se = param$pop_size_se,
    
    thierrychambert's avatar
    thierrychambert committed
                                      pop_size_type = param$pop_size_unit,
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
                                      pop_growth_mean = param$pop_growth_mean,
                                      pop_growth_se = param$pop_growth_se,
    
                                      survivals = param$s_calibrated,
                                      fecundities = param$f_calibrated,
    
                                      carrying_capacity = param$carrying_capacity,
    
    Marie-Bocage's avatar
    Marie-Bocage committed
                                      rMAX_species = param$rMAX_species,
    
                                      model_demo = NULL,
    
                                      time_horzion = param$time_horzion,
                                      coeff_var_environ = param$coeff_var_environ,
                                      fatal_constant = param$fatal_constant)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        }) # Close withProgress
      }) # Close observEvent
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      # Plot Impacts
    
    thierrychambert's avatar
    thierrychambert committed
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      plot_out_impact <- function(){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        if(is.null(param$N1)) {} else {plot_impact(N = param$N1$N, xlab = "year", ylab = "pop size")}
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      }
    
      output$graph_impact <- renderPlot({
        plot_out_impact()
      })
    
    thierrychambert's avatar
    thierrychambert committed
    
      # Plot trajectories
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
      plot_out_traj <- function(){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        if(is.null(param$N1)) {} else {plot_traj(N = param$N1$N, xlab = "year", ylab = "pop size")}
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      }
    
      output$graph_traj <- renderPlot({
        plot_out_traj()
      })
      # End simulations
    
    
    
      ##--------------------------------------------
      ##  Display General information             --
      ##--------------------------------------------
    
    
    thierrychambert's avatar
    thierrychambert committed
      #output$species_name <- renderText({ paste0("Espce : ", as.character(input$species_choice)) })
    
    thierrychambert's avatar
    thierrychambert committed
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      ## Fatalities
      output$fatalities_mean_info <- renderText({
    
    thierrychambert's avatar
    thierrychambert committed
        if(input$fatalities_input_type == "eli_exp"){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          if(!(is.null(param$fatalities_eli_result))){
    
            info <- round(param$fatalities_eli_result$mean, 2)
    
    thierrychambert's avatar
    thierrychambert committed
          } else {
            info <- NA
          }
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        }
        else {
          info <- input$fatalities_mean
        }
    
        paste0("Moyenne : ", info)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      })
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      output$fatalities_se_info <- renderText({
    
    thierrychambert's avatar
    thierrychambert committed
        if(input$fatalities_input_type == "eli_exp"){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          if(!(is.null(param$fatalities_eli_result))){
    
    thierrychambert's avatar
    thierrychambert committed
            info <- round(param$fatalities_eli_result$SE, 2)
          } else {
            info <- NA
          }
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        }
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        else {
          info <- input$fatalities_se
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        }
    
        paste0("Erreur-type : ", info)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      })
    
    
    thierrychambert's avatar
    thierrychambert committed
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      ## Poplutation size
    
    thierrychambert's avatar
    thierrychambert committed
      output$pop_size_unit_info <- renderText({
        if(input$pop_size_unit == "Npair"){
    
          paste0("Nombre de couple")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        } else {
    
          paste0("Effectif total")
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        }
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      })
    
      output$pop_size_mean_info <- renderText({
    
    thierrychambert's avatar
    thierrychambert committed
        if(input$pop_size_input_type == "eli_exp"){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          if(!(is.null(param$pop_size_eli_result))){
            info <- round(param$pop_size_eli_result$mean)
          } else {info <- NA}
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        }
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        else {
          info <- input$pop_size_mean
        }
    
        paste0("Moyenne : ", info)
    
    thierrychambert's avatar
    thierrychambert committed
      })
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      output$pop_size_se_info <- renderText({
    
    thierrychambert's avatar
    thierrychambert committed
        if(input$pop_size_input_type == "eli_exp"){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          if(!(is.null(param$pop_size_eli_result))){
            info <- round(param$pop_size_eli_result$SE)
          } else {info <- NA}
        }
        else {
          info <- input$pop_size_se
        }
    
        paste0("Erreur-type : ", info)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      })
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      ## Carrying capacity
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      output$carrying_capacity_info <- renderText({
    
    thierrychambert's avatar
    thierrychambert committed
    
        # N type
        if(input$pop_size_unit == "Npair"){
          info1 <- paste0("Nombre de couple : ")
        } else {
          info1 <- paste0("Effectif total : ")
        }
    
        # value of K
    
    thierrychambert's avatar
    thierrychambert committed
        if(input$carrying_cap_input_type == "eli_exp"){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          if(!(is.null(param$carrying_cap_eli_result))){
    
    thierrychambert's avatar
    thierrychambert committed
            info2 <- round(param$carrying_cap_eli_result$mean)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          } else {info <- NA}
        }
        else {
    
    thierrychambert's avatar
    thierrychambert committed
          info2 <- input$carrying_capacity
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        }
    
    thierrychambert's avatar
    thierrychambert committed
    
        # paste for printing
        paste0(info1, info2)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      })
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      ## Population growth
      output$pop_growth_mean_info <- renderText({
    
    thierrychambert's avatar
    thierrychambert committed
        if(input$pop_growth_input_type == "eli_exp"){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          if(!(is.null(param$pop_growth_eli_result))){
            info <- round(param$pop_growth_eli_result$mean, 2)
          } else {info <- NA}
    
    thierrychambert's avatar
    thierrychambert committed
        } else if(input$pop_growth_input_type == "trend"){
    
    thierrychambert's avatar
    thierrychambert committed
          if(input$pop_trend == "Croissance") {
            if(input$pop_trend_strength == "Faible") {
              info <- 1.01
            } else if(input$pop_trend_strength == "Moyen"){
              info <- 1.03
            } else {
              info <- 1.06
            }
          } else if(input$pop_trend == "Dclin"){
            if(input$pop_trend_strength == "Faible") {
              info <- 0.99
            } else if(input$pop_trend_strength == "Moyen"){
              info <- 0.97
    
    Marie-Bocage's avatar
    Marie-Bocage committed
            } else {
    
    thierrychambert's avatar
    thierrychambert committed
              info <- 0.94
    
    Marie-Bocage's avatar
    Marie-Bocage committed
            }
    
    thierrychambert's avatar
    thierrychambert committed
          } else {
            info <- 1.00
          }
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        } else {
    
    thierrychambert's avatar
    thierrychambert committed
          info <- input$pop_growth_mean
    
    Marie-Bocage's avatar
    Marie-Bocage committed
        }
    
        paste0("Moyenne : ", info)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      })
    
      output$pop_growth_se_info <- renderText({
    
    thierrychambert's avatar
    thierrychambert committed
        if(input$pop_growth_input_type == "eli_exp"){
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          if(!(is.null(param$pop_growth_eli_result))){
            info <- round(param$pop_growth_eli_result$SE, 2)
          } else {info <- NA}
    
    thierrychambert's avatar
    thierrychambert committed
        } else if (input$pop_growth_input_type == "trend") {
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          info <- 0.03
        }
        else {
          info <- input$pop_growth_se
        }
    
        paste0("Erreur-type : ", info)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      })
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      ## Vital rates
      output$vital_rates_info <- renderTable({
    
        input$mat_fill_vr
    
    thierrychambert's avatar
    thierrychambert committed
      }, rownames = TRUE)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      ## Update matrix cumulated impact
    
    
      observeEvent({input$farm_number_cumulated}, {
        rows_names <- function(n){
    
          v <- c(paste0("Parc n", c(1:n)))
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          return(v)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
    
        nrow <- input$farm_number_cumulated
        number_parks <- rows_names(nrow)
    
    
        init_cumul_new <- rep(init_cumul_add, nrow)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
        updateMatrixInput(session, inputId = "fatalities_mat_cumulated",
    
    thierrychambert's avatar
    thierrychambert committed
                          value =  matrix(init_cumul_new, nrow = nrow, ncol = 3, byrow = TRUE,
    
                                          dimnames = list(number_parks,
    
                                                            "Anne de mise en service du parc"))))
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
      # Survivals and Fecundities
    
    
      create.matrice <- function(data_sf, species){
        out_mat <- data_sf %>%
    
    Marie-Bocage's avatar
    Marie-Bocage committed
          filter(species == data_sf$Nom_espece) %>%
          select(classes_age, survie, fecondite)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
      }
    
    
    thierrychambert's avatar
    thierrychambert committed
      ## Update the vital rate matrix when changing species in the list
    
      observeEvent({input$species_choice}, {
    
        if(input$species_choice == "Espce gnrique") {} else {
    
          tab_species <- create.matrice(data_sf = data_sf, species = input$species_choice)
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
          if(all(is.na(tab_species))) {
            updateMatrixInput(session, inputId = "mat_fill_vr",
    
                              value = matrix(data = NA,
    
    Marie-Bocage's avatar
    Marie-Bocage committed
                                             nrow = 4,
                                             ncol = 2,
    
                                             dimnames = list(c("Juv 1", "Juv 2", "Juv 3", "Adulte"), c("Survie", "Fcondit"))))
    
    Marie-Bocage's avatar
    Marie-Bocage committed
    
          } 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
    
    
    
    thierrychambert's avatar
    thierrychambert committed
      ###################################################################################
    
    thierrychambert's avatar
    thierrychambert committed