Reinforce unit tests for page 4

Why?

Be sure reformatting gives correct results

What?

Test intermediate outputs

issue #120

R/mod_c_third_fct_query_and_plot.R

@@ -185,7 +185,8 @@ plot_nit <- function(model_res_filtered,
         ), alpha = 0.3) +
       geom_line(
         aes(y = nit_movingavg,
-            colour = .data[[with_colour_source]]
+            colour = .data[[with_colour_source]],
+            linetype = .data[[with_colour_source]]
         )
       ) +
       scale_colour_viridis_d() +

R/mod_d_fourth_fct.R

@@ -576,12 +576,14 @@ nit_feature_species_basin <- function(Nit_list,
     bind_rows(
       # reference for this species
       reference_results %>% 
-        filter(latin_name == selected_latin_name) %>% 
+        filter(latin_name == !!selected_latin_name) %>% 
+        collect() %>% 
         group_by(basin_name, year) %>% 
         summarise(min = min(nit),
                   max = max(nit),
-                  mean = mean(nit), .groups = 'drop') %>% 
-        collect() %>% 
+                  mean = mean(nit),
+                  .groups = 'drop') %>% 
+        # collect() %>% 
         group_by(basin_name) %>% 
         mutate(rolling_mean = frollmean(mean, n = 10, align = 'center')) %>% 
         mutate(source = 'reference') %>% 

data-raw/altas_simulation.R

@@ -341,7 +341,7 @@ runSimulation_pml = function(selected_latin_name, hydiad_parameter, anthropogeni
     results <- computeEffective_PML(currentYear, results, generationtime, nbCohorts)
   } 
 
-  dput(results, file = "tests/testthat/results_PML_dput")
+  # dput(results, file = "tests/testthat/results_pml_dput")
   cat('\n')
   if (verbose) toc()
 
@@ -370,7 +370,7 @@ Nit_list <- results[['model']] %>%
 
 
 
-nit_feature = function(data_list){
+nit_feature_pml = function(data_list){
   return( data_list %>% reduce(pmin) %>%  
             as_tibble(rownames = 'basin_name') %>% 
             pivot_longer(cols = -basin_name, names_to = 'year', values_to = 'min') %>% 
@@ -391,9 +391,10 @@ nit_feature = function(data_list){
             mutate(rolling_mean = frollmean(mean, n = 10, align = 'center')))
 }
 
-basin = 'Mondego'
+# basin = 'Mondego'
+basin = 'Authie'
 
-# nit_feature(Nit_ref) %>% 
+# nit_feature_pml(Nit_ref) %>% 
 #   filter(basin_name == basin) %>% 
 #   print(n = Inf) %>% 
 #   ggplot(aes(x=year)) +
@@ -416,17 +417,20 @@ basin = 'Mondego'
 #   geom_line(aes(y=rolling_mean), col ='red')
 # 
 # 
-# nit_feature(Nit_list) %>% 
+# nit_feature_pml(Nit_list) %>% 
 #   filter(basin_name == basin) %>% 
 #   print(n = Inf) %>% 
 #   ggplot(aes(x=year)) +
 #   geom_ribbon(aes(ymin = min, ymax = max), alpha = .5)  +
 #   geom_line(aes(y=rolling_mean), col ='red')
 
+model_nit_outputs <- nit_feature_pml(Nit_list)
+dput(model_nit_outputs, file = "tests/testthat/model_nit_outputs_dput")
 
-nit_feature(Nit_list) %>% 
+model_res_filtered_pml <- model_nit_outputs %>% 
   mutate(source = 'simul') %>% 
   bind_rows(reference_results %>% 
+              collect() %>% 
               filter(latin_name == selected_latin_name) %>% 
               group_by(basin_name, year) %>% 
               summarise(min = min(nit),
@@ -437,10 +441,15 @@ nit_feature(Nit_list) %>%
               mutate(source = 'reference')) %>% 
   suppressWarnings() %>% 
   filter(basin_name == basin,
-         year >= 1951) %>% 
+         year >= 1951) 
+
+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, col = source)) + 
+  geom_line(aes(y = rolling_mean, colour = source, linetype = source),
+            alpha = 0.9) + 
   ylab('Nit') 
 
 #=================================================================================

data-raw/be-page4-future.Rmd

@@ -67,13 +67,22 @@ lang <- "fr"
 # Generate all inputs as in the Shiny application
 countries <- datasets[["countries_mortalities_list"]]
 
-mortalities <- data.frame(
+mortalities <- tibble::tibble(
   # country = golem::get_golem_options('countries_mortalities_list'),
   country = datasets[["countries_mortalities_list"]],
   yearsimubegin = 
-    rep(0.1, length(datasets[["countries_mortalities_list"]])),
+    case_when(
+      country == "France" ~ -log(.5),
+      # country == "France" ~ -5,
+      TRUE ~ 0
+    ),
+  # rep(-log(.5), length(datasets[["countries_mortalities_list"]])),
   yearsimuend = 
-    rep(0.5, length(datasets[["countries_mortalities_list"]]))
+    case_when(
+      country == "France" ~ -log(.75),
+      TRUE ~ 0
+    )
+  # rep(-log(.75), length(datasets[["countries_mortalities_list"]]))
 )
 
 mortalities
@@ -99,7 +108,7 @@ results <- runSimulation(
   data_simulation[["data_hsi_nmax"]], # 663300 rows
   data_simulation[["data_ni0"]], # 4422 rows
   data_simulation[["outlet_distance"]], # 18225 rows
-  verbose = TRUE
+  verbose = FALSE
 )
 })
 
@@ -113,7 +122,7 @@ results <- runSimulation(
 # graphics ----
 Nit_list <- get_model_nit(results) 
 
-basin <- 'Mondego'
+basin <- 'Authie'
 
 #' Plot Nit predictions
 model_res_filtered <- nit_feature_species_basin(
@@ -129,6 +138,14 @@ plot_nit(model_res_filtered,
          withNitStandardisation = FALSE,
          with_colour_source = "source")
 
+model_res_filtered %>% 
+  ggplot(aes(x = year)) + 
+  geom_ribbon(aes(ymin = nit_min, ymax = nit_max, fill = source), alpha = .5) + 
+  geom_line(aes(y = nit_movingavg,
+                colour = source, linetype = source),
+            alpha = 0.8) + 
+  ylab('Nit') 
+
 ```