Skip to content
Snippets Groups Projects
server.R 25.1 KiB
Newer Older
Marie-Bocage's avatar
Marie-Bocage committed
server <- function(input, output, session){
Marie-Bocage's avatar
Marie-Bocage committed


thierrychambert's avatar
thierrychambert committed
  ##--------------------------------------------
  ##  Hide all inputs excepted actionButtons  --
  ##--------------------------------------------
  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)


thierrychambert's avatar
thierrychambert committed
  ##--------------------------------------------
  ##  Hide all inputs excepted actionButtons  --
  ##--------------------------------------------
thierrychambert's avatar
thierrychambert committed
  observe({
thierrychambert's avatar
thierrychambert committed

    #shinyjs::hide("fatal_constant")
Marie-Bocage's avatar
Marie-Bocage committed
    shinyjs::hide("fatalities_input_type")
    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")
Marie-Bocage's avatar
Marie-Bocage committed
    shinyjs::hide("pop_size_input_type")
    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")
Marie-Bocage's avatar
Marie-Bocage committed
    shinyjs::hide("carrying_cap_input_type")
Marie-Bocage's avatar
Marie-Bocage committed
    shinyjs::hide("carrying_capacity")
Marie-Bocage's avatar
Marie-Bocage committed
    shinyjs::hide("carrying_cap_mat_expert")
Marie-Bocage's avatar
Marie-Bocage committed
    shinyjs::hide("carrying_cap_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")
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

thierrychambert's avatar
thierrychambert 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_trend%%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