Skip to content
Snippets Groups Projects
server.R 39.4 KiB
Newer Older
    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

  }) # end observe
  #####

  #####
  ##-----------------------------------------------------------------------------------
  ##                                RUN SIMULATIONS
  ##-----------------------------------------------------------------------------------
  observeEvent({
    input$run
  }, {
Marie-Bocage's avatar
Marie-Bocage committed

    if(ready$fatalities & ready$pop_size & ready$pop_growth & ready$carrying_capacity){
      withProgress(message = 'Simulation progress', value = 0, {

        out$run <- run_simul_shiny(nsim = param$nsim,
                                   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,
                                   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,
Marie-Bocage's avatar
Marie-Bocage committed

                                   survivals = param$s_calibrated,
                                   fecundities = param$f_calibrated,
Marie-Bocage's avatar
Marie-Bocage committed

                                   carrying_capacity = param$carrying_capacity,
                                   theta = param$theta,
                                   rMAX_species = param$rMAX_species,
Marie-Bocage's avatar
Marie-Bocage committed

                                   model_demo = NULL,
                                   time_horzion = param$time_horzion,
                                   coeff_var_environ = param$coeff_var_environ,
                                   fatal_constant = param$fatal_constant)
      }) # Close withProgress

    }else{
      out$run <- NULL
      out$msg <- "error_not_ready"
    }
  }) # Close observEvent
  #####
  #####
  ##-----------------------------------------------------------------------------------
  ##                                OUTPUTS
  ##-----------------------------------------------------------------------------------
Marie-Bocage's avatar
Marie-Bocage committed

  ##-------------------------------------------
  ## Impact text
  ##-------------------------------------------
  ## Functions to print the output as text (non cumulated impacts)
  print_impact_text <- function(impact, lci, uci){
    paste0("Impact : ", round(impact, 2)*100, "%",
           "[", round(lci, 2)*100, "% ; ", round(uci, 2)*100, "%]")
  } # end function print_impact_text

  ## Functions to print the output as text (non cumulated impacts)
  print_impact_table <- function(res){
    nfarm <- (dim(res$indiv_farm$impact)[3]-1)
    fil <- paste0(round(t(res$indiv_farm$impact[time_horzion, -2, -1]),2)*100, "%")
    matrix(fil,
           nrow = nfarm,
           dimnames = list(paste("Parc",1:nfarm), c("Impact", "IC (min)", "IC (max)"))
    )
  } # end function print_impact_table

      if(param$cumulated_impacts){
        # cumulated impact ==> Table
        print_impact_table(res = get_metrics(N = out$run$N, cumulated_impacts = TRUE))
      }else{
        # non cumulated impact ==> Text
        print_impact_text(impact = get_metrics(N = out$run$N)$scenario$impact[time_horzion, "avg",-1],
                 lci = get_metrics(N = out$run$N)$scenario$impact[time_horzion, "lci",-1],
                 uci = get_metrics(N = out$run$N)$scenario$impact[time_horzion, "uci",-1])
      }

    } else {
      # When run is NULL

      if(!is.null(out$msg)){

        # Print the error msg, if there is one
        if(out$msg == "error_not_ready"){
          paste0("Erreur: Vous n'avez pas lancer l'analyse 'valeurs experts'")
        }else{
          paste0("Some other error occurred")
        }

      }else{
        # When no error msg : nothing happens
      } # if "msg"
    } # if "run
Marie-Bocage's avatar
Marie-Bocage committed

  # Display title
  output$title_impact_result <- renderText({
    if(input$run > 0){
      "Rsultat : Impact estim au bout de 30 ans"
    }
  })

  # Display result (text for non cumulated impacts)
  output$impact_text <- renderText({
    }else{
      if(!param$cumulated_impacts){
        print_out()
      } else{
        NULL
      }
Marie-Bocage's avatar
Marie-Bocage committed

  # Display result (table for cumulated impacts)
  output$impact_table <- renderTable({
    if(input$run == 0){
      NULL
    }else{
      if(param$cumulated_impacts){
        print_out()
      } else{
        NULL
      }
    }
  }, rownames = TRUE)

  ##-------------------------------------------
  ## Plot Impacts
  ##-------------------------------------------
  ## Function to plot the impact
  plot_out_impact <- function(){
thierrychambert's avatar
thierrychambert committed
    if(is.null(out$run)) {} else {
      plot_impact(N = out$run$N, onset_year = param$onset_year, percent = TRUE,
                  xlab = "\nAnne", ylab = "Impact relatif (%)\n")
      }
  output$title_impact_plot <- renderText({
    if(input$run > 0){
      "Rsultat : Impact relatif au cours du temps"
    }
  })

  output$impact_plot <- renderPlot({
    plot_out_impact()
  })

  ##-------------------------------------------
  ## Plot Demographic Trajectories
  ##-------------------------------------------
  # Function to plot trajectories
  plot_out_traj <- function(){
    if(is.null(out$run)) {} else {plot_traj(N = out$run$N, xlab = "year", ylab = "pop size")}
  }

  output$title_traj_plot <- renderText({
    if(input$run > 0){
      "Graphique : Trajectoire dmographique"
    }
  })

  output$traj_plot <- renderPlot({
thierrychambert's avatar
thierrychambert committed
  ###################################################################################
thierrychambert's avatar
thierrychambert committed