<!DOCTYPE html>
be-page4-future
# library(diades.atlas)
pkgload::load_all(here::here())
#> Warning:
#> ── Conflicts ───────────────────────────────────────────────────────────────────────── diades.atlas conflicts ──
#> ✖ get_bv_geoms() masks diades.atlas::get_bv_geoms()
#>
#> Did you accidentally source a file rather than using `load_all()`?
#> Run `rm(list = c("get_bv_geoms"))` to remove the conflicts.
library(dplyr)
library(leaflet)
library(ggplot2)
Connect to database
Do not forget to set environment variables in .Renviron
# Connect to database
conn_eurodiad <- connect()
# Listtables
# sort(DBI::dbListTables(conn_eurodiad))
# DBI::dbListObjects(conn_eurodiad)
Prepare Data
Queries from preparation_atlas_simulation.R
data_simulation <- get_data_simulation(conn_eurodiad)
data_catchment <- data_simulation[["data_catchment"]]
data_catchment
#> # Source: SQL [?? x 5]
#> # Database: postgres [ptlambert@citerne.bordeaux.irstea.priv:5432/eurodiad]
#> basin_id basin_name country surface_area ccm_area
#> <int> <chr> <chr> <dbl> <dbl>
#> 1 147 Spey Scotland 3060 3061.
#> 2 155 Tay Scotland 5021 5902.
#> 3 137 Selune France 1000 1014.
#> 4 65 Gotaalv Sweden 50200 51464.
#> 5 232 Orkla Norway 3092 3182.
#> 6 242 Vefsna Norway 4122 4218.
#> 7 177 Vilaine France 10475 10490.
#> 8 233 Namsen Norway 6000 6163.
#> 9 271 Thames England 13331 13514.
#> 10 62 Glomma Norway 42441 41911
#> # … with more rows
data_simulation[["outlet_distance"]]
#> # Source: SQL [?? x 5]
#> # Database: postgres [ptlambert@citerne.bordeaux.irstea.priv:5432/eurodiad]
#> departure departure_id arrival arrival_id distance
#> <chr> <int> <chr> <int> <dbl>
#> 1 Aa 1 Aa 1 0
#> 2 Aa 1 Canche 29 132.
#> 3 Aa 1 Yser 188 150.
#> 4 Aa 1 Authie 15 173.
#> 5 Aa 1 Bresle 25 204.
#> 6 Aa 1 Somme 146 206.
#> 7 Aa 1 Thames 271 210.
#> 8 Aa 1 Touques 163 297.
#> 9 Aa 1 Dives 41 301.
#> 10 Aa 1 Seine 136 307.
#> # … with more rows
hydiad_parameter <- data_simulation[["hydiad_parameter"]]
hydiad_parameter
#> # Source: lazy query [?? x 18]
#> # Database: postgres [ptlambert@citerne.bordeaux.irstea.priv:5432/eurodiad]
#> latin_name Lname species_id Dmax lambda r AgeFirstMat nbCohorts gamma DistMean alpha beta Mdisp
#> <chr> <chr> <int> <dbl> <dbl> <dbl> <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 Acipenser… AStu… 4 1.06e-1 4.72e-2 1.3 11 3 0.0865 464. 1.10e-4 1.35 4.28e-4
#> 2 Alosa alo… AAlo… 6 7.11e+0 9.31e-2 1.3 5 3 0.173 40.5 4.44e-1 0.417 1.90e-2
#> 3 Alosa fal… AFal… 8 4.07e+0 4.42e-1 1.3 3 3 0.145 24.0 5.49e-1 0.418 3.69e-2
#> 4 Anguilla … AAng… 13 3.59e+1 0 1.3 12 3 0.253 170. 2.04e-5 1.85 4.67e-3
#> 5 Lampetra … LFlu… 18 7.14e-1 1.93e-1 1.3 5 3 0.366 10 2.16e-1 0.706 3.81e-2
#> 6 Osmerus e… OEpe… 20 4.62e+1 1.43e-3 1.3 2 3 0.109 2.42 9.04e-1 0.556 3.98e-1
#> 7 Petromyzo… PMar… 21 1.17e+0 1.36e-1 1.3 8 3 0.628 83.2 1.80e-2 0.869 4.88e-3
#> 8 Platichth… PFle… 22 1.25e+3 2.37e-5 1.3 4.5 3 0.175 26.8 1.07e-6 3.41 1.45e-2
#> 9 Salmo sal… SSal… 25 4.96e-1 2.70e-1 1.3 3 3 0.0605 20.5 3.80e-1 0.496 3.57e-2
#> 10 Salmo tru… STru… 26 1.15e+1 8.51e-3 1.3 3.5 3 0.0828 25.4 3.76e-2 0.931 2.92e-2
#> # … with more rows, and 5 more variables: DistMax <dbl>, withAllee <lgl>, withNatalStray <lgl>,
#> # usePresence <lgl>, Sdisp <dbl>
data_hsi_nmax <- data_simulation[["data_hsi_nmax"]]
data_hsi_nmax
#> # Source: lazy query [?? x 9]
#> # Database: postgres [ptlambert@citerne.bordeaux.irstea.priv:5432/eurodiad]
#> latin_name basin_id basin_name country year climatic_scenario climatic_model_code hsi Nmax
#> <chr> <int> <chr> <chr> <int> <chr> <chr> <dbl> <dbl>
#> 1 Alosa alosa 1 Aa France 1951 rcp45 cnrmcm5 0.244 2109.
#> 2 Alosa alosa 1 Aa France 1952 rcp45 cnrmcm5 0.322 2783.
#> 3 Alosa alosa 1 Aa France 1953 rcp45 cnrmcm5 0.195 1680.
#> 4 Alosa alosa 1 Aa France 1954 rcp45 cnrmcm5 0.246 2122.
#> 5 Alosa alosa 1 Aa France 1955 rcp45 cnrmcm5 0.0850 734.
#> 6 Alosa alosa 1 Aa France 1956 rcp45 cnrmcm5 0.235 2030.
#> 7 Alosa alosa 1 Aa France 1957 rcp45 cnrmcm5 0.327 2827.
#> 8 Alosa alosa 1 Aa France 1958 rcp45 cnrmcm5 0.415 3584.
#> 9 Alosa alosa 1 Aa France 1959 rcp45 cnrmcm5 0.246 2120.
#> 10 Alosa alosa 1 Aa France 1960 rcp45 cnrmcm5 0.380 3278.
#> # … with more rows
reference_results <- data_simulation[["reference_results"]]
data_simulation[["data_ni0"]]
#> # Source: lazy query [?? x 9]
#> # Database: postgres [ptlambert@citerne.bordeaux.irstea.priv:5432/eurodiad]
#> # Ordered by: latin_name, basin_id, climatic_model_code
#> latin_name basin_id basin_name year climatic_scenario climatic_model_code nit hsi Nmax
#> <chr> <int> <chr> <int> <chr> <chr> <dbl> <dbl> <dbl>
#> 1 Alosa alosa 1 Aa 0 rcp45 cnrmcm5 1451. 0.168 1451.
#> 2 Alosa alosa 3 Adour 0 rcp45 cnrmcm5 103366. 0.862 103366.
#> 3 Alosa alosa 358 Anllons 0 rcp45 cnrmcm5 1336. 0.364 1336.
#> 4 Alosa alosa 359 Artibai 0 rcp45 cnrmcm5 398. 0.509 398.
#> 5 Alosa alosa 290 Ason 0 rcp45 cnrmcm5 2800. 0.616 2800.
#> 6 Alosa alosa 14 Aulne 0 rcp45 cnrmcm5 5736. 0.540 5736.
#> 7 Alosa alosa 15 Authie 0 rcp45 cnrmcm5 1211. 0.131 1211.
#> 8 Alosa alosa 16 Auzance 0 rcp45 cnrmcm5 1010. 0.229 1010.
#> 9 Alosa alosa 385 Ave 0 rcp45 cnrmcm5 4006. 0.404 4006.
#> 10 Alosa alosa 17 Avon 0 rcp45 cnrmcm5 4852. 0.243 4852.
#> # … with more rows
catchment_surface <- data_simulation[["catchment_surface"]]
Prepare data frame of simulation
- Use anthropogenic mortality from the Shiny interface
session <- shiny::MockShinySession$new()
session$userData$con <- conn_eurodiad
input <- list()
datasets <- generate_datasets(con = conn_eurodiad)
#> ── generate_datasets ───────────────────────────────────────────────────────────────────────────────────────────
lang <- "fr"
# Generate all inputs as in the Shiny application
countries <- datasets[["countries_mortalities_list"]]
mortalities <- tibble::tibble(
# country = golem::get_golem_options('countries_mortalities_list'),
country = datasets[["countries_mortalities_list"]],
mortsimperiod1 =
case_when(
country == "France" ~ -log(.5),
# country == "France" ~ -5,
TRUE ~ 0
),
# rep(-log(.5), length(datasets[["countries_mortalities_list"]])),
mortsimperiod2 =
case_when(
country == "France" ~ -log(.75),
TRUE ~ 0
)
# rep(-log(.75), length(datasets[["countries_mortalities_list"]]))
)
mortalities
#> # A tibble: 13 × 3
#> country mortsimperiod1 mortsimperiod2
#> <chr> <dbl> <dbl>
#> 1 Denmark 0 0
#> 2 Portugal 0 0
#> 3 Morocco 0 0
#> 4 Sweden 0 0
#> 5 Norway 0 0
#> 6 France 0.693 0.288
#> 7 Wales 0 0
#> 8 Scotland 0 0
#> 9 Netherlands 0 0
#> 10 Spain 0 0
#> 11 England 0 0
#> 12 Germany 0 0
#> 13 Ireland 0 0
scenario <- "rcp85"
# # build from sliders in interface
# expand grid using full_join
anthropogenic_mortality <- expand_anthropogenic_mortality(
data_hsi_nmax, mortalities)
selected_latin_name <- "Alosa alosa"
# selected_latin_name <- "Chelon ramada"
# debugonce(runSimulation)
# shiny::withProgress(
# message = 'Making Simu', value = 0,
# session = session, {
results <- runSimulation(
selected_latin_name,
data_simulation[["hydiad_parameter"]], # 11 rows
# Smaller for example
anthropogenic_mortality, # 1800 rows
data_simulation[["catchment_surface"]], # 134 rows
data_simulation[["data_hsi_nmax"]], # 663300 rows
data_simulation[["data_ni0"]], # 4422 rows
data_simulation[["outlet_distance"]], # 18225 rows
# Add scenario
scenario = scenario,
verbose = FALSE
)
# })
# [1] "cnrmcm5" "csiromk360"
# [3] "noresm1me"
# Les 5 premières lignes des sous-listes
# results %>% purrr::map(~purrr::map(.x, head))
Graphs for Nit
# graphics ----
Nit_list <- get_model_nit(results)
basin <- 'Garonne'
# Plot Nit predictions
model_res_filtered <- nit_feature_species(
Nit_list = Nit_list,
reference_results = reference_results %>%
filter(climatic_scenario == scenario),
selected_latin_name = selected_latin_name)
# same function as for Page 3
model_res_filtered %>%
filter(basin_name == basin) %>%
# filter(source == "reference") %>%
plot_nit(selected_year = 2073,
lg = "fr",
withNitStandardisation = FALSE,
with_colour_source = "source")
#> Warning: Removed 14 row(s) containing missing values (geom_path).
Leaflet
loco <- list()
loco$model_res <- model_res_filtered %>%
filter(source == "simul") %>%
left_join(data_simulation[["data_catchment"]] %>% collect(),
by = "basin_name")
loco$bv_df <- get_bv_geoms(
unique(loco$model_res$basin_id),
lg = "fr", #r$lg,
session
)
draw_bv_leaflet(
bv_df = loco$bv_df,
model_res = loco$model_res,
year = 2100
)
Stop connection
DBI::dbDisconnect(conn_eurodiad)