Cleaner report

inst/ShinyApp/report.Rmd

@@ -41,10 +41,10 @@ params:
   CI: NA
   QT: NA
   risk_A: NA
-  impact_QT: NA
+  impact_QT_table: NA
 ---
 
-### Date de création: `r strftime(Sys.Date(), "%d/%m/%Y")`  
+### Date de création: `r strftime(Sys.Date(), "%d/%m/%Y")`
 
 ### Type d'analyse realisée : `r paste(params$analysis)`
 
@@ -109,11 +109,13 @@ library(kableExtra)
 ```{r, echo=FALSE}
 kable(params$impact_table, align = "ccc", booktabs=T)
 ```  
-Note : Intervalle de confiance (IC) à `r params$CI`%
-
-## Valeur de l'impact au quantile de `r params$QT`%  
-`r paste0("Scénario ", 1:length(params$impact_QT), " : ", round(as.numeric(params$impact_QT),1), "%\n", collapse = "")`
+Note : Intervalle de confiance (IC) à `r params$CI`%  
 
+## Valeur de l'impact au quantile de `r params$QT`%
+(soit un risque de `r params$risk_A`% de sous-estimer l'impact)
+```{r, echo=FALSE}
+kbl(params$impact_QT_table, align = "c", booktabs=T)
+```  
 ## `r paste("Probabilité d'extinction à", params$time_horizon, "ans")`
 ```{r, echo=FALSE}
 kbl(params$PrExt_table, align = "c", booktabs=T)
@@ -121,20 +123,20 @@ kbl(params$PrExt_table, align = "c", booktabs=T)
 
 
 
-## Graphique : Densité de probabilité de l'impact relatif (final)
+## Graphique 1 : Densité de probabilité de l'impact relatif (à `r params$time_horizon` ans)
 ```{r, echo=FALSE}
 params$PDF_plot
 ```
 Note : La médiane et l'intervalle de confiance (IC à `r params$CI`%) sont montrés sur le graphe.  
 
-## Graphique : Probabilité cumulée de l'impact relatif (final)
+## Graphique 2 : Probabilité cumulée de l'impact relatif (à `r params$time_horizon` ans)
 ```{r, echo=FALSE}
 params$ECDF_plot
 ```
 Note : Quantile = `r params$QT`%,  
-soit un risque de sous-estimation de l'impact de `r params$risk_A`%  
+soit un risque de `r params$risk_A`% de sous-estimer l'impact
 
-## Graphique : Impact relatif au cours du temps
+## Graphique 3 : Impact relatif au cours du temps
 ```{r, echo=FALSE}
 params$impact_plot
 ```

inst/ShinyApp/server.R

@@ -1640,6 +1640,28 @@ server <- function(input, output, session){
     )
   }
 
+  ## Function to make a table of the impacts at given quantile
+  table_impact_QT <- function(show_quantile){
+    req(out$run)
+    res <- get_metrics(N = out$run$N, cumulated_impacts = FALSE)
+    n_scen <- (dim(res$scenario$impact)[3]-1)
+
+    RowNam <- NULL
+    if(out$analysis_choice == "single_farm") RowNam <- c("Parc 1")
+    if(out$analysis_choice == "cumulated") RowNam <- c("Parc 1", paste("... + Parc", (2:n_scen)))
+    if(out$analysis_choice == "multi_scenario") RowNam <- paste("Scenario", (1:n_scen))
+
+    dr_N <- get_metrics(N = out$run$N, cumulated_impacts = param$cumulated_impacts)$scenario$DR_N
+    fil <- paste0(round(
+      quantiles_impact(dr_N, show_quantile = 1-(input$risk_A/100), show_CI = NULL, percent = TRUE)$QT[-1]
+      , 1), "%")
+
+    matrix(fil,
+           nrow = n_scen,
+           dimnames = list(RowNam, c("Impact au quantile"))
+    )
+  }
+
   ## Function to print the Probability of Extinction
   print_PrExt <- function(){
     req(out$run)
@@ -1658,7 +1680,6 @@ server <- function(input, output, session){
     )
   }
 
-
   ## Function to plot the probability density of the impact
   plot_out_PDF <- function(legend_position, text_size, show_scenario, show_CI){
     if(is.null(out$run)) {} else {
@@ -1822,8 +1843,7 @@ server <- function(input, output, session){
   output$quantile_impact_result <- renderText({
     dr_N <- get_metrics(N = out$run$N, cumulated_impacts = param$cumulated_impacts)$scenario$DR_N
     impact_QT <- quantiles_impact(dr_N, show_quantile = 1-(input$risk_A/100), show_CI = NULL, percent = TRUE)$QT[-1]
-    out$impact_QT <- impact_QT
-    paste0("Scnario ", 1:length(impact_QT), " : ", round(impact_QT,1), "%\n", collapse = "")
+    paste0("Scnario ", 1:length(impact_QT), " : ", round(impact_QT,1), "%", collapse = "\n")
   })
 
 
@@ -2027,7 +2047,7 @@ server <- function(input, output, session){
     if(input$carrying_cap_input_type == "no_K"){
       out$carrying_cap_input_type <- NULL
       out$carrying_cap_val1 <- paste0("Absence de capacit de charge")
-      out$carrying_cap_val2 <- paste0("Justifi ou pas ??")
+      out$carrying_cap_val2 <- NULL
     }
 
   })
@@ -2043,6 +2063,7 @@ server <- function(input, output, session){
     input$show_CI
     input$risk_A
   }, {
+    req(input$run > 0)
     out$PDF_plot <- plot_out_PDF(legend_position = "bottom", text_size = "small",
                                  show_scenario = "all", show_CI = input$show_CI/100)
     out$ECDF_plot <- plot_out_ECDF(legend_position = "bottom", text_size = "small",
@@ -2053,6 +2074,12 @@ server <- function(input, output, session){
     out$CI <- input$show_CI
     out$QT <- 100-(input$risk_A)
     out$risk_A <- input$risk_A
+
+    #dr_N <- get_metrics(N = out$run$N, cumulated_impacts = param$cumulated_impacts)$scenario$DR_N
+    #out$impact_QT <- quantiles_impact(dr_N, show_quantile = 1-(input$risk_A/100), show_CI = NULL, percent = TRUE)$QT[-1]
+    out$impact_QT_table <- table_impact_QT(show_quantile = 1-(input$risk_A/100))
+
+    print(out$impact_QT_table)
   })
 
 
@@ -2115,7 +2142,7 @@ server <- function(input, output, session){
         CI = out$CI,
         QT = out$QT,
         risk_A = out$risk_A,
-        impact_QT = out$impact_QT
+        impact_QT_table = out$impact_QT_table
         )