Page 4: show results outputs map

Why?

- Show simulation outputs

What?

- Modify simu outputs to create map

Issues
issue #89

NAMESPACE

@@ -13,7 +13,7 @@ export(get_help_bubble_entries)
 export(get_hybrid_model)
 export(launch_mongo)
 export(nit_feature)
-export(nit_feature_species_basin)
+export(nit_feature_species)
 export(plot_hsi)
 export(plot_hsi_nit)
 export(plot_nit)

R/globals.R

@@ -39,6 +39,6 @@ globalVariables(unique(c(
   "arrival", "climatic_model_code", "country", "departure",
   "distance", "latin_name_s", "Nmax", "phase", "proportion",
   "r_eh2", "surface_area", "survival", "survivingProportion", "withNatalStray",
-  # nit_feature_species_basin
+  # nit_feature_species
   "nit", "rolling_mean"
 )))

R/mod_c_third.R

@@ -170,8 +170,7 @@ mod_third_server <- function(id, r = r) {
           filter(basin_id == !!loco$selected_bv_id) %>%
           mutate(basin_name = diadesatlas.translate(basin_name, !!r$lg)) %>%
           collect()
-
-
+
         loco$leaflet <- draw_bv_leaflet(
           bv_df = loco$bv_df,
           model_res = loco$model_res,

R/mod_c_third_fct_query_and_plot.R

@@ -183,6 +183,7 @@ plot_nit <- function(model_res_filtered,
             ymax = nit_max,
             fill = .data[[with_colour_source]]
         ), alpha = 0.3) +
+      geom_vline(xintercept = 2001, colour = "gray", linetype = "dashed") +
       geom_line(
         aes(y = nit_movingavg,
             colour = .data[[with_colour_source]],

R/mod_d_fourth.R

@@ -95,9 +95,9 @@ mod_fourth_ui <- function(id) {
                   sliderInput(
                     ns("date"),
                     NULL,
-                    min = 1950,
+                    min = 1951,
                     max = 2100,
-                    value = 1950, 
+                    value = 1951, 
                     sep = ""
                   )
                 ),
@@ -118,7 +118,7 @@ mod_fourth_ui <- function(id) {
               "prediction_map_abundance_help"
             )
           ),
-          plotOutput(ns("map"))
+          leafletOutput(ns("plot"), height = 600)
         ),
         w3css::w3_half(
           h4(
@@ -153,7 +153,9 @@ mod_fourth_server <- function(id, r = r) {
         yearsimuend = rep(0.1, length(golem::get_golem_options('countries_mortalities_list')))
       ),
       data_simulation = get_data_simulation(conn_eurodiad),
-      results = NULL
+      results = NULL,
+      model_res_filtered = NULL,
+      trigger_graphs = 0
     )
 
     mod_species_server(
@@ -201,6 +203,7 @@ mod_fourth_server <- function(id, r = r) {
 
     # Run simulations ----
     observeEvent(input$launch_simu, {
+      golem::invoke_js("disable", paste0("#", ns("launch_simu")))
       # loco$data_simulation
       # countries <- golem::get_golem_options('countries_mortalities_list')
       # loco$mortalities
@@ -215,7 +218,7 @@ mod_fourth_server <- function(id, r = r) {
       shiny::withProgress(
         message = 'Run Simulation', value = 0, 
         session = session, {
-          loco$results <- runSimulation(
+          results <- runSimulation(
             selected_latin_name = loco$species, #selected_latin_name, 
             scenario = input$scenario,
             hydiad_parameter = loco$data_simulation[["hydiad_parameter"]], # 11 rows
@@ -228,42 +231,77 @@ mod_fourth_server <- function(id, r = r) {
             verbose = TRUE
           )
         })
+
+      Nit_list <- get_model_nit(results)
+
+      loco$model_res_filtered <- nit_feature_species(
+        Nit_list = Nit_list,
+        reference_results = loco$data_simulation[["reference_results"]],
+        selected_latin_name = loco$species)
+
+      if (!is.null(loco$model_res_filtered)) {
+        loco$trigger_graphs <- loco$trigger_graphs + 1
+      }
+      golem::invoke_js("reable", paste0("#", ns("launch_simu")))
     }, ignoreInit = TRUE)
 
     # Show results ----
-    output$map <- renderPlot({
-      input$launch_simu
-      the_data <- loco$mortalities
-      names(the_data) <- c("X1", "X2", "X3")
-      ggplot(the_data) +
-        aes(X2, X3) +
-        geom_point() +
-        # ggplot(map_data("france"), aes(long, lat, group = group)) +
-        #   geom_polygon() +
-        #   geom_polygon(
-        #     data = map_data("france") %>%
-        #       dplyr::filter(region %in% sample(
-        #         unique(map_data("france")$region),
-        #         3
-        #       )),
-        #     aes(fill = region)
-        #   ) +
-        # coord_map() +
-      theme_classic() +
-        guides(
-          fill = "none"
+    observeEvent(list(loco$trigger_graphs, r$lg), {
+      req(loco$model_res_filtered)
+
+      # loco$ui_summary <- create_ui_summary_html(
+      #   species = loco$species,
+      #   date = input$date,
+      #   basin_name = loco$selected_bv_name$basin_name,
+      #   country = loco$selected_bv_name$country
+      # )
+
+      output$plot <- renderLeaflet({
+
+        req(loco$model_res_filtered)
+        loco$bind_event <- rnorm(10000)
+
+        model_res <- loco$model_res_filtered %>% 
+          filter(source == "simul") %>% 
+          left_join(loco$data_simulation[["data_catchment"]] %>% collect(),
+                    by = "basin_name")
+
+        loco$bv_df <- get_bv_geoms(
+          unique(model_res$basin_id),
+          lg = r$lg,
+          session
         )
-    })
+
+        draw_bv_leaflet(
+          bv_df = loco$bv_df,
+          model_res = model_res,
+          year = input$date
+        )
+
+      })
+    }, ignoreInit = TRUE)
 
-    output$prediction <- renderPlot({
-      input$launch_simu
-      p1 <- shinipsum::random_ggplot(type = "line")
-      p2 <- shinipsum::random_ggplot(type = "line")
-      getFromNamespace("/.ggplot", "patchwork")(
-        p1, p2
-      )
-    })
+    observeEvent(list(loco$trigger_graphs, r$lg), {
+      # req(loco$trigger_graphs)
+      req(loco$model_res_filtered)
+
+      basin <- 'Adour'
+
+      # Plot Nit predictions
+      model_res_filtered <- loco$model_res_filtered %>% 
+        filter(basin_name == basin)
+
+      output$prediction <- renderPlot({
+        # same function as for Page 3
+        plot_nit(model_res_filtered,
+                 selected_year = input$date,
+                 lg = r$lg,
+                 withNitStandardisation = FALSE,
+                 with_colour_source = "source")
+      })
+    }, ignoreInit = TRUE)
 
+    # UI dropdown menus ----
     observeEvent(input$scenario, {
       golem::invoke_js(
         "changeinnerhtmlwithid",

R/mod_d_fourth_fct.R

@@ -569,22 +569,20 @@ nit_feature <- function(data_list) {
   return(res)
 }
 
-#' Get nit reference and predictions for one species and one basin
+#' Get nit reference and predictions for one species and all basins
 #' 
 #' @param Nit_list Nit_list as issued from [get_model_nit()]
 #' @param reference_results reference_results as issued from [prepare_datasets()]
 #' @param selected_latin_name Latin species name
-#' @param basin Name of the basin
 #' 
 #' @importFrom dplyr mutate bind_rows filter group_by summarise
 #' @importFrom dplyr ungroup
 #' @importFrom data.table frollmean
 #' @return data.frame of Nit results for one species and one basin
 #' @export
-nit_feature_species_basin <- function(Nit_list,
+nit_feature_species <- function(Nit_list,
                                       reference_results,
-                                      selected_latin_name,
-                                      basin) {
+                                      selected_latin_name) {
   nit_feature(Nit_list) %>% 
     mutate(source = 'simul') %>% 
     bind_rows(
@@ -604,8 +602,7 @@ nit_feature_species_basin <- function(Nit_list,
         ungroup()
       ) %>%
     suppressWarnings() %>% 
-    filter(basin_name == basin,
-           year >= 1951) %>% 
+    filter(year >= 1951) %>% 
     rename(
       nit_min = min,
       nit_max = max,

data-raw/be-page4-future.Rmd

@@ -60,6 +60,7 @@ catchment_surface <- data_simulation[["catchment_surface"]]
 
 ```{r}
 session <- shiny::MockShinySession$new()
+session$userData$con <- conn_eurodiad
 input <- list()
 datasets <- generate_datasets(con = conn_eurodiad)
 lang <- "fr"
@@ -125,24 +126,47 @@ shiny::withProgress(
 # graphics ----
 Nit_list <- get_model_nit(results) 
 
-basin <- 'Adour'
+basin <- 'Garonne'
 
-#' Plot Nit predictions
-model_res_filtered <- nit_feature_species_basin(
+# Plot Nit predictions
+model_res_filtered <- nit_feature_species(
   Nit_list = Nit_list,
   reference_results = reference_results,
-  selected_latin_name = selected_latin_name,
-  basin = basin)
+  selected_latin_name = selected_latin_name)
   
 # same function as for Page 3
-plot_nit(model_res_filtered,
-         selected_year = 2073,
-         lg = "fr",
-         withNitStandardisation = FALSE,
-         with_colour_source = "source")
+model_res_filtered %>% 
+  filter(basin_name == basin) %>% 
+  # filter(source == "reference") %>% 
+  plot_nit(selected_year = 2073,
+           lg = "fr",
+           withNitStandardisation = FALSE,
+           with_colour_source = "source")
 
 ```
 
+## Leaflet
+
+```{r}
+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
 

tests/testthat/test-mod_d_fourth_fct.R

@@ -170,12 +170,12 @@ test_that("runSimulation works", {
     ungroup()
   expect_equal(model_nit_outputs, mno_expected)
 
-  # nit_feature_species_basin ----
-  model_res_filtered <- nit_feature_species_basin(
+  # nit_feature_species ----
+  model_res_filtered <- nit_feature_species(
     Nit_list = Nit_list,
     reference_results = reference_results,
-    selected_latin_name = selected_latin_name,
-    basin = basin)
+    selected_latin_name = selected_latin_name) %>% 
+    filter(basin_name == basin)
 
   mrf_object <- model_res_filtered %>% 
     arrange(basin_name, year)