Page1 button

R/mod_a_first.R

@@ -25,19 +25,6 @@ mod_first_ui <- function(id) {
             mod_species_ui(ns("species_ui_1"))
           )
         ),
-        actionButton(ns("showaqua"),
-                     label = 'AquaMaps'),
-        actionButton(ns("positive_catch"),
-                     label = 'Positive catch'),
-
-        # radioButtons(
-        #   ns("showaqua"),
-        #   label = NULL,
-        #   choices = c(
-        #     "Hide AquaMaps" = "hide",
-        #     "Show AquaMaps" = "show"
-        #   )
-        # ),
         w3css::w3_quarter()  
       )
     ),
@@ -60,6 +47,28 @@ mod_first_ui <- function(id) {
       ),
       w3css::w3_col(
         class = "s2",
+        actionButton(ns("showaqua"),
+                     label = 'AquaMaps', 
+                     style = "background-color: #FFFF0080"),
+        # radioButtons(
+        #   ns("showaqua"),
+        #   label = NULL,
+        #   choices = c(
+        #     "Hide AquaMaps" = "hide",
+        #     "Show AquaMaps" = "show"
+        #   )
+        # ),
+        w3_help_button(
+          "Display AquaMpas",
+          "display_aquamaps_help"
+        ),
+        actionButton(ns("positive_catch"),
+                     label = with_i18('Positive catch', 'positive_catch_button'),
+                     style = "background-color: #00FF0080"),
+        w3_help_button(
+          "Display positive catch",
+          "display_positive_catch_help"
+        ),
         h4(
           with_i18(
             "Conservation status",

R/mod_a_first_fct_map.R

@@ -38,6 +38,7 @@ tm_ocean <- function(dataOcean,
       title = paste0(title, "\n(", yearStart, "-", yearEnd, ")"),
       palette = c("#F7FBFF", "#C6DBEF", "#9ECAE1", "#4292C6", "#08519C", "#08306B"),
       n = 6,
+      alpha = .5,
       border.col = "gray90",
       labels = c(
         "Not recorded in the period" %>% with_i18("absent") %>% as.character(),
@@ -144,7 +145,6 @@ bbox <- sf::st_bbox(c(xmin = -17.5, xmax = 19, ymax = 36, ymin = 62), crs = sf::
 #' @param spatial_type Geom to use in the map
 #' @param con The Connection object
 #' @param yearStart,yearEnd date used
-#' @param dataCatchment,catchment_geom,dataALL,ices_geom,ices_division  internal datasets
 #' @param dataCatchment,catchment_geom internal datasets for continental waters
 #' @param dataALL,ices_geom,ices_division,positive_catch_area  internal datasets for marines water
 #' @param session The Shiny Session object

data-raw/altas_simulation.R

@@ -1,5 +1,5 @@
 # ==== Run this to create the dput for unit tests ====
-library(tictoc)
+#library(tictoc)
 library(purrr)
 # library(Rfast)
 library(Matrix)
@@ -17,7 +17,6 @@ source('data-raw/preparation_atlas_simulation.R')
 hydiad_parameter  %>% 
   print()
 
-
 # Anthropogenic mortality ----
 # build from sliders in interface 
 # here fake data
@@ -55,8 +54,7 @@ selected_latin_name = "Alosa alosa"
 
 runSimulation_pml = function(selected_latin_name, hydiad_parameter, anthropogenic_mortality,
                              catchment_surface, data_hsi_nmax, data_ni0,  outlet_distance, verbose = FALSE) {
-  if (verbose) tic()
-
+
   # --------------------------------------------------------------------------------------- #
   results = list()
 
@@ -141,9 +139,6 @@ runSimulation_pml = function(selected_latin_name, hydiad_parameter, anthropogeni
     arrange(year)
   results[['param']][['years']] <- years 
 
-  if (verbose) toc()
-
-  if (verbose) tic()
   # ------------------------------------------------------------------------------- #
   ## compute Nmax_eh1 matrix and prepare Nit matrix  ----
   resultsPM <- results[["model"]] <- lapply(models, function(model) {
@@ -255,8 +250,6 @@ runSimulation_pml = function(selected_latin_name, hydiad_parameter, anthropogeni
 
   #Rq: transpose of Besty's matrix (not sure now)
 
-  if (verbose) toc()
-
   # for testing: resultsModel <- results[['model']][[1]]
   # compute effective for 1 model ----
   computeEffectiveForModel_PML = function(model, currentYear, results, generationtime, nbCohorts){
@@ -333,7 +326,6 @@ runSimulation_pml = function(selected_latin_name, hydiad_parameter, anthropogeni
 
 
   # run simulation over years 
-  if (verbose) tic()
   for (currentYear  in yearsToRun) {
     # currentYear <- yearsToRun[1]
     ## print a progress bar to the console
@@ -343,17 +335,17 @@ runSimulation_pml = function(selected_latin_name, hydiad_parameter, anthropogeni
 
   # dput(results, file = "tests/testthat/results_pml_dput")
   cat('\n')
-  if (verbose) toc()
+
 
   return(results)
 }
 
 # =======================================================================================================
 # run simulation ----
-tic()
+
 results <- runSimulation_pml(selected_latin_name, hydiad_parameter, anthropogenic_mortality,
                              catchment_surface, data_hsi_nmax, data_ni0, outlet_distance, verbose = FALSE)
-toc()
+
 
 dput(results, file = "tests/testthat/results_pml_dput")
 utils::zip("tests/testthat/results_pml_dput", zipfile = "tests/testthat/results_pml_dput.zip")
@@ -448,7 +440,8 @@ dput(model_res_filtered_pml, file = "tests/testthat/model_res_filtered_dput")
 model_res_filtered_pml %>% 
   ggplot(aes(x = year)) + 
   geom_ribbon(aes(ymin = min, ymax = max, fill = source), alpha = .5) + 
-  geom_line(aes(y = rolling_mean, colour = source, linetype = source),
+  geom_line(data = . %>% filter(!is.na(rolling_mean)), 
+            aes(y = rolling_mean, colour = source, linetype = source),
             alpha = 0.9) + 
   ylab('Nit') 
 

data-raw/preparation_atlas_simulation.R

@@ -1,39 +1,35 @@
 library(DBI)
+# library(tidyverse)
 
-library(tictoc)
-library(tidyverse)
-
-# rm(list = ls())
-connection_sql = TRUE
-
-
-# connection to the data base
-if (connection_sql)
-  # conn_eurodiad <- dbConnect(RPostgres::Postgres(), dbname = 'eurodiad',
-  #                            host = 'citerne.bordeaux.irstea.priv',
-  #                            port = 5432, 
-  #                            user = 'patrick.lambert',
-  #                            password = rstudioapi::askForPassword("Database password"))
-  conn_eurodiad <- connect()
+pkgload::load_all(here::here()) # simulate installation and give access to objects in the package
+# session <- shiny::MockShinySession$new() #new.env()
+# connect(session)
+# con <- get_con(session)
+# connection to the data base  
+conn_eurodiad <- connect()
 
 # data upload ----
 
 # ---------------------------------------------------------------------- #
 ## Catchment features ----
-if (connection_sql) {
-  data_catchment <- dbGetQuery(conn_eurodiad, "SELECT basin_id, basin_name, country, surface_area_drainage_basin as surface_area, ccm_area FROM diadesatlas.basin b
-INNER JOIN diadesatlas.basin_outlet bo USING (basin_id);" ) %>%
+data_catchment <- dbGetQuery(conn_eurodiad, 
+  "SELECT 
+    basin_id, 
+    basin_name, 
+    country, 
+    surface_area_drainage_basin as surface_area,  
+    ccm_area 
+  FROM 
+    diadesatlas.basin b
+  INNER JOIN 
+    diadesatlas.basin_outlet bo 
+      USING (basin_id);" ) %>%
     tibble()
-
-
-  # write_rds(data_catchment, './data_input/data_catchment.rds')
-} else {
-  data_catchment <- read_rds('./data_input/data_catchment.rds')
-}
+
 # ---------------------------------------------------------------------- #
 ## Distances between catchment ----
-if ( connection_sql) {
-  outlet_distance = dbGetQuery(conn_eurodiad,"SELECT
+outlet_distance = dbGetQuery(conn_eurodiad, 
+"SELECT
 	b.basin_name AS departure,
 	od.departure AS departure_id,
 	b2.basin_name AS arrival,
@@ -48,37 +44,54 @@ INNER JOIN diadesatlas.basin b2 ON
 ORDER BY departure, distance ;") %>% 
    tibble() 
 
-  # write_rds(outlet_distance, "./data_input/outletDistance.rds")
-} else {
-  outlet_distance <- read_rds( "./data_input/outletDistance.rds")
-}
 
 # ---------------------------------------------------------------------- #
 # HyDiaD parameters ----
-if (connection_sql) {
-  hydiad_parameter <-  dbGetQuery(conn_eurodiad, "
-                                 SELECT s.latin_name, s.local_name AS \"Lname\", h.* FROM diadesatlas.hydiadparameter h
-INNER JOIN diadesatlas.species s USING (species_id);") %>%
+hydiad_parameter <-  
+    dbGetQuery(conn_eurodiad, 
+    "SELECT 
+      s.latin_name, 
+      s.local_name AS \"Lname\", 
+      h.* 
+     FROM 
+      diadesatlas.hydiadparameter h
+    INNER JOIN 
+      diadesatlas.species s 
+        USING (species_id);") %>%
     tibble() 
-
-  # hydiad_parameter %>% write_rds("./data_input/HyDiaDParameter.rds")
 
-} else {
-  hydiad_parameter <- read_rds("./data_input/HyDiaDParameter.rds")
-}
 
 
 # ---------------------------------------------------------------------- #
 ## HSI  abd Nmax ----
-if (connection_sql) {
-  # a query to load HSI for only 8.5 scenario (which do not change between simulations)
-  query = "SELECT s.latin_name, basin_id, basin_name, country, surface_area_drainage_basin as surface_area, year, climatic_scenario, climatic_model_code, hsi FROM diadesatlas.hybrid_model_result hmr
-INNER JOIN diadesatlas.species s USING (species_id)
-INNER JOIN diadesatlas.basin b USING (basin_id)
-INNER JOIN diadesatlas.climatic_model cm USING (climatic_model_id)
-WHERE year > 0 AND climatic_scenario = 'rcp85'"
-
-  data_hsi_nmax <- dbGetQuery(conn_eurodiad, query) %>%
+# a query to load HSI for only 8.5 scenario (which do not change between simulations)
+query = 
+  "SELECT 
+    s.latin_name,
+    basin_id, 
+    basin_name, 
+    country, 
+    surface_area_drainage_basin as surface_area, 
+    year, 
+    climatic_scenario, 
+    climatic_model_code, 
+    hsi 
+  FROM 
+    diadesatlas.hybrid_model_result hmr
+  INNER JOIN 
+    diadesatlas.species s 
+      USING (species_id)
+  INNER JOIN 
+      diadesatlas.basin b 
+        USING (basin_id)
+  INNER JOIN 
+    diadesatlas.climatic_model cm 
+      USING (climatic_model_id)
+  WHERE 
+    year > 0 
+    AND climatic_scenario = 'rcp85'"
+
+data_hsi_nmax <- dbGetQuery(conn_eurodiad, query) %>%
     tibble() %>%
     # compute the maximum abundance (#) according to hsi,
     #   maximal density (Dmax) , catchment area (ccm_area)
@@ -88,53 +101,75 @@ WHERE year > 0 AND climatic_scenario = 'rcp85'"
     mutate(Nmax = hsi * Dmax * surface_area) %>%
     select(-c(surface_area, Dmax))
 
-  # write_rds(data_hsi_nmax, './data_input/data_hsi_Nmax.rds')
-
-  rm(query)
-} else {
-  data_hsi_nmax <- read_rds('./data_input/data_hsi_Nmax.rds')
-}
+rm(query)
 
 
 # No ccm_area for  Bou_Regreg,   Loukkos,   Oum_er_Rbia,  Sebou. use surface_area_drainage_basin
 
 # reference results
-if (connection_sql) {
-  reference_results <- dbGetQuery(conn_eurodiad, 
-                                 "SELECT s.latin_name, basin_id, basin_name, year, climatic_scenario, climatic_model_code, nit  FROM diadesatlas.hybrid_model_result hmr
-INNER JOIN diadesatlas.species s USING (species_id)
-INNER JOIN diadesatlas.basin b USING (basin_id)
-INNER JOIN diadesatlas.climatic_model cm USING (climatic_model_id)
-WHERE year > 0 AND climatic_scenario = 'rcp85' 
-ORDER BY latin_name, basin_id, climatic_model_code") %>%
+reference_results <- dbGetQuery(conn_eurodiad, 
+  "SELECT 
+    s.latin_name, 
+    basin_id, 
+    basin_name, 
+    year, 
+    climatic_scenario, 
+    climatic_model_code, 
+    nit  
+  FROM 
+    diadesatlas.hybrid_model_result hmr
+  INNER JOIN 
+    diadesatlas.species s 
+      USING (species_id)
+  INNER JOIN 
+    diadesatlas.basin b 
+      USING (basin_id)
+  INNER JOIN 
+    diadesatlas.climatic_model cm 
+      USING (climatic_model_id)
+  WHERE 
+    year > 0 AND 
+    climatic_scenario = 'rcp85' 
+  ORDER BY 
+    latin_name, 
+    basin_id, 
+    climatic_model_code") %>%
     tibble()
 
-  # write_rds(reference_results, './data_input/referenceResults.rds')
-} else {
-  reference_results <- read_rds('./data_input/referenceResults.rds')
-}
-
-
 ## initial abundance in catchments ----
-if (connection_sql) {
-  data_ni0 <- dbGetQuery(conn_eurodiad, "SELECT s.latin_name, basin_id, basin_name, surface_area_drainage_basin as surface_area, year, climatic_scenario, climatic_model_code, nit, hsi  FROM diadesatlas.hybrid_model_result hmr
-INNER JOIN diadesatlas.species s USING (species_id)
-INNER JOIN diadesatlas.basin b USING (basin_id)
-INNER JOIN diadesatlas.climatic_model cm USING (climatic_model_id)
-WHERE  climatic_scenario = 'rcp85'
-AND year = 0
-ORDER BY latin_name, basin_id, climatic_model_code") %>%
+data_ni0 <- 
+  dbGetQuery(conn_eurodiad, 
+"SELECT 
+  s.latin_name, 
+  basin_id, 
+  basin_name, 
+  surface_area_drainage_basin as surface_area, 
+  year, 
+  climatic_scenario, 
+  climatic_model_code, 
+  nit, 
+  hsi  
+FROM 
+  diadesatlas.hybrid_model_result hmr
+INNER JOIN 
+  diadesatlas.species s 
+    USING (species_id)
+INNER JOIN 
+  diadesatlas.basin b 
+    USING (basin_id)
+INNER JOIN 
+  diadesatlas.climatic_model cm 
+    USING (climatic_model_id)
+WHERE  
+  climatic_scenario = 'rcp85'
+  AND year = 0
+ORDER BY 
+  latin_name, 
+  basin_id, 
+  climatic_model_code") %>%
     tibble() %>% 
     inner_join(hydiad_parameter %>%
                  select(latin_name, Dmax),
                by = 'latin_name') %>%
     mutate(Nmax = hsi * Dmax * surface_area) %>%
     select(-c(surface_area, Dmax))
-
-  # write_rds(data_ni0, './data_input/data_ni0.rds')
-} else {
-  data_ni0 <- read_rds('./data_input/data_ni0.rds')
-}
-
-#
-