rm(list = ls(all.names = TRUE)) #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Initial stuff { ## Load libraries library(shiny) library(shinyjs) library(shinyBS) 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.03 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 ) } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~### ###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~### ## User Interface ###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~### # fluidPage {ui <- fluidPage( useShinyjs(), 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 cumul�s</b> : pour analyser l\\'impact d\\'<b>un seul parc �olien</b>. <br><br> <b>Impact cumul�s</b> : pour analyser l\\'impact de <b>plusieurs parcs �oliens</b> (attention : il faudra fournir des valeurs de mortalit�s propres � chaque parc)." ), placement = "right", trigger = "click", options = list(container='body') ) ), choices = c("Impacts non cumul�s" = "scenario", "Impacts cumul�s" = "cumulated") )}, # Choose species (selectInput) {selectInput(inputId = "species_choice", selected = "Faucon cr�cerellette", width = '80%', label = h4(strong("S�lectionner une esp�ce"), bsButton("Q_species_choice", label = "", icon = icon("question"), size = "extra-small"), bsPopover(id = "Q_species_choice", title = "Choix de l\\'esp�ce", content = HTML( "N�cessaire pour fixer les valeurs de <b>param�tres d�mographiques</b> (survie, f�condit�). <br> La liste fournie correspond � une liste d\\'esp�ces prioritaires. Au besoin, une option \\'esp�ce g�n�rique\\' est disponible � la fin de la liste." ), placement = "right", trigger = "click", options = list(container='body') ) ), choices = species_list)}, )}, # close column # Show vital rate values (tableOutput) {column(width = 4, fluidRow( h4(strong("Param�tres d�mographiques"), bsButton("Q_vital_rates_info", label = "", icon = icon("question"), size = "extra-small"), bsPopover(id = "Q_vital_rates_info", title = "Param�tres d�mographiques", content = HTML( "Valeurs de <b>survie et f�condit�s par classe d\\'�ge</b>, pour l\\'esp�ce s�lectionn�e. <br><br><b>Juv 0</b> correspond � un individu n� dans l\\'ann�e, n\\'ayant <u>pas encore</u> 1 an r�volu.<br><b>Juv 1</b> correspond � un individu ayant 1 an r�volu, donc dans sa 2<sup>e</sup> ann�e 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 param�tres d�mographiques", 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", "F�condit�"))), 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 param�tres", style="font-size:28px", bsButton("Q_param_enter", label = "", icon = icon("question"), size = "extra-small"), bsPopover(id = "Q_param_enter", title = "Saisie des param�tres pour l\\'analyse", content = HTML( "Cliquer sur les boutons ci-dessous pour saisir les valeurs des quatre param�tres requis pour l\\'analyse : <br>(1) Mortalit�s 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("Mortalit�s annuelles", style = "font-weight: bold; font-size: 18px;") ), bsPopover(id = "button_fatalities", title = "Mortalit�s annuelles", content = HTML( "Nombre de mortalit�s totales <b><u>annuelles</u> (cad. sur 12 mois) </b> attendues, pour l\\'esp�ce s�lectionn�e, sur chaque parc �olien concern� (somme des mortalit�s 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("Intervalle" = "itvl", "Valeurs" = "val", "Elicitation d'expert" = "eli_exp")), # Interval numericInput(inputId = "fatalities_lower", label = "Borne inf�rieure (mortalit�s annuelles)", value = 0.5, min = 0, max = Inf, step = 0.5), numericInput(inputId = "fatalities_upper", label = "Borne sup�rieure (mortalit�s annuelles)", value = 2.5, min = 0, max = Inf, step = 0.5), # Values numericInput(inputId = "fatalities_mean", label = "Moyenne (mortalit�s annuelles)", value = 2.2, min = 0, max = Inf, step = 0.5), numericInput(inputId = "fatalities_se", label = "Erreur-type (mortalit�s annuelles)", value = 0.5, min = 0, max = Inf, step = 0.1), # 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("Mortalit�s dans chaque parc", bsButton("Q_fatalities_mat_cumulated", label = "", icon = icon("question"), size = "extra-small"), bsPopover(id = "Q_fatalities_mat_cumulated", title = "Mortalit�s cumul�es", content = HTML( "1 ligne = 1 parc <br><br>Les parcs doivent �tre fournis dans l\\'<b>ordre chronologique</b> de leur mise en service (\\'Ann�e d�but\\'). <br><br>Pour chaque parc, veuillez indiquer la <u>moyenne</u> et l\\'<u>erreur-type</u> du nombre de mortalit�s estim�es, ainsi que son <u>ann�e 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", "Ann�e de mise en service du parc"))), class = "numeric", rows = list(names = TRUE), cols = list(names = TRUE)), )}, # close wellPanel )}, # close conditional panel )}, # end column "mortalit�" ###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~### ##~~~~~~~~~~~~~~~~~~~~~~~~~ ## 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"), selected = "Npair"), )}, # close wellPanel 1 {wellPanel(style = "background:#F0F8FF", radioButtons(inputId = "pop_size_input_type", label = "Type de saisie", choices = c("Intervalle" = "itvl", "Valeurs" = "val", "Elicitation d'expert" = "eli_exp")), # Interval numericInput(inputId = "pop_size_lower", label = "Borne inf�rieure (taille population)", value = 130, min = 0, max = Inf, step = 10), numericInput(inputId = "pop_size_upper", label = "Borne sup�rieure (taille population)", value = 140, min = 0, max = Inf, step = 10), # Values 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), # Matrix for expert elicitation 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 d�faut, on pourra juste cocher la <b>tendance globale</b> (d�clin, 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 r�gionale" = "trend")), ## Input values: mean and se numericInput(inputId = "pop_growth_mean", label = "Moyenne de la croissance de la population", value = 0.99, min = 0, max = Inf, step = 0.01), numericInput(inputId = "pop_growth_se", label = "Erreur-type de la croissance de la population", value = 0, min = 0, max = Inf, step = 0.01), ## Input expert elicitation: table 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", "D�clin" = "decline")), ), # Strength of trend column(6, radioButtons(inputId = "pop_trend_strength", label = "Force", choices = c("Faible" = "weak", "Moyen" = "average", "Fort" = "strong")), ), )}, # close fluidRow )}, # 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 consid�r�es. <br><br><u>Note:</u> Ce chiffre sera exprim� dans la <b>m�me unit�</b> que la taille de population (cad. nombre de couples ou effectif total). <br>Il n\\'a pas besoin d\\'�tre tr�s pr�cis ; il doit simplement fournir un ordre de grandeur de la taille limite au-del� de laquelle la population ne peut plus cro�tre (environnement local �satur�)." ), placement = "top", trigger = "hover", options = list(container='body') ), {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 fluidRow )}, # # End wellPanel ###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~### ###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~### ## Side Panel : Parameter information {sidebarLayout( {sidebarPanel( p("Valeurs s�lectionn�es", 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 param�tres actuellement s�lectionn�es.", placement = "right", trigger = "click", options = list(container='body') ) ), # Mortalites annuelles {wellPanel(style = "background:#DCDCDC", p("Mortalit�s 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"), )}, )}, # End sidebarPanel #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Creation of outputs parts {mainPanel( tabsetPanel( tabPanel(title = "Distribution param�tres", br(), hr(), #h3("Mortalites annuelles", align = "center"), span(textOutput(outputId = "title_distri_plot"), style="font-size:24px; font-weight:bold"), plotOutput(outputId = "distri_plot"), ), # End tabPanel tabPanel(title = "Impact population", br(), numericInput(inputId = "nsim", label = "Nombre de simulations", value = 10, min = 0, max = Inf, step = 10), radioButtons(inputId = "fatal_constant", label = "Mod�lisation", choices = c("Taux de mortalit�s (h) constant" = "h", "Nombre de mortalit�s (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")), br(), hr(), tags$h4(textOutput("title_impact_plot"), align = "center"), plotOutput("impact_plot", width = "100%", height = "550px"), hr(), tags$h4(textOutput("title_traj_plot"), align = "center"), plotOutput("traj_plot", width = "100%", height = "550px") ), # End tabPanel 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")), numericInput(inputId = "wind_farm_nb", h4("Nombre de parcs"), value = 1, min = 0, max = Inf, step = 1), numericInput(inputId = "wind_turbine_nb", h4("Nombre d'�oliennes"), value = 1, min = 0, max = Inf, step = 1) ) # End tabPanel ) # End tabSetPanel )} # End mainPanel )} # sidebarLayout )} # FluidPage # End UI #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~###