diff --git a/inst/ShinyApp/server.R b/inst/ShinyApp/server.R
index 728bf7be35d6f6072059695b4399e0083dbba29a..929fe89b994701ebf065fba6683b26835819086c 100644
--- a/inst/ShinyApp/server.R
+++ b/inst/ShinyApp/server.R
@@ -1,4 +1,4 @@
-server <- function(input, output){
+server <- function(input, output, session){
# Hide all inputs excepted actionButtons
@@ -8,6 +8,7 @@ server <- function(input, output){
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")
@@ -15,14 +16,16 @@ server <- function(input, output){
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_cap_mean")
- shinyjs::hide("carrying_cap_se")
+ 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("fill_type_vr")
@@ -44,6 +47,7 @@ server <- function(input, output){
}
if(input$fatalities_input_type == "Elicitation d'expert"){
shinyjs::show("fatalities_mat_expert")
+ shinyjs::show("fatalities_run_expert")
}
}
@@ -67,6 +71,7 @@ server <- function(input, output){
}
if(input$pop_size_input_type == "Elicitation d'expert"){
shinyjs::show("pop_size_mat_expert")
+ shinyjs::show("pop_size_run_expert")
}
}
@@ -75,11 +80,11 @@ server <- function(input, output){
if(input$button_carrying_cap%%2 == 1){
shinyjs::show("carrying_cap_input_type")
if(input$carrying_cap_input_type == "Valeurs"){
- shinyjs::show("carrying_cap_mean")
- shinyjs::show("carrying_cap_se")
+ 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")
}
}
@@ -93,8 +98,9 @@ server <- function(input, output){
}
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 régionale"){
+ if(input$lambda_input_type == "Tendance locale ou r�gionale"){
shinyjs::show("pop_trend")
shinyjs::show("pop_trend_strength")
}
@@ -113,60 +119,233 @@ server <- function(input, output){
}
})
+ # Elicitation experts part
+
+ 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)))
+ }
+
+ func_eli_plot <- function(out){
+ plot_elicitation(out)
+ }
+
## Output
- out <- reactiveValues(N1 = NULL, fatalities_mean = NULL, fecundities = NULL, survivals = NULL,
- cumulated_impacts = NULL, onset_time = NULL, onset_year = NULL,
- DD_params = NULL)
+ 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 = rMAX_species,
+ 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)
+
+ # Elicitation
+
+ ## 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"){
- out$cumulated_impacts = FALSE
+ param$cumulated_impacts = FALSE
} else {
- out$cumulated_impacts = TRUE
+ param$cumulated_impacts = TRUE
}
})
- # fatalities mean and onset_time
+ # Fatalities
+ ## onset time, mean and se
observeEvent({input$run}, {
if(input$analysis_choice == "scenario"){
- out$fatalities_mean <- c(0, input$fatalities_mean)
- out$onset_time = NULL
+ 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("#Int�grer 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 {
- out$fatalities_mean <- c(0, input$fatalities_mat_cumulated[,1])
- out$onset_year <- c(min(input$fatalities_mat_cumulated[,3]), input$fatalities_mat_cumulated[,3])
- out$onset_time <- out$onset_year - min(out$onset_year) + 1
+ 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])
}
})
- # fatalities se
+ # Population size
+ ## Mean, se and type
- observeEvent({input$run}, {
- if(input$analysis_choice == "scenario"){
- out$fatalities_se <- input$fatalities_se
+ 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("#int�grer un message d'erreur")
+ }
} else {
- out$fatalities_se <- c(min(input$fatalities_mat_cumulated[,2]), input$fatalities_mat_cumulated[,2])
+ 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
+ ## Avoid unrealistic scenarios
+
+ 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("#int�grer un message d'erreur")
+ }
+ } else if(input$lambda_input_type == "Tendance locale ou r�gionale"){
+ 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 == "D�clin"){
+ 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 means
+ # Survivals and fecundities
observeEvent({input$run}, {
if(input$fill_type_vr == "Manuelle"){
- out$survivals <- input$mat_fill_vr[,1]
- out$fecundities <- input$mat_fill_vr[,2]
+ param$survivals <- input$mat_fill_vr[,1]
+ param$fecundities <- input$mat_fill_vr[,2]
} else {
- out$survivals <- c(0.5, 0.7, 0.8, 0.95)
- out$fecundities <- c(0, 0, 0.05, 0.55)
+ param$survivals <- survivals
+ param$fecundities <- fecundities
}
})
- # observe({
- # DD_params$K <- input$carrying_cap_mean
- # })
+ # Survival and fecundity calibration
+
+ observeEvent({
+ input$run
+ # input$species_choice
+ # input$pop_growth_mean
+ },{
+
+ ## Avoid unrealistic scenarios
+ #param$pop_growth_mean <- min(1 + param$rMAX_species, input$pop_growth_mean)
+
+ 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("#int�grer 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
@@ -175,19 +354,42 @@ server <- function(input, output){
observeEvent({
input$run
}, {
- out$N1 <- run_simul(nsim = 10, cumuated_impacts = out$cumulated_impacts, onset_time = out$onset_time, fatalities_mean = out$fatalities_mean,
- fatalities_se = input$fatalities_se*out$fatalities_mean, DD_params = DD_params,
- pop_size_type = input$pop_size_type, pop_size_mean = input$pop_size_mean, pop_size_se = input$pop_size_se,
- pop_growth_mean = input$pop_growth_mean, pop_growth_se = input$pop_growth_se, survivals = out$survivals,
- fecundities = out$fecundities, model_demo = NULL, time_horzion = 30, coeff_var_environ = 0.1,
- fatal_constant = input$fatal_constant)
- })
+
+ withProgress(message = 'Simulation progress', value = 0, {
+
+ param$N1 <- run_simul_shiny(nsim = input$nsim,
+ cumuated_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(out$N1)) {} else {plot_impact(N = out$N1$N, xlab = "year", ylab = "pop size")}
+ if(is.null(param$N1)) {} else {plot_impact(N = param$N1$N, xlab = "year", ylab = "pop size")}
}
output$graph_impact <- renderPlot({
@@ -197,7 +399,7 @@ server <- function(input, output){
# Plot trajectories
plot_out_traj <- function(){
- if(is.null(out$N1)) {} else {plot_traj(N = out$N1$N, xlab = "year", ylab = "pop size")}
+ if(is.null(param$N1)) {} else {plot_traj(N = param$N1$N, xlab = "year", ylab = "pop size")}
}
output$graph_traj <- renderPlot({
@@ -205,66 +407,201 @@ server <- function(input, output){
})
# End simulations
- # Elicitation experts part
+ # General informations output
- 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)))
- }
+ ## Fatalities
- func_eli_plot <- function(out){
- plot_elicitation(out)
- }
+ 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 mortalit�s : ", info)
+ })
- observeEvent({input$run_expert}, {
- if(all(is.na(input$fatalities_mat_expert))) {} else {
- fatalities_result_eli <- func_eli(input$fatalities_mat_expert)
- output$fatalities_expert_mean <- renderText({paste0("Moyenne : ", fatalities_result_eli$mean)})
- output$fatalities_expert_sqrt_var <- renderText({paste0("Ecart-type : ", fatalities_result_eli$SE)})
- output$fatalities_expert_plot <- renderPlot({func_eli_plot(fatalities_result_eli$out)})
+ 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}
}
- if(all(is.na(input$pop_size_mat_expert))) {} else {
- pop_size_result_eli <- func_eli(input$pop_size_mat_expert)
- output$pop_size_expert_mean <- renderText({paste0("Moyenne : ", pop_size_result_eli$mean)})
- output$pop_size_expert_sqrt_var <- renderText({paste0("Ecart-type : ", pop_size_result_eli$SE)})
- output$pop_size_expert_plot <- renderPlot({func_eli_plot(pop_size_result_eli$out)})
+ else {
+ info <- input$fatalities_se
}
- if(all(is.na(input$carrying_cap_mat_expert))) {} else {
- carrying_cap_result_eli <- func_eli(input$carrying_cap_mat_expert)
- output$carrying_cap_expert_mean <- renderText({paste0("Moyenne : ", carrying_cap_result_eli$mean)})
- output$carrying_cap_expert_sqrt_var <- renderText({paste0("Ecart-type : ", carrying_cap_result_eli$SE)})
- output$carrying_cap_expert_plot <- renderPlot({func_eli_plot(carrying_cap_result_eli$out)})
+ paste0("Ecart-type des mortalit�s : ", 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")
}
- if(all(is.na(input$pop_growth_mat_expert))) {} else {
- pop_growth_result_eli <- func_eli(input$pop_growth_mat_expert)
- output$pop_growth_expert_mean <- renderText({paste0("Moyenne : ", pop_growth_result_eli$mean)})
- output$pop_growth_expert_sqrt_var <- renderText({paste0("Ecart-type : ", pop_growth_result_eli$SE)})
- output$pop_growth_expert_plot <- renderPlot({func_eli_plot(pop_growth_result_eli$out)})
+ })
+
+ 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)
})
- # End of elicitation part
- # Info outputs
+ 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)
+ })
- output$fatalities_mean_info <- renderText({paste0("Moyenne des mortalités : ", input$fatalities_mean)})
- output$fatalities_se_info <- renderText({paste0("Ecart-type des mortalités : ", input$fatalities_se)})
+ ## Carrying capacity
- output$pop_size_mean_info <- renderText({paste0("Moyenne Taille de pop : ", input$pop_size_mean)})
- output$pop_size_se_info <- renderText({paste0("Ecart-type Taille de pop : ", input$pop_size_se)})
+ 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)
+ })
- output$carrying_cap_mean_info <- renderText({paste0("Moyenne Capacité de charge : ", input$carrying_cap_mean)})
- output$carrying_cap_se_info <- renderText({paste0("Ecart-type Capacité de charge : ", input$carrying_cap_se)})
+ ## Population growth
output$pop_trend_type_info <- renderText({paste0("Type de Tendance de pop : ", input$lambda_input_type)})
- output$pop_trend_mean_info <- renderText({paste0("Moyenne Tendance de pop : ", input$pop_growth_mean)})
- output$pop_trend_se_info <- renderText({paste0("Ecart-type Tendance de pop : ", input$pop_growth_se)})
+
+ 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 r�gionale"){
+ 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 == "D�clin"){
+ 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 r�gionale") {
+ 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({
+ if(input$fill_type_vr == "Automatique"){
+ input$mat_display_vr
+ } else {
+ input$mat_fill_vr
+ }
+ })
+ # 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)
+ # data_fatalities_cumulated <- c(c(input$fatalities_mat_cumulated[,1]),
+ # c(input$fatalities_mat_cumulated[,2]),
+ # c(input$fatalities_mat_cumulated[,3]))
+
+ updateMatrixInput(session, inputId = "fatalities_mat_cumulated",
+ value = matrix("", nrow = nrow, 3,
+ dimnames = list(number_parks,
+ c("Moyennes des mortalit�s annuelles",
+ "Ecart-type des mortalit�s annuelles",
+ "Ann�e de mise en service du parc"))))
+ })
+
+ # Survivals and Fecundities
+
+ create.matrice <- function(species){
+ tab_test <- data_sf %>%
+ filter(species == data_sf$Nom_espece) %>%
+ select(classes_age, survie, fecondite)
+ return(tab_test)
+ }
+
+ observeEvent({input$species_list}, {
+ if(input$species_list == "Esp�ce") {} else {
+ tab_species <- create.matrice(input$species_list)
+
+ if(all(is.na(tab_species))) {
+ updateMatrixInput(session, inputId = "mat_fill_vr",
+ value = matrix(data = "",
+ nrow = 4,
+ ncol = 2,
+ dimnames = list(c("Juv 1", "Juv 2", "Juv 3", "Adulte"), c("Survie", "F�condit�"))))
+
+ } 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", "F�condit�"))))
+ }
+ }
+ })
}
# End server
+shinyApp(ui, server)
diff --git a/inst/ShinyApp/survivals_fecundities_species.csv b/inst/ShinyApp/survivals_fecundities_species.csv
new file mode 100644
index 0000000000000000000000000000000000000000..b2bce0a2b10a784ed2371f9fb4b884f51b01bd0c
--- /dev/null
+++ b/inst/ShinyApp/survivals_fecundities_species.csv
@@ -0,0 +1,10 @@
+Nom_espece,classes_age,survie,fecondite
+Aigle bott�,Juv 1,0.5,0
+Aigle bott�,Juv 2,0.7,0
+Aigle bott�,Juv 3,0.8,0.05
+Aigle bott�,Adulte,0.95,0.55
+Aigle de Bonelli,Juv 1,0.4,0
+Aigle de Bonelli,Juv 2,0.55,0
+Aigle de Bonelli,Juv 3,0.6,0.05
+Aigle de Bonelli,Juv 4,0.65,0.3
+Aigle de Bonelli,Adulte,0.8,0.4
\ No newline at end of file
diff --git a/inst/ShinyApp/ui.R b/inst/ShinyApp/ui.R
index 576f3ff807ff48b6a690c0da15716455057c095e..b20338e5ef9e7b6e40dcacdb7b910983e33719a9 100644
--- a/inst/ShinyApp/ui.R
+++ b/inst/ShinyApp/ui.R
@@ -10,209 +10,286 @@ library(eolpop)
# source("./inst/ShinyApp/f_output.R")
source("./inst/ShinyApp/param_fixes.R")
+
species_data <- read.csv("./inst/ShinyApp/species_list.csv", sep = ",")
-species_list <- unique(as.character(species_data$NomEspece))
+head(species_data)
+# species_list <- unique(as.character(species_data$NomEspece))
+species_list <- species_data$NomEspece
-# Data elicitation, fatalities for cumulated impacts, vital rates and DD_params
+data_sf <- read.csv("./inst/ShinyApp/survivals_fecundities_species.csv", sep = ",")#, encoding = "UTF-8")
+head(data_sf)
+
+
+# Fixed parameters (for now)
+nsim = 10
+coeff_var_environ = 0.10
+time_horzion = 30
+survivals <- c(0.5, 0.7, 0.8, 0.95)
+fecundities <- c(0, 0, 0.05, 0.55)
+# Data elicitation, fatalities for cumulated impacts, vital rates and DD_params
data_eli = c("",1, 50, 70, 100, 0.80, "", 0.2, 200, 240, 280, 0.90, "", 0.2, 100, 180, 300, 0.90,"", 0.1, 120, 160, 220, 0.70)
-data_fatalities = c(5, 10, 15, 0.05, 0.05, 0.05, 2010, 2013, 2016)
+data_eli_trend = c("", 1, 0.60, 0.66, 0.78, 0.80, "", 0.2, 0.75, 0.83, 0.89, 0.90, "", 0.2, 0.56, 0.67, 0.77, 0.90, "", 0.1, 0.76, 0.89, 0.94, 0.70)
+data_fatalities = c(10, 5, 8, 0.05, 0.05, 0.05, 2010, 2015, 2018)
data_vr = c(0.5, 0.7, 0.8, 0.95, 0, 0, 0.05, 0.55)
-rMax = NULL
+# DD parameters
theta = 1
-DD_params = list(rMax = rMax, K = NULL, theta = theta)
-# UI
+# Define theoretical rMAX for the species
+rMAX_species <- rMAX_spp(surv = tail(survivals,1), afr = min(which(fecundities != 0)))
+rMAX_species
+
+##--------------------------------------------
+## User Interface --
+##--------------------------------------------
ui <- fluidPage(
useShinyjs(),
- titlePanel("eolpop_2 : Impact demographique des éoliennes"),
+ titlePanel("eolpop : Impact demographique des �oliennes"),
# Creation of the first page (select species, analysis type choice)
wellPanel(
selectInput(inputId = "species_list",
- h4(strong("Sélection d'une espèce ou groupe d'espèces")),
+ h4(strong("S�lection d'une esp�ce ou groupe d'esp�ces")),
choices = species_list),
radioButtons(inputId = "analysis_choice",
- h4(strong("Sélectionner un type d'analyse")),
- choices = c("Impacts non cumulés" = "scenario", "Impacts cumulés" = "cumulated"))
+ h4(strong("S�lectionner un type d'analyse")),
+ choices = c("Impacts non cumul�s" = "scenario", "Impacts cumul�s" = "cumulated"))
), # End wellPanel
- # Info
+
+ ##--------------------------------------------
+ ## General information --
+ ##--------------------------------------------
wellPanel(
fluidRow(
- column(width = 6,
+ column(width = 4,
textOutput(outputId = "specie_name"),
- h4("#Partie Mortalités"),
+ h4("Mortalit�s"),
textOutput(outputId = "fatalities_mean_info"),
textOutput(outputId = "fatalities_se_info"),
- textOutput(outputId = "fatalities_expert_info"),
- h4("#Partie Taille de la population"),
+ h4("Taille de la population"),
+ textOutput(outputId = "pop_size_type_info"),
textOutput(outputId = "pop_size_mean_info"),
- textOutput(outputId = "pop_size_se_info"),
- textOutput(outputId = "pop_size_expert_info")),
+ textOutput(outputId = "pop_size_se_info")),
fluidRow(
- column(width = 6,
- h4("#Partie Capacité de charge"),
- textOutput(outputId = "carrying_cap_mean_info"),
- textOutput(outputId = "carrying_cap_se_info"),
- textOutput(outputId = "carrying_cap_expert_info"),
- h4("#Partie Tendance de la population"),
+ column(width = 4,
+ h4("Capacit� de charge"),
+ textOutput(outputId = "carrying_capacity_info"),
+ h4("Tendance de la population"),
textOutput(outputId = "pop_trend_type_info"),
- textOutput(outputId = "pop_trend_mean_info"),
- textOutput(outputId = "pop_trend_se_info"),
- textOutput(outputId = "pop_trend_expert_info"))
+ textOutput(outputId = "pop_growth_mean_info"),
+ textOutput(outputId = "pop_growth_se_info")),
+ fluidRow(
+ column(width = 4,
+ h4("Param�tres d�mographiques"),
+ tableOutput(outputId = "vital_rates_info"))
+ )
)
)
), # End wellPanel
- # Creation of units (fatalities, pop size, carrying capacity, pop trend and vital rates).
+ # Paramter Inputs (fatalities, pop size, carrying capacity, pop trend and vital rates).
sidebarLayout(
sidebarPanel(
- # First part : Fatalities
+ ##--------------------------------------------
+ ## 1. Fatalities --
+ ##--------------------------------------------
actionButton(inputId = "button_fatalities",
- label = "Mortalités"),
+ label = "Mortalit�s"),
radioButtons(inputId = "fatal_constant",
- label = h4("Modélisation"),
- choices = c("Taux de mortalités (h) constant" = "h",
- "Nombre de mortalités (M) constant" = "M")),
-
- # Part for none cumulated impacts
+ label = h4("Mod�lisation"),
+ choices = c("Taux de mortalit�s (h) constant" = "h",
+ "Nombre de mortalit�s (M) constant" = "M")),
+ ### Part for non-cumulated impacts
+ # Input type
radioButtons(inputId = "fatalities_input_type",
- label = h4("Source des données"),
+ label = h4("Source des donn�es"),
choices = c("Valeurs", "Elicitation d'expert")),
+
+ # Values
numericInput(inputId = "fatalities_mean",
- label = "Moyenne des mortalités annuelles",
+ label = "Moyenne des mortalit�s annuelles",
value = 5,
- min = 0, max = Inf, step = 1),
+ min = 0, max = Inf, step = 0.5),
numericInput(inputId = "fatalities_se",
- label = "Ecart-type des mortalités annuelles",
+ label = "Ecart-type des mortalit�s annuelles",
value = 0.05,
- min = 0, max = Inf, step = 1),
+ min = 0, max = Inf, step = 0.1),
+
+ # Matrix for expert elicitation
matrixInput(inputId = "fatalities_mat_expert",
value = matrix(data = data_eli, 4, 6, dimnames = list(c("#1", "#2", "#3", "#4"), c("Nom", "Poids", "Min", "Meilleure Estimation", "Max", "IC (coverage)" )), byrow = TRUE),
class = "numeric",
rows = list(names = TRUE),
cols = list(names = TRUE)),
- # Part for cumulated impacts
+ actionButton(inputId = "fatalities_run_expert", label = "Analyse"),
+
+ ### Part for cumulated impacts
numericInput(inputId = "farm_number_cumulated",
- label = "Nombre de parcs éoliens",
- value = 2, min = 2, max = Inf, step = 1),
+ label = "Nombre de parcs �oliens",
+ value = 3, min = 2, max = Inf, step = 1),
+
matrixInput(inputId = "fatalities_mat_cumulated",
- value = matrix(data = data_fatalities, 3, 3, dimnames = list(c("#1", "#2", "#3"), c("Moyennes des mortalités annuelles",
- "Ecart-type des mortalités annuelles",
- "Année de mise en service du parc"))),
+ value = matrix(data_fatalities, 3, 3,
+ dimnames = list(c(paste0("Parc n�", c(1:3))),
+ c("Moyennes des mortalit�s annuelles",
+ "Ecart-type des mortalit�s annuelles",
+ "Ann�e de mise en service du parc"))),
class = "numeric",
rows = list(names = TRUE),
cols = list(names = TRUE)),
- # Second part : Pop size
- br(),
+ ##--------------------------------------------
+ ## 2. Population Size --
+ ##--------------------------------------------
+
+ br(" "),
actionButton(inputId = "button_pop_size",
label = "Taille de la population"),
+
radioButtons(inputId = "pop_size_type",
- label = h4("Unité"),
+ label = h4("Unit�"),
choices = c("Nombre de couple" = "Npair", "Effectif total" = "Ntotal")),
+
radioButtons(inputId = "pop_size_input_type",
label = h4("Type de saisie"),
choices = c("Valeurs", "Elicitation d'expert")),
+
numericInput(inputId = "pop_size_mean",
label = "Moyenne de la taille de la population",
value = 200,
- min = 0, max = Inf, step = 100),
+ min = 0, max = Inf, step = 50),
+
numericInput(inputId = "pop_size_se",
label = "Ecart-type de la taille de la population",
value = 25,
min = 0, max = Inf, step = 1),
+
matrixInput(inputId = "pop_size_mat_expert",
- value = matrix(data = data_eli, 4, 6, dimnames = list(c("#1", "#2", "#3", "#4"), c("Nom", "Poids", "Min", "Meilleure Estimation", "Max", "IC (coverage)" )), byrow = TRUE),
+ value = matrix(data = data_eli, 4, 6,
+ dimnames = list(c("#1", "#2", "#3", "#4"),
+ c("Nom", "Poids", "Min", "Best", "Max", "IC" )),
+ byrow = TRUE),
class = "numeric",
rows = list(names = TRUE),
cols = list(names = TRUE)),
- # Third part : Carrying capacity
+ actionButton(inputId = "pop_size_run_expert", label = "Analyse"),
+
- br(),
+ ##--------------------------------------------
+ ## 3. Carrying capacity --
+ ##--------------------------------------------
+
+ br(" "),
actionButton(inputId = "button_carrying_cap",
- label = "Capacité de charge"),
+ label = "Capacit� de charge"),
+
radioButtons(inputId = "carrying_cap_input_type",
- label = h4("Type d'unité"),
+ label = h4("Type d'unit�"),
choices = c("Valeurs", "Elicitation d'expert")),
- numericInput(inputId = "carrying_cap_mean",
- label = "Moyenne de la capacité de charge",
- value = 500,
- min = 0, max = Inf, step = 1),
- numericInput(inputId = "carrying_cap_se",
- label = "Ecart-type de la capacité de charge",
- value = 1,
- min = 0, max = Inf, step = 1),
+
+ numericInput(inputId = "carrying_capacity",
+ label = "Capacit� de charge",
+ value = 1000,
+ min = 0, max = Inf, step = 100),
+
matrixInput(inputId = "carrying_cap_mat_expert",
- value = matrix("", 4, 6, dimnames = list(c("#1", "#2", "#3", "#4"), c("Nom", "Poids", "Min", "Meilleure Estimation", "Max", "IC (coverage)" ))),
+ value = matrix(data = data_eli, 4, 6, dimnames = list(c("#1", "#2", "#3", "#4"), c("Nom", "Poids", "Min", "Meilleure Estimation", "Max", "IC (coverage)" )), byrow = TRUE),
class = "numeric",
rows = list(names = TRUE),
cols = list(names = TRUE)),
- # Fourth part : Pop trend
+ actionButton(inputId = "carrying_cap_run_expert", label = "Analyse"),
- br(),
+ ##--------------------------------------------
+ ## 4. Population Trend --
+ ##--------------------------------------------
+
+ br(" "),
actionButton(inputId = "button_pop_trend",
label = "Tendance de la population"),
+
radioButtons(inputId = "lambda_input_type",
label = h4("Type de tendance"),
- choices = c("Taux de croissance", "Elicitation d'expert", "Tendance locale ou régionale")),
+ choices = c("Taux de croissance", "Elicitation d'expert", "Tendance locale ou r�gionale")),
+
numericInput(inputId = "pop_growth_mean",
label = "Moyenne de la croissance de la population",
value = 1,
- min = 0, max = Inf, step = 1),
+ min = 0, max = Inf, step = 0.01),
+
numericInput(inputId = "pop_growth_se",
label = "Ecart-type de la croissance de la population",
- value = 0.03,
- min = 0, max = Inf, step = 1),
+ value = 0,
+ min = 0, max = Inf, step = 0.01),
+
matrixInput(inputId = "pop_growth_mat_expert",
- value = matrix("", 4, 6, dimnames = list(c("#1", "#2", "#3", "#4"), c("Nom", "Poids", "Min", "Meilleure Estimation", "Max", "IC (coverage)" ))),
+ value = matrix(data = data_eli_trend, 4, 6, dimnames = list(c("#1", "#2", "#3", "#4"), c("Nom", "Poids", "Min", "Meilleure Estimation", "Max", "IC (coverage)" )), byrow = TRUE),
class = "numeric",
rows = list(names = TRUE),
cols = list(names = TRUE)),
+
+ actionButton(inputId = "pop_growth_run_expert", label = "Analyse"),
+
+ h4("Tendance de la population"),
+
radioButtons(inputId = "pop_trend",
- label = h4("Tendance de la population"),
- choices = c("Croissance", "Stable", "Déclin")),
+ label = NULL,
+ choices = c("Croissance", "Stable", "D�clin")),
+
radioButtons(inputId = "pop_trend_strength",
label = NULL,
choices = c("Faible", "Moyen", "Fort")),
- # Fifth part : Vital rates
+ # tags$style("#pop_trend_strength {position:fixed; top: 600px; right: 100px;}"),
+
+
+ ##--------------------------------------------
+ ## 5. Vital rates --
+ ##--------------------------------------------
- br(),
+ br(" "),
actionButton(inputId = "button_vital_rates",
- label = "Paramètres démographiques"),
+ label = "Param�tres d�mographiques"),
+
radioButtons(inputId = "fill_type_vr",
label = "Type de saisie",
choices = c("Automatique", "Manuelle")),
+
+ # tableOutput(outputId = "mat_display_vr"),
+
matrixInput(inputId = "mat_display_vr",
- value = matrix("", 4, 2, dimnames = list(c("Juv 1", "Juv 2", "Juv 3", "Adulte"), c("Survie", "Fécondité"))),
+ value = matrix("", 4, 2, dimnames = list(c("Juv 1", "Juv 2", "Juv 3", "Adulte"), c("Survie", "F�condit�"))),
class = "numeric",
rows = list(names = TRUE),
cols = list(names = TRUE)),
+
matrixInput(inputId = "mat_fill_vr",
- value = matrix(data = data_vr, 4, 2, dimnames = list(c("Juv 1", "Juv 2", "Juv 3", "Adulte"), c("Survie", "Fécondité"))),
+ value = matrix(data = data_vr, 4, 2, dimnames = list(c("Juv 1", "Juv 2", "Juv 3", "Adulte"), c("Survie", "F�condit�"))),
class = "numeric",
rows = list(names = TRUE),
cols = list(names = TRUE))
+
), # End sidebarPanel
- # End of units
+
+ #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
# Creation of outputs parts
@@ -221,53 +298,46 @@ ui <- fluidPage(
tabPanel(title = "Impact population",
strong(span(textOutput("message"), style="color:blue; font-size:24px", align = "center")),
br(),
+ numericInput(inputId = "nsim", label = "Nombre de simulations",
+ value = 50, min = 0, max = Inf, step = 10),
+ br(),
actionButton(inputId = "run", label = "Lancer l'analyse"),
hr(),
- h4("Graphique : Impact relatif de chaque scénario", align = "center"),
+ h4("Graphique : Impact relatif de chaque sc�nario", align = "center"),
plotOutput("graph_impact", width = "100%", height = "550px"),
hr(),
- h4("Graphique : Trajectoire démographique", align = "center"),
+ h4("Graphique : Trajectoire d�mographique", align = "center"),
plotOutput("graph_traj", width = "100%", height = "550px")),
- tabPanel(title = "Distribution paramètres",
- br(),
- actionButton(inputId = "run_expert", label = "Analyse"),
+ tabPanel(title = "Distribution param�tres",
br(),
hr(),
- h4("#Graphe élicitation d'expert pour les mortalités", align = "center"),
- textOutput(outputId = "fatalities_expert_mean"),
- textOutput(outputId = "fatalities_expert_sqrt_var"),
+ h4("#Graphe �licitation d'expert pour les mortalit�s", align = "center"),
plotOutput(outputId = "fatalities_expert_plot"),
hr(),
- h4("#Graphe élicitation d'expert pour la taille de la population", align = "center"),
- textOutput(outputId = "pop_size_expert_mean"),
- textOutput(outputId = "pop_size_expert_sqrt_var"),
+ h4("#Graphe �licitation d'expert pour la taille de la population", align = "center"),
plotOutput(outputId = "pop_size_expert_plot"),
hr(),
- h4("#Graphe élicitation d'expert pour la capacité de charge", align = "center"),
- textOutput(outputId = "carrying_cap_expert_mean"),
- textOutput(outputId = "carrying_cap_expert_sqrt_var"),
+ h4("#Graphe �licitation d'expert pour la capacit� de charge", align = "center"),
plotOutput(outputId = "carrying_cap_expert_plot"),
hr(),
- h4("#Graphe élicitation d'expert pour la tendance de la population", align = "center"),
- textOutput(outputId = "pop_growth_expert_mean"),
- textOutput(outputId = "pop_growth_expert_sqrt_var"),
+ h4("#Graphe �licitation d'expert pour la tendance de la population", align = "center"),
plotOutput(outputId = "pop_growth_expert_plot"),
),
tabPanel(title = "Rapport",
br(),
radioButtons(inputId = "lifestyle",
- h4("Mode de vie de l'espèce"),
- choices = c("Sédentaire", "Non-sédentaire nicheur", "Non-sédentaire hivernant", "Migrateur de passage")),
+ h4("Mode de vie de l'esp�ce"),
+ choices = c("S�dentaire", "Non-s�dentaire nicheur", "Non-s�dentaire hivernant", "Migrateur de passage")),
numericInput(inputId = "wind_turbines",
- h4("Nombre d'éoliennes"),
+ h4("Nombre d'�oliennes"),
value = 5, min = 0, max = Inf, step = 1),
numericInput(inputId = "farm_number",
h4("Nombre de parcs"),
value = 1, min = 0, max = Inf, step = 1),
numericInput(inputId = "wind_turbines_2",
- h4("Nombre d'éoliennes"),
+ h4("Nombre d'�oliennes"),
value = 1, min = 0, max = Inf, step = 1)
) # End tabPanel
@@ -278,4 +348,4 @@ ui <- fluidPage(
# End UI
-# shinyApp(ui = ui, server = server)
+shinyApp(ui = ui, server = server)
diff --git a/run_shiny.R b/run_shiny.R
index 487b2c55228dfdb0298ab211a0353369b66efebf..c845766867efa66b8f352e178815bc0858c3096d 100644
--- a/run_shiny.R
+++ b/run_shiny.R
@@ -1,4 +1,4 @@
-source("C:/rdev/eolpop/inst/ShinyApp/ui.R")
-source("C:/rdev/eolpop/inst/ShinyApp/server.R")
-
-shinyApp(ui = ui, server = server)
+source("C:/rdev/eolpop/inst/ShinyApp/ui.R")
+source("C:/rdev/eolpop/inst/ShinyApp/server.R")
+
+shinyApp(ui = ui, server = server)