From cc6388344d3379443f180839a5dd3fb1cf8866ed Mon Sep 17 00:00:00 2001
From: thierrychambert <thierry.chambert@gmail.com>
Date: Tue, 17 Aug 2021 16:40:19 +0200
Subject: [PATCH] Shiny : added text output (impact as %)
---
inst/ShinyApp/server.R | 55 ++++++++++++++++++++++++++++++++++++------
inst/ShinyApp/ui.R | 15 +++++++-----
2 files changed, 56 insertions(+), 14 deletions(-)
diff --git a/inst/ShinyApp/server.R b/inst/ShinyApp/server.R
index 67ec156..2c837e6 100644
--- a/inst/ShinyApp/server.R
+++ b/inst/ShinyApp/server.R
@@ -196,8 +196,10 @@ server <- function(input, output, session){
##--------------------------------------------
- ## Reactive value : simulation inputs
+ ## Reactive value
##--------------------------------------------
+ out <- reactiveValues(run = NULL)
+
param <- reactiveValues(N1 = NULL,
nsim = NULL,
cumulated_impacts = NULL,
@@ -681,7 +683,7 @@ server <- function(input, output, session){
withProgress(message = 'Simulation progress', value = 0, {
- param$N1 <- run_simul_shiny(nsim = param$nsim,
+ out$run <- run_simul_shiny(nsim = param$nsim,
cumulated_impacts = param$cumulated_impacts,
fatalities_mean = param$fatalities_mean,
@@ -710,26 +712,63 @@ server <- function(input, output, session){
}) # Close observEvent
- # Plot Impacts
+
+
+
+
+ ##--------------------------------------------------------------------------##
+ ## OUTPUTS
+ ##--------------------------------------------------------------------------##
+
+
+ ##--------------------------------------------
+ # Show result : impact text
+ ##--------------------------------------------
+ ## Two Functions to print the output
+ # print_it
+ print_it <- function(impact, lci, uci){
+ paste0("Impact sur la taille de population : ", round(impact, 2)*100, "%",
+ "[", round(lci, 2)*100, "% ; ", round(uci, 2)*100, "%]")
+ }
+
+ # print_out
+ print_out <- function() if(is.null(out$run$N)) {} else {
+ print_it(impact = get_metrics(N = out$run$N)$scenario$impact[time_horzion, "avg",-1],
+ lci = get_metrics(N = out$run$N)$scenario$impact[time_horzion, "lci",-1],
+ uci = get_metrics(N = out$run$N)$scenario$impact[time_horzion, "uci",-1])
+ }
+
+ # Display result (text)
+ output$impact_text <- renderText({ print_out() })
+
+ # Plot Impacts
plot_out_impact <- function(){
- if(is.null(param$N1)) {} else {plot_impact(N = param$N1$N, xlab = "year", ylab = "pop size")}
+ if(is.null(out$run)) {} else {plot_impact(N = out$run$N, xlab = "year", ylab = "pop size")}
}
- output$graph_impact <- renderPlot({
+ output$title_impact_plot <- renderText({
+ if(input$run > 0){
+ "Résultat : Impact relatif au cours du temps"
+ }
+ })
+
+ output$impact_plot <- renderPlot({
plot_out_impact()
})
# Plot trajectories
-
plot_out_traj <- function(){
- if(is.null(param$N1)) {} else {plot_traj(N = param$N1$N, xlab = "year", ylab = "pop size")}
+ if(is.null(out$run)) {} else {plot_traj(N = out$run$N, xlab = "year", ylab = "pop size")}
}
output$graph_traj <- renderPlot({
plot_out_traj()
})
- # End simulations
+
+
+
+
##--------------------------------------------
diff --git a/inst/ShinyApp/ui.R b/inst/ShinyApp/ui.R
index d43e7bd..e2f2200 100644
--- a/inst/ShinyApp/ui.R
+++ b/inst/ShinyApp/ui.R
@@ -446,25 +446,28 @@ rm(list = ls(all.names = TRUE))
tabPanel(title = "Impact population",
- br(""),
- numericInput(inputId = "nsim", label = "Nombre de simulations",
+ br(),
+ numericInput(inputId = "nsim",
+ label = "Nombre de simulations",
value = 10, min = 0, max = Inf, step = 10),
radioButtons(inputId = "fatal_constant",
- label = h4("Modélisation"),
+ label = "Modélisation",
choices = c("Taux de mortalités (h) constant" = "h",
"Nombre de mortalités (M) constant" = "M")),
br(),
- strong(span(textOutput("message"), style="color:blue; font-size:24px", align = "center")),
+ strong(span(textOutput("impact_text"), style="color:blue; font-size:24px", align = "left")),
br(),
actionButton(inputId = "run", label = "Lancer l'analyse"),
hr(),
- h4("Graphique : Impact relatif de chaque scénario", align = "center"),
- plotOutput("graph_impact", width = "100%", height = "550px"),
+
+ tags$h4(textOutput("title_impact_plot"), align = "center"),
+ plotOutput("impact_plot", width = "100%", height = "550px"),
hr(),
+
h4("Graphique : Trajectoire démographique", align = "center"),
plotOutput("graph_traj", width = "100%", height = "550px")
), # End tabPanel
--
GitLab