Newer
Older
shinyjs::hide("fatal_constant")
shinyjs::hide("fatalities_input_type")
shinyjs::hide("fatalities_mean")
shinyjs::hide("fatalities_se")
shinyjs::hide("fatalities_mat_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("lambda_input_type")
shinyjs::hide("pop_growth_mean")
shinyjs::hide("pop_growth_se")
shinyjs::hide("pop_growth_mat_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")
}
}
# 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")
}
}
# 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"){
}
if(input$carrying_cap_input_type == "Elicitation d'expert"){
shinyjs::show("carrying_cap_mat_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")
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
# 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)
}
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
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"){
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)
}
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])
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")
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("#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
param$survivals <- input$mat_fill_vr[,1]
param$fecundities <- input$mat_fill_vr[,2]
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
# 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("#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
}, {
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
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
if(is.null(param$N1)) {} else {plot_impact(N = param$N1$N, xlab = "year", ylab = "pop size")}
}
output$graph_impact <- renderPlot({
plot_out_impact()
})
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)) })
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}
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)
})
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$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)
observeEvent({input$farm_number_cumulated}, {
rows_names <- function(n){
v <- c(paste0("Parc n", c(1:n)))
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"))))
create.matrice <- function(data_sf, species){
out_mat <- data_sf %>%
filter(species == data_sf$Nom_espece) %>%
select(classes_age, survie, fecondite)
## 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",
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