server.R

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


  ##--------------------------------------------
  ##  Hide all inputs excepted actionButtons  --
  ##--------------------------------------------
  observe({
    shinyjs::hide("fatal_constant")
    shinyjs::hide("fatalities_input_type")
    shinyjs::hide("fatalities_mean")
    shinyjs::hide("fatalities_se")
    shinyjs::hide("fatalities_mat_expert")
    shinyjs::hide("fatalities_run_expert")
    shinyjs::hide("farm_number_cumulated")
    shinyjs::hide("fatalities_mat_cumulated")
    shinyjs::hide("pop_size_type")
    shinyjs::hide("pop_size_input_type")
    shinyjs::hide("pop_size_mean")
    shinyjs::hide("pop_size_se")
    shinyjs::hide("pop_size_mat_expert")
    shinyjs::hide("pop_size_run_expert")
    shinyjs::hide("carrying_cap_input_type")
    shinyjs::hide("carrying_capacity")
    shinyjs::hide("carrying_cap_mat_expert")
    shinyjs::hide("carrying_cap_run_expert")
    shinyjs::hide("lambda_input_type")
    shinyjs::hide("pop_growth_mean")
    shinyjs::hide("pop_growth_se")
    shinyjs::hide("pop_growth_mat_expert")
    shinyjs::hide("pop_growth_run_expert")
    shinyjs::hide("pop_trend")
    shinyjs::hide("pop_trend_strength")
    shinyjs::hide("mat_fill_vr")

    # Show fatalities part

    if(input$button_fatalities%%2 == 1){
      shinyjs::show("fatal_constant")

      # Show inputs for none cumulated impacts scenario

      if(input$analysis_choice == "scenario"){
        shinyjs::show("fatalities_input_type")
        if(input$fatalities_input_type == "Valeurs"){
          shinyjs::show("fatalities_mean")
          shinyjs::show("fatalities_se")
        }
        if(input$fatalities_input_type == "Elicitation d'expert"){
          shinyjs::show("fatalities_mat_expert")
          shinyjs::show("fatalities_run_expert")
        }
      }

      # Show inputs for cumulated scenario

      if(input$analysis_choice == "cumulated"){
        shinyjs::show("farm_number_cumulated")
        shinyjs::show("fatalities_mat_cumulated")
      }

    }

    # Show inputs for population size part

    if(input$button_pop_size%%2 == 1){
      shinyjs::show("pop_size_type")
      shinyjs::show("pop_size_input_type")
      if(input$pop_size_input_type == "Valeurs"){
        shinyjs::show("pop_size_mean")
        shinyjs::show("pop_size_se")
      }
      if(input$pop_size_input_type == "Elicitation d'expert"){
        shinyjs::show("pop_size_mat_expert")
        shinyjs::show("pop_size_run_expert")
      }
    }

    # 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 == "Valeurs"){
        shinyjs::show("carrying_capacity")
      }
      if(input$carrying_cap_input_type == "Elicitation d'expert"){
        shinyjs::show("carrying_cap_mat_expert")
        shinyjs::show("carrying_cap_run_expert")
      }
    }

    # Show inputs for population trend part

    if(input$button_pop_trend%%2 == 1){
      shinyjs::show("lambda_input_type")
      if(input$lambda_input_type == "Taux de croissance"){
        shinyjs::show("pop_growth_mean")
        shinyjs::show("pop_growth_se")
      }
      if(input$lambda_input_type == "Elicitation d'expert"){
        shinyjs::show("pop_growth_mat_expert")
        shinyjs::show("pop_growth_run_expert")
      }
      if(input$lambda_input_type == "Tendance locale ou rgionale"){
        shinyjs::show("pop_trend")
        shinyjs::show("pop_trend_strength")
      }
    }

    # Show inputs vital rates part

    if(input$button_vital_rates%%2 == 1){
        shinyjs::show("mat_fill_vr")
    }

  }) # en observe show/hide


  ##--------------------------------------------
  ##  Functions                               --
  ##--------------------------------------------
  # Function to extract value from elicitation matrix and run the elication analysis
  func_eli <- function(mat_expert){
    t_mat_expert <- t(mat_expert)
    vals = t_mat_expert[3:5,]
    Cp = t_mat_expert[6,]
    weights = t_mat_expert[2,]

    out <- elicitation(vals, Cp, weights)
    return(list(out = out, mean = out$mean_smooth, SE = sqrt(out$var_smooth)))
  }

  # Function to plot output from elicitation analysis
  func_eli_plot <- function(out){
    plot_elicitation(out)
  }



  ##--------------------------------------------
  ##  Reactive values                         --
  ##--------------------------------------------
  param <- reactiveValues(N1 = NULL,
                          fatalities_mean = NULL,
                          fecundities = NULL,
                          survivals = NULL,
                          s_calibrated = NULL,
                          f_calibrated = NULL,
                          vr_calibrated = NULL,
                          cumulated_impacts = NULL,
                          onset_time = NULL,
                          onset_year = NULL,
                          carrying_capacity = NULL,
                          rMAX_species = NULL,
                          theta = theta,
                          fatalities_eli_result = NULL,
                          pop_size_eli_result = NULL,
                          pop_size_mean = NULL,
                          pop_size_se = NULL,
                          pop_size_type = NULL,
                          pop_growth_eli_result = NULL,
                          pop_growth_mean = NULL,
                          pop_growth_se = NULL,
                          carrying_cap_eli_result = NULL)





  ## Fatalities

  observeEvent({input$fatalities_run_expert}, {
    if(all(is.na(input$fatalities_mat_expert))) {} else {
      param$fatalities_eli_result <- func_eli(input$fatalities_mat_expert)

      ### Plot fatalities
      output$fatalities_expert_plot <- renderPlot({func_eli_plot(param$fatalities_eli_result$out)})}
  })

  ## Population size

  observeEvent({input$pop_size_run_expert}, {
    if(all(is.na(input$pop_size_mat_expert))) {} else {
      param$pop_size_eli_result <- func_eli(input$pop_size_mat_expert)

      ### Plot pop size
      output$pop_size_expert_plot <- renderPlot({func_eli_plot(param$pop_size_eli_result$out)})}
  })

  ## Population growth

  observeEvent({input$pop_growth_run_expert},{
    if(all(is.na(input$pop_growth_mat_expert))) {} else {
      param$pop_growth_eli_result <- func_eli(input$pop_growth_mat_expert)

      ### plot pop growth
      output$pop_growth_expert_plot <- renderPlot({func_eli_plot(param$pop_growth_eli_result$out)})
    }
  })

  ## Carrying capacity

  observeEvent({input$carrying_cap_run_expert},{
    if(all(is.na(input$carrying_cap_mat_expert))) {} else {
      param$carrying_cap_eli_result <- func_eli(input$carrying_cap_mat_expert)

      ### Plot carrying capacity
      output$carrying_cap_expert_plot <- renderPlot({func_eli_plot(param$carrying_cap_eli_result$out)})
    }
  })

  # Reactive values (cumulated impacts, fatalities mean, fatalities se, onset_time, survivals mean, fecundities mean)

  observeEvent({input$run}, {
    if(input$analysis_choice == "scenario"){
      param$cumulated_impacts = FALSE
    } else {
      param$cumulated_impacts = TRUE
    }
  })

  # Fatalities
  ## onset time, mean and se

  observeEvent({input$run}, {
    if(input$analysis_choice == "scenario"){
      if(input$fatalities_input_type == "Elicitation d'expert"){
        if(!(is.null(param$fatalities_eli_result))) {
          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))
        } else {
          print("#Intgrer un message d'erreur")
        }
      } else {
        param$fatalities_mean <- c(0, input$fatalities_mean)
        param$onset_time = NULL
        param$fatalities_se <- c(0, input$fatalities_se)
      }
    } else {
      param$fatalities_mean <- c(0, input$fatalities_mat_cumulated[,1])
      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
      param$fatalities_se <- c(0, input$fatalities_mat_cumulated[,2])
    }
  })

  # Observe pop size value
  ## Mean, se and type
  observeEvent({input$run},{
    if(input$pop_size_input_type == "Elicitation d'expert"){
      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 {
        print("#intgrer un message d'erreur")
      }
    } else {
      param$pop_size_mean <- input$pop_size_mean
      param$pop_size_se <- input$pop_size_se
    }
    param$pop_size_type <- input$pop_size_type
  })

  # Observe pop growth value
  observeEvent({input$run}, {
    if(input$lambda_input_type == "Elicitation d'expert"){
      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 {
        print("#intgrer un message d'erreur")
      }
    } else if(input$lambda_input_type == "Tendance locale ou rgionale"){
      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"){
        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
    }
    else {
      param$pop_growth_mean <- round(min(1 + param$rMAX_species, input$pop_growth_mean), 2)
      param$pop_growth_se <- input$pop_growth_se
    }
  })

  # Survivals and fecundities

  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

  # Survival and fecundity calibration

  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
  observeEvent({input$run}, {
    if(input$carrying_cap_input_type == "Elicitation d'expert"){
      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")
      }
    } else {
      param$carrying_capacity <- input$carrying_capacity
    }
  })

  observeEvent({input$run}, {
    print(param$pop_growth_mean)
    print(param$pop_growth_se)
  })

  # End of reactive

  # Simulations

  observeEvent({
    input$run
  }, {

    withProgress(message = 'Simulation progress', value = 0, {

      param$N1 <- run_simul_shiny(nsim = input$nsim,
                                  cumulated_impacts = param$cumulated_impacts,

                                  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_type,

                                  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,
                                  theta = param$theta,
                                  rMAX_species = param$rMAX_species,

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


  # Plot Impacts

  plot_out_impact <- function(){
    if(is.null(param$N1)) {} else {plot_impact(N = param$N1$N, xlab = "year", ylab = "pop size")}
  }

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

  # Plot trajectories

  plot_out_traj <- function(){
    if(is.null(param$N1)) {} else {plot_traj(N = param$N1$N, xlab = "year", ylab = "pop size")}
  }

  output$graph_traj <- renderPlot({
    plot_out_traj()
  })
  # End simulations


  ##--------------------------------------------
  ##  Display General information             --
  ##--------------------------------------------

  output$species_name <- renderText({ paste0("Espce slectionne : ", as.character(input$species_choice)) })


  ## Fatalities

  output$fatalities_mean_info <- renderText({
    if(input$fatalities_input_type == "Elicitation d'expert"){
      if(!(is.null(param$fatalities_eli_result))){
        info <- round(param$fatalities_eli_result$mean)
      } else {info <- NA}
    }
    else {
      info <- input$fatalities_mean
    }
    paste0("Moyenne des mortalits : ", info)
  })

  output$fatalities_se_info <- renderText({
    if(input$fatalities_input_type == "Elicitation d'expert"){
      if(!(is.null(param$fatalities_eli_result))){
        info <- round(param$fatalities_eli_result$SE)
      } else {info <- NA}
    }
    else {
      info <- input$fatalities_se
    }
    paste0("Ecart-type des mortalits : ", info)
  })

  ## Poplutation size

  output$pop_size_type_info <- renderText({
    if(input$pop_size_type == "Npair"){
      paste0("Type de taille de pop : ", "Nombre de couple")
    } else {
      paste0("Type de taille de pop : ", "Effectif total")
    }
  })

  output$pop_size_mean_info <- renderText({
    if(input$pop_size_input_type == "Elicitation d'expert"){
      if(!(is.null(param$pop_size_eli_result))){
        info <- round(param$pop_size_eli_result$mean)
      } else {info <- NA}
    }
    else {
      info <- input$pop_size_mean
    }
    paste0("Moyenne de la taille de la population : ", info)
  })

  output$pop_size_se_info <- renderText({
    if(input$pop_size_input_type == "Elicitation d'expert"){
      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("Ecart-type de la taille de la population : ", info)
  })

  ## Carrying capacity

  output$carrying_capacity_info <- renderText({
    if(input$carrying_cap_input_type == "Elicitation d'expert"){
      if(!(is.null(param$carrying_cap_eli_result))){
        info <- round(param$carrying_cap_eli_result$mean)
      } else {info <- NA}
    }
    else {
      info <- input$carrying_capacity
    }
    paste0("Capacit de charge du milieu : ", info)
  })

  ## Population growth

  output$pop_trend_type_info <- renderText({paste0("Type de Tendance de pop : ", input$lambda_input_type)})

  output$pop_growth_mean_info <- renderText({
    if(input$lambda_input_type == "Elicitation d'expert"){
      if(!(is.null(param$pop_growth_eli_result))){
        info <- round(param$pop_growth_eli_result$mean, 2)
      } else {info <- NA}
    } else if(input$lambda_input_type == "Tendance locale ou rgionale"){
        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
          } else {
            info <- 0.94
          }
        } else {
          info <- 1.00
        }
    } else {
        info <- input$pop_growth_mean
    }
    paste0("Moyenne de la croissance de la population : ", info)
  })

  output$pop_growth_se_info <- renderText({
    if(input$lambda_input_type == "Elicitation d'expert"){
      if(!(is.null(param$pop_growth_eli_result))){
        info <- round(param$pop_growth_eli_result$SE, 2)
      } else {info <- NA}
    } else if (input$lambda_input_type == "Tendance locale ou rgionale") {
      info <- 0.03
    }
    else {
      info <- input$pop_growth_se
    }
    paste0("Ecart-type de  la croissance de la population : ", info)
  })


  ## Vital rates

  output$vital_rates_info <- renderTable({
    input$mat_fill_vr
    }, rownames = TRUE)

  # End genral informations output



  ## Update matrix cumulated impact

  observeEvent({input$farm_number_cumulated}, {
    rows_names <- function(n){
      v <- c(paste0("Parc n", c(1:n)))
      return(v)
    }

    nrow <- input$farm_number_cumulated
    number_parks <- rows_names(nrow)

    init_cumul_new <- rep(init_cumul_add, nrow)

    updateMatrixInput(session, inputId = "fatalities_mat_cumulated",
                      value =  matrix(init_cumul_new, nrow = nrow, 3, byrow = TRUE,
                                      dimnames = list(number_parks,
                                                      c("Moyenne",
                                                        "Ecart-type",
                                                        "Anne de mise en service du parc"))))
  })

  # Survivals and Fecundities

  create.matrice <- function(data_sf, species){
    out_mat <- data_sf %>%
      filter(species == data_sf$Nom_espece) %>%
      select(classes_age, survie, fecondite)
    return(out_mat)
  }


## 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)

      if(all(is.na(tab_species))) {
        updateMatrixInput(session, inputId = "mat_fill_vr",
                          value = matrix(data = NA,
                                         nrow = 4,
                                         ncol = 2,
                                         dimnames = list(c("Juv 1", "Juv 2", "Juv 3", "Adulte"), 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


###################################################################################
} # End server