Newer
Older
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Initial stuff
{
## Load libraries
library(shiny)
library(shinyjs)
library(shinyMatrix)
library(tidyverse)
library(eolpop)
## Load species list
species_data <- read.csv("./inst/ShinyApp/species_list.csv", sep = ",")
species_list <- unique(as.character(species_data$NomEspece))
## Load survival and fecundities data
data_sf <- read.csv("./inst/ShinyApp/survivals_fecundities_species.csv", sep = ",")#, encoding = "UTF-8")
(data_sf)
# Fixed parameters (for now)
nsim = 10
coeff_var_environ = 0.10
time_horzion = 30
theta = 1 # DD parameter theta
CP = 0.99 # Coverage probability for lower - upper values
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Pre-fill data
{
## Data elicitation pre-fill data
# fatalities
eli_fatalities <- c(1.0, 2, 5, 8, 0.80,
0.2, 0, 3, 6, 0.90,
0.2, 2, 4, 10, 0.90,
0.1, 1, 3, 7, 0.70)
# population size
eli_pop_size <- c(1.0, 150, 200, 250, 0.80,
0.5, 120, 180, 240, 0.90,
0.8, 170, 250, 310, 0.90,
0.3, 180, 200, 230, 0.70)
# carrying capacity
eli_carrying_cap <- c(1.0, 500, 700, 1000, 0.80,
0.5, 1000, 1500, 2000, 0.90,
0.8, 800, 1200, 1600, 0.90,
0.3, 100, 1200, 1500, 0.70)
# population growth rate
eli_pop_growth <- c(1 , 0.95, 0.98, 1.00, 0.95,
0.2, 0.97, 1.00, 1.01, 0.90,
0.5, 0.92, 0.96, 0.99, 0.90,
0.3, 0.90, 0.95, 0.98, 0.70)
## Other pre-fill data
# fatality table for cumulated impacts (several wind farms)
set.seed(seed = 200)
init_cumul <-
matrix(
round(c(
runif(n = 20, 1, 10),
runif(n = 20, 0.01, 0.20),
sort(sample(x = 2000:2050, size = 20, replace = TRUE))
), 2),
nrow = 20, ncol = 3, byrow = FALSE)
# Undo last 'set.seed'
set.seed( ((((Sys.time() %>% as.numeric) %% 1e10) * 1e9) %% 1e5) %>% round )
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
titlePanel("eolpop : Impact demographique des collisions aviaires avec les oliennes"),
###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
# Head Panel 1 : type of analysis and species
{wellPanel(
{fluidRow(
# Select type of analysis : cumulated impacted or not
{column(width = 4,
# Choose analysis type (radioButton)
{radioButtons(inputId = "analysis_choice",
label = h4(strong("Type d'analyse"),
bsButton("Q_analysis_choice", label = "", icon = icon("question"), size = "extra-small"),
bsPopover(id = "Q_analysis_choice",
title = "Choix du type d\\'analyse",
content = HTML(
"<b>Impacts non cumuls</b> : pour analyser l\\'impact d\\'<b>un seul parc olien</b>. <br><br> <b>Impact cumuls</b> : pour analyser l\\'impact de <b>plusieurs parcs oliens</b> (attention : il faudra fournir des valeurs de mortalits propres chaque parc)."
),
placement = "right",
trigger = "click",
options = list(container='body')
)
),
choices = c("Impacts non cumuls" = "scenario", "Impacts cumuls" = "cumulated")
)},
# Choose species (selectInput)
{selectInput(inputId = "species_choice",
label = h4(strong("Slectionner une espce"),
bsButton("Q_species_choice", label = "", icon = icon("question"), size = "extra-small"),
bsPopover(id = "Q_species_choice",
title = "Choix de l\\'espce",
content = HTML(
"Ncessaire pour fixer les valeurs de <b>paramtres dmographiques</b> (survie, fcondit). <br> La liste fournie correspond une liste d\\'espces prioritaires. Au besoin, une option \\'espce gnrique\\' est disponible la fin de la liste."
),
placement = "right",
trigger = "click",
options = list(container='body')
)
),
choices = species_list)},
# Show vital rate values (tableOutput)
h4(strong("Paramtres dmographiques"),
bsButton("Q_vital_rates_info", label = "", icon = icon("question"), size = "extra-small"),
bsPopover(id = "Q_vital_rates_info",
title = "Paramtres dmographiques",
content = HTML(
"Valeurs de <b>survie et fcondits par classe d\\'ge</b>, pour l\\'espce slectionne. <br><br><b>Juv 0</b> correspond un individu n dans l\\'anne, n\\'ayant <u>pas encore</u> 1 an rvolu.<br><b>Juv 1</b> correspond un individu ayant 1 an rvolu, donc dans sa 2<sup>e</sup> anne de vie.<br>Etc."
),
placement = "right",
trigger = "click",
options = list(container='body')
)
),
tableOutput(outputId = "vital_rates_info"),
),
)}, # close column
## Modify vital rates, if needed (actionButton and matrixInput)
{column(width = 4,
tags$style(HTML('#button_vital_rates{background-color:#C2C8D3}')),
actionButton(inputId = "button_vital_rates",
label = tags$span("Modifier les paramtres dmographiques",
style = "font-weight: bold; font-size: 18px;")
),
br(),
matrixInput(inputId = "mat_fill_vr",
label = "",
value = matrix(data = NA, 3, 2,
dimnames = list(c("Juv 1", "Juv 2", "Adulte"), c("Survie", "Fcondit"))),
class = "numeric",
rows = list(names = TRUE),
cols = list(names = TRUE)
)
)}, # close column
)}, # End fluidRow
)}, # End wellPanel
###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
# Head Panel 2 : Model parameters
{wellPanel(
## Enter parameter values (TITLE)
{p("Saisie des paramtres", style="font-size:28px",
bsButton("Q_param_enter", label = "", icon = icon("question"), size = "extra-small"),
bsPopover(id = "Q_param_enter",
title = "Saisie des paramtres pour l\\'analyse",
content = HTML(
"Cliquer sur les boutons ci-dessous pour saisir les valeurs des quatre paramtres requis pour l\\'analyse : <br>(1) Mortalits annuelles, <br>(2) Taille de la population, <br>(3) Tendance de la population, <br>(4) Capacit de charge."
),
placement = "right",
trigger = "click",
options = list(container='body')
)
{fluidRow(
##~~~~~~~~~~~~~~~~~~~~~~~~~
## 1. Fatalities
##~~~~~~~~~~~~~~~~~~~~~~~~~
{column(width = 3,
tags$style(HTML('#button_fatalities{background-color:#C2C8D3}')),
actionButton(inputId = "button_fatalities", width = '100%',
label = tags$span("Mortalits annuelles", style = "font-weight: bold; font-size: 18px;")
),
bsPopover(id = "button_fatalities",
title = "Mortalits annuelles",
content = HTML(
"Nombre de mortalits totales <b><u>annuelles</u> (cad. sur 12 mois) </b> attendues, pour l\\'espce slectionne, sur chaque parc olien concern (somme des mortalits attendues sur toutes les oliennes d\\'un parc)."
),
placement = "top",
trigger = "hover",
options = list(container='body')
),
### Part for non-cumulated impacts
# Input type
{conditionalPanel("output.hide_fatalities",
br(),
{wellPanel(style = "background:#F0F8FF",
radioButtons(inputId = "fatalities_input_type",
label = "Type de saisie",
choices = c("Valeurs" = "val", "Elicitation d'expert" = "eli_exp")),
# Values
thierrychambert
committed
numericInput(inputId = "fatalities_lower",
label = "Borne infrieure (mortalits annuelles)",
value = 0.5,
min = 0, max = Inf, step = 0.5),
numericInput(inputId = "fatalities_upper",
label = "Borne suprieure (mortalits annuelles)",
value = 2.5,
min = 0, max = Inf, step = 0.5),
thierrychambert
committed
#actionButton(inputId = "fatalities_run_values", label = "Utiliser ces valeurs"),
# Matrix for expert elicitation
matrixInput(inputId = "fatalities_mat_expert",
value = matrix(data = eli_fatalities, nrow = 4, ncol = 5,
dimnames = list(c("#1", "#2", "#3", "#4"),
c("Poids", "Min", "Best", "Max", "% IC" )),
byrow = TRUE),
class = "numeric",
rows = list(names = TRUE),
cols = list(names = TRUE)),
actionButton(inputId = "fatalities_run_expert", label = "Utiliser valeurs experts"),
### Part for cumulated impacts
numericInput(inputId = "farm_number_cumulated",
label = "Nombre de parcs oliens",
value = 3, min = 2, max = Inf, step = 1),
matrixInput(inputId = "fatalities_mat_cumulated",
label = span("Mortalits dans chaque parc",
bsButton("Q_fatalities_mat_cumulated", label = "", icon = icon("question"), size = "extra-small"),
bsPopover(id = "Q_fatalities_mat_cumulated",
title = "Mortalits cumules",
content = HTML(
"1 ligne = 1 parc <br><br>Les parcs doivent tre fournis dans l\\'<b>ordre chronologique</b> de leur mise en service (\\'Anne dbut\\'). <br><br>Pour chaque parc, veuillez indiquer la <u>moyenne</u> et l\\'<u>erreur-type</u> du nombre de mortalits estimes, ainsi que son <u>anne de mise en service</u>."
),
placement = "right",
trigger = "click",
options = list(container='body')
)
),
value = matrix(init_cumul, 3, 3,
dimnames = list(c(paste0("Parc num.", c(1:3))),
c("Moyenne",
"Erreur-type",
"Anne de mise en service du parc"))),
class = "numeric",
rows = list(names = TRUE),
cols = list(names = TRUE)),
)}, # close wellPanel
)}, # close conditional panel
###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
##~~~~~~~~~~~~~~~~~~~~~~~~~
## 2. Population Size
##~~~~~~~~~~~~~~~~~~~~~~~~~
{column(width = 3,
tags$style(HTML('#button_pop_size{background-color:#C2C8D3}')),
actionButton(inputId = "button_pop_size", width = '100%',
label = tags$span("Taille de la population", style = "font-weight: bold; font-size: 18px;")
),
bsPopover(id = "button_pop_size",
title = "Taille de la population",
content = HTML(
"Effectif de la population cible pour l\\'analyse d\\'impact. <br> Il peut s\\'agir soit du <b>nombre de couples</b>, soit de l\\'<b>effectif total</b> de la population (cad. toutes classes d\\'ge incluses)."
),
placement = "top",
trigger = "hover",
options = list(container='body')
),
{conditionalPanel("output.hide_pop_size",
br(),
{wellPanel(style = "background:#FFF8DC",
radioButtons(inputId = "pop_size_unit", inline = TRUE,
label = "Unit",
choices = c("Nombre de couples" = "Npair", "Effectif total" = "Ntotal"),
)}, # close wellPanel 1
{wellPanel(style = "background:#F0F8FF",
radioButtons(inputId = "pop_size_input_type",
label = "Type de saisie",
choices = c("Valeurs" = "val", "Elicitation d'expert" = "eli_exp")),
numericInput(inputId = "pop_size_mean",
label = "Moyenne de la taille de la population",
value = 200,
min = 0, max = Inf, step = 50),
numericInput(inputId = "pop_size_se",
label = "Erreur-type de la taille de la population",
value = 25,
min = 0, max = Inf, step = 1),
matrixInput(inputId = "pop_size_mat_expert",
value = matrix(data = eli_pop_size, nrow = 4, ncol = 5,
dimnames = list(c("#1", "#2", "#3", "#4"),
c("Poids", "Min", "Best", "Max", "% IC" )),
byrow = TRUE),
class = "numeric",
rows = list(names = TRUE),
cols = list(names = TRUE)),
actionButton(inputId = "pop_size_run_expert", label = "Utiliser valeurs experts"),
)}, # close wellPanel 2
)}, # close conditional panel
)}, # end column "mortalite"
###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
##~~~~~~~~~~~~~~~~~~~~~~~~~
## 3. Population Growth
##~~~~~~~~~~~~~~~~~~~~~~~~~
{column(width = 3,
tags$style(HTML('#button_pop_growth{background-color:#C2C8D3}')),
actionButton(inputId = "button_pop_growth", width = '100%',
label = tags$span("Tendance de la population", style = "font-weight: bold; font-size: 18px;")
),
bsPopover(id = "button_pop_growth",
title = "Tendance de la population",
content = HTML(
"<b>Taux de croissance annuel (λ) </b> de la population (avec λ = 1 pour une population stable). <br>A dfaut, on pourra juste cocher la <b>tendance globale</b> (dclin, stabilit ou croissance) et l\\'intensit de cette tendance (faible, moyenne, forte)."
),
placement = "top",
trigger = "hover",
options = list(container='body')
),
{conditionalPanel("output.hide_pop_growth",
br(),
{wellPanel(style = "background:#F0F8FF",
radioButtons(inputId = "pop_growth_input_type",
label = "Type de saisie",
choices = c("Taux de croissance" = "val",
"Elicitation d'expert" = "eli_exp",
"Tendance locale ou rgionale" = "trend")),
numericInput(inputId = "pop_growth_mean",
label = "Moyenne de la croissance de la population",
value = 1.1,
min = 0, max = Inf, step = 0.01),
numericInput(inputId = "pop_growth_se",
label = "Erreur-type de la croissance de la population",
value = 0.01,
min = 0, max = Inf, step = 0.01),
matrixInput(inputId = "pop_growth_mat_expert",
value = matrix(data = eli_pop_growth, nrow = 4, ncol = 5,
dimnames = list(c("#1", "#2", "#3", "#4"),
c("Poids", "Min", "Best", "Max", "% IC" )),
byrow = TRUE),
class = "numeric",
rows = list(names = TRUE),
cols = list(names = TRUE)),
actionButton(inputId = "pop_growth_run_expert", label = "Utiliser valeurs experts"),
## Input trend: radio buttons
{fluidRow(
# Trend
column(6,
radioButtons(inputId = "pop_trend",
label = "Tendance",
choices = c("Croissance" = "growth",
"Stable" = "stable",
"Dclin" = "decline")),
),
# Strength of trend
column(6,
radioButtons(inputId = "pop_trend_strength",
label = "Force",
choices = c("Faible" = "weak",
"Moyen" = "average",
"Fort" = "strong")),
)}, # close wellPanel
)}, # close conditional panel
)}, # end column "mortalite"
###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
##~~~~~~~~~~~~~~~~~~~~~~~~~
## 4. Carrying capacity
##~~~~~~~~~~~~~~~~~~~~~~~~~
{column(width = 3,
tags$style(HTML('#button_carrying_cap{background-color:#C2C8D3}')),
actionButton(inputId = "button_carrying_cap", width = '100%',
label = tags$span("Capacit de charge", style = "font-weight: bold; font-size: 18px;")
),
bsPopover(id = "button_carrying_cap",
title = "Capacit de charge",
content = HTML(
"La capacit de charge correspond la <b>taille maximale que peut atteindre la population</b> dans son environnement et les limites spatiales considres. <br><br><u>Note:</u> Ce chiffre sera exprim dans la <b>mme unit</b> que la taille de population (cad. nombre de couples ou effectif total). <br>Il n\\'a pas besoin d\\'tre trs prcis ; il doit simplement fournir un ordre de grandeur de la taille limite au-del de laquelle la population ne peut plus crotre (environnement local satur)."
),
placement = "top",
trigger = "hover",
options = list(container='body')
),
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
{conditionalPanel("output.hide_carrying_cap",
br(),
{wellPanel(style = "background:#FFF8DC",
span(textOutput(outputId = "carrying_cap_unit_info"), style="font-size:16px"),
)}, # close wellPanel 1
{wellPanel(style = "background:#F0F8FF",
radioButtons(inputId = "carrying_cap_input_type",
label = "Type de saisie",
choices = c("Valeurs" = "val", "Elicitation d'expert" = "eli_exp")),
numericInput(inputId = "carrying_capacity",
label = "Capacit de charge",
value = 500,
min = 0, max = Inf, step = 100),
matrixInput(inputId = "carrying_cap_mat_expert",
value = matrix(data = eli_carrying_cap, nrow = 4, ncol = 5,
dimnames = list(c("#1", "#2", "#3", "#4"),
c("Poids", "Min", "Best", "Max", "% IC" )),
byrow = TRUE),
class = "numeric",
rows = list(names = TRUE),
cols = list(names = TRUE)),
actionButton(inputId = "carrying_cap_run_expert", label = "Utiliser valeurs experts"),
)}, # close wellPanel 2
)}, # close conditional panel
)}, # end column "fatalities"
###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
)}, # # End wellPanel
###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###
## Side Panel : Parameter information
{sidebarLayout(
{sidebarPanel(
p("Valeurs slectionnes", style="font-size:28px",
bsButton("Q_selected_values", label = "", icon = icon("question"), size = "extra-small"),
bsTooltip(id = "Q_selected_values",
title = "Rappel des valeurs de paramtres actuellement slectionnes.",
placement = "right",
trigger = "click",
options = list(container='body')
)
),
# Mortalites annuelles
{wellPanel(style = "background:#DCDCDC",
p("Mortalits annuelles", style="font-size:20px; font-weight: bold"),
span(textOutput(outputId = "fatalities_mean_info"), style="font-size:16px"),
span(textOutput(outputId = "fatalities_se_info"), style="font-size:16px"),
)},
# Taille de population
{wellPanel(style = "background:#DCDCDC",
p("Taille de la population", style="font-size:20px; font-weight: bold"),
shiny::tags$u(textOutput(outputId = "pop_size_unit_info"), style="font-size:16px"),
p(""),
span(textOutput(outputId = "pop_size_mean_info"), style="font-size:16px"),
span(textOutput(outputId = "pop_size_se_info"), style="font-size:16px"),
# Tendance de la population
{wellPanel(style = "background:#DCDCDC",
p("Tendance de la population", style="font-size:20px; font-weight: bold"),
span(textOutput(outputId = "pop_growth_mean_info"), style="font-size:16px"),
span(textOutput(outputId = "pop_growth_se_info"), style="font-size:16px"),
)},
# Capacite de charge
{wellPanel(style = "background:#DCDCDC",
p("Capacit de charge", style="font-size:20px; font-weight: bold"),
span(textOutput(outputId = "carrying_capacity_info"), style="font-size:16px"),
)},
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
tabPanel(title = "Distribution paramtres",
br(),
hr(),
#h3("Mortalites annuelles", align = "center"),
span(textOutput(outputId = "title_distri_plot"), style="font-size:24px; font-weight:bold"),
plotOutput(outputId = "distri_plot"),
br(),
numericInput(inputId = "nsim",
label = "Nombre de simulations",
thierrychambert
committed
value = 10, min = 0, max = Inf, step = 10),
choices = c("Taux de mortalits (h) constant" = "h",
"Nombre de mortalits (M) constant" = "M")),
br(),
actionButton(inputId = "run", label = "Lancer l'analyse"),
hr(),
span(textOutput("title_impact_result"), align = "left", style = "font-weight: bold; font-size: 18px;"),
br(),
strong(span(textOutput("impact_text"), style="color:blue; font-size:18px", align = "left")),
strong(span(tableOutput("impact_table"), style="color:blue; font-size:18px", align = "left")),
tags$h4(textOutput("title_impact_plot"), align = "center"),
plotOutput("impact_plot", width = "100%", height = "550px"),
tags$h4(textOutput("title_traj_plot"), align = "center"),
plotOutput("traj_plot", width = "100%", height = "550px")
tabPanel(title = "Rapport",
br(),
radioButtons(inputId = "lifestyle",
h4("Mode de vie de l'espce"),
choices = c("Sdentaire", "Non-sdentaire nicheur", "Non-sdentaire hivernant", "Migrateur de passage")),
h4("Nombre de parcs"),
value = 1, min = 0, max = Inf, step = 1),
)} # End mainPanel
)} # sidebarLayout
)} # FluidPage
# End UI #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###