From 9d8c26e3af9bd7694465abd000f54217bb6d46da Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Grall?= <seinormigr.grall@gmail.com>
Date: Wed, 19 Oct 2022 14:14:18 +0000
Subject: [PATCH 01/47] mod mig env en cours
---
R/app_server.R | 6 ++++--
R/mod_migr_env.R | 28 ++++++++++++++++------------
2 files changed, 20 insertions(+), 14 deletions(-)
diff --git a/R/app_server.R b/R/app_server.R
index 417d217..2658696 100644
--- a/R/app_server.R
+++ b/R/app_server.R
@@ -55,9 +55,11 @@ app_server <- function(input, output, session) {
DD$button_ref_parquan_migr_car <- mod_ref_parquan_server("ref_parquan_migr_car", DD, mytab = "migr_car")
# mod_mig_env -----------------------------
- mod_migr_env_server("migr_env_ui_1")
+ mod_migr_env_server("migr_env_ui_1",DD)
DD$button_ref_stationmesure_mod_migr_env <- mod_ref_stationmesure_server("ref_stationmesure_mod_migr_env", DD, mytab = "migr_env")
-
+ DD$button_ref_taxa_migr_env <- mod_ref_taxa_server("ref_taxa_mod_migr_env", DD, mytab = "migr_env")
+ DD$button_ref_stage_migr_env <- mod_ref_stage_server("ref_stage_mod_migr_env", DD, mytab = "migr_env")
+
# mod_sat_age -----------------------------
mod_sat_age_server("sat_age_ui_1")
DD$button_ref_stage_sat_age <- mod_ref_stage_server("ref_stage_sat_age", DD, mytab = "sat_age")
diff --git a/R/mod_migr_env.R b/R/mod_migr_env.R
index 7257b42..bec26c9 100644
--- a/R/mod_migr_env.R
+++ b/R/mod_migr_env.R
@@ -14,9 +14,7 @@ mod_migr_env_ui <- function(id) {
box(title = "S\u00e9lections :",
collapsible = TRUE,
width = 3,
- selectizeInput("station_mesure_mult", h5("Choisissez une ou plusieurs station(s) de mesure :"),
- choices = list("Choice 1" = 1, "Choice 2" = 2, "Choice 3" = 3),
- multiple = TRUE),
+ mod_ref_stationmesure_ui("ref_stationmesure_mod_migr_env"),
dateRangeInput("dates", label = h5("S\u00e9lectionnez la date de d\u00e9but et de fin :")),
selectizeInput("pas_temps", h5("Choisissez un pas de temps :"),
@@ -24,12 +22,8 @@ mod_migr_env_ui <- function(id) {
multiple = FALSE),
numericInput("num", label = h5("Nombre de pas de temps :"), value = 365),
- selectizeInput("taxon_mult", h5("Choisissez un ou plusieurs taxon(s) :"),
- choices = list("Choice 1" = 1, "Choice 2" = 2, "Choice 3" = 3),
- multiple = TRUE),
- selectizeInput("stade_mult", h5("Choisissez un ou plusieurs stade(s) :"),
- choices = list("Choice 1" = 1, "Choice 2" = 2, "Choice 3" = 3),
- multiple = TRUE),
+ mod_ref_taxa_ui("ref_taxa_mod_migr_env"),
+ mod_ref_stage_server("ref_stage_mod_migr_env"),
checkboxGroupInput(ns("choix_sorties"), label = h4("Choisissez les sorties graphiques ou tableaux :"),
choices = list("plot_migr_env1" = 1, "plot_migr_env2" = 2),
@@ -56,9 +50,19 @@ mod_migr_env_ui <- function(id) {
#' migr_env Server Functions
#' @importFrom shinipsum random_ggplot
#' @noRd
-mod_migr_env_server <- function(id) {
+mod_migr_env_server <- function(id,DD,mytab) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
+ observeEvent(
+ eventExpr = {
+ DD$button_ref_stationmesure_mod_migr_env()
+ },
+ handlerExpr = {
+ shinyCatch({
+
+
+
+
output$plot_migr_env1 <- renderPlot({
random_ggplot()
})
@@ -66,9 +70,9 @@ mod_migr_env_server <- function(id) {
output$plot_migr_env2 <- renderPlot({
random_ggplot()
})
-
+ }) ## end shinycatch
})
-}
+})}
## To be copied in the UI
# mod_migr_env_ui("migr_env_ui_1")
--
GitLab
From 41c76f90ad8e6141c6628bd0407fd7e7679e7ab8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Grall?= <seinormigr.grall@gmail.com>
Date: Wed, 19 Oct 2022 17:14:49 +0200
Subject: [PATCH 02/47] bug fix
---
R/mod_migr_env.R | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/R/mod_migr_env.R b/R/mod_migr_env.R
index bec26c9..9ded14a 100644
--- a/R/mod_migr_env.R
+++ b/R/mod_migr_env.R
@@ -23,7 +23,7 @@ mod_migr_env_ui <- function(id) {
numericInput("num", label = h5("Nombre de pas de temps :"), value = 365),
mod_ref_taxa_ui("ref_taxa_mod_migr_env"),
- mod_ref_stage_server("ref_stage_mod_migr_env"),
+ mod_ref_stage_ui("ref_stage_mod_migr_env"),
checkboxGroupInput(ns("choix_sorties"), label = h4("Choisissez les sorties graphiques ou tableaux :"),
choices = list("plot_migr_env1" = 1, "plot_migr_env2" = 2),
--
GitLab
From a504bb69fb4b302554b4c5df0b72adf575b7212e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Grall?= <seinormigr.grall@gmail.com>
Date: Wed, 19 Oct 2022 17:39:57 +0200
Subject: [PATCH 03/47] mod migr env en cours
---
R/mod_annuel.R | 3 ++-
R/mod_interannuel.R | 3 ++-
R/mod_migr_env.R | 8 +++++++-
R/mod_ref_stage.R | 1 +
4 files changed, 12 insertions(+), 3 deletions(-)
diff --git a/R/mod_annuel.R b/R/mod_annuel.R
index 7810fa4..4459d57 100644
--- a/R/mod_annuel.R
+++ b/R/mod_annuel.R
@@ -22,7 +22,8 @@ mod_annuel_ui <- function(id){
label = h5("Choisissez l'ann\u00e9e de d\u00e9but et de fin :"),
min = 1980,
max = CY,
- value = c(2011, CY)),
+ value = c(2011, CY),
+ sep = ""),
mod_ref_taxa_ui("ref_taxa_mod_annuel"),
mod_ref_stage_ui("ref_stage_mod_annuel"),
checkboxGroupInput(ns("choix_sorties"),
diff --git a/R/mod_interannuel.R b/R/mod_interannuel.R
index c521c1f..f17321d 100644
--- a/R/mod_interannuel.R
+++ b/R/mod_interannuel.R
@@ -23,7 +23,8 @@ mod_interannuel_ui <- function(id){
label = h5("Choisissez l\'ann\u00e9e"),
min = 1980,
max = CY,
- value = c(2011, CY)),
+ value = c(2011, CY),
+ sep = ""),
mod_ref_taxa_ui("ref_taxa_mod_interannuel", multiple=FALSE),
mod_ref_stage_ui("ref_stage_mod_interannuel", multiple=FALSE),
diff --git a/R/mod_migr_env.R b/R/mod_migr_env.R
index 9ded14a..f0af0a5 100644
--- a/R/mod_migr_env.R
+++ b/R/mod_migr_env.R
@@ -56,10 +56,16 @@ mod_migr_env_server <- function(id,DD,mytab) {
observeEvent(
eventExpr = {
DD$button_ref_stationmesure_mod_migr_env()
+ DD$button_ref_taxa_migr_env()
+ DD$button_ref_stage_migr_env()
},
handlerExpr = {
shinyCatch({
-
+ validate(need(exists("envir_stacomi"), "Le programme stacomi doit être lancé"))
+ db_connection <- envir_stacomi$db_connection
+ validate(need(!is.null(db_connection), "db needs connection"))
+
+
diff --git a/R/mod_ref_stage.R b/R/mod_ref_stage.R
index 142bcd9..1e4238a 100644
--- a/R/mod_ref_stage.R
+++ b/R/mod_ref_stage.R
@@ -45,6 +45,7 @@ mod_ref_stage_server <- function(id, DD, mytab) {
DD$button_ref_taxa_interannuel()
DD$button_ref_taxa_migr_car()
DD$button_ref_taxa_sample_char()
+ DD$button_ref_taxa_migr_env()
DD$tabs()
},
handlerExpr = {
--
GitLab
From 7268df61107bd2cbf05e525d0b0aa8690d043500 Mon Sep 17 00:00:00 2001
From: Guirec Andre <guirec.andre@ofb.gouv.fr>
Date: Thu, 20 Oct 2022 09:04:38 +0200
Subject: [PATCH 04/47] correct year format to date
---
R/mod_annuel.R | 3 ++-
R/mod_interannuel.R | 3 ++-
2 files changed, 4 insertions(+), 2 deletions(-)
diff --git a/R/mod_annuel.R b/R/mod_annuel.R
index 7810fa4..4459d57 100644
--- a/R/mod_annuel.R
+++ b/R/mod_annuel.R
@@ -22,7 +22,8 @@ mod_annuel_ui <- function(id){
label = h5("Choisissez l'ann\u00e9e de d\u00e9but et de fin :"),
min = 1980,
max = CY,
- value = c(2011, CY)),
+ value = c(2011, CY),
+ sep = ""),
mod_ref_taxa_ui("ref_taxa_mod_annuel"),
mod_ref_stage_ui("ref_stage_mod_annuel"),
checkboxGroupInput(ns("choix_sorties"),
diff --git a/R/mod_interannuel.R b/R/mod_interannuel.R
index c521c1f..2bd8a40 100644
--- a/R/mod_interannuel.R
+++ b/R/mod_interannuel.R
@@ -23,7 +23,8 @@ mod_interannuel_ui <- function(id){
label = h5("Choisissez l\'ann\u00e9e"),
min = 1980,
max = CY,
- value = c(2011, CY)),
+ value = c(2011, CY),
+ sep = ""),
mod_ref_taxa_ui("ref_taxa_mod_interannuel", multiple=FALSE),
mod_ref_stage_ui("ref_stage_mod_interannuel", multiple=FALSE),
--
GitLab
From ce3ed655f0655852bacfce71284f901ce0df816f Mon Sep 17 00:00:00 2001
From: Guirec Andre <guirec.andre@ofb.gouv.fr>
Date: Thu, 20 Oct 2022 09:11:57 +0200
Subject: [PATCH 05/47] correction pb merge
---
R/mod_interannuel.R | 7 ++-----
1 file changed, 2 insertions(+), 5 deletions(-)
diff --git a/R/mod_interannuel.R b/R/mod_interannuel.R
index 51a8b67..9f3ed05 100644
--- a/R/mod_interannuel.R
+++ b/R/mod_interannuel.R
@@ -24,11 +24,8 @@ mod_interannuel_ui <- function(id){
min = 1980,
max = CY,
value = c(2011, CY),
-<<<<<<< HEAD
- sep = ""),
-=======
- sep = ""),
->>>>>>> a504bb69fb4b302554b4c5df0b72adf575b7212e
+ sep = ""),
+
mod_ref_taxa_ui("ref_taxa_mod_interannuel", multiple=FALSE),
mod_ref_stage_ui("ref_stage_mod_interannuel", multiple=FALSE),
--
GitLab
From f8ad87b9445e74675682a87f286bfaa7990cae11 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Grall?= <seinormigr.grall@gmail.com>
Date: Thu, 20 Oct 2022 11:00:34 +0200
Subject: [PATCH 06/47] issue with plot
---
R/mod_migr_env.R | 112 +++++++++++++++++++++++++++++++++++++----------
1 file changed, 89 insertions(+), 23 deletions(-)
diff --git a/R/mod_migr_env.R b/R/mod_migr_env.R
index f0af0a5..8e660f7 100644
--- a/R/mod_migr_env.R
+++ b/R/mod_migr_env.R
@@ -15,12 +15,13 @@ mod_migr_env_ui <- function(id) {
collapsible = TRUE,
width = 3,
mod_ref_stationmesure_ui("ref_stationmesure_mod_migr_env"),
- dateRangeInput("dates", label = h5("S\u00e9lectionnez la date de d\u00e9but et de fin :")),
-
- selectizeInput("pas_temps", h5("Choisissez un pas de temps :"),
- selected = "1 jour", choices = c("1 sec", "1 min", "10 min", "15 min", "30 min", "1 h", "12 h", "1 jour", "1 sem", "2 sem", "1 mois", "3 mois", "6 mois", "1 an"),
- multiple = FALSE),
- numericInput("num", label = h5("Nombre de pas de temps :"), value = 365),
+ dateInput(ns("migr_env.datedebut"), label = h5("Choisissez une date de début :"), value = paste0(as.numeric(strftime(Sys.Date(),"%Y"))-1,"-01-01")),
+ dateInput(ns("migr_env.datefin"), label = h5("Choisissez une date de fin :"), value =paste0(as.numeric(strftime(Sys.Date(),"%Y"))-1,"-12-31")),
+#
+# selectizeInput("pas_temps", h5("Choisissez un pas de temps :"),
+# selected = "1 jour", choices = c("1 sec", "1 min", "10 min", "15 min", "30 min", "1 h", "12 h", "1 jour", "1 sem", "2 sem", "1 mois", "3 mois", "6 mois", "1 an"),
+# multiple = FALSE),
+# numericInput("num", label = h5("Nombre de pas de temps :"), value = 365),
mod_ref_taxa_ui("ref_taxa_mod_migr_env"),
mod_ref_stage_ui("ref_stage_mod_migr_env"),
@@ -37,12 +38,31 @@ mod_migr_env_ui <- function(id) {
),
- box(collapsible = TRUE,
- width = 9,
- plotOutput(ns("plot_migr_env1")),
- plotOutput(ns("plot_migr_env2"))
+ shinydashboardPlus::box(
+ id=ns("box_plot_migr_env_1"),
+ title="Plot env 1",
+ status = "primary",
+ solidHeader = TRUE,
+ collapsible = TRUE,
+ collapsed=TRUE,
+ width=8,
+ plotOutput(ns("plot_migr_env1"),
+ width = "100%",
+ height = "600px")
+),
- )
+shinydashboardPlus::box(
+ id=ns("box_plot_migr_env_2"),
+ title="Plot env 2",
+ status = "primary",
+ solidHeader = TRUE,
+ collapsible = TRUE,
+ collapsed=TRUE,
+ width=8,
+ plotOutput(ns("plot_migr_env2"),
+ width = "100%",
+ height = "600px")
+),
)
}
@@ -55,27 +75,73 @@ mod_migr_env_server <- function(id,DD,mytab) {
ns <- session$ns
observeEvent(
eventExpr = {
- DD$button_ref_stationmesure_mod_migr_env()
- DD$button_ref_taxa_migr_env()
- DD$button_ref_stage_migr_env()
+ # DD$button_ref_stationmesure_mod_migr_env()
+ # DD$button_ref_taxa_migr_env()
+ # DD$button_ref_stage_migr_env()
+ input$bttn_migrenv
},
handlerExpr = {
shinyCatch({
validate(need(exists("envir_stacomi"), "Le programme stacomi doit être lancé"))
db_connection <- envir_stacomi$db_connection
validate(need(!is.null(db_connection), "db needs connection"))
+ r_mig_env<-new("report_mig_env")
+ ref_dc <- base::get("ref_dc", envir=envir_stacomi)
+ ref_taxa <- base::get("ref_taxa", envir=envir_stacomi)
+ ref_stage <- base::get("ref_stage", envir=envir_stacomi)
+ isolate(ref_env <- rlang::env_get(envir_stacomi, "ref_env", default = NULL))
+ req(!is.null(ref_env))
+ validate(need(length(ref_env@env_selected) > 0, "Les stations de mesures n'ont pas été sélectionnées"))
+ validate(need(length(ref_dc@dc_selected)>0, "Pas de DC sélectionné"))
+ validate(need(length(ref_taxa@taxa_selected)>0, "pas de taxon sélectionné"))
+ validate(need(length(ref_stage@stage_selected)>0, "pas de stade sélectionné"))
+
+ r_mig_env<-choice_c(r_mig_env,
+ dc=ref_dc@dc_selected,
+ taxa=ref_taxa@taxa_selected,
+ stage=ref_stage@stage_selected,
+ stationMesure=ref_env@env_selected,
+ datedebut=input$migr_env.datedebut,
+ datefin=input$migr_env.datefin,
+ silent=TRUE)
+ shinybusy::show_modal_spinner(text="please wait") # show the modal window
+ r_mig_env<-charge(r_mig_env) # this is necessary to load operations, DF and DC
+ r_mig_env<-connect(r_mig_env)
+ r_mig_env<-calcule(r_mig_env,silent=TRUE)
+ shinybusy::remove_modal_spinner() # remove it when done
+ # graphiques et sorties ----------------------
+ if (nrow(r_mig_env@report_env@data) == 0) {
+ warning("no data available_mig_env")
+ } else {
+ if ("1" %in% input$choix_sorties) {
+ if (input$box_plot_migr_env_1$collapsed) shinydashboardPlus::updateBox("box_plot_migr_env_1", action = "toggle")
+ output$plot_migr_env1 <- renderPlot({
+ #stacomiR::plot(r_mig_env, plot.type = "1")
+ random_ggplot()
+ })
+ } else {
+ if (!input$box_plot_migr_env_1$collapsed) shinydashboardPlus::updateBox("box_plot_migr_env_1", action = "toggle")
+ } # end ifelse "1"
+ if ("2" %in% input$choix_sorties) {
+ if (input$box_plot_migr_env_2$collapsed) shinydashboardPlus::updateBox("box_plot_migr_env_2", action = "toggle")
+ output$plot_migr_env2 <- renderPlot({
+ #stacomiR::plot(r_mig_env, plot.type = "2")
+ random_ggplot()
+ })
+ } else {
+ if (!input$box_plot_migr_env_2$collapsed) shinydashboardPlus::updateBox("box_plot_migr_env_2", action = "toggle")
+ } # end ifelse "2"
+ }
-
-
- output$plot_migr_env1 <- renderPlot({
- random_ggplot()
- })
-
- output$plot_migr_env2 <- renderPlot({
- random_ggplot()
- })
+ # output$plot_migr_env1 <- renderPlot({
+ # random_ggplot()
+ # })
+ #
+ # output$plot_migr_env2 <- renderPlot({
+ # random_ggplot()
+ # })
}) ## end shinycatch
})
})}
--
GitLab
From e37e8a65eae28eebff5db523cffe7e5ad3c82b04 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Grall?= <seinormigr.grall@gmail.com>
Date: Thu, 20 Oct 2022 14:02:29 +0200
Subject: [PATCH 07/47] deux pour le prix d'une
---
R/mod_migr_env.R | 61 ++++++++++++++++++------------------------------
1 file changed, 23 insertions(+), 38 deletions(-)
diff --git a/R/mod_migr_env.R b/R/mod_migr_env.R
index 8e660f7..5d22775 100644
--- a/R/mod_migr_env.R
+++ b/R/mod_migr_env.R
@@ -17,17 +17,11 @@ mod_migr_env_ui <- function(id) {
mod_ref_stationmesure_ui("ref_stationmesure_mod_migr_env"),
dateInput(ns("migr_env.datedebut"), label = h5("Choisissez une date de début :"), value = paste0(as.numeric(strftime(Sys.Date(),"%Y"))-1,"-01-01")),
dateInput(ns("migr_env.datefin"), label = h5("Choisissez une date de fin :"), value =paste0(as.numeric(strftime(Sys.Date(),"%Y"))-1,"-12-31")),
-#
-# selectizeInput("pas_temps", h5("Choisissez un pas de temps :"),
-# selected = "1 jour", choices = c("1 sec", "1 min", "10 min", "15 min", "30 min", "1 h", "12 h", "1 jour", "1 sem", "2 sem", "1 mois", "3 mois", "6 mois", "1 an"),
-# multiple = FALSE),
-# numericInput("num", label = h5("Nombre de pas de temps :"), value = 365),
-
mod_ref_taxa_ui("ref_taxa_mod_migr_env"),
mod_ref_stage_ui("ref_stage_mod_migr_env"),
checkboxGroupInput(ns("choix_sorties"), label = h4("Choisissez les sorties graphiques ou tableaux :"),
- choices = list("plot_migr_env1" = 1, "plot_migr_env2" = 2),
+ choices = list("plot_migr_env" = 1),
selected = 1),
actionBttn(
inputId = ns("bttn_migrenv"),
@@ -35,34 +29,20 @@ mod_migr_env_ui <- function(id) {
style = "fill",
color = "primary"
)
-
),
shinydashboardPlus::box(
- id=ns("box_plot_migr_env_1"),
- title="Plot env 1",
- status = "primary",
- solidHeader = TRUE,
- collapsible = TRUE,
- collapsed=TRUE,
- width=8,
- plotOutput(ns("plot_migr_env1"),
- width = "100%",
- height = "600px")
-),
-
-shinydashboardPlus::box(
- id=ns("box_plot_migr_env_2"),
- title="Plot env 2",
+ id=ns("box_plot_migr_env"),
+ title="Plot migr env",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
collapsed=TRUE,
width=8,
- plotOutput(ns("plot_migr_env2"),
+ plotOutput(ns("plot_migr_env"),
width = "100%",
height = "600px")
-),
+)
)
}
@@ -116,23 +96,28 @@ mod_migr_env_server <- function(id,DD,mytab) {
warning("no data available_mig_env")
} else {
if ("1" %in% input$choix_sorties) {
- if (input$box_plot_migr_env_1$collapsed) shinydashboardPlus::updateBox("box_plot_migr_env_1", action = "toggle")
- output$plot_migr_env1 <- renderPlot({
+ if (input$box_plot_migr_env$collapsed) shinydashboardPlus::updateBox("box_plot_migr_env", action = "toggle")
+ output$plot_migr_env <- renderPlot({
#stacomiR::plot(r_mig_env, plot.type = "1")
- random_ggplot()
+ color_dc<-stacomiR::colortable(color = NULL,r_mig_env@report_mig_mult@dc@dc_selected,palette = "Set2",color_function = c("random"))
+ color_dc_vec<-color_dc$color
+ color_dc_vec=setNames(color_dc_vec,color_dc$name)
+
+ color_sta_mesure<-stacomiR::colortable(color = NULL, r_mig_env@report_env@stationMesure@env_selected,palette = "Set2",color_function = c("random"))
+ color_sta_mesure_vec<-color_sta_mesure$color
+ color_sta_mesure_vec=setNames(color_sta_mesure_vec,color_sta_mesure$name)
+
+ stacomiR::plot(r_mig_env,
+ color_station=color_sta_mesure_vec,
+ color_dc=color_dc_vec
+ )
+
+
})
} else {
- if (!input$box_plot_migr_env_1$collapsed) shinydashboardPlus::updateBox("box_plot_migr_env_1", action = "toggle")
+ if (!input$box_plot_migr_env$collapsed) shinydashboardPlus::updateBox("box_plot_migr_env", action = "toggle")
} # end ifelse "1"
- if ("2" %in% input$choix_sorties) {
- if (input$box_plot_migr_env_2$collapsed) shinydashboardPlus::updateBox("box_plot_migr_env_2", action = "toggle")
- output$plot_migr_env2 <- renderPlot({
- #stacomiR::plot(r_mig_env, plot.type = "2")
- random_ggplot()
- })
- } else {
- if (!input$box_plot_migr_env_2$collapsed) shinydashboardPlus::updateBox("box_plot_migr_env_2", action = "toggle")
- } # end ifelse "2"
+
}
# output$plot_migr_env1 <- renderPlot({
--
GitLab
From 524b16664e23a240c15cb9aa02b7c024f43beee0 Mon Sep 17 00:00:00 2001
From: Guirec Andre <guirec.andre@ofb.gouv.fr>
Date: Thu, 20 Oct 2022 16:24:39 +0200
Subject: [PATCH 08/47] modif mod_mig_env
---
R/mod_migr_env.R | 3 +++
1 file changed, 3 insertions(+)
diff --git a/R/mod_migr_env.R b/R/mod_migr_env.R
index 5d22775..0f3fbdc 100644
--- a/R/mod_migr_env.R
+++ b/R/mod_migr_env.R
@@ -92,6 +92,9 @@ mod_migr_env_server <- function(id,DD,mytab) {
# graphiques et sorties ----------------------
+ if (nrow(r_mig_env@report_mig_mult@data) == 0) {
+ warning("no data available_mig_mult")
+ } else
if (nrow(r_mig_env@report_env@data) == 0) {
warning("no data available_mig_env")
} else {
--
GitLab
From 03cb9a5c54cc35a97c88e19b908a678a6cedca45 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Grall?= <seinormigr.grall@gmail.com>
Date: Thu, 20 Oct 2022 16:24:54 +0200
Subject: [PATCH 09/47] rien de nouveau
---
R/mod_migr_env.R | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/R/mod_migr_env.R b/R/mod_migr_env.R
index 5d22775..ef6fe2b 100644
--- a/R/mod_migr_env.R
+++ b/R/mod_migr_env.R
@@ -94,11 +94,11 @@ mod_migr_env_server <- function(id,DD,mytab) {
# graphiques et sorties ----------------------
if (nrow(r_mig_env@report_env@data) == 0) {
warning("no data available_mig_env")
- } else {
+ }
+ else {
if ("1" %in% input$choix_sorties) {
if (input$box_plot_migr_env$collapsed) shinydashboardPlus::updateBox("box_plot_migr_env", action = "toggle")
output$plot_migr_env <- renderPlot({
- #stacomiR::plot(r_mig_env, plot.type = "1")
color_dc<-stacomiR::colortable(color = NULL,r_mig_env@report_mig_mult@dc@dc_selected,palette = "Set2",color_function = c("random"))
color_dc_vec<-color_dc$color
color_dc_vec=setNames(color_dc_vec,color_dc$name)
--
GitLab
From cdceedc36d594f6e5166bb113c9570bb4b30d158 Mon Sep 17 00:00:00 2001
From: cedricbriandgithub <cedric.briand@eptb-vilaine.fr>
Date: Thu, 20 Oct 2022 16:44:10 +0200
Subject: [PATCH 10/47] Changing package loading
---
DESCRIPTION | 6 +++---
R/mod_migr_env.R | 2 +-
dev/run_dev.R | 5 ++++-
3 files changed, 8 insertions(+), 5 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index bc69275..2cf640e 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -22,7 +22,7 @@ Imports:
spsComps,
pool,
shinipsum,
- stacomiR (>= 0.6.0.5),
+ stacomiR (>= 0.6.0.7),
dplyr,
rlang,
shinybusy,
@@ -39,8 +39,8 @@ Language: en-US
URL: https://forgemia.inra.fr/stacomi/stacoshiny
BugReports: https://forgemia.inra.fr/stacomi/stacoshiny/issues
Remotes:
- git::git@forgemia.inra.fr:stacomi/stacomirtools.git,
- git::git@forgemia.inra.fr:stacomi/stacomir.git
+ git::https://forgemia.inra.fr/stacomi/stacomirtools.git,
+ git::https://forgemia.inra.fr/stacomi/stacomir.git
VignetteBuilder: knitr
Depends:
R (>= 2.10)
diff --git a/R/mod_migr_env.R b/R/mod_migr_env.R
index bec26c9..9ded14a 100644
--- a/R/mod_migr_env.R
+++ b/R/mod_migr_env.R
@@ -23,7 +23,7 @@ mod_migr_env_ui <- function(id) {
numericInput("num", label = h5("Nombre de pas de temps :"), value = 365),
mod_ref_taxa_ui("ref_taxa_mod_migr_env"),
- mod_ref_stage_server("ref_stage_mod_migr_env"),
+ mod_ref_stage_ui("ref_stage_mod_migr_env"),
checkboxGroupInput(ns("choix_sorties"), label = h4("Choisissez les sorties graphiques ou tableaux :"),
choices = list("plot_migr_env1" = 1, "plot_migr_env2" = 2),
diff --git a/dev/run_dev.R b/dev/run_dev.R
index 2714d87..147b3f3 100644
--- a/dev/run_dev.R
+++ b/dev/run_dev.R
@@ -8,7 +8,10 @@ options(golem.app.prod = FALSE) # TRUE = production mode, FALSE = development mo
rm(list=ls(all.names = TRUE))
# Document and reload your package
-remotes::install_deps()
+remotes::install_deps(upgrade='never')
+# Pour mettre à jour le package stacomiR (décommenter puis choisir stacomiR)
+#remotes::install_deps(upgrade='ask')
+
golem::document_and_reload()
# these options set the scene before connecting to the database
--
GitLab
From 3930090246abc4a74bb1e9d559162b6c9869c3a6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Grall?= <seinormigr.grall@gmail.com>
Date: Fri, 21 Oct 2022 09:59:06 +0000
Subject: [PATCH 11/47] issue fixe
---
R/mod_migr_env.R | 2 +-
dev/run_dev.R | 1 +
2 files changed, 2 insertions(+), 1 deletion(-)
diff --git a/R/mod_migr_env.R b/R/mod_migr_env.R
index 2ea51f9..ebe5c69 100644
--- a/R/mod_migr_env.R
+++ b/R/mod_migr_env.R
@@ -109,7 +109,7 @@ mod_migr_env_server <- function(id,DD,mytab) {
color_sta_mesure<-stacomiR::colortable(color = NULL, r_mig_env@report_env@stationMesure@env_selected,palette = "Set2",color_function = c("random"))
color_sta_mesure_vec<-color_sta_mesure$color
color_sta_mesure_vec=setNames(color_sta_mesure_vec,color_sta_mesure$name)
-
+
stacomiR::plot(r_mig_env,
color_station=color_sta_mesure_vec,
color_dc=color_dc_vec
diff --git a/dev/run_dev.R b/dev/run_dev.R
index 147b3f3..469fd64 100644
--- a/dev/run_dev.R
+++ b/dev/run_dev.R
@@ -9,6 +9,7 @@ rm(list=ls(all.names = TRUE))
# Document and reload your package
remotes::install_deps(upgrade='never')
+#devtools::load_all(path = "C:/Users/seino/OneDrive - Seine-Normandie Migrateurs/R/Stacoshiny/stacomir/")
# Pour mettre à jour le package stacomiR (décommenter puis choisir stacomiR)
#remotes::install_deps(upgrade='ask')
--
GitLab
From 4a15c415f9cbe6f26056f060b3f313e3a3533cff Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Grall?= <seinormigr.grall@gmail.com>
Date: Mon, 24 Oct 2022 15:42:15 +0000
Subject: [PATCH 12/47] add DD on app_server mod_bilan_dc
---
R/app_server.R | 2 +-
dev/run_dev.R | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/R/app_server.R b/R/app_server.R
index f8599be..7456b64 100644
--- a/R/app_server.R
+++ b/R/app_server.R
@@ -88,7 +88,7 @@ app_server <- function( input, output, session ) {
mod_ang_argentee_server("ang_argentee_ui_1")
mod_civ_poids_server("civ_poids_ui_1")
- mod_bilan_dc_server("bilan_dc_ui_1")
+ mod_bilan_dc_server("bilan_dc_ui_1",DD)
# mod_bilan_df -----------------------------
diff --git a/dev/run_dev.R b/dev/run_dev.R
index 469fd64..29c468d 100644
--- a/dev/run_dev.R
+++ b/dev/run_dev.R
@@ -9,7 +9,7 @@ rm(list=ls(all.names = TRUE))
# Document and reload your package
remotes::install_deps(upgrade='never')
-#devtools::load_all(path = "C:/Users/seino/OneDrive - Seine-Normandie Migrateurs/R/Stacoshiny/stacomir/")
+#devtools::load_all(path = "D://OneDrive - Seine-Normandie Migrateurs/R/Stacoshiny/stacomir/")
# Pour mettre à jour le package stacomiR (décommenter puis choisir stacomiR)
#remotes::install_deps(upgrade='ask')
--
GitLab
From 48dc3163e047f648a80d7d139a25518fd9122550 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Grall?= <seinormigr.grall@gmail.com>
Date: Mon, 24 Oct 2022 15:47:54 +0000
Subject: [PATCH 13/47] add BB$button_box_custom for mod_bilan_dc
---
R/app_server.R | 5 +++++
1 file changed, 5 insertions(+)
diff --git a/R/app_server.R b/R/app_server.R
index 7456b64..607b866 100644
--- a/R/app_server.R
+++ b/R/app_server.R
@@ -88,7 +88,12 @@ app_server <- function( input, output, session ) {
mod_ang_argentee_server("ang_argentee_ui_1")
mod_civ_poids_server("civ_poids_ui_1")
+
+ # mod bilan_dc
mod_bilan_dc_server("bilan_dc_ui_1",DD)
+ DD$button_box_custom_bilan_dc_1<-mod_custom_plot_server("custom_plot_bilan_dc_1",DD,mytab="bilan_dc")
+ DD$button_box_custom_bilan_dc_2<-mod_custom_plot_server("custom_plot_bilan_dc_2",DD,mytab="bilan_dc")
+ DD$button_box_custom_bilan_dc_4<-mod_custom_plot_server("custom_plot_bilan_dc_4",DD,mytab="bilan_dc")
# mod_bilan_df -----------------------------
--
GitLab
From 783b4f4680860c9f1a1f290ba0ea3f01bae4e999 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Grall?= <seinormigr.grall@gmail.com>
Date: Thu, 27 Oct 2022 15:22:58 +0000
Subject: [PATCH 14/47] use renderDT for all table export and add download
buttons
---
R/mod_ang_argentee.R | 11 +++++--
R/mod_annuel.R | 15 +++++----
R/mod_bilan_dc.R | 46 +++++++++++++---------------
R/mod_bilan_df.R | 73 ++++++++++++++++++++++----------------------
R/mod_civ_poids.R | 28 +++++++++++++++--
R/mod_espece.R | 17 ++++++++++-
R/mod_interannuel.R | 18 +++++++++--
R/mod_mig_char.R | 13 +++++++-
R/mod_migr_mult.R | 19 +++++-------
R/mod_sample_char.R | 27 +++++++---------
R/mod_sat_age.R | 14 ++++++++-
11 files changed, 173 insertions(+), 108 deletions(-)
diff --git a/R/mod_ang_argentee.R b/R/mod_ang_argentee.R
index ad27ddc..d484256 100644
--- a/R/mod_ang_argentee.R
+++ b/R/mod_ang_argentee.R
@@ -157,6 +157,7 @@ mod_ang_argentee_server <- function(id, DD) {
assign("r_silver", r_silver, envir = envir_stacomi)
if (nrow(r_silver@data) == 0) {
warning("no data available")
+ shinybusy::remove_modal_spinner() # remove it when done
}
# calculations
r_silver <- calcule(r_silver, silent = TRUE)
@@ -196,9 +197,14 @@ mod_ang_argentee_server <- function(id, DD) {
if ("5" %in% input$choix_sorties) {
if (input$box_tab_angarg$collapsed) shinydashboardPlus::updateBox("box_tab_angarg", action = "toggle")
output$tab_angarg_summary <- renderDT({
- table <- r_silver@calcdata %>% dplyr::bind_rows() %>% dplyr::select(ope_dic_identifiant, annee, lot_identifiant, ope_identifiant, ope_dic_identifiant, dev_libelle, CONT, LINP, stage, BL, W, Dv, Dh, FL, MD)
+ table <- r_silver@calcdata %>% dplyr::bind_rows() %>%
+ dplyr::select(ope_dic_identifiant, ope_date_debut, ope_date_fin,annee, lot_identifiant, ope_identifiant,
+ ope_dic_identifiant, dev_libelle, CONT, LINP, stage, BL, W, Dv, Dh, FL, MD) %>%
+ dplyr::mutate(ope_date_debut=format(as.POSIXct(ope_date_debut))) %>%
+ dplyr::mutate(ope_date_fin=format(as.POSIXct(ope_date_fin)))
DT::datatable(table,
extensions = 'Buttons', options = list(
+ scrollX = TRUE,
dom = 'Bfrtip',
buttons =
list('copy', 'print', list(
@@ -206,8 +212,7 @@ mod_ang_argentee_server <- function(id, DD) {
buttons = c('csv', 'excel', 'pdf'),
text = 'Download'
))
-
- ))
+ ))
})
} else {
if (!input$box_tab_angarg$collapsed) shinydashboardPlus::updateBox("box_tab_angarg", action = "toggle")
diff --git a/R/mod_annuel.R b/R/mod_annuel.R
index 4459d57..5480c86 100644
--- a/R/mod_annuel.R
+++ b/R/mod_annuel.R
@@ -136,15 +136,14 @@ mod_annuel_server <- function(id, DD){
rownames=FALSE,
extensions = "Buttons",
option=list(
- scroller = TRUE,
scrollX = TRUE,
- lengthMenu=list(c(-1,5,20,50),c("All","5","20","50")),
- "pagelength"=-1,
- dom= "Blfrtip",
- scrollX = T,
- buttons=list(
- list(extend="excel",
- filename = "resume_bilan_annuel"))
+ dom= "Bfrtip",
+ buttons=
+ list('copy', 'print', list(
+ extend = 'collection',
+ buttons = c('csv', 'excel', 'pdf'),
+ text = 'Download'
+ ))
))
diff --git a/R/mod_bilan_dc.R b/R/mod_bilan_dc.R
index 6bd507a..e2d3018 100644
--- a/R/mod_bilan_dc.R
+++ b/R/mod_bilan_dc.R
@@ -240,16 +240,13 @@ mod_bilan_dc_server <- function(id,DD){
rownames=FALSE,
extensions = "Buttons",
option=list(
- scroller = TRUE,
- scrollX = TRUE,
- lengthMenu=list(c(-1,5,20,50),c("All","5","20","50")),
- "pagelength"=-1,
- dom= "Blfrtip",
- scrollX = T,
- buttons=list(
- list(extend="excel",
- filename = "resume_report_bilan_DC"))
- ))
+ scrollX = TRUE,
+ dom= "Bfrtip",
+ buttons=list('copy', 'print', list(
+ extend = 'collection',
+ buttons = c('csv', 'excel', 'pdf'),
+ text = 'Download'
+ ))))
})
output$tab_per_tar_code<-renderDT({
@@ -257,14 +254,13 @@ mod_bilan_dc_server <- function(id,DD){
rownames=FALSE,
extensions = "Buttons",
option=list(
- scroller = TRUE,
scrollX = TRUE,
- "pagelength"=-1,
- dom= "Blfrtip",
- scrollX = T,
- buttons=list(
- list(extend="excel",
- filename = "resume_per_tar_code"))
+ dom= "Bfrtip",
+ buttons=list('copy', 'print', list(
+ extend = 'collection',
+ buttons = c('csv', 'excel', 'pdf'),
+ text = 'Download'
+ ))
))
})
@@ -273,15 +269,15 @@ mod_bilan_dc_server <- function(id,DD){
rownames=FALSE,
extensions = "Buttons",
option=list(
- scroller = TRUE,
scrollX = TRUE,
- "pagelength"=-1,
- dom= "Blfrtip",
- scrollX = T,
- buttons=list(
- list(extend="excel",
- filename = "resume_per_etat_fonctionnement"))
- ))
+ dom= "Bfrtip",
+ buttons=
+ list('copy', 'print', list(
+ extend = 'collection',
+ buttons = c('csv', 'excel', 'pdf'),
+ text = 'Download'
+ ))
+ ))
})
} else {
diff --git a/R/mod_bilan_df.R b/R/mod_bilan_df.R
index 9675ecb..1fffa1f 100644
--- a/R/mod_bilan_df.R
+++ b/R/mod_bilan_df.R
@@ -218,51 +218,50 @@ mod_bilan_df_server <- function(id, DD) {
output$tab_df_data <- renderDT({
DT::datatable(t_periodefonctdispositif_per,
- rownames = FALSE,
- extensions = "Buttons",
- option = list(
- scroller = TRUE,
- scrollX = TRUE,
- lengthMenu = list(c(-1, 5, 20, 50), c("All", "5", "20", "50")),
- "pagelength" = -1,
- dom = "Blfrtip",
- scrollX = T,
- buttons = list(
- list(extend = "excel",
- filename = "resume_report_bilan_DF"))
- ))
+ rownames=FALSE,
+ extensions = "Buttons",
+ option=list(
+ scrollX = TRUE,
+ dom= "Bfrtip",
+ buttons=
+ list('copy', 'print', list(
+ extend = 'collection',
+ buttons = c('csv', 'excel', 'pdf'),
+ text = 'Download'
+ ))
+ ))
})
output$tab_per_tar_code <- renderDT({
DT::datatable(summary_per_tar_code,
- rownames = FALSE,
- extensions = "Buttons",
- option = list(
- scroller = TRUE,
- scrollX = TRUE,
- "pagelength" = -1,
- dom = "Blfrtip",
- scrollX = T,
- buttons = list(
- list(extend = "excel",
- filename = "resume_per_tar_code"))
- ))
+ rownames=FALSE,
+ extensions = "Buttons",
+ option=list(
+ scrollX = TRUE,
+ dom= "Bfrtip",
+ buttons=
+ list('copy', 'print', list(
+ extend = 'collection',
+ buttons = c('csv', 'excel', 'pdf'),
+ text = 'Download'
+ ))
+ ))
})
output$tab_per_etat_fct <- renderDT({
DT::datatable(summary_per_etat_fonctionnement,
- rownames = FALSE,
- extensions = "Buttons",
- option = list(
- scroller = TRUE,
- scrollX = TRUE,
- "pagelength" = -1,
- dom = "Blfrtip",
- scrollX = T,
- buttons = list(
- list(extend = "excel",
- filename = "resume_per_etat_fonctionnement"))
- ))
+ rownames=FALSE,
+ extensions = "Buttons",
+ option=list(
+ scrollX = TRUE,
+ dom= "Bfrtip",
+ buttons=
+ list('copy', 'print', list(
+ extend = 'collection',
+ buttons = c('csv', 'excel', 'pdf'),
+ text = 'Download'
+ ))
+ ))
})
} else {
diff --git a/R/mod_civ_poids.R b/R/mod_civ_poids.R
index d533db8..8b56466 100644
--- a/R/mod_civ_poids.R
+++ b/R/mod_civ_poids.R
@@ -181,7 +181,19 @@ mod_civ_poids_server <- function(id, DD) {
tab <- table(r_gew@calcdata$data)
tab2 <- data.frame(tab)
output$tab_civpoids <- renderDT({
- print(tab2)
+ DT::datatable(tab2,
+ rownames=FALSE,
+ extensions = "Buttons",
+ option=list(
+ scrollX = TRUE,
+ dom= "Bfrtip",
+ buttons=
+ list('copy', 'print', list(
+ extend = 'collection',
+ buttons = c('csv', 'excel', 'pdf'),
+ text = 'Download'
+ ))
+ ))
})
} else {
if (!input$box_tab_civpoids$collapsed)
@@ -193,7 +205,19 @@ mod_civ_poids_server <- function(id, DD) {
tab3 <- table(r_gew@calcdata$coe)
tab4 <- data.frame(tab3)
output$tab_civpoids2 <- renderDT({
- print(tab4)
+ DT::datatable(tab4,
+ rownames=FALSE,
+ extensions = "Buttons",
+ option=list(
+ scrollX = TRUE,
+ dom= "Bfrtip",
+ buttons=
+ list('copy', 'print', list(
+ extend = 'collection',
+ buttons = c('csv', 'excel', 'pdf'),
+ text = 'Download'
+ ))
+ ))
})
} else {
if (!input$box_tab_civpoids2$collapsed)
diff --git a/R/mod_espece.R b/R/mod_espece.R
index 492750b..f8fba44 100644
--- a/R/mod_espece.R
+++ b/R/mod_espece.R
@@ -99,6 +99,7 @@ mod_espece_server <- function(id) {
"Mois" = "month",
"Ann\u00e9e" = "year"
)
+ shinybusy::show_modal_spinner(text="loading from db")
bilesp <- choice_c(
bilesp,
dc = ref_dc@dc_selected,
@@ -111,6 +112,7 @@ mod_espece_server <- function(id) {
bilesp <- charge(bilesp, silent = TRUE)
bilesp <- connect(bilesp, silent = TRUE)
bilesp <- calcule(bilesp, silent = TRUE)
+ shinybusy::remove_modal_spinner()
if (nrow(bilesp@data) == 0) {
warning("no data available")
} else {
@@ -133,7 +135,20 @@ mod_espece_server <- function(id) {
if ("3" %in% input$choix_sorties) {
if (input$box_esp_summary$collapsed) shinydashboardPlus::updateBox("box_esp_summary", action = "toggle")
output$tab_esp_summary <- renderDT({
- bilesp@calcdata
+ DT::datatable(bilesp@calcdata,
+ rownames=FALSE,
+ extensions = "Buttons",
+ option=list(
+ scrollX = TRUE,
+ dom= "Bfrtip",
+ buttons=
+ list('copy', 'print', list(
+ extend = 'collection',
+ buttons = c('csv', 'excel', 'pdf'),
+ text = 'Download'
+ ))
+ ))
+
})
} else {
if (!input$box_esp_summary$collapsed) shinydashboardPlus::updateBox("box_esp_summary", action = "toggle")
diff --git a/R/mod_interannuel.R b/R/mod_interannuel.R
index 9f3ed05..67fee7a 100644
--- a/R/mod_interannuel.R
+++ b/R/mod_interannuel.R
@@ -212,7 +212,7 @@ mod_interannuel_server <- function(id,DD){
if (length(ref_stage@stage_selected) >1)
ref_stage@stage_selected <- ref_stage@stage_selected[1]
req(!is.null(input$slider_interannuel_annee[2]))
- #shinybusy::show_modal_spinner(spin="flower", text="loading from db")
+ shinybusy::show_modal_spinner(spin="flower", text="loading from db")
r_mig_interannual <- choice_c(r_mig_interannual,
dc=ref_dc@dc_selected,
taxa=ref_taxa@taxa_selected,
@@ -222,7 +222,7 @@ mod_interannuel_server <- function(id,DD){
silent=TRUE)
r_mig_interannual <-charge(r_mig_interannual)
r_mig_interannual <- connect(r_mig_interannual, silent = TRUE)
- #shinybusy::remove_modal_spinner()
+ shinybusy::remove_modal_spinner()
# silent = TRUE sinon redemande avant de ré-écrire
r_mig_interannual <- calcule(r_mig_interannual, silent = FALSE)
@@ -326,7 +326,19 @@ mod_interannuel_server <- function(id,DD){
}
summary <- stacomiR::summary(r_mig_interannual, year_choice=selected_year, silent =TRUE)
output$tab_interannuel_summary <- renderDT({
- summary[[selected_dc]]
+ DT::datatable(summary[[selected_dc]],
+ rownames=FALSE,
+ extensions = "Buttons",
+ option=list(
+ scrollX = TRUE,
+ dom= "Bfrtip",
+ buttons=
+ list('copy', 'print', list(
+ extend = 'collection',
+ buttons = c('csv', 'excel', 'pdf'),
+ text = 'Download'
+ ))
+ ))
})
} else {
if (!input$box_interannuel_summary$collapsed) shinydashboardPlus::updateBox("box_interannuel_summary", action = "toggle")
diff --git a/R/mod_mig_char.R b/R/mod_mig_char.R
index 3f3090a..d950003 100644
--- a/R/mod_mig_char.R
+++ b/R/mod_mig_char.R
@@ -351,7 +351,18 @@ mod_migr_car_server <- function(id, DD){
if ("button_migr_car_data" %in% input$choix_sorties) {
if (input$box_migr_car_data$collapsed) shinydashboardPlus::updateBox("box_migr_car_data", action = "toggle")
output$tab_migr_car_data <- renderDT({
- stacomiR::summary(r_mig_char)
+ DT::datatable(stacomiR::summary(r_mig_char),
+ rownames=FALSE,
+ extensions = "Buttons",
+ option=list(
+ scrollX = TRUE,
+ dom= "Bfrtip",
+ buttons=list('copy', 'print', list(
+ extend = 'collection',
+ buttons = c('csv', 'excel', 'pdf'),
+ text = 'Download'
+ ))
+ ))
})
} else {
if (!input$box_migr_car_data$collapsed) shinydashboardPlus::updateBox("box_migr_car_data", action = "toggle")
diff --git a/R/mod_migr_mult.R b/R/mod_migr_mult.R
index 211da57..8e6a807 100644
--- a/R/mod_migr_mult.R
+++ b/R/mod_migr_mult.R
@@ -216,18 +216,15 @@ mod_migr_mult_server <- function(id, DD){
rownames=TRUE,
extensions = "Buttons",
option=list(
- scroller = TRUE,
scrollX = TRUE,
- scrollY = "500px",
- order=list(3,"asc"),
- lengthMenu=list(c(-1,5,20,50),c("All","5","20","50")),
- "pagelength"=-1,
- dom= "Blfrtip",
- scrollX = T,
- buttons=list(
- list(extend="excel",
- filename = "resume_report_mig_mult"))
- ))
+ dom= "Bfrtip",
+ buttons=
+ list('copy', 'print', list(
+ extend = 'collection',
+ buttons = c('csv', 'excel', 'pdf'),
+ text = 'Download'
+ ))
+ ))
})
}
} else {
diff --git a/R/mod_sample_char.R b/R/mod_sample_char.R
index 7451df8..c230c7f 100644
--- a/R/mod_sample_char.R
+++ b/R/mod_sample_char.R
@@ -180,22 +180,17 @@ mod_sample_char_server <- function(id, DD){
if (input$box_tab_sample_char_data$collapsed) shinydashboardPlus::updateBox("box_tab_sample_char_data", action = "toggle")
output$tab_sample_char_data <- renderDT({
DT::datatable(r_sample_char@data,
- rownames=TRUE,
- extensions = "Buttons",
- option=list(
- scroller = TRUE,
- scrollX = TRUE,
- scrollY = "500px",
- order=list(3,"asc"),
- lengthMenu=list(c(-1,5,20,50),c("All","5","20","50")),
- "pagelength"=-1,
- dom= "Blfrtip",
- scrollX = T,
- buttons=list(
- list(extend="excel",
- filename = "resume_report_sample_char"))
- )
- )
+ rownames=FALSE,
+ extensions = "Buttons",
+ option=list(
+ scrollX = TRUE,
+ dom= "Bfrtip",
+ buttons=list('copy', 'print', list(
+ extend = 'collection',
+ buttons = c('csv', 'excel', 'pdf'),
+ text = 'Download'
+ ))
+ ))
})
} else {
if (!input$box_tab_sample_char_data$collapsed) shinydashboardPlus::updateBox("box_tab_sample_char_data", action = "toggle")
diff --git a/R/mod_sat_age.R b/R/mod_sat_age.R
index fe23a7a..47c1f39 100644
--- a/R/mod_sat_age.R
+++ b/R/mod_sat_age.R
@@ -129,7 +129,19 @@ mod_sat_age_server <- function(id, DD) {
colnames(tab2) <- c("DC", "Age_mer", "Effectif")
tab2 <- dplyr::arrange(tab2, DC)
output$tab_sat_age <- renderDT({
- print(tab2)
+ DT::datatable(tab2,
+ rownames=FALSE,
+ extensions = "Buttons",
+ option=list(
+ scrollX = TRUE,
+ dom= "Bfrtip",
+ buttons=
+ list('copy', 'print', list(
+ extend = 'collection',
+ buttons = c('csv', 'excel', 'pdf'),
+ text = 'Download'
+ ))
+ ))
})
} else {
if (!input$box_summary_sat_age$collapsed) shinydashboardPlus::updateBox("box_summary_sat_age", action = "toggle")
--
GitLab
From c4614fe1e174443df5d2219064837420f74fe167 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Grall?= <seinormigr.grall@gmail.com>
Date: Fri, 28 Oct 2022 09:43:37 +0200
Subject: [PATCH 15/47] fixed #25 with adding server=FALSE
---
R/mod_ang_argentee.R | 2 +-
R/mod_annuel.R | 2 +-
R/mod_bilan_dc.R | 6 +++---
R/mod_bilan_df.R | 6 +++---
R/mod_civ_poids.R | 4 ++--
R/mod_espece.R | 2 +-
R/mod_interannuel.R | 2 +-
R/mod_mig_char.R | 2 +-
R/mod_migr_mult.R | 2 +-
R/mod_sample_char.R | 2 +-
R/mod_sat_age.R | 2 +-
11 files changed, 16 insertions(+), 16 deletions(-)
diff --git a/R/mod_ang_argentee.R b/R/mod_ang_argentee.R
index d484256..d13211e 100644
--- a/R/mod_ang_argentee.R
+++ b/R/mod_ang_argentee.R
@@ -213,7 +213,7 @@ mod_ang_argentee_server <- function(id, DD) {
text = 'Download'
))
))
- })
+ },server = FALSE)
} else {
if (!input$box_tab_angarg$collapsed) shinydashboardPlus::updateBox("box_tab_angarg", action = "toggle")
}
diff --git a/R/mod_annuel.R b/R/mod_annuel.R
index 5480c86..51b261e 100644
--- a/R/mod_annuel.R
+++ b/R/mod_annuel.R
@@ -147,7 +147,7 @@ mod_annuel_server <- function(id, DD){
))
- })
+ },server = FALSE)
} else {
if (!input$box_annuel_data$collapsed) shinydashboardPlus::updateBox("box_annuel_data", action = "toggle")
} # end ifelse "3"
diff --git a/R/mod_bilan_dc.R b/R/mod_bilan_dc.R
index e2d3018..f41a4d1 100644
--- a/R/mod_bilan_dc.R
+++ b/R/mod_bilan_dc.R
@@ -248,7 +248,7 @@ mod_bilan_dc_server <- function(id,DD){
text = 'Download'
))))
- })
+ },server = FALSE)
output$tab_per_tar_code<-renderDT({
DT::datatable(summary_per_tar_code,
rownames=FALSE,
@@ -263,7 +263,7 @@ mod_bilan_dc_server <- function(id,DD){
))
))
- })
+ },server = FALSE)
output$tab_per_etat_fct<-renderDT({
DT::datatable(summary_per_etat_fonctionnement,
rownames=FALSE,
@@ -278,7 +278,7 @@ mod_bilan_dc_server <- function(id,DD){
text = 'Download'
))
))
- })
+ },server = FALSE)
} else {
if (!input$box_tab_dc_data$collapsed) shinydashboardPlus::updateBox("box_tab_dc_data", action = "toggle")
diff --git a/R/mod_bilan_df.R b/R/mod_bilan_df.R
index 1fffa1f..4ddb0e5 100644
--- a/R/mod_bilan_df.R
+++ b/R/mod_bilan_df.R
@@ -231,7 +231,7 @@ mod_bilan_df_server <- function(id, DD) {
))
))
- })
+ },server = FALSE)
output$tab_per_tar_code <- renderDT({
DT::datatable(summary_per_tar_code,
rownames=FALSE,
@@ -247,7 +247,7 @@ mod_bilan_df_server <- function(id, DD) {
))
))
- })
+ },server = FALSE)
output$tab_per_etat_fct <- renderDT({
DT::datatable(summary_per_etat_fonctionnement,
rownames=FALSE,
@@ -262,7 +262,7 @@ mod_bilan_df_server <- function(id, DD) {
text = 'Download'
))
))
- })
+ },server = FALSE)
} else {
if (!input$box_tab_df_data$collapsed) shinydashboardPlus::updateBox("box_tab_df_data", action = "toggle")
diff --git a/R/mod_civ_poids.R b/R/mod_civ_poids.R
index 8b56466..23971f0 100644
--- a/R/mod_civ_poids.R
+++ b/R/mod_civ_poids.R
@@ -194,7 +194,7 @@ mod_civ_poids_server <- function(id, DD) {
text = 'Download'
))
))
- })
+ },server = FALSE)
} else {
if (!input$box_tab_civpoids$collapsed)
shinydashboardPlus::updateBox("box_tab_civpoids", action = "toggle")
@@ -218,7 +218,7 @@ mod_civ_poids_server <- function(id, DD) {
text = 'Download'
))
))
- })
+ },server = FALSE)
} else {
if (!input$box_tab_civpoids2$collapsed)
shinydashboardPlus::updateBox("box_tab_civpoids2", action = "toggle")
diff --git a/R/mod_espece.R b/R/mod_espece.R
index f8fba44..4e7c31d 100644
--- a/R/mod_espece.R
+++ b/R/mod_espece.R
@@ -149,7 +149,7 @@ mod_espece_server <- function(id) {
))
))
- })
+ },server = FALSE)
} else {
if (!input$box_esp_summary$collapsed) shinydashboardPlus::updateBox("box_esp_summary", action = "toggle")
} # end ifelse "3"
diff --git a/R/mod_interannuel.R b/R/mod_interannuel.R
index 67fee7a..18633c8 100644
--- a/R/mod_interannuel.R
+++ b/R/mod_interannuel.R
@@ -339,7 +339,7 @@ mod_interannuel_server <- function(id,DD){
text = 'Download'
))
))
- })
+ },server = FALSE)
} else {
if (!input$box_interannuel_summary$collapsed) shinydashboardPlus::updateBox("box_interannuel_summary", action = "toggle")
}# end if "8"
diff --git a/R/mod_mig_char.R b/R/mod_mig_char.R
index d950003..acda15e 100644
--- a/R/mod_mig_char.R
+++ b/R/mod_mig_char.R
@@ -363,7 +363,7 @@ mod_migr_car_server <- function(id, DD){
text = 'Download'
))
))
- })
+ },server = FALSE)
} else {
if (!input$box_migr_car_data$collapsed) shinydashboardPlus::updateBox("box_migr_car_data", action = "toggle")
}
diff --git a/R/mod_migr_mult.R b/R/mod_migr_mult.R
index 8e6a807..3d15358 100644
--- a/R/mod_migr_mult.R
+++ b/R/mod_migr_mult.R
@@ -225,7 +225,7 @@ mod_migr_mult_server <- function(id, DD){
text = 'Download'
))
))
- })
+ },server = FALSE)
}
} else {
if (!input$box_tab_mm$collapsed) shinydashboardPlus::updateBox("box_tab_mm", action = "toggle")
diff --git a/R/mod_sample_char.R b/R/mod_sample_char.R
index c230c7f..2ed404c 100644
--- a/R/mod_sample_char.R
+++ b/R/mod_sample_char.R
@@ -191,7 +191,7 @@ mod_sample_char_server <- function(id, DD){
text = 'Download'
))
))
- })
+ },server = FALSE)
} else {
if (!input$box_tab_sample_char_data$collapsed) shinydashboardPlus::updateBox("box_tab_sample_char_data", action = "toggle")
}
diff --git a/R/mod_sat_age.R b/R/mod_sat_age.R
index 47c1f39..88e97fc 100644
--- a/R/mod_sat_age.R
+++ b/R/mod_sat_age.R
@@ -142,7 +142,7 @@ mod_sat_age_server <- function(id, DD) {
text = 'Download'
))
))
- })
+ },server = FALSE)
} else {
if (!input$box_summary_sat_age$collapsed) shinydashboardPlus::updateBox("box_summary_sat_age", action = "toggle")
} # end ifelse "3"
--
GitLab
From 757e1bc52bf7947bd0083b1373099e3d48a18b04 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Grall?= <seinormigr.grall@gmail.com>
Date: Fri, 28 Oct 2022 11:06:11 +0200
Subject: [PATCH 16/47] change replace summary(r_mig_char) with
r_mig_char@calcdata #24
---
R/mod_mig_char.R | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/R/mod_mig_char.R b/R/mod_mig_char.R
index acda15e..f4fcc43 100644
--- a/R/mod_mig_char.R
+++ b/R/mod_mig_char.R
@@ -351,7 +351,7 @@ mod_migr_car_server <- function(id, DD){
if ("button_migr_car_data" %in% input$choix_sorties) {
if (input$box_migr_car_data$collapsed) shinydashboardPlus::updateBox("box_migr_car_data", action = "toggle")
output$tab_migr_car_data <- renderDT({
- DT::datatable(stacomiR::summary(r_mig_char),
+ DT::datatable(r_mig_char@calcdata,
rownames=FALSE,
extensions = "Buttons",
option=list(
--
GitLab
From ad240ad8bd4384b8d35d9a6c46c38dd6cf99866d Mon Sep 17 00:00:00 2001
From: cedricbriandgithub <cedric.briand@eptb-vilaine.fr>
Date: Sat, 7 Jan 2023 21:30:04 +0100
Subject: [PATCH 17/47] fixed #12
---
R/app_server.R | 14 +--
R/mod_interannuel.R | 220 ++++++++++++++++++++++----------------------
dev/run_dev.R | 2 +-
3 files changed, 120 insertions(+), 116 deletions(-)
diff --git a/R/app_server.R b/R/app_server.R
index ad9b5ad..f032573 100644
--- a/R/app_server.R
+++ b/R/app_server.R
@@ -35,13 +35,13 @@ app_server <- function( input, output, session ) {
mod_interannuel_server("interannuel_ui_1",DD)
DD$button_ref_taxa_interannuel <- mod_ref_taxa_server("ref_taxa_mod_interannuel", DD, mytab="interannuel")
DD$button_ref_stage_interannuel <- mod_ref_stage_server("ref_stage_mod_interannuel", DD, mytab="interannuel")
- DD$button_box_custom_interannuel_1<-mod_custom_plot_server("custom_plot_interannuel_1",DD,mytab="interannuel")
- DD$button_box_custom_interannuel_2<-mod_custom_plot_server("custom_plot_interannuel_2",DD,mytab="interannuel")
- DD$button_box_custom_interannuel_3<-mod_custom_plot_server("custom_plot_interannuel_3",DD,mytab="interannuel")
- DD$button_box_custom_interannuel_4<-mod_custom_plot_server("custom_plot_interannuel_4",DD,mytab="interannuel")
- DD$button_box_custom_interannuel_5<-mod_custom_plot_server("custom_plot_interannuel_5",DD,mytab="interannuel")
- DD$button_box_custom_interannuel_6<-mod_custom_plot_server("custom_plot_interannuel_6",DD,mytab="interannuel")
- DD$button_box_custom_interannuel_7<-mod_custom_plot_server("custom_plot_interannuel_7",DD,mytab="interannuel")
+ DD$button_box_custom_interannuel_line<-mod_custom_plot_server("custom_plot_interannuel_line",DD,mytab="interannuel")
+ DD$button_box_custom_interannuel_standard<-mod_custom_plot_server("custom_plot_interannuel_standard",DD,mytab="interannuel")
+ DD$button_box_custom_interannuel_step<-mod_custom_plot_server("custom_plot_interannuel_step",DD,mytab="interannuel")
+ DD$button_box_custom_interannuel_barchart<-mod_custom_plot_server("custom_plot_interannuel_barchart",DD,mytab="interannuel")
+ DD$button_box_custom_interannuel_pointrange<-mod_custom_plot_server("custom_plot_interannuel_pointrange",DD,mytab="interannuel")
+ DD$button_box_custom_interannuel_density<-mod_custom_plot_server("custom_plot_interannuel_density",DD,mytab="interannuel")
+ DD$button_box_custom_interannuel_seasonal<-mod_custom_plot_server("custom_plot_interannuel_seasonal",DD,mytab="interannuel")
# especes ---------------------------------------------------
diff --git a/R/mod_interannuel.R b/R/mod_interannuel.R
index c521c1f..f1fcb48 100644
--- a/R/mod_interannuel.R
+++ b/R/mod_interannuel.R
@@ -20,16 +20,16 @@ mod_interannuel_ui <- function(id){
status="primary",
width = 3,
sliderInput(ns("slider_interannuel_annee"),
- label = h5("Choisissez l\'ann\u00e9e"),
+ label = h5("Choisissez les \'ann\u00e9es"),
min = 1980,
max = CY,
value = c(2011, CY)),
-
+ # todo add year selected choice there (no effect for seasonal)
mod_ref_taxa_ui("ref_taxa_mod_interannuel", multiple=FALSE),
mod_ref_stage_ui("ref_stage_mod_interannuel", multiple=FALSE),
- selectizeInput(ns('pas_temps'), h5('Choisissez un d\u00e9coupage :'),
- selected="Jour", choices = c("Jour","Semaine","Mois","Quinzaine"),
+ selectizeInput(ns('pas_temps'), h5('Choisissez un d\u00e9coupage :'),
+ selected="jour", choices = c("Jour"="jour","Semaine"="semaine","Mois"="mois","Quinzaine"="quinzaine"),
multiple = FALSE),
checkboxGroupInput(ns("choix_sorties"),
label = h5("Choisissez les sorties graphiques ou tableaux :"),
@@ -59,7 +59,7 @@ mod_interannuel_ui <- function(id){
sidebar = shinydashboardPlus::boxSidebar(
id = ns("box_interannuel_line_sidebar"),
width = 25,
- mod_custom_plot_ui("custom_plot_interannuel_1"),
+ mod_custom_plot_ui("custom_plot_interannuel_line"),
),
plotOutput(ns("plot_interannuel_line"))),
shinydashboardPlus::box(
@@ -69,11 +69,11 @@ mod_interannuel_ui <- function(id){
solidHeader = TRUE,
collapsible = TRUE,
collapsed=TRUE,
- # sidebar = shinydashboardPlus::boxSidebar(
- # id = ns("box_interannuel_standard_sidebar"),
- # width = 25,
- # mod_custom_plot_ui("custom_plot_interannuel_2"),
- # ),
+ sidebar = shinydashboardPlus::boxSidebar(
+ id = ns("box_interannuel_standard_sidebar"),
+ width = 25,
+ mod_custom_plot_ui("custom_plot_interannuel_standard"),
+ ),
plotOutput(ns("plot_interannuel_standard"))),
shinydashboardPlus::box(
id=ns("box_interannuel_step"),
@@ -85,7 +85,7 @@ mod_interannuel_ui <- function(id){
sidebar = shinydashboardPlus::boxSidebar(
id = ns("box_interannuel_step_sidebar"),
width = 25,
- mod_custom_plot_ui("custom_plot_interannuel_3"),
+ mod_custom_plot_ui("custom_plot_interannuel_step"),
),
plotOutput(ns("plot_interannuel_step"))),
shinydashboardPlus::box(
@@ -98,7 +98,7 @@ mod_interannuel_ui <- function(id){
# sidebar = shinydashboardPlus::boxSidebar(
# id = ns("box_interannuel_barchart_sidebar"),
# width = 25,
- # mod_custom_plot_ui("custom_plot_interannuel_4"),
+ # mod_custom_plot_ui("custom_plot_interannuel_barchart"),
# ),
plotOutput(ns("plot_interannuel_barchart"))),
shinydashboardPlus::box(
@@ -111,7 +111,7 @@ mod_interannuel_ui <- function(id){
# sidebar = shinydashboardPlus::boxSidebar(
# id = ns("box_interannuel_pointrange_sidebar"),
# width = 25,
- # mod_custom_plot_ui("custom_plot_interannuel_5"),
+ # mod_custom_plot_ui("custom_plot_interannuel_pointrange"),
# ),
plotOutput(ns("plot_interannuel_pointRange"))),
shinydashboardPlus::box(
@@ -124,7 +124,7 @@ mod_interannuel_ui <- function(id){
sidebar = shinydashboardPlus::boxSidebar(
id = ns("box_interannuel_density_sidebar"),
width = 25,
- mod_custom_plot_ui("custom_plot_interannuel_6"),
+ mod_custom_plot_ui("custom_plot_interannuel_density"),
),
plotOutput(ns("plot_interannuel_density"))),
shinydashboardPlus::box(
@@ -137,7 +137,7 @@ mod_interannuel_ui <- function(id){
sidebar = shinydashboardPlus::boxSidebar(
id = ns("box_interannuel_seasonal_sidebar"),
width = 25,
- mod_custom_plot_ui("custom_plot_interannuel_7"),
+ mod_custom_plot_ui("custom_plot_interannuel_seasonal"),
),
plotOutput(ns("plot_interannuel_seasonal"))),
shinydashboardPlus::box(
@@ -261,7 +261,7 @@ mod_interannuel_server <- function(id,DD){
if ("4" %in% input$choix_sorties) {
if (input$box_interannuel_barchart$collapsed) shinydashboardPlus::updateBox("box_interannuel_barchart", action = "toggle")
output$plot_interannuel_barchart <- renderPlot({
- stacomiR::plot(r_mig_interannual, plot.type = "barchart", silent = TRUE)
+ stacomiR::plot(r_mig_interannual, plot.type = "barchart", timesplit = input$pas_temps, silent = TRUE)
})
} else {
if (!input$box_interannuel_barchart$collapsed) shinydashboardPlus::updateBox("box_interannuel_barchart", action = "toggle")
@@ -270,7 +270,7 @@ mod_interannuel_server <- function(id,DD){
if ("5" %in% input$choix_sorties) {
if (input$box_interannuel_pointrange$collapsed) shinydashboardPlus::updateBox("box_interannuel_pointrange", action = "toggle")
output$plot_interannuel_pointRange <- renderPlot({
- stacomiR::plot(r_mig_interannual, plot.type = "pointrange", silent = TRUE)
+ stacomiR::plot(r_mig_interannual, plot.type = "pointrange", timesplit = input$pas_temps, silent = TRUE)
})
} else {
if (!input$box_interannuel_pointrange$collapsed) shinydashboardPlus::updateBox("box_interannuel_pointrange", action = "toggle")
@@ -288,7 +288,7 @@ mod_interannuel_server <- function(id,DD){
if ("7" %in% input$choix_sorties) {
if (input$box_interannuel_seasonal$collapsed) shinydashboardPlus::updateBox("box_interannuel_seasonal", action = "toggle")
output$plot_interannuel_seasonal <- renderPlot({
- stacomiR::plot(r_mig_interannual, plot.type = "seasonal", silent = TRUE)
+ stacomiR::plot(r_mig_interannual, plot.type = "seasonal", timesplit = input$pas_temps, silent = TRUE)
})
} else {
if (!input$box_interannuel_seasonal$collapsed) shinydashboardPlus::updateBox("box_interannuel_seasonal", action = "toggle")
@@ -332,39 +332,40 @@ mod_interannuel_server <- function(id,DD){
} # end else
- observeEvent({DD$button_box_custom_interannuel_1()
-
+ observeEvent({
+ DD$button_box_custom_interannuel_line()
},{
+
shinyCatch({
-
+
palette_plot<-envir_stacomi$palette_plot
plot_title<-envir_stacomi$plot_title
plot_xlab<-envir_stacomi$xlab
plot_ylab<-envir_stacomi$ylab
theme_plot<-envir_stacomi$theme_plot
- g_interannuel_1=envir_stacomi$g
-
- g_interannuel_1 <- g_interannuel_1+
+ g_interannuel_line <- envir_stacomi$g_line
+ g_interannuel_line <- g_interannuel_line+
ggplot2::ggtitle(plot_title) +
ggplot2::ylab(plot_ylab) +
ggplot2::xlab(plot_xlab) +
- ggplot2::scale_color_brewer(palette = palette_plot)+
+ ggplot2::scale_color_brewer(palette = palette_plot) +
match.fun(theme_plot)()
output$plot_interannuel_line<-renderPlot({
- g_interannuel_1
+ g_interannuel_line
})
},blocking_level = "error"
- )},
+ )
+ },
ignoreInit=TRUE,
ignoreNULL = TRUE
)
- observeEvent({DD$button_box_custom_interannuel_2()
+ observeEvent({DD$button_box_custom_interannuel_standard()
},{
shinyCatch({
@@ -375,18 +376,21 @@ mod_interannuel_server <- function(id,DD){
plot_ylab<-envir_stacomi$ylab
theme_plot<-envir_stacomi$theme_plot
- g_interannuel_2=envir_stacomi$g
-
- g_interannuel_2 <- g_interannuel_2+
+ g_interannuel_standard <- envir_stacomi$g_standard
+ title <- g_interannuel_standard$labels$title
+ legend_title <- str_split(title,",")[[1]][3]
+ the_choice <- str_split(str_split(title,",")[[1]][3],"/")[[1]][1]
+ labels <- str_split(str_split(title,",")[[1]][3],"/")[[1]][2]
+ g_interannuel_standard <- g_interannuel_standard +
ggplot2::ggtitle(plot_title) +
ggplot2::ylab(plot_ylab) +
ggplot2::xlab(plot_xlab) +
- ggplot2::scale_fill_brewer(palette = palette_plot)+
+ ggplot2::scale_fill_brewer(name=legend_title,label=c("Historical amplitude",the_choice),palette = palette_plot)+
match.fun(theme_plot)()
output$plot_interannuel_standard<-renderPlot({
- g_interannuel_2
+ g_interannuel_standard
})
@@ -396,7 +400,7 @@ mod_interannuel_server <- function(id,DD){
ignoreNULL = TRUE
)
- observeEvent({DD$button_box_custom_interannuel_3()
+ observeEvent({DD$button_box_custom_interannuel_step()
},{
shinyCatch({
@@ -407,9 +411,9 @@ mod_interannuel_server <- function(id,DD){
plot_ylab<-envir_stacomi$ylab
theme_plot<-envir_stacomi$theme_plot
- g_interannuel_3=envir_stacomi$g
+ g_interannuel_step <- envir_stacomi$g_step
- g_interannuel_3 <- g_interannuel_3+
+ g_interannuel_step <- g_interannuel_step+
ggplot2::ggtitle(plot_title) +
ggplot2::ylab(plot_ylab) +
ggplot2::xlab(plot_xlab) +
@@ -418,7 +422,7 @@ mod_interannuel_server <- function(id,DD){
output$plot_interannuel_step<-renderPlot({
- g_interannuel_3
+ g_interannuel_step
})
@@ -428,71 +432,71 @@ mod_interannuel_server <- function(id,DD){
ignoreNULL = TRUE
)
- observeEvent({DD$button_box_custom_interannuel_4()
-
- },{
- shinyCatch({
-
- palette_plot<-envir_stacomi$palette_plot
- plot_title<-envir_stacomi$plot_title
- plot_xlab<-envir_stacomi$xlab
- plot_ylab<-envir_stacomi$ylab
- theme_plot<-envir_stacomi$theme_plot
-
- g_interannuel_4=envir_stacomi$g
-
- g_interannuel_4 <- g_interannuel_4+
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_fill_brewer(palette = palette_plot)+
- match.fun(theme_plot)()
-
-
- output$plot_interannuel_barchart<-renderPlot({
- g_interannuel_4
- })
-
-
- },blocking_level = "error"
- )},
- ignoreInit=TRUE,
- ignoreNULL = TRUE
- )
+# observeEvent({DD$button_box_custom_interannuel_barchart()
+#
+# },{
+# shinyCatch({
+#
+# palette_plot<-envir_stacomi$palette_plot
+# plot_title<-envir_stacomi$plot_title
+# plot_xlab<-envir_stacomi$xlab
+# plot_ylab<-envir_stacomi$ylab
+# theme_plot<-envir_stacomi$theme_plot
+#
+# g_interannuel_barchart=envir_stacomi$g
+#
+# g_interannuel_barchart <- g_interannuel_barchart+
+# ggplot2::ggtitle(plot_title) +
+# ggplot2::ylab(plot_ylab) +
+# ggplot2::xlab(plot_xlab) +
+# ggplot2::scale_fill_brewer(palette = palette_plot)+
+# match.fun(theme_plot)()
+#
+#
+# output$plot_interannuel_barchart<-renderPlot({
+# g_interannuel_barchart
+# })
+#
+#
+# },blocking_level = "error"
+# )},
+# ignoreInit=TRUE,
+# ignoreNULL = TRUE
+# )
- observeEvent({DD$button_box_custom_interannuel_5()
-
- },{
- shinyCatch({
-
- palette_plot<-envir_stacomi$palette_plot
- plot_title<-envir_stacomi$plot_title
- plot_xlab<-envir_stacomi$xlab
- plot_ylab<-envir_stacomi$ylab
- theme_plot<-envir_stacomi$theme_plot
-
- g_interannuel_5=envir_stacomi$g
-
- g_interannuel_5 <- g_interannuel_5+
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_fill_brewer(palette = palette_plot)+
- match.fun(theme_plot)()
-
-
- output$plot_interannuel_pointrange<-renderPlot({
- g_interannuel_5
- })
-
-
- },blocking_level = "error"
- )},
- ignoreInit=TRUE,
- ignoreNULL = TRUE
- )
+# observeEvent({DD$button_box_custom_interannuel_pointrange()
+#
+# },{
+# shinyCatch({
+#
+# palette_plot<-envir_stacomi$palette_plot
+# plot_title<-envir_stacomi$plot_title
+# plot_xlab<-envir_stacomi$xlab
+# plot_ylab<-envir_stacomi$ylab
+# theme_plot<-envir_stacomi$theme_plot
+#
+# g_interannuel_pointrange=envir_stacomi$g
+#
+# g_interannuel_pointrange <- g_interannuel_pointrange+
+# ggplot2::ggtitle(plot_title) +
+# ggplot2::ylab(plot_ylab) +
+# ggplot2::xlab(plot_xlab) +
+# ggplot2::scale_fill_brewer(palette = palette_plot)+
+# match.fun(theme_plot)()
+#
+#
+# output$plot_interannuel_pointrange<-renderPlot({
+# g_interannuel_pointrange
+# })
+#
+#
+# },blocking_level = "error"
+# )},
+# ignoreInit=TRUE,
+# ignoreNULL = TRUE
+# )
- observeEvent({DD$button_box_custom_interannuel_6()
+ observeEvent({DD$button_box_custom_interannuel_density()
},{
shinyCatch({
@@ -503,9 +507,9 @@ mod_interannuel_server <- function(id,DD){
plot_ylab<-envir_stacomi$ylab
theme_plot<-envir_stacomi$theme_plot
- g_interannuel_6=envir_stacomi$g
+ g_interannuel_density <- envir_stacomi$g_density
- g_interannuel_6 <- g_interannuel_6+
+ g_interannuel_density <- g_interannuel_density+
ggplot2::ggtitle(plot_title) +
ggplot2::ylab(plot_ylab) +
ggplot2::xlab(plot_xlab) +
@@ -513,8 +517,8 @@ mod_interannuel_server <- function(id,DD){
match.fun(theme_plot)()
- output$plot_interannuel_density<-renderPlot({
- g_interannuel_6
+ output$plot_interannuel_density <- renderPlot({
+ g_interannuel_density
})
@@ -524,7 +528,7 @@ mod_interannuel_server <- function(id,DD){
ignoreNULL = TRUE
)
- observeEvent({DD$button_box_custom_interannuel_7()
+ observeEvent({DD$button_box_custom_interannuel_seasonal()
},{
shinyCatch({
@@ -535,9 +539,9 @@ mod_interannuel_server <- function(id,DD){
plot_ylab<-envir_stacomi$ylab
theme_plot<-envir_stacomi$theme_plot
- g_interannuel_7=envir_stacomi$g
+ g_interannuel_seasonal <- envir_stacomi$g_seasonal
- g_interannuel_7 <- g_interannuel_7+
+ g_interannuel_seasonal <- g_interannuel_seasonal+
ggplot2::ggtitle(plot_title) +
ggplot2::ylab(plot_ylab) +
ggplot2::xlab(plot_xlab) +
@@ -546,7 +550,7 @@ mod_interannuel_server <- function(id,DD){
output$plot_interannuel_seasonal<-renderPlot({
- g_interannuel_7
+ g_interannuel_seasonal
})
diff --git a/dev/run_dev.R b/dev/run_dev.R
index 2714d87..d43465e 100644
--- a/dev/run_dev.R
+++ b/dev/run_dev.R
@@ -12,7 +12,7 @@ remotes::install_deps()
golem::document_and_reload()
# these options set the scene before connecting to the database
-
+devtools::load_all("C:\\workspace\\stacomir")
#options(shiny.error = browser)
spsComps:::spsOption("traceback", TRUE)
stacoshiny() # options=list(port= 3882, host= "127.0.0.1", launch.browser= FALSE)
--
GitLab
From d1e874dae803868453c4a19556aa5610ec0ed815 Mon Sep 17 00:00:00 2001
From: cedricbriandgithub <cedric.briand@eptb-vilaine.fr>
Date: Tue, 10 Oct 2023 09:24:17 +0200
Subject: [PATCH 18/47] fix : issue#26
---
R/mod_ang_argentee.R | 6 +++++-
1 file changed, 5 insertions(+), 1 deletion(-)
diff --git a/R/mod_ang_argentee.R b/R/mod_ang_argentee.R
index ad27ddc..4f6b15e 100644
--- a/R/mod_ang_argentee.R
+++ b/R/mod_ang_argentee.R
@@ -136,7 +136,9 @@ mod_ang_argentee_server <- function(id, DD) {
ns <- session$ns
observeEvent(input$bttn_angarg, {
shinyCatch(
+
{
+ browser()
validate(need(exists("envir_stacomi"), "Le programme stacomi doit être lancé"))
db_connection <- envir_stacomi$db_connection
validate(need(!is.null(db_connection), "db needs connection"))
@@ -157,9 +159,11 @@ mod_ang_argentee_server <- function(id, DD) {
assign("r_silver", r_silver, envir = envir_stacomi)
if (nrow(r_silver@data) == 0) {
warning("no data available")
+ } else {
+ r_silver <- calcule(r_silver, silent = TRUE)
}
# calculations
- r_silver <- calcule(r_silver, silent = TRUE)
+
shinybusy::remove_modal_spinner() # remove it when done
if ("1" %in% input$choix_sorties) {
if (input$box_plot_angarg_1$collapsed) shinydashboardPlus::updateBox("box_plot_angarg_1", action = "toggle")
--
GitLab
From 8d9aa78f87581ad791b94f3a64c3670c08156623 Mon Sep 17 00:00:00 2001
From: cedricbriandgithub <cedric.briand@eptb-vilaine.fr>
Date: Tue, 10 Oct 2023 09:25:29 +0200
Subject: [PATCH 19/47] dev : change version for stacomirtools references
---
DESCRIPTION | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index bc69275..bb1d2d5 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -13,7 +13,7 @@ Imports:
DT,
glue,
htmltools,
- stacomirtools (>= 0.6.0.1),
+ stacomirtools (>= 0.6.1.0),
shinydashboard,
shinydashboardPlus,
shinyjs,
@@ -29,7 +29,7 @@ Imports:
magrittr
Encoding: UTF-8
LazyData: true
-RoxygenNote: 7.2.1
+RoxygenNote: 7.2.3
Suggests:
testthat,
spelling,
--
GitLab
From d3f93cb8bf4a8c071928e1ab8bf6cd6e9bfb431c Mon Sep 17 00:00:00 2001
From: cedricbriandgithub <cedric.briand@eptb-vilaine.fr>
Date: Tue, 10 Oct 2023 09:26:09 +0200
Subject: [PATCH 20/47] dev : change init, add support for reactlog
---
dev/02_dev.R | 2 +-
dev/run_dev.R | 4 +++-
2 files changed, 4 insertions(+), 2 deletions(-)
diff --git a/dev/02_dev.R b/dev/02_dev.R
index 3be4362..6e2350f 100644
--- a/dev/02_dev.R
+++ b/dev/02_dev.R
@@ -34,7 +34,7 @@ usethis::use_package("ggthemes")
usethis::use_dev_package("stacomirtools",
remote = "Remotes: gitlab::git@forgemia.inra.fr:stacomi/stacomirtools.git" )
usethis::use_dev_package("stacomiR", remote = "Remotes: gitlab::git@forgemia.inra.fr:stacomi/stacomir.git" )
-
+usethis::use_dev_package("stacomirtools", remote = "Remotes: gitlab::git@forgemia.inra.fr:stacomi/stacomirtools.git" )
install.packages(file.path(getwd(),"inst/stacomirtools_0.6.0.9000.tar.gz"),repos=NULL, type="source")
install.packages(file.path(getwd(),"inst/stacomiR_0.6.0.tar.gz"),repos=NULL, type="source")
diff --git a/dev/run_dev.R b/dev/run_dev.R
index d43465e..c54c893 100644
--- a/dev/run_dev.R
+++ b/dev/run_dev.R
@@ -8,11 +8,12 @@ options(golem.app.prod = FALSE) # TRUE = production mode, FALSE = development mo
rm(list=ls(all.names = TRUE))
# Document and reload your package
-remotes::install_deps()
+#remotes::install_deps()
golem::document_and_reload()
# these options set the scene before connecting to the database
devtools::load_all("C:\\workspace\\stacomir")
+devtools::load_all("C:\\workspace\\stacomirtools")
#options(shiny.error = browser)
spsComps:::spsOption("traceback", TRUE)
stacoshiny() # options=list(port= 3882, host= "127.0.0.1", launch.browser= FALSE)
@@ -21,3 +22,4 @@ stacoshiny() # options=list(port= 3882, host= "127.0.0.1", launch.browser= FALSE
# si ça plante au debut non function => un des boutons passés depuis un observeEnvent via return(reactive(input$bttn))
# n'a pas le bon nom
# si le bouton ne déclenche pas vérifier si il est encadré par ns() pour l'id dans UI
+# options(shiny.reactlog = TRUE) # puis CRTL F3 dans le navigateur
\ No newline at end of file
--
GitLab
From c9b256dd66f1772d3dea07925d4f820381da7285 Mon Sep 17 00:00:00 2001
From: cedricbriandgithub <cedric.briand@eptb-vilaine.fr>
Date: Tue, 10 Oct 2023 09:27:20 +0200
Subject: [PATCH 21/47] fix: fire message if error
---
R/mod_header.R | 6 ++++--
1 file changed, 4 insertions(+), 2 deletions(-)
diff --git a/R/mod_header.R b/R/mod_header.R
index 673a33c..6a0459a 100644
--- a/R/mod_header.R
+++ b/R/mod_header.R
@@ -103,7 +103,7 @@ mod_header_server <- function(id) {
# cat("choice db")
- # browser()
+ #browser()
db_connection <- new("ConnectionDB")
db_connection <- connect(db_connection,
base = c(dbname, host, port, user, password))
@@ -138,7 +138,9 @@ mod_header_server <- function(id) {
)
}) # fin output$statut_connection
- } # fin if
+ } else {
+ stop(db_connection@status)
+ }# fin if
},
--
GitLab
From 1843a9f60f6d366c5bb73dd9d2d49f7f25120c6f Mon Sep 17 00:00:00 2001
From: cedricbriandgithub <cedric.briand@eptb-vilaine.fr>
Date: Tue, 10 Oct 2023 09:27:33 +0200
Subject: [PATCH 22/47] docs
---
R/mod_ref_schema.R | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/R/mod_ref_schema.R b/R/mod_ref_schema.R
index f0a63cc..ba3ff4f 100644
--- a/R/mod_ref_schema.R
+++ b/R/mod_ref_schema.R
@@ -46,12 +46,13 @@ mod_ref_schema_ui <- function(id) {
mod_ref_schema_server <- function(id, DD) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
- observeEvent(DD$login_button(),
+ observeEvent(eventExpr = DD$login_button(),
+ handlerExpr =
{
# cat("TEST\n")
shinyCatch(
{
- # browser()
+ #browser()
validate(need(exists("envir_stacomi"), "Le programme stacomi doit être lancé"))
db_connection <- envir_stacomi$db_connection
validate(need(!is.null(db_connection), "Pas de connexion, cliquez sur le bouton dans la barre de titre"))
--
GitLab
From f6decddca59dea094b342d00bff9cf3ec5e34590 Mon Sep 17 00:00:00 2001
From: cedricbriandgithub <cedric.briand@eptb-vilaine.fr>
Date: Tue, 10 Oct 2023 15:56:11 +0200
Subject: [PATCH 23/47] docs : spacing
---
R/mod_migr_env.R | 24 ++++++++++++------------
1 file changed, 12 insertions(+), 12 deletions(-)
diff --git a/R/mod_migr_env.R b/R/mod_migr_env.R
index ebe5c69..907bc4a 100644
--- a/R/mod_migr_env.R
+++ b/R/mod_migr_env.R
@@ -76,7 +76,7 @@ mod_migr_env_server <- function(id,DD,mytab) {
validate(need(length(ref_taxa@taxa_selected)>0, "pas de taxon sélectionné"))
validate(need(length(ref_stage@stage_selected)>0, "pas de stade sélectionné"))
- r_mig_env<-choice_c(r_mig_env,
+ r_mig_env <- choice_c(r_mig_env,
dc=ref_dc@dc_selected,
taxa=ref_taxa@taxa_selected,
stage=ref_stage@stage_selected,
@@ -85,9 +85,9 @@ mod_migr_env_server <- function(id,DD,mytab) {
datefin=input$migr_env.datefin,
silent=TRUE)
shinybusy::show_modal_spinner(text="please wait") # show the modal window
- r_mig_env<-charge(r_mig_env) # this is necessary to load operations, DF and DC
- r_mig_env<-connect(r_mig_env)
- r_mig_env<-calcule(r_mig_env,silent=TRUE)
+ r_mig_env <- charge(r_mig_env) # this is necessary to load operations, DF and DC
+ r_mig_env <- connect(r_mig_env)
+ r_mig_env <- calcule(r_mig_env,silent=TRUE)
shinybusy::remove_modal_spinner() # remove it when done
@@ -102,17 +102,17 @@ mod_migr_env_server <- function(id,DD,mytab) {
if ("1" %in% input$choix_sorties) {
if (input$box_plot_migr_env$collapsed) shinydashboardPlus::updateBox("box_plot_migr_env", action = "toggle")
output$plot_migr_env <- renderPlot({
- color_dc<-stacomiR::colortable(color = NULL,r_mig_env@report_mig_mult@dc@dc_selected,palette = "Set2",color_function = c("random"))
- color_dc_vec<-color_dc$color
- color_dc_vec=setNames(color_dc_vec,color_dc$name)
+ color_dc <- stacomiR::colortable(color = NULL,r_mig_env@report_mig_mult@dc@dc_selected,palette = "Set2",color_function = c("random"))
+ color_dc_vec <- color_dc$color
+ color_dc_vec <- setNames(color_dc_vec,color_dc$name)
- color_sta_mesure<-stacomiR::colortable(color = NULL, r_mig_env@report_env@stationMesure@env_selected,palette = "Set2",color_function = c("random"))
- color_sta_mesure_vec<-color_sta_mesure$color
- color_sta_mesure_vec=setNames(color_sta_mesure_vec,color_sta_mesure$name)
+ color_sta_mesure <- stacomiR::colortable(color = NULL, r_mig_env@report_env@stationMesure@env_selected,palette = "Set2",color_function = c("random"))
+ color_sta_mesure_vec <- color_sta_mesure$color
+ color_sta_mesure_vec <- setNames(color_sta_mesure_vec,color_sta_mesure$name)
stacomiR::plot(r_mig_env,
- color_station=color_sta_mesure_vec,
- color_dc=color_dc_vec
+ color_station = color_sta_mesure_vec,
+ color_dc = color_dc_vec
)
--
GitLab
From 82cf4fa1549d70cad9ce0b1f50cc2ed00d8f7951 Mon Sep 17 00:00:00 2001
From: cedricbriandgithub <cedric.briand@eptb-vilaine.fr>
Date: Tue, 10 Oct 2023 15:56:25 +0200
Subject: [PATCH 24/47] fix minor
---
dev/run_dev.R | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/dev/run_dev.R b/dev/run_dev.R
index f4e86d5..203634b 100644
--- a/dev/run_dev.R
+++ b/dev/run_dev.R
@@ -8,7 +8,7 @@ options(golem.app.prod = FALSE) # TRUE = production mode, FALSE = development mo
rm(list=ls(all.names = TRUE))
# Document and reload your package
-remotes::install_deps(upgrade='never')
+# remotes::install_deps(upgrade='never')
#devtools::load_all(path = "D://OneDrive - Seine-Normandie Migrateurs/R/Stacoshiny/stacomir/")
--
GitLab
From 826817289bbcbd86ac0223ba41d95f6c682e3418 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Grall?= <seinormigr.grall@gmail.com>
Date: Thu, 12 Oct 2023 10:51:00 +0200
Subject: [PATCH 25/47] error comment in mod dc df date sup/inf
---
R/mod_bilan_dc.R | 2 +-
R/mod_bilan_df.R | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/R/mod_bilan_dc.R b/R/mod_bilan_dc.R
index f41a4d1..5f6a1e3 100644
--- a/R/mod_bilan_dc.R
+++ b/R/mod_bilan_dc.R
@@ -130,7 +130,7 @@ mod_bilan_dc_server <- function(id,DD){
validate(need(length(ref_dc@dc_selected) >0, "No dc selected"))
if (length(ref_dc@dc_selected) >1)
ref_dc@dc_selected <- ref_dc@dc_selected[1]
- validate(need(input$bilan_dc.datedebut<input$bilan_dc.datefin,"la date de début doit être supérieure à la date de fin"))
+ validate(need(input$bilan_dc.datedebut<input$bilan_dc.datefin,"la date de début doit être inférieure à la date de fin"))
r_dc<-choice_c(r_dc,
dc=ref_dc@dc_selected,
horodatedebut=input$bilan_dc.datedebut,
diff --git a/R/mod_bilan_df.R b/R/mod_bilan_df.R
index 4ddb0e5..3463568 100644
--- a/R/mod_bilan_df.R
+++ b/R/mod_bilan_df.R
@@ -110,7 +110,7 @@ mod_bilan_df_server <- function(id, DD) {
r_df <- new("report_df")
ref_df <- base::get("ref_df", envir = envir_stacomi)
validate(need(length(ref_df@df_selected) > 0, "No df selected"))
- validate(need(input$bilan_df.datedebut < input$bilan_df.datefin, "la date de début doit être supérieure à la date de fin"))
+ validate(need(input$bilan_df.datedebut < input$bilan_df.datefin, "la date de début doit être inférieure à la date de fin"))
r_df <- choice_c(r_df,
df = ref_df@df_selected,
horodatedebut = input$bilan_df.datedebut,
--
GitLab
From 2d9a69a86313456a4615149bfc80760fe62da667 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Grall?= <seinormigr.grall@gmail.com>
Date: Thu, 12 Oct 2023 11:49:07 +0200
Subject: [PATCH 26/47] fix #31 : unique choice DC
---
R/mod_civ_poids.R | 6 ++++++
1 file changed, 6 insertions(+)
diff --git a/R/mod_civ_poids.R b/R/mod_civ_poids.R
index 23971f0..3681da0 100644
--- a/R/mod_civ_poids.R
+++ b/R/mod_civ_poids.R
@@ -124,7 +124,13 @@ mod_civ_poids_server <- function(id, DD) {
validate(need(!is.null(db_connection), "db needs connection"))
r_gew <- new("report_ge_weight")
ref_dc <- base::get("ref_dc", envir = envir_stacomi)
+ validate(need(input$civ_poids.datedebut<input$civ_poids.datefin,"la date de début doit être inférieure à la date de fin"))
validate(need(length(ref_dc@dc_selected) > 0, "Pas de DC sélectionné"))
+ validate(need(length(ref_dc@dc_selected) < 2, "Plusieurs DC sélectionnés, en choisir uniquement 1"))
+ #if (length(ref_dc@dc_selected) > 1){
+ # warning ("Plusieurs DC sélectionnés, seul le premier sera utilisé")}
+ ref_dc@dc_selected<-ref_dc@dc_selected[1]
+ #browser()
r_gew <- choice_c(
r_gew,
dc = ref_dc@dc_selected,
--
GitLab
From 1cda8fbecc105b19891953c64ac6f10493733546 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Grall?= <seinormigr.grall@gmail.com>
Date: Thu, 12 Oct 2023 12:27:54 +0200
Subject: [PATCH 27/47] suppression limite de 1 DC pour AGG
---
R/mod_ang_argentee.R | 1 -
R/mod_civ_poids.R | 2 +-
2 files changed, 1 insertion(+), 2 deletions(-)
diff --git a/R/mod_ang_argentee.R b/R/mod_ang_argentee.R
index 76004a9..085c61d 100644
--- a/R/mod_ang_argentee.R
+++ b/R/mod_ang_argentee.R
@@ -144,7 +144,6 @@ mod_ang_argentee_server <- function(id, DD) {
r_silver <- new("report_silver_eel")
ref_dc <- base::get("ref_dc", envir = envir_stacomi)
validate(need(length(ref_dc@dc_selected) > 0, "Pas de DC sélectionné"))
- validate(need(length(ref_dc@dc_selected) == 1, "Vous ne pouvez sélectionner qu'un seul DC"))
r_silver <- choice_c(r_silver,
dc = ref_dc@dc_selected,
horodatedebut = input$angarg.datedebut,
diff --git a/R/mod_civ_poids.R b/R/mod_civ_poids.R
index 3681da0..f362d82 100644
--- a/R/mod_civ_poids.R
+++ b/R/mod_civ_poids.R
@@ -126,7 +126,7 @@ mod_civ_poids_server <- function(id, DD) {
ref_dc <- base::get("ref_dc", envir = envir_stacomi)
validate(need(input$civ_poids.datedebut<input$civ_poids.datefin,"la date de début doit être inférieure à la date de fin"))
validate(need(length(ref_dc@dc_selected) > 0, "Pas de DC sélectionné"))
- validate(need(length(ref_dc@dc_selected) < 2, "Plusieurs DC sélectionnés, en choisir uniquement 1"))
+ validate(need(length(ref_dc@dc_selected) < 2, "Vous ne pouvez sélectionner qu'un seul DC"))
#if (length(ref_dc@dc_selected) > 1){
# warning ("Plusieurs DC sélectionnés, seul le premier sera utilisé")}
ref_dc@dc_selected<-ref_dc@dc_selected[1]
--
GitLab
From c0f2f439ca2507d458dda9a13f87b9c13f2d0050 Mon Sep 17 00:00:00 2001
From: cedricbriandgithub <cedric.briand@eptb-vilaine.fr>
Date: Thu, 12 Oct 2023 14:15:41 +0200
Subject: [PATCH 28/47] fix bug in table
---
R/mod_civ_poids.R | 10 ++++------
1 file changed, 4 insertions(+), 6 deletions(-)
diff --git a/R/mod_civ_poids.R b/R/mod_civ_poids.R
index f362d82..2d8a2c3 100644
--- a/R/mod_civ_poids.R
+++ b/R/mod_civ_poids.R
@@ -184,10 +184,9 @@ mod_civ_poids_server <- function(id, DD) {
if ("4" %in% input$choix_sorties) {
if (input$box_tab_civpoids$collapsed)
shinydashboardPlus::updateBox("box_tab_civpoids", action = "toggle")
- tab <- table(r_gew@calcdata$data)
- tab2 <- data.frame(tab)
+
output$tab_civpoids <- renderDT({
- DT::datatable(tab2,
+ DT::datatable(data.frame(r_gew@calcdata$data),
rownames=FALSE,
extensions = "Buttons",
option=list(
@@ -208,10 +207,9 @@ mod_civ_poids_server <- function(id, DD) {
if ("5" %in% input$choix_sorties) {
if (input$box_tab_civpoids2$collapsed)
shinydashboardPlus::updateBox("box_tab_civpoids2", action = "toggle")
- tab3 <- table(r_gew@calcdata$coe)
- tab4 <- data.frame(tab3)
+
output$tab_civpoids2 <- renderDT({
- DT::datatable(tab4,
+ DT::datatable(as.data.frame(r_gew@calcdata$coe),
rownames=FALSE,
extensions = "Buttons",
option=list(
--
GitLab
From d4f8bcf4636f5777af1c4e29529a092c8a3cf204 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Grall?= <seinormigr.grall@gmail.com>
Date: Thu, 12 Oct 2023 17:25:22 +0200
Subject: [PATCH 29/47] fix custom plot in mod interanual change name to get
plot in envir stacomi
---
R/mod_interannuel.R | 17 +++++++++--------
1 file changed, 9 insertions(+), 8 deletions(-)
diff --git a/R/mod_interannuel.R b/R/mod_interannuel.R
index 1dd6f34..fbe989d 100644
--- a/R/mod_interannuel.R
+++ b/R/mod_interannuel.R
@@ -9,6 +9,7 @@
#' @importFrom shiny NS tagList
#' @importFrom shinydashboard tabItem box
#' @importFrom DT renderDT DTOutput
+#' @importFrom stringr str_split
mod_interannuel_ui <- function(id){
ns <- NS(id)
tabItem(tabName = "interannuel",
@@ -344,7 +345,7 @@ mod_interannuel_server <- function(id,DD){
plot_ylab<-envir_stacomi$ylab
theme_plot<-envir_stacomi$theme_plot
- g_interannuel_line <- envir_stacomi$g_line
+ g_interannuel_line <- envir_stacomi$g
g_interannuel_line <- g_interannuel_line+
ggplot2::ggtitle(plot_title) +
ggplot2::ylab(plot_ylab) +
@@ -376,11 +377,11 @@ mod_interannuel_server <- function(id,DD){
plot_ylab<-envir_stacomi$ylab
theme_plot<-envir_stacomi$theme_plot
- g_interannuel_standard <- envir_stacomi$g_standard
+ g_interannuel_standard <- envir_stacomi$g
title <- g_interannuel_standard$labels$title
- legend_title <- str_split(title,",")[[1]][3]
- the_choice <- str_split(str_split(title,",")[[1]][3],"/")[[1]][1]
- labels <- str_split(str_split(title,",")[[1]][3],"/")[[1]][2]
+ legend_title <- stringr::str_split(title,",")[[1]][3]
+ the_choice <- stringr::str_split(stringr::str_split(title,",")[[1]][3],"/")[[1]][1]
+ labels <- stringr::str_split(stringr::str_split(title,",")[[1]][3],"/")[[1]][2]
g_interannuel_standard <- g_interannuel_standard +
ggplot2::ggtitle(plot_title) +
ggplot2::ylab(plot_ylab) +
@@ -411,7 +412,7 @@ mod_interannuel_server <- function(id,DD){
plot_ylab<-envir_stacomi$ylab
theme_plot<-envir_stacomi$theme_plot
- g_interannuel_step <- envir_stacomi$g_step
+ g_interannuel_step <- envir_stacomi$g
g_interannuel_step <- g_interannuel_step+
ggplot2::ggtitle(plot_title) +
@@ -507,7 +508,7 @@ mod_interannuel_server <- function(id,DD){
plot_ylab<-envir_stacomi$ylab
theme_plot<-envir_stacomi$theme_plot
- g_interannuel_density <- envir_stacomi$g_density
+ g_interannuel_density <- envir_stacomi$g
g_interannuel_density <- g_interannuel_density+
ggplot2::ggtitle(plot_title) +
@@ -539,7 +540,7 @@ mod_interannuel_server <- function(id,DD){
plot_ylab<-envir_stacomi$ylab
theme_plot<-envir_stacomi$theme_plot
- g_interannuel_seasonal <- envir_stacomi$g_seasonal
+ g_interannuel_seasonal <- envir_stacomi$g
g_interannuel_seasonal <- g_interannuel_seasonal+
ggplot2::ggtitle(plot_title) +
--
GitLab
From 04c98679a2820e6182108edd8bb2b80d6881f4ac Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Grall?= <seinormigr.grall@gmail.com>
Date: Thu, 12 Oct 2023 17:28:00 +0200
Subject: [PATCH 30/47] add import from str_split
---
NAMESPACE | 1 +
1 file changed, 1 insertion(+)
diff --git a/NAMESPACE b/NAMESPACE
index 5a5de8a..90aed20 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -52,3 +52,4 @@ importFrom(shinydashboardPlus,renderUser)
importFrom(shinydashboardPlus,userOutput)
importFrom(spsComps,shinyCatch)
importFrom(spsComps,spsDepend)
+importFrom(stringr,str_split)
--
GitLab
From 2042873dcce2d0f37fd9b99cd59e2b0ab1001ae2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Grall?= <seinormigr.grall@gmail.com>
Date: Thu, 12 Oct 2023 17:49:06 +0200
Subject: [PATCH 31/47] fix : mod custom plot migr inter : change g to g1 for
plot standard to get plot in envir staco
---
R/mod_interannuel.R | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/R/mod_interannuel.R b/R/mod_interannuel.R
index fbe989d..2f7e1f2 100644
--- a/R/mod_interannuel.R
+++ b/R/mod_interannuel.R
@@ -377,7 +377,7 @@ mod_interannuel_server <- function(id,DD){
plot_ylab<-envir_stacomi$ylab
theme_plot<-envir_stacomi$theme_plot
- g_interannuel_standard <- envir_stacomi$g
+ g_interannuel_standard <- envir_stacomi$g1
title <- g_interannuel_standard$labels$title
legend_title <- stringr::str_split(title,",")[[1]][3]
the_choice <- stringr::str_split(stringr::str_split(title,",")[[1]][3],"/")[[1]][1]
--
GitLab
From cd188f7d5e460f0f0dfe43af0553f111306847f8 Mon Sep 17 00:00:00 2001
From: cedricbriandgithub <cedric.briand@eptb-vilaine.fr>
Date: Fri, 13 Oct 2023 11:55:02 +0200
Subject: [PATCH 32/47] dev : change interactive use of plot in interannual
---
R/app_server.R | 10 +-
R/mod_custom_plot_interannual.R | 116 ++++
R/mod_interannuel.R | 1087 +++++++++++++++----------------
dev/run_dev.R | 23 +-
4 files changed, 682 insertions(+), 554 deletions(-)
create mode 100644 R/mod_custom_plot_interannual.R
diff --git a/R/app_server.R b/R/app_server.R
index a9024aa..de1e63d 100644
--- a/R/app_server.R
+++ b/R/app_server.R
@@ -20,8 +20,8 @@ app_server <- function( input, output, session ) {
DD$button_ref_taxa_migr_mult <- mod_ref_taxa_server("ref_taxa_mod_migr_mult", DD, mytab="migr_mult")
DD$button_ref_stage_migr_mult <- mod_ref_stage_server("ref_stage_mod_migr_mult", DD, mytab="migr_mult")
- DD$button_box_custom_migr_mult_2<-mod_custom_plot_server("custom_plot_migr_mult_2",DD,mytab="migr_mult")
- DD$button_box_custom_migr_mult_3<-mod_custom_plot_server("custom_plot_migr_mult_3",DD,mytab="migr_mult")
+ DD$button_box_custom_migr_mult_2 <-mod_custom_plot_server("custom_plot_migr_mult_2",DD,mytab="migr_mult")
+ DD$button_box_custom_migr_mult_3 <-mod_custom_plot_server("custom_plot_migr_mult_3",DD,mytab="migr_mult")
# annuel ---------------------------------------------------
@@ -39,8 +39,10 @@ app_server <- function( input, output, session ) {
DD$button_box_custom_interannuel_line<-mod_custom_plot_server("custom_plot_interannuel_line",DD,mytab="interannuel")
DD$button_box_custom_interannuel_standard<-mod_custom_plot_server("custom_plot_interannuel_standard",DD,mytab="interannuel")
DD$button_box_custom_interannuel_step<-mod_custom_plot_server("custom_plot_interannuel_step",DD,mytab="interannuel")
- DD$button_box_custom_interannuel_barchart<-mod_custom_plot_server("custom_plot_interannuel_barchart",DD,mytab="interannuel")
- DD$button_box_custom_interannuel_pointrange<-mod_custom_plot_server("custom_plot_interannuel_pointrange",DD,mytab="interannuel")
+
+ DD$button_box_custom_interannuel_barchart<-mod_custom_plot_interannual_server("custom_plot_interannuel_barchart",DD,mytab="interannuel")
+
+ DD$button_box_custom_interannuel_pointrange<-mod_custom_plot_server("custom_plot_interannuel_pointrange",DD,mytab="interannuel")
DD$button_box_custom_interannuel_density<-mod_custom_plot_server("custom_plot_interannuel_density",DD,mytab="interannuel")
DD$button_box_custom_interannuel_seasonal<-mod_custom_plot_server("custom_plot_interannuel_seasonal",DD,mytab="interannuel")
diff --git a/R/mod_custom_plot_interannual.R b/R/mod_custom_plot_interannual.R
new file mode 100644
index 0000000..e3967c2
--- /dev/null
+++ b/R/mod_custom_plot_interannual.R
@@ -0,0 +1,116 @@
+#' custom_plot UI Function
+#'
+#' @description Shiny module based on mod_custom_plot, which applied to a shinydashboardPlus::box
+#' allows to interact and add reactive component to graphs. Here we use the same code but add a choice for the year
+#' of reference and the timesplit.
+#'
+#' @param id,input,output,session Internal parameters for {shiny}.
+#'
+#' @noRd
+#'
+#' @importFrom shiny NS tagList
+mod_custom_plot_interannual_ui <- function(id){
+ ns <- NS(id)
+ tagList(
+
+ spsDepend("toastr"),
+ selectizeInput(ns('pas_temps'),
+ h5('Choisissez un d\u00e9coupage :'),
+ selected="jour",
+ choices = c("Jour"="jour","Semaine"="semaine","Mois"="mois","Quinzaine"="quinzaine"),
+ multiple = FALSE),
+ textInput(
+ inputId = ns("plot_title"),
+ label = "titre",
+ value = "",
+ placeholder = "un titre"
+ ),
+ textInput(
+ inputId = ns("plot_xlab"),
+ label = "xlab",
+ value = "",
+ placeholder = "axe des abscisses"
+ ),
+ textInput(
+ inputId = ns("plot_ylab"),
+ label = "ylab",
+ value = "",
+ placeholder = "axe des ordonnées"
+ ),
+ selectInput(inputId=ns("select_palette_plot"),
+ h5('Choisissez la palette :'),
+ selected=NULL,
+ choices=NULL,
+ multiple = FALSE),
+ selectInput(inputId=ns("select_theme_plot"),
+ h5('Choisissez le theme :'),
+ selected=NULL,
+ choices=NULL,
+ multiple = FALSE),
+
+ actionBttn(ns("button_box_custom"), "OK"),
+ )
+}
+
+#' custom_plot Server Functions
+#'
+#' @noRd
+mod_custom_plot_interannual_server <- function(id,DD,mytab){
+ moduleServer( id, function(input, output, session){
+ ns <- session$ns
+ observeEvent({
+ DD$login_button()
+ },{
+ shinyCatch({
+
+ palette_plot<-rownames(RColorBrewer::brewer.pal.info)
+
+ theme_plot_ggthemes<-ls("package:ggthemes")[grepl("theme_", ls("package:ggthemes"))]
+ theme_plot_ggplot<-c("theme_gray","theme_bw","theme_linedraw","theme_light","theme_dark","theme_minimal","theme_classic","theme_void","theme_test")
+
+ theme_plot<-append(theme_plot_ggplot,theme_plot_ggthemes)
+
+ updateSelectInput(session, "select_palette_plot",
+ choices = palette_plot
+ )
+ updateSelectInput(session, "select_theme_plot",
+ choices = theme_plot
+ )
+
+
+ }, blocking_level = "error")
+ },
+ ignoreInit=TRUE,
+ ignoreNULL=TRUE,
+ priority = 0
+ )
+
+ observeEvent({
+ input$button_box_custom
+ },{
+ shinyCatch({
+
+ assign("palette_plot",input$select_palette_plot,envir=envir_stacomi)
+ assign("theme_plot",input$select_theme_plot,envir=envir_stacomi)
+ assign("plot_title",input$plot_title,envir = envir_stacomi)
+ assign("xlab",input$plot_xlab,envir = envir_stacomi)
+ assign("ylab",input$plot_ylab,envir = envir_stacomi)
+ assign("pas_temps", input$pas_temps, envir=envir_stacomi)
+
+ }, blocking_level = "error")
+ },
+ ignoreInit=TRUE,
+ ignoreNULL=TRUE,
+ priority = 1
+ )
+
+ return("button_box_custom" =reactive(input$button_box_custom))
+
+ })
+}
+
+## To be copied in the UI
+# mod_custom_plot_ui("custom_plot_1")
+
+## To be copied in the server
+# mod_custom_plot_server("custom_plot_1")
diff --git a/R/mod_interannuel.R b/R/mod_interannuel.R
index 2f7e1f2..428462d 100644
--- a/R/mod_interannuel.R
+++ b/R/mod_interannuel.R
@@ -11,164 +11,161 @@
#' @importFrom DT renderDT DTOutput
#' @importFrom stringr str_split
mod_interannuel_ui <- function(id){
- ns <- NS(id)
- tabItem(tabName = "interannuel",
- shinydashboardPlus::box(
- title = "S\u00e9lections :",
- solidHeader = TRUE,
- #icon("list-alt"),
- collapsible = TRUE,
- status="primary",
- width = 3,
- sliderInput(ns("slider_interannuel_annee"),
- label = h5("Choisissez les \'ann\u00e9es"),
- min = 1980,
- max = CY,
- value = c(2011, CY)),
+ ns <- NS(id)
+ tabItem(tabName = "interannuel",
+ shinydashboardPlus::box(
+ title = "S\u00e9lections :",
+ solidHeader = TRUE,
+ #icon("list-alt"),
+ collapsible = TRUE,
+ status="primary",
+ width = 3,
+ sliderInput(ns("slider_interannuel_annee"),
+ label = h5("Choisissez les \'ann\u00e9es"),
+ min = 1980,
+ max = CY,
+ value = c(2011, CY)),
# todo add year selected choice there (no effect for seasonal)
- mod_ref_taxa_ui("ref_taxa_mod_interannuel", multiple=FALSE),
- mod_ref_stage_ui("ref_stage_mod_interannuel", multiple=FALSE),
-
- selectizeInput(ns('pas_temps'), h5('Choisissez un d\u00e9coupage :'),
- selected="jour", choices = c("Jour"="jour","Semaine"="semaine","Mois"="mois","Quinzaine"="quinzaine"),
- multiple = FALSE),
- checkboxGroupInput(ns("choix_sorties"),
- label = h5("Choisissez les sorties graphiques ou tableaux :"),
- choices = list("plot_line" = 1,
- "plot_standard" = 2,
- "plot_step" = 3,
- "plot_barchart"= 4,
- "plot_pointRange"= 5,
- "plot_density"= 6,
- "plot_seasonal"= 7,
- "tab_summary"= 8),
- selected = 1),
- actionBttn(
- inputId = ns("bttn_interannuel"),
- label = "OK",
- style = "fill",
- color = "primary"
- )
- ),
- shinydashboardPlus::box(
- id=ns("box_interannuel_line"),
- title="Line",
- status = "primary",
- solidHeader = TRUE,
- collapsible = TRUE,
- collapsed=TRUE,
- sidebar = shinydashboardPlus::boxSidebar(
- id = ns("box_interannuel_line_sidebar"),
- width = 25,
- mod_custom_plot_ui("custom_plot_interannuel_line"),
- ),
- plotOutput(ns("plot_interannuel_line"))),
- shinydashboardPlus::box(
- id=ns("box_interannuel_standard"),
- title="Standard",
- status = "primary",
- solidHeader = TRUE,
- collapsible = TRUE,
- collapsed=TRUE,
- sidebar = shinydashboardPlus::boxSidebar(
- id = ns("box_interannuel_standard_sidebar"),
- width = 25,
- mod_custom_plot_ui("custom_plot_interannuel_standard"),
- ),
- plotOutput(ns("plot_interannuel_standard"))),
- shinydashboardPlus::box(
- id=ns("box_interannuel_step"),
- title="Step",
- status = "primary",
- solidHeader = TRUE,
- collapsible = TRUE,
- collapsed=TRUE,
- sidebar = shinydashboardPlus::boxSidebar(
- id = ns("box_interannuel_step_sidebar"),
- width = 25,
- mod_custom_plot_ui("custom_plot_interannuel_step"),
- ),
- plotOutput(ns("plot_interannuel_step"))),
- shinydashboardPlus::box(
- id=ns("box_interannuel_barchart"),
- title="Barchart",
- status = "primary",
- solidHeader = TRUE,
- collapsible = TRUE,
- collapsed=TRUE,
- # sidebar = shinydashboardPlus::boxSidebar(
- # id = ns("box_interannuel_barchart_sidebar"),
- # width = 25,
- # mod_custom_plot_ui("custom_plot_interannuel_barchart"),
- # ),
- plotOutput(ns("plot_interannuel_barchart"))),
- shinydashboardPlus::box(
- id=ns("box_interannuel_pointrange"),
- title="Pointrange",
- status = "primary",
- solidHeader = TRUE,
- collapsible = TRUE,
- collapsed=TRUE,
- # sidebar = shinydashboardPlus::boxSidebar(
- # id = ns("box_interannuel_pointrange_sidebar"),
- # width = 25,
- # mod_custom_plot_ui("custom_plot_interannuel_pointrange"),
- # ),
- plotOutput(ns("plot_interannuel_pointRange"))),
- shinydashboardPlus::box(
- id=ns("box_interannuel_density"),
- title="density",
- status = "primary",
- solidHeader = TRUE,
- collapsible = TRUE,
- collapsed=TRUE,
- sidebar = shinydashboardPlus::boxSidebar(
- id = ns("box_interannuel_density_sidebar"),
- width = 25,
- mod_custom_plot_ui("custom_plot_interannuel_density"),
- ),
- plotOutput(ns("plot_interannuel_density"))),
- shinydashboardPlus::box(
- id=ns("box_interannuel_seasonal"),
- title="Seasonal",
- status = "primary",
- solidHeader = TRUE,
- collapsible = TRUE,
- collapsed=TRUE,
- sidebar = shinydashboardPlus::boxSidebar(
- id = ns("box_interannuel_seasonal_sidebar"),
- width = 25,
- mod_custom_plot_ui("custom_plot_interannuel_seasonal"),
- ),
- plotOutput(ns("plot_interannuel_seasonal"))),
- shinydashboardPlus::box(
- id=ns("box_interannuel_summary"),
- title="Summary",
- width=9,
- solidHeader = TRUE,
- collapsible = TRUE,
- actionButton(ns("box_summary_update"), "Choix du DC"),
- sidebar = shinydashboardPlus::boxSidebar(
- id = ns("box_summary_sidebar"),
- width = 25,
- selectizeInput(ns("select_dc_summary_interannuel"),
- h5('Choisissez le DC :'),
- selected=NULL,
- choices=NULL,
- multiple = FALSE),
- selectizeInput(ns("select_year_summary_interannuel"),
- h5("Choisissez l''année de calcul :"),
- selected=NULL,
- choices=NULL,
- multiple = FALSE),
- ),
-
- DTOutput(ns("tab_interannuel_summary"))
- )
-
-
- )
-
+ mod_ref_taxa_ui("ref_taxa_mod_interannuel", multiple=FALSE),
+ mod_ref_stage_ui("ref_stage_mod_interannuel", multiple=FALSE),
+ checkboxGroupInput(ns("choix_sorties"),
+ label = h5("Choisissez les sorties graphiques ou tableaux :"),
+ choices = list("plot_line" = 1,
+ "plot_standard" = 2,
+ "plot_step" = 3,
+ "plot_barchart"= 4,
+ "plot_pointRange"= 5,
+ "plot_density"= 6,
+ "plot_seasonal"= 7,
+ "tab_summary"= 8),
+ selected = 1),
+ actionBttn(
+ inputId = ns("bttn_interannuel"),
+ label = "OK",
+ style = "fill",
+ color = "primary"
+ )
+ ),
+ shinydashboardPlus::box(
+ id=ns("box_interannuel_line"),
+ title="Line",
+ status = "primary",
+ solidHeader = TRUE,
+ collapsible = TRUE,
+ collapsed=TRUE,
+ sidebar = shinydashboardPlus::boxSidebar(
+ id = ns("box_interannuel_line_sidebar"),
+ width = 25,
+ mod_custom_plot_ui("custom_plot_interannuel_line"),
+ ),
+ plotOutput(ns("plot_interannuel_line"))),
+ shinydashboardPlus::box(
+ id=ns("box_interannuel_standard"),
+ title="Standard",
+ status = "primary",
+ solidHeader = TRUE,
+ collapsible = TRUE,
+ collapsed=TRUE,
+ sidebar = shinydashboardPlus::boxSidebar(
+ id = ns("box_interannuel_standard_sidebar"),
+ width = 25,
+ mod_custom_plot_ui("custom_plot_interannuel_standard"),
+ ),
+ plotOutput(ns("plot_interannuel_standard"))),
+ shinydashboardPlus::box(
+ id=ns("box_interannuel_step"),
+ title="Step",
+ status = "primary",
+ solidHeader = TRUE,
+ collapsible = TRUE,
+ collapsed=TRUE,
+ sidebar = shinydashboardPlus::boxSidebar(
+ id = ns("box_interannuel_step_sidebar"),
+ width = 25,
+ mod_custom_plot_ui("custom_plot_interannuel_step"),
+ ),
+ plotOutput(ns("plot_interannuel_step"))),
+ shinydashboardPlus::box(
+ id=ns("box_interannuel_barchart"),
+ title="Barchart",
+ status = "primary",
+ solidHeader = TRUE,
+ collapsible = TRUE,
+ collapsed=TRUE,
+ sidebar = shinydashboardPlus::boxSidebar(
+ id = ns("box_interannuel_barchart_sidebar"),
+ width = 25,
+ mod_custom_plot_interannual_ui("custom_plot_interannuel_barchart"),
+ ),
+ plotOutput(ns("plot_interannuel_barchart"))),
+ shinydashboardPlus::box(
+ id=ns("box_interannuel_pointrange"),
+ title="Pointrange",
+ status = "primary",
+ solidHeader = TRUE,
+ collapsible = TRUE,
+ collapsed=TRUE,
+ #TODO CEDRIC
+ sidebar = shinydashboardPlus::boxSidebar(
+ id = ns("box_interannuel_pointrange_sidebar"),
+ width = 25,
+ mod_custom_plot_interannual_ui("custom_plot_interannuel_pointrange"),
+ ),
+ plotOutput(ns("plot_interannuel_pointRange"))),
+ shinydashboardPlus::box(
+ id=ns("box_interannuel_density"),
+ title="density",
+ status = "primary",
+ solidHeader = TRUE,
+ collapsible = TRUE,
+ collapsed=TRUE,
+ sidebar = shinydashboardPlus::boxSidebar(
+ id = ns("box_interannuel_density_sidebar"),
+ width = 25,
+ mod_custom_plot_ui("custom_plot_interannuel_density"),
+ ),
+ plotOutput(ns("plot_interannuel_density"))),
+ shinydashboardPlus::box(
+ id=ns("box_interannuel_seasonal"),
+ title="Seasonal",
+ status = "primary",
+ solidHeader = TRUE,
+ collapsible = TRUE,
+ collapsed=TRUE,
+ sidebar = shinydashboardPlus::boxSidebar(
+ id = ns("box_interannuel_seasonal_sidebar"),
+ width = 25,
+ mod_custom_plot_ui("custom_plot_interannuel_seasonal"),
+ ),
+ plotOutput(ns("plot_interannuel_seasonal"))),
+ shinydashboardPlus::box(
+ id=ns("box_interannuel_summary"),
+ title="Summary",
+ width=9,
+ solidHeader = TRUE,
+ collapsible = TRUE,
+ actionButton(ns("box_summary_update"), "Choix du DC"),
+ sidebar = shinydashboardPlus::boxSidebar(
+ id = ns("box_summary_sidebar"),
+ width = 25,
+ selectizeInput(ns("select_dc_summary_interannuel"),
+ h5('Choisissez le DC :'),
+ selected=NULL,
+ choices=NULL,
+ multiple = FALSE),
+ selectizeInput(ns("select_year_summary_interannuel"),
+ h5("Choisissez l''année de calcul :"),
+ selected=NULL,
+ choices=NULL,
+ multiple = FALSE),
+ ),
+
+ DTOutput(ns("tab_interannuel_summary"))
+ )
+
+
+ )
+
}
#' interannuel Server Functions
@@ -176,394 +173,394 @@ mod_interannuel_ui <- function(id){
#' @noRd
#' @importFrom shinipsum random_ggplot random_DT
mod_interannuel_server <- function(id,DD){
- moduleServer( id, function(input, output, session){
- ns <- session$ns
- #observe(print(input$box_summary_sidebar))
- # pour la sidebar de summary, voir https://rinterface.github.io/shinydashboardPlus/articles/improved-boxes.html#box-components-1
- observeEvent(input$box_summary_update, {
- shinydashboardPlus::updateBoxSidebar("box_summary_sidebar")
- })
-
-
- observeEvent(
- eventExpr={
- input$bttn_interannuel
- # les buttons qui suivent sont cachés dans la box summary
- input$select_dc_summary_interannuel
- input$select_year_summary_interannuel
- },
- handlerExpr={
-
- shinyCatch({
- # Bilan migration interannuel -----------------------
- validate(need(exists("envir_stacomi"), "Le programme stacomi doit être lancé"))
- db_connection <- envir_stacomi$db_connection
- validate(need(!is.null(db_connection), "db needs connection"))
- r_mig_interannual <- new("report_mig_interannual")
- ref_dc <- base::get("ref_dc", envir=envir_stacomi)
- validate(need(length(ref_dc@dc_selected) >0, "No dc selected"))
- ref_taxa <- base::get("ref_taxa", envir=envir_stacomi)
- validate(need(length(ref_taxa@taxa_selected) >0, "No taxa selected") )
- if (length(ref_taxa@taxa_selected) >1)
- ref_taxa@taxa_selected <- ref_taxa@taxa_selected[1]
- ref_stage <- base::get("ref_stage", envir=envir_stacomi)
- validate(need(length(ref_stage@stage_selected) >0, "No stage selected") )
- if (length(ref_stage@stage_selected) >1)
- ref_stage@stage_selected <- ref_stage@stage_selected[1]
- req(!is.null(input$slider_interannuel_annee[2]))
- shinybusy::show_modal_spinner(spin="flower", text="loading from db")
- r_mig_interannual <- choice_c(r_mig_interannual,
- dc=ref_dc@dc_selected,
- taxa=ref_taxa@taxa_selected,
- stage=ref_stage@stage_selected,
- start_year=input$slider_interannuel_annee[1],
- end_year=input$slider_interannuel_annee[2],
- silent=TRUE)
- r_mig_interannual <-charge(r_mig_interannual)
- r_mig_interannual <- connect(r_mig_interannual, silent = TRUE)
- shinybusy::remove_modal_spinner()
- # silent = TRUE sinon redemande avant de ré-écrire
- r_mig_interannual <- calcule(r_mig_interannual, silent = FALSE)
-
-
-
- # graphiques et sorties ----------------------
-
- if (nrow(r_mig_interannual@data)==0){
- warning("no data available")
- } else {
- if ("1" %in% input$choix_sorties) {
- if (input$box_interannuel_line$collapsed) shinydashboardPlus::updateBox("box_interannuel_line", action = "toggle")
- output$plot_interannuel_line <- renderPlot({
- stacomiR::plot(r_mig_interannual, plot.type = "line", silent = TRUE)
- })
- } else {
- if (!input$box_interannuel_line$collapsed) shinydashboardPlus::updateBox("box_interannuel_line", action = "toggle")
- }#end if "1"
-
- if ("2" %in% input$choix_sorties) {
- if (input$box_interannuel_standard$collapsed) shinydashboardPlus::updateBox("box_interannuel_standard", action = "toggle")
- output$plot_interannuel_standard <- renderPlot({
- stacomiR::plot(r_mig_interannual, plot.type = "standard", silent = TRUE)
- })
- } else {
- if (!input$box_interannuel_standard$collapsed) shinydashboardPlus::updateBox("box_interannuel_standard", action = "toggle")
- } # end if "2"
-
- if ("3" %in% input$choix_sorties) {
- if (input$box_interannuel_step$collapsed) shinydashboardPlus::updateBox("box_interannuel_step", action = "toggle")
- output$plot_interannuel_step <- renderPlot({
- stacomiR::plot(r_mig_interannual, plot.type = "step", silent = TRUE)
- })
- } else {
- if (!input$box_interannuel_step$collapsed) shinydashboardPlus::updateBox("box_interannuel_step", action = "toggle")
- }# end if "3"
-
- if ("4" %in% input$choix_sorties) {
- if (input$box_interannuel_barchart$collapsed) shinydashboardPlus::updateBox("box_interannuel_barchart", action = "toggle")
- output$plot_interannuel_barchart <- renderPlot({
- stacomiR::plot(r_mig_interannual, plot.type = "barchart", timesplit = input$pas_temps, silent = TRUE)
- })
- } else {
- if (!input$box_interannuel_barchart$collapsed) shinydashboardPlus::updateBox("box_interannuel_barchart", action = "toggle")
- }# end if "4"
-
- if ("5" %in% input$choix_sorties) {
- if (input$box_interannuel_pointrange$collapsed) shinydashboardPlus::updateBox("box_interannuel_pointrange", action = "toggle")
- output$plot_interannuel_pointRange <- renderPlot({
- stacomiR::plot(r_mig_interannual, plot.type = "pointrange", timesplit = input$pas_temps, silent = TRUE)
- })
- } else {
- if (!input$box_interannuel_pointrange$collapsed) shinydashboardPlus::updateBox("box_interannuel_pointrange", action = "toggle")
- }# end if "5"
-
- if ("6" %in% input$choix_sorties) {
- if (input$box_interannuel_density$collapsed) shinydashboardPlus::updateBox("box_interannuel_density", action = "toggle")
- output$plot_interannuel_density <- renderPlot({
- stacomiR::plot(r_mig_interannual, plot.type = "density", silent = TRUE)
- })
- } else {
- if (!input$box_interannuel_density$collapsed) shinydashboardPlus::updateBox("box_interannuel_density", action = "toggle")
- }# end if "6"
-
- if ("7" %in% input$choix_sorties) {
- if (input$box_interannuel_seasonal$collapsed) shinydashboardPlus::updateBox("box_interannuel_seasonal", action = "toggle")
- output$plot_interannuel_seasonal <- renderPlot({
- stacomiR::plot(r_mig_interannual, plot.type = "seasonal", timesplit = input$pas_temps, silent = TRUE)
- })
- } else {
- if (!input$box_interannuel_seasonal$collapsed) shinydashboardPlus::updateBox("box_interannuel_seasonal", action = "toggle")
- }# end if "7"
-
- if ("8" %in% input$choix_sorties) {
-
-
- if (input$box_interannuel_summary$collapsed) shinydashboardPlus::updateBox("box_interannuel_summary", action = "toggle")
-
- selected_dc <- input$select_dc_summary_interannuel
- selected_year <- input$select_year_summary_interannuel
-
- # mise à jour du combo des DC dans la box summary quand il est vide ----------------
- if (selected_dc=="") {
- selected_dc <- as.character(ref_dc@dc_selected[1])
- updateSelectInput(session, "select_dc_summary_interannuel",
- choices = ref_dc@dc_selected,
- selected = ref_dc@dc_selected[1]
- )
- }
-
- # mise à jour du combo pour selectionner l'année de réference dans la box summary ----
-
- years <- unique(r_mig_interannual@data$bjo_annee)
-
- if (selected_year==""){
- updateSelectInput(session, "select_year_summary_interannuel",
- choices = years,
- selected = years[length(years)]
- )
- selected_year <- years[length(years)]
- }
- summary <- stacomiR::summary(r_mig_interannual, year_choice=selected_year, silent =TRUE)
- output$tab_interannuel_summary <- renderDT({
- summary[[selected_dc]]
- })
- } else {
- if (!input$box_interannuel_summary$collapsed) shinydashboardPlus::updateBox("box_interannuel_summary", action = "toggle")
- }# end if "8"
- } # end else
-
-
- observeEvent({
- DD$button_box_custom_interannuel_line()
- },{
-
- shinyCatch({
-
- palette_plot<-envir_stacomi$palette_plot
- plot_title<-envir_stacomi$plot_title
- plot_xlab<-envir_stacomi$xlab
- plot_ylab<-envir_stacomi$ylab
- theme_plot<-envir_stacomi$theme_plot
-
- g_interannuel_line <- envir_stacomi$g
- g_interannuel_line <- g_interannuel_line+
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_color_brewer(palette = palette_plot) +
- match.fun(theme_plot)()
-
-
- output$plot_interannuel_line<-renderPlot({
- g_interannuel_line
- })
-
-
- },blocking_level = "error"
- )
- },
- ignoreInit=TRUE,
- ignoreNULL = TRUE
- )
-
- observeEvent({DD$button_box_custom_interannuel_standard()
-
- },{
- shinyCatch({
-
- palette_plot<-envir_stacomi$palette_plot
- plot_title<-envir_stacomi$plot_title
- plot_xlab<-envir_stacomi$xlab
- plot_ylab<-envir_stacomi$ylab
- theme_plot<-envir_stacomi$theme_plot
-
- g_interannuel_standard <- envir_stacomi$g1
- title <- g_interannuel_standard$labels$title
- legend_title <- stringr::str_split(title,",")[[1]][3]
- the_choice <- stringr::str_split(stringr::str_split(title,",")[[1]][3],"/")[[1]][1]
- labels <- stringr::str_split(stringr::str_split(title,",")[[1]][3],"/")[[1]][2]
- g_interannuel_standard <- g_interannuel_standard +
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_fill_brewer(name=legend_title,label=c("Historical amplitude",the_choice),palette = palette_plot)+
- match.fun(theme_plot)()
-
-
- output$plot_interannuel_standard<-renderPlot({
- g_interannuel_standard
- })
-
-
- },blocking_level = "error"
- )},
- ignoreInit=TRUE,
- ignoreNULL = TRUE
- )
-
- observeEvent({DD$button_box_custom_interannuel_step()
-
- },{
- shinyCatch({
-
- palette_plot<-envir_stacomi$palette_plot
- plot_title<-envir_stacomi$plot_title
- plot_xlab<-envir_stacomi$xlab
- plot_ylab<-envir_stacomi$ylab
- theme_plot<-envir_stacomi$theme_plot
-
- g_interannuel_step <- envir_stacomi$g
-
- g_interannuel_step <- g_interannuel_step+
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_color_brewer(palette = palette_plot)+
- match.fun(theme_plot)()
-
-
- output$plot_interannuel_step<-renderPlot({
- g_interannuel_step
- })
-
-
- },blocking_level = "error"
- )},
- ignoreInit=TRUE,
- ignoreNULL = TRUE
- )
-
-# observeEvent({DD$button_box_custom_interannuel_barchart()
-#
-# },{
-# shinyCatch({
-#
-# palette_plot<-envir_stacomi$palette_plot
-# plot_title<-envir_stacomi$plot_title
-# plot_xlab<-envir_stacomi$xlab
-# plot_ylab<-envir_stacomi$ylab
-# theme_plot<-envir_stacomi$theme_plot
-#
-# g_interannuel_barchart=envir_stacomi$g
-#
-# g_interannuel_barchart <- g_interannuel_barchart+
-# ggplot2::ggtitle(plot_title) +
-# ggplot2::ylab(plot_ylab) +
-# ggplot2::xlab(plot_xlab) +
-# ggplot2::scale_fill_brewer(palette = palette_plot)+
-# match.fun(theme_plot)()
-#
-#
-# output$plot_interannuel_barchart<-renderPlot({
-# g_interannuel_barchart
-# })
-#
-#
-# },blocking_level = "error"
-# )},
-# ignoreInit=TRUE,
-# ignoreNULL = TRUE
-# )
-
-# observeEvent({DD$button_box_custom_interannuel_pointrange()
-#
-# },{
-# shinyCatch({
-#
-# palette_plot<-envir_stacomi$palette_plot
-# plot_title<-envir_stacomi$plot_title
-# plot_xlab<-envir_stacomi$xlab
-# plot_ylab<-envir_stacomi$ylab
-# theme_plot<-envir_stacomi$theme_plot
-#
-# g_interannuel_pointrange=envir_stacomi$g
-#
-# g_interannuel_pointrange <- g_interannuel_pointrange+
-# ggplot2::ggtitle(plot_title) +
-# ggplot2::ylab(plot_ylab) +
-# ggplot2::xlab(plot_xlab) +
-# ggplot2::scale_fill_brewer(palette = palette_plot)+
-# match.fun(theme_plot)()
-#
-#
-# output$plot_interannuel_pointrange<-renderPlot({
-# g_interannuel_pointrange
-# })
-#
-#
-# },blocking_level = "error"
-# )},
-# ignoreInit=TRUE,
-# ignoreNULL = TRUE
-# )
-
- observeEvent({DD$button_box_custom_interannuel_density()
-
- },{
- shinyCatch({
-
- palette_plot<-envir_stacomi$palette_plot
- plot_title<-envir_stacomi$plot_title
- plot_xlab<-envir_stacomi$xlab
- plot_ylab<-envir_stacomi$ylab
- theme_plot<-envir_stacomi$theme_plot
-
- g_interannuel_density <- envir_stacomi$g
-
- g_interannuel_density <- g_interannuel_density+
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_fill_brewer(palette = palette_plot)+
- match.fun(theme_plot)()
-
-
- output$plot_interannuel_density <- renderPlot({
- g_interannuel_density
- })
-
-
- },blocking_level = "error"
- )},
- ignoreInit=TRUE,
- ignoreNULL = TRUE
- )
-
- observeEvent({DD$button_box_custom_interannuel_seasonal()
-
- },{
- shinyCatch({
-
- palette_plot<-envir_stacomi$palette_plot
- plot_title<-envir_stacomi$plot_title
- plot_xlab<-envir_stacomi$xlab
- plot_ylab<-envir_stacomi$ylab
- theme_plot<-envir_stacomi$theme_plot
-
- g_interannuel_seasonal <- envir_stacomi$g
-
- g_interannuel_seasonal <- g_interannuel_seasonal+
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_fill_distiller(palette = palette_plot,name="Effectif")+
- match.fun(theme_plot)()
-
-
- output$plot_interannuel_seasonal<-renderPlot({
- g_interannuel_seasonal
- })
-
-
- },blocking_level = "error"
- )},
- ignoreInit=TRUE,
- ignoreNULL = TRUE
- )
-
- }) # end shiny catch
- }, ignoreInit=TRUE, ignoreNULL = TRUE)# end observeEvent
-}) # end moduleServer
+ moduleServer( id, function(input, output, session){
+ ns <- session$ns
+ #observe(print(input$box_summary_sidebar))
+ # pour la sidebar de summary, voir https://rinterface.github.io/shinydashboardPlus/articles/improved-boxes.html#box-components-1
+ observeEvent(input$box_summary_update, {
+ shinydashboardPlus::updateBoxSidebar("box_summary_sidebar")
+ })
+
+
+ observeEvent(
+ eventExpr={
+ input$bttn_interannuel
+ # les buttons qui suivent sont cachés dans la box summary
+ input$select_dc_summary_interannuel
+ input$select_year_summary_interannuel
+ },
+ handlerExpr={
+
+ shinyCatch({
+ # Bilan migration interannuel -----------------------
+ validate(need(exists("envir_stacomi"), "Le programme stacomi doit être lancé"))
+ db_connection <- envir_stacomi$db_connection
+ validate(need(!is.null(db_connection), "db needs connection"))
+ r_mig_interannual <- new("report_mig_interannual")
+ ref_dc <- base::get("ref_dc", envir=envir_stacomi)
+ validate(need(length(ref_dc@dc_selected) >0, "No dc selected"))
+ ref_taxa <- base::get("ref_taxa", envir=envir_stacomi)
+ validate(need(length(ref_taxa@taxa_selected) >0, "No taxa selected") )
+ if (length(ref_taxa@taxa_selected) >1)
+ ref_taxa@taxa_selected <- ref_taxa@taxa_selected[1]
+ ref_stage <- base::get("ref_stage", envir=envir_stacomi)
+ validate(need(length(ref_stage@stage_selected) >0, "No stage selected") )
+ if (length(ref_stage@stage_selected) >1)
+ ref_stage@stage_selected <- ref_stage@stage_selected[1]
+ req(!is.null(input$slider_interannuel_annee[2]))
+ shinybusy::show_modal_spinner(spin="flower", text="loading from db")
+ r_mig_interannual <- choice_c(r_mig_interannual,
+ dc=ref_dc@dc_selected,
+ taxa=ref_taxa@taxa_selected,
+ stage=ref_stage@stage_selected,
+ start_year=input$slider_interannuel_annee[1],
+ end_year=input$slider_interannuel_annee[2],
+ silent=TRUE)
+ r_mig_interannual <-charge(r_mig_interannual)
+ r_mig_interannual <- connect(r_mig_interannual, silent = TRUE)
+ shinybusy::remove_modal_spinner()
+ # silent = TRUE sinon redemande avant de ré-écrire
+ r_mig_interannual <- calcule(r_mig_interannual, silent = FALSE)
+
+
+
+ # graphiques et sorties ----------------------
+
+ if (nrow(r_mig_interannual@data)==0){
+ warning("no data available")
+ } else {
+ if ("1" %in% input$choix_sorties) {
+ if (input$box_interannuel_line$collapsed) shinydashboardPlus::updateBox("box_interannuel_line", action = "toggle")
+ output$plot_interannuel_line <- renderPlot({
+ stacomiR::plot(r_mig_interannual, plot.type = "line", silent = TRUE)
+ })
+ } else {
+ if (!input$box_interannuel_line$collapsed) shinydashboardPlus::updateBox("box_interannuel_line", action = "toggle")
+ }#end if "1"
+
+ if ("2" %in% input$choix_sorties) {
+ if (input$box_interannuel_standard$collapsed) shinydashboardPlus::updateBox("box_interannuel_standard", action = "toggle")
+ output$plot_interannuel_standard <- renderPlot({
+ stacomiR::plot(r_mig_interannual, plot.type = "standard", silent = TRUE)
+ })
+ } else {
+ if (!input$box_interannuel_standard$collapsed) shinydashboardPlus::updateBox("box_interannuel_standard", action = "toggle")
+ } # end if "2"
+
+ if ("3" %in% input$choix_sorties) {
+ if (input$box_interannuel_step$collapsed) shinydashboardPlus::updateBox("box_interannuel_step", action = "toggle")
+ output$plot_interannuel_step <- renderPlot({
+ stacomiR::plot(r_mig_interannual, plot.type = "step", silent = TRUE)
+ })
+ } else {
+ if (!input$box_interannuel_step$collapsed) shinydashboardPlus::updateBox("box_interannuel_step", action = "toggle")
+ }# end if "3"
+
+ if ("4" %in% input$choix_sorties) {
+ if (input$box_interannuel_barchart$collapsed) shinydashboardPlus::updateBox("box_interannuel_barchart", action = "toggle")
+ output$plot_interannuel_barchart <- renderPlot({
+ stacomiR::plot(r_mig_interannual, plot.type = "barchart", timesplit = "jour", silent = TRUE)
+ })
+ } else {
+ if (!input$box_interannuel_barchart$collapsed) shinydashboardPlus::updateBox("box_interannuel_barchart", action = "toggle")
+ }# end if "4"
+
+ if ("5" %in% input$choix_sorties) {
+ if (input$box_interannuel_pointrange$collapsed) shinydashboardPlus::updateBox("box_interannuel_pointrange", action = "toggle")
+ output$plot_interannuel_pointRange <- renderPlot({
+ stacomiR::plot(r_mig_interannual, plot.type = "pointrange", timesplit = "jour", silent = TRUE)
+ })
+ } else {
+ if (!input$box_interannuel_pointrange$collapsed) shinydashboardPlus::updateBox("box_interannuel_pointrange", action = "toggle")
+ }# end if "5"
+
+ if ("6" %in% input$choix_sorties) {
+ if (input$box_interannuel_density$collapsed) shinydashboardPlus::updateBox("box_interannuel_density", action = "toggle")
+ output$plot_interannuel_density <- renderPlot({
+ stacomiR::plot(r_mig_interannual, plot.type = "density", silent = TRUE)
+ })
+ } else {
+ if (!input$box_interannuel_density$collapsed) shinydashboardPlus::updateBox("box_interannuel_density", action = "toggle")
+ }# end if "6"
+
+ if ("7" %in% input$choix_sorties) {
+ if (input$box_interannuel_seasonal$collapsed) shinydashboardPlus::updateBox("box_interannuel_seasonal", action = "toggle")
+ output$plot_interannuel_seasonal <- renderPlot({
+ stacomiR::plot(r_mig_interannual, plot.type = "seasonal", timesplit = "jour", silent = TRUE)
+ })
+ } else {
+ if (!input$box_interannuel_seasonal$collapsed) shinydashboardPlus::updateBox("box_interannuel_seasonal", action = "toggle")
+ }# end if "7"
+
+ if ("8" %in% input$choix_sorties) {
+
+
+ if (input$box_interannuel_summary$collapsed) shinydashboardPlus::updateBox("box_interannuel_summary", action = "toggle")
+
+ selected_dc <- input$select_dc_summary_interannuel
+ selected_year <- input$select_year_summary_interannuel
+
+ # mise à jour du combo des DC dans la box summary quand il est vide ----------------
+ if (selected_dc=="") {
+ selected_dc <- as.character(ref_dc@dc_selected[1])
+ updateSelectInput(session, "select_dc_summary_interannuel",
+ choices = ref_dc@dc_selected,
+ selected = ref_dc@dc_selected[1]
+ )
+ }
+
+ # mise à jour du combo pour selectionner l'année de réference dans la box summary ----
+
+ years <- unique(r_mig_interannual@data$bjo_annee)
+
+ if (selected_year==""){
+ updateSelectInput(session, "select_year_summary_interannuel",
+ choices = years,
+ selected = years[length(years)]
+ )
+ selected_year <- years[length(years)]
+ }
+ summary <- stacomiR::summary(r_mig_interannual, year_choice=selected_year, silent =TRUE)
+ output$tab_interannuel_summary <- renderDT({
+ summary[[selected_dc]]
+ })
+ } else {
+ if (!input$box_interannuel_summary$collapsed) shinydashboardPlus::updateBox("box_interannuel_summary", action = "toggle")
+ }# end if "8"
+ } # end else
+
+
+ observeEvent({
+ DD$button_box_custom_interannuel_line()
+ },{
+
+ shinyCatch({
+
+ palette_plot<-envir_stacomi$palette_plot
+ plot_title<-envir_stacomi$plot_title
+ plot_xlab<-envir_stacomi$xlab
+ plot_ylab<-envir_stacomi$ylab
+ theme_plot<-envir_stacomi$theme_plot
+
+ g_interannuel_line <- envir_stacomi$g_line
+ g_interannuel_line <- g_interannuel_line+
+ ggplot2::ggtitle(plot_title) +
+ ggplot2::ylab(plot_ylab) +
+ ggplot2::xlab(plot_xlab) +
+ ggplot2::scale_color_brewer(palette = palette_plot) +
+ match.fun(theme_plot)()
+
+
+ output$plot_interannuel_line<-renderPlot({
+ g_interannuel_line
+ })
+
+
+ },blocking_level = "error"
+ )
+ },
+ ignoreInit=TRUE,
+ ignoreNULL = TRUE
+ )
+
+ observeEvent({DD$button_box_custom_interannuel_standard()
+
+ },{
+ shinyCatch({
+
+ palette_plot<-envir_stacomi$palette_plot
+ plot_title<-envir_stacomi$plot_title
+ plot_xlab<-envir_stacomi$xlab
+ plot_ylab<-envir_stacomi$ylab
+ theme_plot<-envir_stacomi$theme_plot
+
+ g_interannuel_standard <- envir_stacomi$g_standard
+ title <- g_interannuel_standard$labels$title
+ legend_title <- stringr::str_split(title,",")[[1]][3]
+ the_choice <- stringr::str_split(stringr::str_split(title,",")[[1]][3],"/")[[1]][1]
+ labels <- stringr::str_split(stringr::str_split(title,",")[[1]][3],"/")[[1]][2]
+ g_interannuel_standard <- g_interannuel_standard +
+ ggplot2::ggtitle(plot_title) +
+ ggplot2::ylab(plot_ylab) +
+ ggplot2::xlab(plot_xlab) +
+ ggplot2::scale_fill_brewer(name=legend_title,label=c("Historical amplitude",the_choice),palette = palette_plot)+
+ match.fun(theme_plot)()
+
+
+ output$plot_interannuel_standard<-renderPlot({
+ g_interannuel_standard
+ })
+
+
+ },blocking_level = "error"
+ )},
+ ignoreInit=TRUE,
+ ignoreNULL = TRUE
+ )
+
+ observeEvent({DD$button_box_custom_interannuel_step()
+
+ },{
+ shinyCatch({
+
+ palette_plot<-envir_stacomi$palette_plot
+ plot_title<-envir_stacomi$plot_title
+ plot_xlab<-envir_stacomi$xlab
+ plot_ylab<-envir_stacomi$ylab
+ theme_plot<-envir_stacomi$theme_plot
+
+ g_interannuel_step <- envir_stacomi$g_step
+
+ g_interannuel_step <- g_interannuel_step+
+ ggplot2::ggtitle(plot_title) +
+ ggplot2::ylab(plot_ylab) +
+ ggplot2::xlab(plot_xlab) +
+ ggplot2::scale_color_brewer(palette = palette_plot)+
+ match.fun(theme_plot)()
+
+
+ output$plot_interannuel_step<-renderPlot({
+ g_interannuel_step
+ })
+
+
+ },blocking_level = "error"
+ )},
+ ignoreInit=TRUE,
+ ignoreNULL = TRUE
+ )
+
+ observeEvent({DD$button_box_custom_interannuel_barchart()
+
+ },{
+ shinyCatch({
+
+
+ palette_plot<-envir_stacomi$palette_plot
+ plot_title<-envir_stacomi$plot_title
+ plot_xlab<-envir_stacomi$xlab
+ plot_ylab<-envir_stacomi$ylab
+ theme_plot<-envir_stacomi$theme_plot
+ pas_temps <- envir_stacomi$pas_temps
+ g_interannuel_barchart <- envir_stacomi$g_barchart
+
+ g_interannuel_barchart <- g_interannuel_barchart+
+ ggplot2::ggtitle(plot_title) +
+ ggplot2::ylab(plot_ylab) +
+ ggplot2::xlab(plot_xlab) +
+ ggplot2::scale_fill_brewer(palette = palette_plot)+
+ match.fun(theme_plot)()
+
+ output$plot_interannuel_barchart <- renderPlot({
+ stacomiR::plot(r_mig_interannual, plot.type = "barchart", timesplit = pas_temps, silent = TRUE)
+ })
+
+
+ },blocking_level = "error"
+ )},
+ ignoreInit=TRUE,
+ ignoreNULL = TRUE
+ )
+
+ observeEvent({DD$button_box_custom_interannuel_pointrange()
+
+ },{
+ shinyCatch({
+
+ palette_plot<-envir_stacomi$palette_plot
+ plot_title<-envir_stacomi$plot_title
+ plot_xlab<-envir_stacomi$xlab
+ plot_ylab<-envir_stacomi$ylab
+ theme_plot<-envir_stacomi$theme_plot
+
+ g_interannuel_pointrange=envir_stacomi$g_pointrange
+
+ g_interannuel_pointrange <- g_interannuel_pointrange+
+ ggplot2::ggtitle(plot_title) +
+ ggplot2::ylab(plot_ylab) +
+ ggplot2::xlab(plot_xlab) +
+ ggplot2::scale_fill_brewer(palette = palette_plot)+
+ match.fun(theme_plot)()
+
+
+ output$plot_interannuel_pointrange<-renderPlot({
+ g_interannuel_pointrange
+ })
+
+
+ },blocking_level = "error"
+ )},
+ ignoreInit=TRUE,
+ ignoreNULL = TRUE
+ )
+
+ observeEvent({DD$button_box_custom_interannuel_density()
+
+ },{
+ shinyCatch({
+
+ palette_plot<-envir_stacomi$palette_plot
+ plot_title<-envir_stacomi$plot_title
+ plot_xlab<-envir_stacomi$xlab
+ plot_ylab<-envir_stacomi$ylab
+ theme_plot<-envir_stacomi$theme_plot
+
+ g_interannuel_density <- envir_stacomi$g_density
+
+ g_interannuel_density <- g_interannuel_density+
+ ggplot2::ggtitle(plot_title) +
+ ggplot2::ylab(plot_ylab) +
+ ggplot2::xlab(plot_xlab) +
+ ggplot2::scale_fill_brewer(palette = palette_plot)+
+ match.fun(theme_plot)()
+
+
+ output$plot_interannuel_density <- renderPlot({
+ g_interannuel_density
+ })
+
+
+ },blocking_level = "error"
+ )},
+ ignoreInit=TRUE,
+ ignoreNULL = TRUE
+ )
+
+ observeEvent({DD$button_box_custom_interannuel_seasonal()
+
+ },{
+ shinyCatch({
+
+ palette_plot<-envir_stacomi$palette_plot
+ plot_title<-envir_stacomi$plot_title
+ plot_xlab<-envir_stacomi$xlab
+ plot_ylab<-envir_stacomi$ylab
+ theme_plot<-envir_stacomi$theme_plot
+
+ g_interannuel_seasonal <- envir_stacomi$g_seasonal
+
+ g_interannuel_seasonal <- g_interannuel_seasonal+
+ ggplot2::ggtitle(plot_title) +
+ ggplot2::ylab(plot_ylab) +
+ ggplot2::xlab(plot_xlab) +
+ ggplot2::scale_fill_distiller(palette = palette_plot,name="Effectif")+
+ match.fun(theme_plot)()
+
+
+ output$plot_interannuel_seasonal<-renderPlot({
+ g_interannuel_seasonal
+ })
+
+
+ },blocking_level = "error"
+ )},
+ ignoreInit=TRUE,
+ ignoreNULL = TRUE
+ )
+
+ }) # end shiny catch
+ }, ignoreInit=TRUE, ignoreNULL = TRUE)# end observeEvent
+ }) # end moduleServer
}
## To be copied in the UI
diff --git a/dev/run_dev.R b/dev/run_dev.R
index 203634b..103fc57 100644
--- a/dev/run_dev.R
+++ b/dev/run_dev.R
@@ -1,11 +1,24 @@
-# Set options here
-# setwd("C:\\workspace\\stacoshiny")
+rm(list=ls(all.names = TRUE))
+getUsername <- function(){
+ name <- Sys.info()[["user"]]
+ return(name)
+}
+if (getUsername() == "cedric.briand") {
+ wdshiny <- "C:/workspace/stacoshiny"
+ wdstacomiR <- "C:\\workspace\\stacomir"
+ wdstacomirtools <-"C:\\workspace\\stacomirtools"
+ }
+# else if (getUsername() == "xxxx")){
+# }
+
+setwd(wdshiny)
+
golem::set_golem_options()
options(golem.app.prod = FALSE) # TRUE = production mode, FALSE = development mode
# Detach all loaded packages and clean your environment
#golem::detach_all_attached()
-rm(list=ls(all.names = TRUE))
+
# Document and reload your package
# remotes::install_deps(upgrade='never')
@@ -14,8 +27,8 @@ rm(list=ls(all.names = TRUE))
golem::document_and_reload()
-devtools::load_all("C:\\workspace\\stacomir")
-devtools::load_all("C:\\workspace\\stacomirtools")
+devtools::load_all(wdstacomiR)
+devtools::load_all(wdstacomirtools)
#options(shiny.error = browser)
spsComps:::spsOption("traceback", TRUE)
stacoshiny() # options=list(port= 3882, host= "127.0.0.1", launch.browser= FALSE)
--
GitLab
From 1fa544379b7513b58ad2fa200e11212ebee28eaf Mon Sep 17 00:00:00 2001
From: cedricbriandgithub <cedric.briand@eptb-vilaine.fr>
Date: Fri, 13 Oct 2023 15:25:48 +0200
Subject: [PATCH 33/47] dev: barchart interactive OK
---
R/app_server.R | 8 +++---
R/mod_custom_plot_interannual.R | 27 +++++++++++++++---
R/mod_interannuel.R | 50 +++++++++++++++++++--------------
R/mod_ref_dc.R | 3 +-
4 files changed, 58 insertions(+), 30 deletions(-)
diff --git a/R/app_server.R b/R/app_server.R
index de1e63d..0f3bc2d 100644
--- a/R/app_server.R
+++ b/R/app_server.R
@@ -15,7 +15,7 @@ app_server <- function( input, output, session ) {
# migr_mult -------------------------------------------------
- mod_migr_mult_server("migr_mult_ui_1",DD)
+mod_migr_mult_server("migr_mult_ui_1",DD)
# le mod_ref_taxa est réutilisé par les différents modules, son id (ici "ref_taxa_mod_migr_mult") change...
DD$button_ref_taxa_migr_mult <- mod_ref_taxa_server("ref_taxa_mod_migr_mult", DD, mytab="migr_mult")
@@ -33,7 +33,7 @@ app_server <- function( input, output, session ) {
# interannuel ---------------------------------------------------
- mod_interannuel_server("interannuel_ui_1",DD)
+ DD$button_interannuel <- mod_interannuel_server("interannuel_ui_1",DD)
DD$button_ref_taxa_interannuel <- mod_ref_taxa_server("ref_taxa_mod_interannuel", DD, mytab="interannuel")
DD$button_ref_stage_interannuel <- mod_ref_stage_server("ref_stage_mod_interannuel", DD, mytab="interannuel")
DD$button_box_custom_interannuel_line<-mod_custom_plot_server("custom_plot_interannuel_line",DD,mytab="interannuel")
@@ -42,9 +42,9 @@ app_server <- function( input, output, session ) {
DD$button_box_custom_interannuel_barchart<-mod_custom_plot_interannual_server("custom_plot_interannuel_barchart",DD,mytab="interannuel")
- DD$button_box_custom_interannuel_pointrange<-mod_custom_plot_server("custom_plot_interannuel_pointrange",DD,mytab="interannuel")
+ DD$button_box_custom_interannuel_pointrange<-mod_custom_plot_interannual_server("custom_plot_interannuel_pointrange",DD,mytab="interannuel")
DD$button_box_custom_interannuel_density<-mod_custom_plot_server("custom_plot_interannuel_density",DD,mytab="interannuel")
- DD$button_box_custom_interannuel_seasonal<-mod_custom_plot_server("custom_plot_interannuel_seasonal",DD,mytab="interannuel")
+ DD$button_box_custom_interannuel_seasonal<-mod_custom_plot_interannual_server("custom_plot_interannuel_seasonal",DD,mytab="interannuel")
# especes ---------------------------------------------------
diff --git a/R/mod_custom_plot_interannual.R b/R/mod_custom_plot_interannual.R
index e3967c2..a43e9b2 100644
--- a/R/mod_custom_plot_interannual.R
+++ b/R/mod_custom_plot_interannual.R
@@ -11,14 +11,18 @@
#' @importFrom shiny NS tagList
mod_custom_plot_interannual_ui <- function(id){
ns <- NS(id)
- tagList(
-
+ tagList(
spsDepend("toastr"),
selectizeInput(ns('pas_temps'),
h5('Choisissez un d\u00e9coupage :'),
selected="jour",
choices = c("Jour"="jour","Semaine"="semaine","Mois"="mois","Quinzaine"="quinzaine"),
multiple = FALSE),
+ selectizeInput(ns("year_choice"),
+ h5("choisissez l'année à comparer à l'historique :"),
+ selected=NULL,
+ choices = NULL,
+ multiple=FALSE),
textInput(
inputId = ns("plot_title"),
label = "titre",
@@ -58,9 +62,12 @@ mod_custom_plot_interannual_ui <- function(id){
mod_custom_plot_interannual_server <- function(id,DD,mytab){
moduleServer( id, function(input, output, session){
ns <- session$ns
- observeEvent({
+ observeEvent(
+ eventExpr={
DD$login_button()
- },{
+ DD$button_interannuel()
+ },
+ handlerExpr = {
shinyCatch({
palette_plot<-rownames(RColorBrewer::brewer.pal.info)
@@ -77,8 +84,19 @@ mod_custom_plot_interannual_server <- function(id,DD,mytab){
choices = theme_plot
)
+ DD$annees_disponibles <- envir_stacomi$annees_disponibles
+
+
+
}, blocking_level = "error")
+
+ observe(
+ if (!is.null(DD$annees_disponibles)) {
+ updateSelectInput(session, "year_choice",
+ choices = DD$annees_disponibles
+
+ )})
},
ignoreInit=TRUE,
ignoreNULL=TRUE,
@@ -96,6 +114,7 @@ mod_custom_plot_interannual_server <- function(id,DD,mytab){
assign("xlab",input$plot_xlab,envir = envir_stacomi)
assign("ylab",input$plot_ylab,envir = envir_stacomi)
assign("pas_temps", input$pas_temps, envir=envir_stacomi)
+ assign("year_choice", input$year_choice, envir=envir_stacomi)
}, blocking_level = "error")
},
diff --git a/R/mod_interannuel.R b/R/mod_interannuel.R
index 428462d..1fc341a 100644
--- a/R/mod_interannuel.R
+++ b/R/mod_interannuel.R
@@ -105,13 +105,13 @@ mod_interannuel_ui <- function(id){
solidHeader = TRUE,
collapsible = TRUE,
collapsed=TRUE,
- #TODO CEDRIC
+
sidebar = shinydashboardPlus::boxSidebar(
id = ns("box_interannuel_pointrange_sidebar"),
width = 25,
mod_custom_plot_interannual_ui("custom_plot_interannuel_pointrange"),
),
- plotOutput(ns("plot_interannuel_pointRange"))),
+ plotOutput(ns("plot_interannuel_pointrange"))),
shinydashboardPlus::box(
id=ns("box_interannuel_density"),
title="density",
@@ -135,7 +135,7 @@ mod_interannuel_ui <- function(id){
sidebar = shinydashboardPlus::boxSidebar(
id = ns("box_interannuel_seasonal_sidebar"),
width = 25,
- mod_custom_plot_ui("custom_plot_interannuel_seasonal"),
+ mod_custom_plot_interannual_ui("custom_plot_interannuel_seasonal"),
),
plotOutput(ns("plot_interannuel_seasonal"))),
shinydashboardPlus::box(
@@ -221,7 +221,8 @@ mod_interannuel_server <- function(id,DD){
shinybusy::remove_modal_spinner()
# silent = TRUE sinon redemande avant de ré-écrire
r_mig_interannual <- calcule(r_mig_interannual, silent = FALSE)
-
+ annees_disponibles <- unique(r_mig_interannual@data$bjo_annee)
+ assign("annees_disponibles", annees_disponibles, envir=envir_stacomi)
# graphiques et sorties ----------------------
@@ -267,7 +268,7 @@ mod_interannuel_server <- function(id,DD){
if ("5" %in% input$choix_sorties) {
if (input$box_interannuel_pointrange$collapsed) shinydashboardPlus::updateBox("box_interannuel_pointrange", action = "toggle")
- output$plot_interannuel_pointRange <- renderPlot({
+ output$plot_interannuel_pointrange <- renderPlot({
stacomiR::plot(r_mig_interannual, plot.type = "pointrange", timesplit = "jour", silent = TRUE)
})
} else {
@@ -435,24 +436,27 @@ mod_interannuel_server <- function(id,DD){
},{
shinyCatch({
-
+ # this comes from the module
palette_plot<-envir_stacomi$palette_plot
plot_title<-envir_stacomi$plot_title
plot_xlab<-envir_stacomi$xlab
plot_ylab<-envir_stacomi$ylab
theme_plot<-envir_stacomi$theme_plot
pas_temps <- envir_stacomi$pas_temps
- g_interannuel_barchart <- envir_stacomi$g_barchart
+
+ year_choice <- envir_stacomi$year_choice
+ stacomiR::plot(r_mig_interannual, plot.type = "barchart", timesplit = pas_temps, year_choice=year_choice, silent = TRUE)
+ g_interannuel_barchart <- envir_stacomi$g_barchart
g_interannuel_barchart <- g_interannuel_barchart+
ggplot2::ggtitle(plot_title) +
ggplot2::ylab(plot_ylab) +
ggplot2::xlab(plot_xlab) +
ggplot2::scale_fill_brewer(palette = palette_plot)+
match.fun(theme_plot)()
-
+
output$plot_interannuel_barchart <- renderPlot({
- stacomiR::plot(r_mig_interannual, plot.type = "barchart", timesplit = pas_temps, silent = TRUE)
+ g_interannuel_barchart
})
@@ -467,20 +471,21 @@ mod_interannuel_server <- function(id,DD){
},{
shinyCatch({
- palette_plot<-envir_stacomi$palette_plot
- plot_title<-envir_stacomi$plot_title
- plot_xlab<-envir_stacomi$xlab
- plot_ylab<-envir_stacomi$ylab
- theme_plot<-envir_stacomi$theme_plot
-
- g_interannuel_pointrange=envir_stacomi$g_pointrange
-
- g_interannuel_pointrange <- g_interannuel_pointrange+
+ palette_plot <- envir_stacomi$palette_plot
+ plot_title <- envir_stacomi$plot_title
+ plot_xlab <- envir_stacomi$xlab
+ plot_ylab <- envir_stacomi$ylab
+ theme_plot <- envir_stacomi$theme_plot
+ pas_temps <- envir_stacomi$pas_temps
+ if (is.null(pas_temps)) pas_temps <- "jour"
+ stacomiR::plot(r_mig_interannual, plot.type = "pointrange", timesplit = pas_temps, silent = TRUE)
+ g_interannuel_pointrange <- envir_stacomi$g_pointrange
+ g_interannuel_pointrange <- g_interannuel_pointrange +
ggplot2::ggtitle(plot_title) +
ggplot2::ylab(plot_ylab) +
ggplot2::xlab(plot_xlab) +
- ggplot2::scale_fill_brewer(palette = palette_plot)+
- match.fun(theme_plot)()
+ ggplot2::scale_fill_brewer(palette = palette_plot) +
+ match.fun(theme_plot)()
output$plot_interannuel_pointrange<-renderPlot({
@@ -560,7 +565,10 @@ mod_interannuel_server <- function(id,DD){
}) # end shiny catch
}, ignoreInit=TRUE, ignoreNULL = TRUE)# end observeEvent
- }) # end moduleServer
+ return(reactive(input$bttn_interannuel))
+ }
+
+ ) # end moduleServer
}
## To be copied in the UI
diff --git a/R/mod_ref_dc.R b/R/mod_ref_dc.R
index 14c036b..a78a36d 100644
--- a/R/mod_ref_dc.R
+++ b/R/mod_ref_dc.R
@@ -54,7 +54,8 @@ mod_ref_dc_server <- function(id, DD) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
# when observing on a button , it's good to set ignoreInit to TRUE, for dynamically created buttons
- observeEvent(eventExpr = {
+ observeEvent(
+ eventExpr ={
DD$login_button()
DD$button_ref_schema()
},
--
GitLab
From 46896c2344cbbc08f49acdcab9366f6fe02d23df Mon Sep 17 00:00:00 2001
From: cedricbriandgithub <cedric.briand@eptb-vilaine.fr>
Date: Tue, 17 Oct 2023 15:31:52 +0200
Subject: [PATCH 34/47] Fix issues when connected but not enough permissions to
read tables => now sends a warning
---
R/mod_ref_schema.R | 6 +++++-
1 file changed, 5 insertions(+), 1 deletion(-)
diff --git a/R/mod_ref_schema.R b/R/mod_ref_schema.R
index ba3ff4f..607e4f7 100644
--- a/R/mod_ref_schema.R
+++ b/R/mod_ref_schema.R
@@ -59,13 +59,17 @@ mod_ref_schema_server <- function(id, DD) {
shinybusy::show_modal_spinner(text = "loading from db") # show the modal window
schema <- fun_schema()
shinybusy::remove_modal_spinner() # remove it when done
+ if (nrow(schema)==0){
+ res<- capture.output(fun_schema())
+ warning(res[1])
+ }
# cat(DD$ref_dc@data$df_code)
# output$test_text <- renderText(envir_stacomi$db_connection@base)
updateSelectInput(session, "select_ref_schema", choices = schema$org_code, selected = schema[1])
# cat("TEST2\n")
},
- blocking_level = "error")
+ blocking_level = "warning")
},
ignoreInit = TRUE,
ignoreNULL = TRUE
--
GitLab
From cc8c179a26b814d5023df68d72600ceafcdbb132 Mon Sep 17 00:00:00 2001
From: cedricbriandgithub <cedric.briand@eptb-vilaine.fr>
Date: Tue, 17 Oct 2023 17:35:00 +0200
Subject: [PATCH 35/47] dev : deploy app
---
.Rbuildignore | 2 ++
DESCRIPTION | 3 ++-
2 files changed, 4 insertions(+), 1 deletion(-)
diff --git a/.Rbuildignore b/.Rbuildignore
index 4517734..74cb3a1 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -13,3 +13,5 @@ $run_dev.*
^Jenkinsfile$
^\.gitlab-ci\.yml$
^ci
+^app\.R$
+^rsconnect$
diff --git a/DESCRIPTION b/DESCRIPTION
index c5dc18e..f6dce02 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -26,7 +26,8 @@ Imports:
dplyr,
rlang,
shinybusy,
- magrittr
+ magrittr,
+ pkgload
Encoding: UTF-8
LazyData: true
RoxygenNote: 7.2.3
--
GitLab
From 22c89b8980477a7a9a29f45c80f8b3e4ce4b0a4b Mon Sep 17 00:00:00 2001
From: cedricbriandgithub <cedric.briand@eptb-vilaine.fr>
Date: Tue, 17 Oct 2023 17:35:00 +0200
Subject: [PATCH 36/47] dev : deploy app
---
.Rbuildignore | 2 ++
DESCRIPTION | 3 ++-
R/_disable_autoload.R | 3 +++
app.R | 7 +++++++
4 files changed, 14 insertions(+), 1 deletion(-)
create mode 100644 R/_disable_autoload.R
create mode 100644 app.R
diff --git a/.Rbuildignore b/.Rbuildignore
index 4517734..74cb3a1 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -13,3 +13,5 @@ $run_dev.*
^Jenkinsfile$
^\.gitlab-ci\.yml$
^ci
+^app\.R$
+^rsconnect$
diff --git a/DESCRIPTION b/DESCRIPTION
index c5dc18e..f6dce02 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -26,7 +26,8 @@ Imports:
dplyr,
rlang,
shinybusy,
- magrittr
+ magrittr,
+ pkgload
Encoding: UTF-8
LazyData: true
RoxygenNote: 7.2.3
diff --git a/R/_disable_autoload.R b/R/_disable_autoload.R
new file mode 100644
index 0000000..a8c9436
--- /dev/null
+++ b/R/_disable_autoload.R
@@ -0,0 +1,3 @@
+# Disabling shiny autoload
+
+# See ?shiny::loadSupport for more information
diff --git a/app.R b/app.R
new file mode 100644
index 0000000..0022328
--- /dev/null
+++ b/app.R
@@ -0,0 +1,7 @@
+# Launch the ShinyApp (Do not remove this comment)
+# To deploy, run: rsconnect::deployApp()
+# Or use the blue button on top of this file
+
+pkgload::load_all(export_all = FALSE,helpers = FALSE,attach_testthat = FALSE)
+options( "golem.app.prod" = TRUE)
+stacoshiny::run_app() # add parameters here (if any)
--
GitLab
From 7117a4386902fa140da41002c3e006cd3eaf99e9 Mon Sep 17 00:00:00 2001
From: cedricbriandgithub <cedric.briand@eptb-vilaine.fr>
Date: Tue, 17 Oct 2023 18:00:24 +0200
Subject: [PATCH 37/47] dev : add runapp to namespace
---
NAMESPACE | 1 +
1 file changed, 1 insertion(+)
diff --git a/NAMESPACE b/NAMESPACE
index 90aed20..17cd98b 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,6 +1,7 @@
# Generated by roxygen2: do not edit by hand
export(stacoshiny)
+export(run_app)
import(shiny)
import(stacomirtools)
importFrom(DT,DTOutput)
--
GitLab
From 4bb8296117af579f58d7864588c4dbee97f232df Mon Sep 17 00:00:00 2001
From: cedricbriandgithub <cedric.briand@eptb-vilaine.fr>
Date: Tue, 17 Oct 2023 18:08:57 +0200
Subject: [PATCH 38/47] dev : running stacoshiny trials
---
NAMESPACE | 1 -
app.R | 2 +-
2 files changed, 1 insertion(+), 2 deletions(-)
diff --git a/NAMESPACE b/NAMESPACE
index 17cd98b..90aed20 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,7 +1,6 @@
# Generated by roxygen2: do not edit by hand
export(stacoshiny)
-export(run_app)
import(shiny)
import(stacomirtools)
importFrom(DT,DTOutput)
diff --git a/app.R b/app.R
index 0022328..34d3c1a 100644
--- a/app.R
+++ b/app.R
@@ -4,4 +4,4 @@
pkgload::load_all(export_all = FALSE,helpers = FALSE,attach_testthat = FALSE)
options( "golem.app.prod" = TRUE)
-stacoshiny::run_app() # add parameters here (if any)
+stacoshiny::stacoshiny() # add parameters here (if any)
--
GitLab
From 925e0f8ff855e09f2e851d751aa79d6ebf2afe5b Mon Sep 17 00:00:00 2001
From: cedricbriandgithub <cedric.briand@eptb-vilaine.fr>
Date: Thu, 19 Oct 2023 11:04:19 +0200
Subject: [PATCH 39/47] dev : finished adding custom choice for year and
timestep fixes #30
---
R/app_server.R | 14 ++++-----
R/mod_custom_plot_interannual.R | 54 +++++++++++++++++++++------------
R/mod_interannuel.R | 26 ++++++++++------
3 files changed, 59 insertions(+), 35 deletions(-)
diff --git a/R/app_server.R b/R/app_server.R
index 0f3bc2d..b8639da 100644
--- a/R/app_server.R
+++ b/R/app_server.R
@@ -36,15 +36,15 @@ mod_migr_mult_server("migr_mult_ui_1",DD)
DD$button_interannuel <- mod_interannuel_server("interannuel_ui_1",DD)
DD$button_ref_taxa_interannuel <- mod_ref_taxa_server("ref_taxa_mod_interannuel", DD, mytab="interannuel")
DD$button_ref_stage_interannuel <- mod_ref_stage_server("ref_stage_mod_interannuel", DD, mytab="interannuel")
- DD$button_box_custom_interannuel_line<-mod_custom_plot_server("custom_plot_interannuel_line",DD,mytab="interannuel")
- DD$button_box_custom_interannuel_standard<-mod_custom_plot_server("custom_plot_interannuel_standard",DD,mytab="interannuel")
- DD$button_box_custom_interannuel_step<-mod_custom_plot_server("custom_plot_interannuel_step",DD,mytab="interannuel")
+ DD$button_box_custom_interannuel_line <- mod_custom_plot_interannual_server("custom_plot_interannuel_line",DD,mytab="interannuel", show_pas_temps=FALSE)
+ DD$button_box_custom_interannuel_standard <- mod_custom_plot_server("custom_plot_interannuel_standard",DD,mytab="interannuel")
+ DD$button_box_custom_interannuel_step <- mod_custom_plot_interannual_server("custom_plot_interannuel_step",DD,mytab="interannuel", show_pas_temps=FALSE)
- DD$button_box_custom_interannuel_barchart<-mod_custom_plot_interannual_server("custom_plot_interannuel_barchart",DD,mytab="interannuel")
+ DD$button_box_custom_interannuel_barchart <- mod_custom_plot_interannual_server("custom_plot_interannuel_barchart",DD,mytab="interannuel")
- DD$button_box_custom_interannuel_pointrange<-mod_custom_plot_interannual_server("custom_plot_interannuel_pointrange",DD,mytab="interannuel")
- DD$button_box_custom_interannuel_density<-mod_custom_plot_server("custom_plot_interannuel_density",DD,mytab="interannuel")
- DD$button_box_custom_interannuel_seasonal<-mod_custom_plot_interannual_server("custom_plot_interannuel_seasonal",DD,mytab="interannuel")
+ DD$button_box_custom_interannuel_pointrange <- mod_custom_plot_interannual_server("custom_plot_interannuel_pointrange",DD,mytab="interannuel")
+ DD$button_box_custom_interannuel_density <- mod_custom_plot_server("custom_plot_interannuel_density",DD,mytab="interannuel")
+ DD$button_box_custom_interannuel_seasonal <- mod_custom_plot_interannual_server("custom_plot_interannuel_seasonal",DD,mytab="interannuel", show_year_choice =FALSE)
# especes ---------------------------------------------------
diff --git a/R/mod_custom_plot_interannual.R b/R/mod_custom_plot_interannual.R
index a43e9b2..2f1c514 100644
--- a/R/mod_custom_plot_interannual.R
+++ b/R/mod_custom_plot_interannual.R
@@ -13,16 +13,8 @@ mod_custom_plot_interannual_ui <- function(id){
ns <- NS(id)
tagList(
spsDepend("toastr"),
- selectizeInput(ns('pas_temps'),
- h5('Choisissez un d\u00e9coupage :'),
- selected="jour",
- choices = c("Jour"="jour","Semaine"="semaine","Mois"="mois","Quinzaine"="quinzaine"),
- multiple = FALSE),
- selectizeInput(ns("year_choice"),
- h5("choisissez l'année à comparer à l'historique :"),
- selected=NULL,
- choices = NULL,
- multiple=FALSE),
+ uiOutput(ns('pas_temps')),
+ uiOutput(ns("year_choice")),
textInput(
inputId = ns("plot_title"),
label = "titre",
@@ -57,17 +49,42 @@ mod_custom_plot_interannual_ui <- function(id){
}
#' custom_plot Server Functions
-#'
+
#' @noRd
-mod_custom_plot_interannual_server <- function(id,DD,mytab){
+#' @param show_pas_temps Do you wish to have the pas_temps in server (must be compatible with UI so check)
+#' @param show_year_choice Do you wish to have the year_choice in server (must be compatible with UI so check)
+mod_custom_plot_interannual_server <- function(id, DD, mytab, show_pas_temps=TRUE, show_year_choice =TRUE){
moduleServer( id, function(input, output, session){
ns <- session$ns
+ output$pas_temps <- renderUI({
+ if (show_pas_temps) {
+ selectizeInput(ns('pas_temps'),
+ h5('Choisissez un d\u00e9coupage :'),
+ selected="jour",
+ choices = c("Jour"="jour","Semaine"="semaine","Mois"="mois","Quinzaine"="quinzaine"),
+ multiple = FALSE)
+ }})
+ output$year_choice <- renderUI({
+ if (show_year_choice) {
+ selectizeInput(ns("year_choice"),
+ h5("choisissez l'année à comparer à l'historique :"),
+ selected=tail(DD$annees_disponibles,1),
+ choices = DD$annees_disponibles,
+ multiple=FALSE)
+ }})
+# observe(
+# if (!is.null(DD$annees_disponibles)) {
+# updateSelectInput(session, "year_choice",
+# choices = DD$annees_disponibles
+#
+# )})
observeEvent(
eventExpr={
DD$login_button()
DD$button_interannuel()
},
handlerExpr = {
+
shinyCatch({
palette_plot<-rownames(RColorBrewer::brewer.pal.info)
@@ -85,18 +102,13 @@ mod_custom_plot_interannual_server <- function(id,DD,mytab){
)
DD$annees_disponibles <- envir_stacomi$annees_disponibles
-
+
}, blocking_level = "error")
-
- observe(
- if (!is.null(DD$annees_disponibles)) {
- updateSelectInput(session, "year_choice",
- choices = DD$annees_disponibles
- )})
+
},
ignoreInit=TRUE,
ignoreNULL=TRUE,
@@ -114,7 +126,11 @@ mod_custom_plot_interannual_server <- function(id,DD,mytab){
assign("xlab",input$plot_xlab,envir = envir_stacomi)
assign("ylab",input$plot_ylab,envir = envir_stacomi)
assign("pas_temps", input$pas_temps, envir=envir_stacomi)
+ if (!is.null(input$year_choice)){
assign("year_choice", input$year_choice, envir=envir_stacomi)
+ } else {
+ assign("year_choice", tail(DD$annees_disponibles, 1), envir=envir_stacomi)
+ }
}, blocking_level = "error")
},
diff --git a/R/mod_interannuel.R b/R/mod_interannuel.R
index 1fc341a..ce9236e 100644
--- a/R/mod_interannuel.R
+++ b/R/mod_interannuel.R
@@ -56,7 +56,7 @@ mod_interannuel_ui <- function(id){
sidebar = shinydashboardPlus::boxSidebar(
id = ns("box_interannuel_line_sidebar"),
width = 25,
- mod_custom_plot_ui("custom_plot_interannuel_line"),
+ mod_custom_plot_interannual_ui("custom_plot_interannuel_line"),
),
plotOutput(ns("plot_interannuel_line"))),
shinydashboardPlus::box(
@@ -69,7 +69,7 @@ mod_interannuel_ui <- function(id){
sidebar = shinydashboardPlus::boxSidebar(
id = ns("box_interannuel_standard_sidebar"),
width = 25,
- mod_custom_plot_ui("custom_plot_interannuel_standard"),
+ mod_custom_plot_interannual_ui("custom_plot_interannuel_standard"),
),
plotOutput(ns("plot_interannuel_standard"))),
shinydashboardPlus::box(
@@ -82,7 +82,7 @@ mod_interannuel_ui <- function(id){
sidebar = shinydashboardPlus::boxSidebar(
id = ns("box_interannuel_step_sidebar"),
width = 25,
- mod_custom_plot_ui("custom_plot_interannuel_step"),
+ mod_custom_plot_interannual_ui("custom_plot_interannuel_step"),
),
plotOutput(ns("plot_interannuel_step"))),
shinydashboardPlus::box(
@@ -342,7 +342,10 @@ mod_interannuel_server <- function(id,DD){
plot_xlab<-envir_stacomi$xlab
plot_ylab<-envir_stacomi$ylab
theme_plot<-envir_stacomi$theme_plot
+ year_choice <- envir_stacomi$year_choice
+ stacomiR::plot(r_mig_interannual, plot.type = "line", year_choice = year_choice, silent = TRUE)
+
g_interannuel_line <- envir_stacomi$g_line
g_interannuel_line <- g_interannuel_line+
ggplot2::ggtitle(plot_title) +
@@ -409,6 +412,9 @@ mod_interannuel_server <- function(id,DD){
plot_xlab<-envir_stacomi$xlab
plot_ylab<-envir_stacomi$ylab
theme_plot<-envir_stacomi$theme_plot
+ year_choice <- envir_stacomi$year_choice
+
+ stacomiR::plot(r_mig_interannual, plot.type = "step", year_choice = year_choice, silent = TRUE)
g_interannuel_step <- envir_stacomi$g_step
@@ -442,8 +448,8 @@ mod_interannuel_server <- function(id,DD){
plot_xlab<-envir_stacomi$xlab
plot_ylab<-envir_stacomi$ylab
theme_plot<-envir_stacomi$theme_plot
- pas_temps <- envir_stacomi$pas_temps
-
+
+ pas_temps <- envir_stacomi$pas_temps
year_choice <- envir_stacomi$year_choice
stacomiR::plot(r_mig_interannual, plot.type = "barchart", timesplit = pas_temps, year_choice=year_choice, silent = TRUE)
@@ -476,9 +482,10 @@ mod_interannuel_server <- function(id,DD){
plot_xlab <- envir_stacomi$xlab
plot_ylab <- envir_stacomi$ylab
theme_plot <- envir_stacomi$theme_plot
- pas_temps <- envir_stacomi$pas_temps
- if (is.null(pas_temps)) pas_temps <- "jour"
- stacomiR::plot(r_mig_interannual, plot.type = "pointrange", timesplit = pas_temps, silent = TRUE)
+ pas_temps <- envir_stacomi$pas_temps
+ year_choice <- envir_stacomi$year_choice
+
+ stacomiR::plot(r_mig_interannual, plot.type = "pointrange", timesplit = pas_temps, year_choice=year_choice, silent = TRUE)
g_interannuel_pointrange <- envir_stacomi$g_pointrange
g_interannuel_pointrange <- g_interannuel_pointrange +
ggplot2::ggtitle(plot_title) +
@@ -541,7 +548,8 @@ mod_interannuel_server <- function(id,DD){
plot_xlab<-envir_stacomi$xlab
plot_ylab<-envir_stacomi$ylab
theme_plot<-envir_stacomi$theme_plot
-
+ pas_temps <- envir_stacomi$pas_temps
+ stacomiR::plot(r_mig_interannual, plot.type = "seasonal", timesplit = pas_temps, silent = TRUE)
g_interannuel_seasonal <- envir_stacomi$g_seasonal
g_interannuel_seasonal <- g_interannuel_seasonal+
--
GitLab
From 085803def144585e0df0fb519b7c095f90912028 Mon Sep 17 00:00:00 2001
From: cedricbriandgithub <cedric.briand@eptb-vilaine.fr>
Date: Thu, 19 Oct 2023 13:07:22 +0200
Subject: [PATCH 40/47] dev : adapt palette and themes and other to use default
values
---
R/app_server.R | 4 +-
R/mod_annuel.R | 25 +-
R/mod_bilan_dc.R | 712 ++++++++++++++++----------------
R/mod_custom_plot.R | 8 +-
R/mod_custom_plot_interannual.R | 9 +-
R/mod_interannuel.R | 93 +++--
R/mod_migr_mult.R | 50 +--
R/mod_sample_char.R | 52 +--
8 files changed, 478 insertions(+), 475 deletions(-)
diff --git a/R/app_server.R b/R/app_server.R
index b8639da..034a954 100644
--- a/R/app_server.R
+++ b/R/app_server.R
@@ -20,8 +20,8 @@ mod_migr_mult_server("migr_mult_ui_1",DD)
DD$button_ref_taxa_migr_mult <- mod_ref_taxa_server("ref_taxa_mod_migr_mult", DD, mytab="migr_mult")
DD$button_ref_stage_migr_mult <- mod_ref_stage_server("ref_stage_mod_migr_mult", DD, mytab="migr_mult")
- DD$button_box_custom_migr_mult_2 <-mod_custom_plot_server("custom_plot_migr_mult_2",DD,mytab="migr_mult")
- DD$button_box_custom_migr_mult_3 <-mod_custom_plot_server("custom_plot_migr_mult_3",DD,mytab="migr_mult")
+ DD$button_box_custom_migr_mult_step <-mod_custom_plot_server("custom_plot_migr_mult_step",DD,mytab="migr_mult")
+ DD$button_box_custom_migr_mult_multiple <-mod_custom_plot_server("custom_plot_migr_mult_multiple",DD,mytab="migr_mult")
# annuel ---------------------------------------------------
diff --git a/R/mod_annuel.R b/R/mod_annuel.R
index 51b261e..ac1e69b 100644
--- a/R/mod_annuel.R
+++ b/R/mod_annuel.R
@@ -160,20 +160,21 @@ mod_annuel_server <- function(id, DD){
},{
shinyCatch({
- palette_plot<-envir_stacomi$palette_plot
- plot_title<-envir_stacomi$plot_title
- plot_xlab<-envir_stacomi$xlab
- plot_ylab<-envir_stacomi$ylab
- theme_plot<-envir_stacomi$theme_plot
+ palette_plot <- envir_stacomi$palette_plot
+ plot_title <- envir_stacomi$plot_title
+ plot_xlab <- envir_stacomi$xlab
+ plot_ylab <- envir_stacomi$ylab
+ theme_plot <- envir_stacomi$theme_plot
- g_annuel_2=envir_stacomi$g
+ g_annuel_2 <- envir_stacomi$g
- g_annuel_2 <- g_annuel_2+
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_color_brewer(palette = palette_plot)+
- match.fun(theme_plot)()
+ g_annuel_2 <- g_annuel_2
+ if (plot_title != "") g_annuel_2 <- g_annuel_2 + ggplot2::ggtitle(plot_title)
+ if (plot_ylab != "") g_annuel_2 <- g_annuel_2 + ggplot2::ylab(plot_ylab)
+ if (plot_xlab != "") g_annuel_2 <- g_annuel_2 + ggplot2::xlab(plot_xlab)
+ if (theme_plot != "aucun") g_annuel_2 <- g_annuel_2 + match.fun(theme_plot)()
+ if (palette_plot != "aucun") g_annuel_2 <- g_annuel_2 + ggplot2::scale_color_brewer(palette = palette_plot)
+
output$plot_annuel_point<-renderPlot({
diff --git a/R/mod_bilan_dc.R b/R/mod_bilan_dc.R
index 5f6a1e3..8019b36 100644
--- a/R/mod_bilan_dc.R
+++ b/R/mod_bilan_dc.R
@@ -11,388 +11,384 @@
mod_bilan_dc_ui <- function(id){
ns <- NS(id)
tabItem(tabName = "bilan_dc",
- shinydashboardPlus::box(
- title = "S\u00e9lections :",
- solidHeader = TRUE,
- collapsible = TRUE,
- status="primary",
- width = 3,
- #dateRangeInput("dates", label = h5("S\u00e9lectionnez la date de d\u00e9but et de fin :")),
- dateInput(ns("bilan_dc.datedebut"), label = h5("Choisissez une date de début :"), value = "2020-01-01"),
- dateInput(ns("bilan_dc.datefin"), label = h5("Choisissez une date de fin :"), value = "2021-01-01"),
-
- checkboxGroupInput(ns("choix_sorties"), label = h4("Choisissez les sorties graphiques ou tableaux :"),
- choices = list("plot_dc_barchar_fonct" = 1,
- "plot_dc_barchar_service" = 2,
- "plot_dc_box_1" = 3,
- "plot_dc_box_2" = 4,
- "tab_dc_data" = 5),
- selected = 1),
- actionBttn(
- inputId = ns("bttn_dc"),
- label = "OK",
- style = "fill",
- color = "primary"
- )
- ),
+ shinydashboardPlus::box(
+ title = "S\u00e9lections :",
+ solidHeader = TRUE,
+ collapsible = TRUE,
+ status="primary",
+ width = 3,
+ #dateRangeInput("dates", label = h5("S\u00e9lectionnez la date de d\u00e9but et de fin :")),
+ dateInput(ns("bilan_dc.datedebut"), label = h5("Choisissez une date de début :"), value = "2020-01-01"),
+ dateInput(ns("bilan_dc.datefin"), label = h5("Choisissez une date de fin :"), value = "2021-01-01"),
- shinydashboardPlus::box(
- id=ns("box_dc_barchar_fonct"),
- title = "Barchar_fonct",
- status="primary",
- solidHeader = TRUE,
- collapsible = TRUE,
- collapsed = TRUE,
- sidebar = shinydashboardPlus::boxSidebar(
+ checkboxGroupInput(ns("choix_sorties"), label = h4("Choisissez les sorties graphiques ou tableaux :"),
+ choices = list("plot_dc_barchar_fonct" = 1,
+ "plot_dc_barchar_service" = 2,
+ "plot_dc_box_1" = 3,
+ "plot_dc_box_2" = 4,
+ "tab_dc_data" = 5),
+ selected = 1),
+ actionBttn(
+ inputId = ns("bttn_dc"),
+ label = "OK",
+ style = "fill",
+ color = "primary"
+ )
+ ),
+
+ shinydashboardPlus::box(
+ id=ns("box_dc_barchar_fonct"),
+ title = "Barchar_fonct",
+ status="primary",
+ solidHeader = TRUE,
+ collapsible = TRUE,
+ collapsed = TRUE,
+ sidebar = shinydashboardPlus::boxSidebar(
id = ns("box_dc_barchar_fonct_sidebar"),
width = 25,
mod_custom_plot_ui("custom_plot_bilan_dc_1"),
- ),
+ ),
plotOutput(ns("plot_dc_barchar_fonct"))),
-
- shinydashboardPlus::box(
- id=ns("box_dc_barchar_service"),
- title = "Barchar_service",
- status="primary",
- solidHeader = TRUE,
- collapsible = TRUE,
- collapsed = TRUE,
- sidebar = shinydashboardPlus::boxSidebar(
+
+ shinydashboardPlus::box(
+ id=ns("box_dc_barchar_service"),
+ title = "Barchar_service",
+ status="primary",
+ solidHeader = TRUE,
+ collapsible = TRUE,
+ collapsed = TRUE,
+ sidebar = shinydashboardPlus::boxSidebar(
id = ns("box_dc_barchar_service_sidebar"),
width = 25,
mod_custom_plot_ui("custom_plot_bilan_dc_2"),
- ),
- plotOutput(ns("plot_dc_barchar_service"))),
-
- shinydashboardPlus::box(
- id=ns("box_dc_box_1"),
- title = "Box_1",
- status="primary",
- solidHeader = TRUE,
- collapsible = TRUE,
- collapsed = TRUE,
- plotOutput(ns("plot_dc_box_1"))),
-
- shinydashboardPlus::box(
- id=ns("box_dc_box_2"),
- title = "Box_2",
- status="primary",
- solidHeader = TRUE,
- collapsible = TRUE,
- collapsed = TRUE,
- sidebar = shinydashboardPlus::boxSidebar(
+ ),
+ plotOutput(ns("plot_dc_barchar_service"))),
+
+ shinydashboardPlus::box(
+ id=ns("box_dc_box_1"),
+ title = "Box_1",
+ status="primary",
+ solidHeader = TRUE,
+ collapsible = TRUE,
+ collapsed = TRUE,
+ plotOutput(ns("plot_dc_box_1"))),
+
+ shinydashboardPlus::box(
+ id=ns("box_dc_box_2"),
+ title = "Box_2",
+ status="primary",
+ solidHeader = TRUE,
+ collapsible = TRUE,
+ collapsed = TRUE,
+ sidebar = shinydashboardPlus::boxSidebar(
id = ns("box_dc_box_2_sidebar"),
width = 25,
mod_custom_plot_ui("custom_plot_bilan_dc_4"),
- ),
- plotOutput(ns("plot_dc_box_2"))),
-
- shinydashboardPlus::box(
- id=ns("box_tab_dc_data"),
- title = "DC_data",
- status="primary",
- solidHeader = TRUE,
- collapsible = TRUE,
- collapsed = TRUE,
- width = 9,
- DTOutput(ns("tab_dc_data")),
- DTOutput(ns("tab_per_tar_code")),
- DTOutput(ns("tab_per_etat_fct"))
- ),
-
- )
+ ),
+ plotOutput(ns("plot_dc_box_2"))),
+
+ shinydashboardPlus::box(
+ id=ns("box_tab_dc_data"),
+ title = "DC_data",
+ status="primary",
+ solidHeader = TRUE,
+ collapsible = TRUE,
+ collapsed = TRUE,
+ width = 9,
+ DTOutput(ns("tab_dc_data")),
+ DTOutput(ns("tab_per_tar_code")),
+ DTOutput(ns("tab_per_etat_fct"))
+ ),
+
+ )
}
-
+
#' bilan_dc Server Functions
#'
#' @noRd
#' @importFrom DT renderDT
mod_bilan_dc_server <- function(id,DD){
moduleServer( id, function(input, output, session){
- ns <- session$ns
-
- observeEvent(
- eventExpr={
- input$bttn_dc
- },
- handlerExpr={
+ ns <- session$ns
- shinyCatch({
-
- #Bilan DC
- validate(need(exists("envir_stacomi"), "Le programme stacomi doit être lancé"))
- db_connection <- envir_stacomi$db_connection
- validate(need(!is.null(db_connection), "db needs connection"))
- r_dc=new("report_dc")
- ref_dc <- base::get("ref_dc", envir=envir_stacomi)
- validate(need(length(ref_dc@dc_selected) >0, "No dc selected"))
- if (length(ref_dc@dc_selected) >1)
- ref_dc@dc_selected <- ref_dc@dc_selected[1]
- validate(need(input$bilan_dc.datedebut<input$bilan_dc.datefin,"la date de début doit être inférieure à la date de fin"))
- r_dc<-choice_c(r_dc,
- dc=ref_dc@dc_selected,
- horodatedebut=input$bilan_dc.datedebut,
- horodatefin=input$bilan_dc.datefin,
- silent=TRUE)
- Sys.setenv(TZ='GMT')
- r_dc<-connect(r_dc)
-
-
- # graphiques et sorties ----------------------
- if (nrow(r_dc@data)==0){
- warning("no data available")
- }else{
- if ("1" %in% input$choix_sorties) {
- if (input$box_dc_barchar_fonct$collapsed) shinydashboardPlus::updateBox("box_dc_barchar_fonct",action="toggle")
- output$plot_dc_barchar_fonct<-renderPlot({
- stacomiR::plot(r_dc,plot.type="1")
- })
- } else {
- if (!input$box_dc_barchar_fonct$collapsed) shinydashboardPlus::updateBox("box_dc_barchar_fonct",action="toggle")
- } #end ifelse "1"
- if ("2" %in% input$choix_sorties) {
- if (input$box_dc_barchar_service$collapsed) shinydashboardPlus::updateBox("box_dc_barchar_service",action="toggle")
- output$plot_dc_barchar_service<-renderPlot({
- stacomiR::plot(r_dc,plot.type="2")
- })
- } else {
- if (!input$box_dc_barchar_service$collapsed) shinydashboardPlus::updateBox("box_dc_barchar_service",action="toggle")
- } #end ifelse "2"
- if ("3" %in% input$choix_sorties) {
- if (input$box_dc_box_1$collapsed) shinydashboardPlus::updateBox("box_dc_box_1",action="toggle")
- output$plot_dc_box_1<-renderPlot({
- stacomiR::plot(r_dc,plot.type="3")
- })
- } else {
- if (!input$box_dc_box_1$collapsed) shinydashboardPlus::updateBox("box_dc_box_1",action="toggle")
- } #end ifelse "3"
- if ("4" %in% input$choix_sorties) {
- if (input$box_dc_box_2$collapsed) shinydashboardPlus::updateBox("box_dc_box_2",action="toggle")
- output$plot_dc_box_2<-renderPlot({
- stacomiR::plot(r_dc,plot.type="4")
- })
- } else {
- if (!input$box_dc_box_2$collapsed) shinydashboardPlus::updateBox("box_dc_box_2",action="toggle")
- } #end ifelse "4"
- if ("5" %in% input$choix_sorties) {
- if (input$box_tab_dc_data$collapsed) shinydashboardPlus::updateBox("box_tab_dc_data", action = "toggle")
- t_periodefonctdispositif_per <-
- r_dc@data # on recupere le data.frame
-
- ## on remplace la date de début et de fin de la période rentré dans la table par les horodates de début et de fin choisis dans le module
-
- t_periodefonctdispositif_per<-t_periodefonctdispositif_per %>%
- dplyr::mutate(per_date_debut=replace(per_date_debut,per_date_debut==min(per_date_debut),r_dc@horodatedebut@horodate)) %>%
- dplyr::mutate(per_date_fin=replace(per_date_fin,per_date_fin==max(per_date_fin),r_dc@horodatefin@horodate))
-
- t_periodefonctdispositif_per$per_date_debut <-
- as.character(t_periodefonctdispositif_per$per_date_debut)
- t_periodefonctdispositif_per$per_date_fin <-
- as.character(t_periodefonctdispositif_per$per_date_fin)
- annee = paste(unique(strftime(
- as.POSIXlt(t_periodefonctdispositif_per$per_date_debut),
- "%Y"
- )), collapse = "+")
-
-
- duree <-
- difftime(
- t_periodefonctdispositif_per$per_date_fin,
- t_periodefonctdispositif_per$per_date_debut,
- units = "day"
- )
-
-
- sum_per_tar_code <-
- tapply(duree, t_periodefonctdispositif_per$per_tar_code, sum)
- sum_per_tar_code<-as.data.frame(sum_per_tar_code)
- summary_per_tar_code<-tibble::rownames_to_column(sum_per_tar_code, var = "per_tar_code")
-
-
- summary_per_tar_code$perc_per_tar_code <- round(100 * summary_per_tar_code$sum_per_tar_code/sum(summary_per_tar_code$sum_per_tar_code))
- summary_per_tar_code$sum_per_tar_code <- round(summary_per_tar_code$sum_per_tar_code, 2)
-
- summary_per_tar_code<-summary_per_tar_code %>%
- dplyr::mutate(per_tar_code=replace(per_tar_code,per_tar_code==1,"Normal oper")) %>%
- dplyr::mutate(per_tar_code=replace(per_tar_code,per_tar_code==2,"Operational stop")) %>%
- dplyr::mutate(per_tar_code=replace(per_tar_code,per_tar_code==3,"Stop")) %>%
- dplyr::mutate(per_tar_code=replace(per_tar_code,per_tar_code==4,"Dysfunct")) %>%
- dplyr::mutate(per_tar_code=replace(per_tar_code,per_tar_code==5,"Unknown"))
-
-
- sum_per_etat_fonctionnement <-
- tapply(duree, t_periodefonctdispositif_per$per_etat_fonctionnement, sum)
- sum_per_etat_fonctionnement<-as.data.frame(sum_per_etat_fonctionnement)
- summary_per_etat_fonctionnement<-tibble::rownames_to_column(sum_per_etat_fonctionnement, var = "per_etat_fonctionnement")
-
- summary_per_etat_fonctionnement$perc_per_etat_fonctionnement<-round(100*summary_per_etat_fonctionnement$sum_per_etat_fonctionnement/sum(summary_per_etat_fonctionnement$sum_per_etat_fonctionnement))
- summary_per_etat_fonctionnement$sum_per_etat_fonctionnement<-round(summary_per_etat_fonctionnement$sum_per_etat_fonctionnement,2)
-
- summary_per_etat_fonctionnement<-summary_per_etat_fonctionnement %>%
- dplyr::mutate(per_etat_fonctionnement=replace(per_etat_fonctionnement,per_etat_fonctionnement=="FALSE","Stop"))%>%
- dplyr::mutate(per_etat_fonctionnement=replace(per_etat_fonctionnement,per_etat_fonctionnement=="TRUE","Func"))
-
-
- output$tab_dc_data <- renderDT({
- DT::datatable(t_periodefonctdispositif_per,
- rownames=FALSE,
- extensions = "Buttons",
- option=list(
- scrollX = TRUE,
- dom= "Bfrtip",
- buttons=list('copy', 'print', list(
- extend = 'collection',
- buttons = c('csv', 'excel', 'pdf'),
- text = 'Download'
- ))))
-
- },server = FALSE)
- output$tab_per_tar_code<-renderDT({
- DT::datatable(summary_per_tar_code,
- rownames=FALSE,
- extensions = "Buttons",
- option=list(
- scrollX = TRUE,
- dom= "Bfrtip",
- buttons=list('copy', 'print', list(
- extend = 'collection',
- buttons = c('csv', 'excel', 'pdf'),
- text = 'Download'
- ))
- ))
-
- },server = FALSE)
- output$tab_per_etat_fct<-renderDT({
- DT::datatable(summary_per_etat_fonctionnement,
- rownames=FALSE,
- extensions = "Buttons",
- option=list(
- scrollX = TRUE,
- dom= "Bfrtip",
- buttons=
- list('copy', 'print', list(
- extend = 'collection',
- buttons = c('csv', 'excel', 'pdf'),
- text = 'Download'
+ observeEvent(
+ eventExpr={
+ input$bttn_dc
+ },
+ handlerExpr={
+
+ shinyCatch({
+
+ #Bilan DC
+ validate(need(exists("envir_stacomi"), "Le programme stacomi doit être lancé"))
+ db_connection <- envir_stacomi$db_connection
+ validate(need(!is.null(db_connection), "db needs connection"))
+ r_dc=new("report_dc")
+ ref_dc <- base::get("ref_dc", envir=envir_stacomi)
+ validate(need(length(ref_dc@dc_selected) >0, "No dc selected"))
+ if (length(ref_dc@dc_selected) >1)
+ ref_dc@dc_selected <- ref_dc@dc_selected[1]
+ validate(need(input$bilan_dc.datedebut<input$bilan_dc.datefin,"la date de début doit être inférieure à la date de fin"))
+ r_dc<-choice_c(r_dc,
+ dc=ref_dc@dc_selected,
+ horodatedebut=input$bilan_dc.datedebut,
+ horodatefin=input$bilan_dc.datefin,
+ silent=TRUE)
+ Sys.setenv(TZ='GMT')
+ r_dc<-connect(r_dc)
+
+
+ # graphiques et sorties ----------------------
+ if (nrow(r_dc@data)==0){
+ warning("no data available")
+ }else{
+ if ("1" %in% input$choix_sorties) {
+ if (input$box_dc_barchar_fonct$collapsed) shinydashboardPlus::updateBox("box_dc_barchar_fonct",action="toggle")
+ output$plot_dc_barchar_fonct<-renderPlot({
+ stacomiR::plot(r_dc,plot.type="1")
+ })
+ } else {
+ if (!input$box_dc_barchar_fonct$collapsed) shinydashboardPlus::updateBox("box_dc_barchar_fonct",action="toggle")
+ } #end ifelse "1"
+ if ("2" %in% input$choix_sorties) {
+ if (input$box_dc_barchar_service$collapsed) shinydashboardPlus::updateBox("box_dc_barchar_service",action="toggle")
+ output$plot_dc_barchar_service<-renderPlot({
+ stacomiR::plot(r_dc,plot.type="2")
+ })
+ } else {
+ if (!input$box_dc_barchar_service$collapsed) shinydashboardPlus::updateBox("box_dc_barchar_service",action="toggle")
+ } #end ifelse "2"
+ if ("3" %in% input$choix_sorties) {
+ if (input$box_dc_box_1$collapsed) shinydashboardPlus::updateBox("box_dc_box_1",action="toggle")
+ output$plot_dc_box_1<-renderPlot({
+ stacomiR::plot(r_dc,plot.type="3")
+ })
+ } else {
+ if (!input$box_dc_box_1$collapsed) shinydashboardPlus::updateBox("box_dc_box_1",action="toggle")
+ } #end ifelse "3"
+ if ("4" %in% input$choix_sorties) {
+ if (input$box_dc_box_2$collapsed) shinydashboardPlus::updateBox("box_dc_box_2",action="toggle")
+ output$plot_dc_box_2 <- renderPlot({
+ stacomiR::plot(r_dc,plot.type="4")
+ })
+ } else {
+ if (!input$box_dc_box_2$collapsed) shinydashboardPlus::updateBox("box_dc_box_2",action="toggle")
+ } #end ifelse "4"
+ if ("5" %in% input$choix_sorties) {
+ if (input$box_tab_dc_data$collapsed) shinydashboardPlus::updateBox("box_tab_dc_data", action = "toggle")
+ t_periodefonctdispositif_per <-
+ r_dc@data # on recupere le data.frame
+
+ ## on remplace la date de début et de fin de la période rentré dans la table par les horodates de début et de fin choisis dans le module
+
+ t_periodefonctdispositif_per<-t_periodefonctdispositif_per %>%
+ dplyr::mutate(per_date_debut=replace(per_date_debut,per_date_debut==min(per_date_debut),r_dc@horodatedebut@horodate)) %>%
+ dplyr::mutate(per_date_fin=replace(per_date_fin,per_date_fin==max(per_date_fin),r_dc@horodatefin@horodate))
+
+ t_periodefonctdispositif_per$per_date_debut <-
+ as.character(t_periodefonctdispositif_per$per_date_debut)
+ t_periodefonctdispositif_per$per_date_fin <-
+ as.character(t_periodefonctdispositif_per$per_date_fin)
+ annee = paste(unique(strftime(
+ as.POSIXlt(t_periodefonctdispositif_per$per_date_debut),
+ "%Y"
+ )), collapse = "+")
+
+
+ duree <-
+ difftime(
+ t_periodefonctdispositif_per$per_date_fin,
+ t_periodefonctdispositif_per$per_date_debut,
+ units = "day"
+ )
+
+
+ sum_per_tar_code <-
+ tapply(duree, t_periodefonctdispositif_per$per_tar_code, sum)
+ sum_per_tar_code<-as.data.frame(sum_per_tar_code)
+ summary_per_tar_code<-tibble::rownames_to_column(sum_per_tar_code, var = "per_tar_code")
+
+
+ summary_per_tar_code$perc_per_tar_code <- round(100 * summary_per_tar_code$sum_per_tar_code/sum(summary_per_tar_code$sum_per_tar_code))
+ summary_per_tar_code$sum_per_tar_code <- round(summary_per_tar_code$sum_per_tar_code, 2)
+
+ summary_per_tar_code<-summary_per_tar_code %>%
+ dplyr::mutate(per_tar_code=replace(per_tar_code,per_tar_code==1,"Normal oper")) %>%
+ dplyr::mutate(per_tar_code=replace(per_tar_code,per_tar_code==2,"Operational stop")) %>%
+ dplyr::mutate(per_tar_code=replace(per_tar_code,per_tar_code==3,"Stop")) %>%
+ dplyr::mutate(per_tar_code=replace(per_tar_code,per_tar_code==4,"Dysfunct")) %>%
+ dplyr::mutate(per_tar_code=replace(per_tar_code,per_tar_code==5,"Unknown"))
+
+
+ sum_per_etat_fonctionnement <-
+ tapply(duree, t_periodefonctdispositif_per$per_etat_fonctionnement, sum)
+ sum_per_etat_fonctionnement<-as.data.frame(sum_per_etat_fonctionnement)
+ summary_per_etat_fonctionnement<-tibble::rownames_to_column(sum_per_etat_fonctionnement, var = "per_etat_fonctionnement")
+
+ summary_per_etat_fonctionnement$perc_per_etat_fonctionnement<-round(100*summary_per_etat_fonctionnement$sum_per_etat_fonctionnement/sum(summary_per_etat_fonctionnement$sum_per_etat_fonctionnement))
+ summary_per_etat_fonctionnement$sum_per_etat_fonctionnement<-round(summary_per_etat_fonctionnement$sum_per_etat_fonctionnement,2)
+
+ summary_per_etat_fonctionnement<-summary_per_etat_fonctionnement %>%
+ dplyr::mutate(per_etat_fonctionnement=replace(per_etat_fonctionnement,per_etat_fonctionnement=="FALSE","Stop"))%>%
+ dplyr::mutate(per_etat_fonctionnement=replace(per_etat_fonctionnement,per_etat_fonctionnement=="TRUE","Func"))
+
+
+ output$tab_dc_data <- renderDT({
+ DT::datatable(t_periodefonctdispositif_per,
+ rownames=FALSE,
+ extensions = "Buttons",
+ option=list(
+ scrollX = TRUE,
+ dom= "Bfrtip",
+ buttons=list('copy', 'print', list(
+ extend = 'collection',
+ buttons = c('csv', 'excel', 'pdf'),
+ text = 'Download'
+ ))))
+
+ },server = FALSE)
+ output$tab_per_tar_code<-renderDT({
+ DT::datatable(summary_per_tar_code,
+ rownames=FALSE,
+ extensions = "Buttons",
+ option=list(
+ scrollX = TRUE,
+ dom= "Bfrtip",
+ buttons=list('copy', 'print', list(
+ extend = 'collection',
+ buttons = c('csv', 'excel', 'pdf'),
+ text = 'Download'
+ ))
))
- ))
- },server = FALSE)
-
- } else {
- if (!input$box_tab_dc_data$collapsed) shinydashboardPlus::updateBox("box_tab_dc_data", action = "toggle")
- } # end ifelse "5"
- } # end else
-
-
-
- observeEvent({DD$button_box_custom_bilan_dc_1()
-
- },{
- shinyCatch({
-
- palette_plot<-envir_stacomi$palette_plot
- plot_title<-envir_stacomi$plot_title
- plot_xlab<-envir_stacomi$xlab
- plot_ylab<-envir_stacomi$ylab
- theme_plot<-envir_stacomi$theme_plot
-
- g_report_dc_1=envir_stacomi$g_report_dc_1
-
- g_report_dc_1 <- g_report_dc_1+
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_fill_brewer(palette = palette_plot)+
- match.fun(theme_plot)()
-
-
- output$plot_dc_barchar_fonct<-renderPlot({
- g_report_dc_1
- })
-
-
- },blocking_level = "error"
- )},
- ignoreInit=TRUE,
- ignoreNULL = TRUE
- )
-
- observeEvent({DD$button_box_custom_bilan_dc_2()
-
- },{
- shinyCatch({
-
- palette_plot<-envir_stacomi$palette_plot
- plot_title<-envir_stacomi$plot_title
- plot_xlab<-envir_stacomi$xlab
- plot_ylab<-envir_stacomi$ylab
- theme_plot<-envir_stacomi$theme_plot
-
-
- g_report_dc_2=envir_stacomi$g_report_dc_2
-
- g_report_dc_2 <- g_report_dc_2+
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_fill_brewer(palette = palette_plot)+
- match.fun(theme_plot)()
-
-
- output$plot_dc_barchar_service<-renderPlot({
- g_report_dc_2
- })
-
-
- },blocking_level = "error"
- )},
- ignoreInit=TRUE,
- ignoreNULL = TRUE
- )
-
- observeEvent({DD$button_box_custom_bilan_dc_4()
-
- },{
- shinyCatch({
-
- palette_plot<-envir_stacomi$palette_plot
- plot_title<-envir_stacomi$plot_title
- plot_xlab<-envir_stacomi$xlab
- plot_ylab<-envir_stacomi$ylab
- theme_plot<-envir_stacomi$theme_plot
-
- g_report_dc_4=envir_stacomi$g_report_dc_4
-
- g_report_dc_4 <- g_report_dc_4+
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_fill_brewer(palette = palette_plot)+
- match.fun(theme_plot)()
-
-
- output$plot_dc_box_2<-renderPlot({
- g_report_dc_4
- })
-
-
- },blocking_level = "error"
- )},
- ignoreInit=TRUE,
- ignoreNULL = TRUE
- )
-
- }) # end shiny catch
-
- })
-
- })
+
+ },server = FALSE)
+ output$tab_per_etat_fct<-renderDT({
+ DT::datatable(summary_per_etat_fonctionnement,
+ rownames=FALSE,
+ extensions = "Buttons",
+ option=list(
+ scrollX = TRUE,
+ dom= "Bfrtip",
+ buttons=
+ list('copy', 'print', list(
+ extend = 'collection',
+ buttons = c('csv', 'excel', 'pdf'),
+ text = 'Download'
+ ))
+ ))
+ },server = FALSE)
+
+ } else {
+ if (!input$box_tab_dc_data$collapsed) shinydashboardPlus::updateBox("box_tab_dc_data", action = "toggle")
+ } # end ifelse "5"
+ } # end else
+
+
+
+ observeEvent({DD$button_box_custom_bilan_dc_1()
+
+ },{
+ shinyCatch({
+ palette_plot <- envir_stacomi$palette_plot
+ plot_title <- envir_stacomi$plot_title
+ plot_xlab <- envir_stacomi$xlab
+ plot_ylab <- envir_stacomi$ylab
+ theme_plot <- envir_stacomi$theme_plot
+
+ g_report_dc_1 <- envir_stacomi$g_report_dc_1
+
+ g_report_dc_1 <- g_report_dc_1
+ if (plot_title != "") g_report_dc_1 <- g_report_dc_1 + ggplot2::ggtitle(plot_title)
+ if (plot_ylab != "") g_report_dc_1 <- g_report_dc_1 + ggplot2::ylab(plot_ylab)
+ if (plot_xlab != "") g_report_dc_1 <- g_report_dc_1 + ggplot2::xlab(plot_xlab)
+ if (theme_plot != "aucun") g_report_dc_1 <- g_report_dc_1 + match.fun(theme_plot)()
+ if (palette_plot != "aucun") g_report_dc_1 <- g_report_dc_1 + ggplot2::scale_fill_brewer(palette = palette_plot)
+
+ output$plot_dc_barchar_fonct<-renderPlot({
+ g_report_dc_1
+ })
+
+
+ },blocking_level = "error"
+ )},
+ ignoreInit=TRUE,
+ ignoreNULL = TRUE
+ )
+
+ observeEvent({DD$button_box_custom_bilan_dc_2()
+
+ },{
+ shinyCatch({
+
+ palette_plot <- envir_stacomi$palette_plot
+ plot_title <- envir_stacomi$plot_title
+ plot_xlab <- envir_stacomi$xlab
+ plot_ylab <- envir_stacomi$ylab
+ theme_plot <- envir_stacomi$theme_plot
+
+ g_report_dc_2 <- envir_stacomi$g_report_dc_2
+
+ g_report_dc_2 <- g_report_dc_2
+ if (plot_title != "") g_report_dc_2 <- g_report_dc_2 + ggplot2::ggtitle(plot_title)
+ if (plot_ylab != "") g_report_dc_2 <- g_report_dc_2 + ggplot2::ylab(plot_ylab)
+ if (plot_xlab != "") g_report_dc_2 <- g_report_dc_2 + ggplot2::xlab(plot_xlab)
+ if (theme_plot != "aucun") g_report_dc_2 <- g_report_dc_2 + match.fun(theme_plot)()
+ if (palette_plot != "aucun") g_report_dc_2 <- g_report_dc_2 + ggplot2::scale_fill_brewer(palette = palette_plot)
+
+
+
+ output$plot_dc_barchar_service<-renderPlot({
+ g_report_dc_2
+ })
+
+
+ },blocking_level = "error"
+ )},
+ ignoreInit=TRUE,
+ ignoreNULL = TRUE
+ )
+
+ observeEvent({DD$button_box_custom_bilan_dc_4()
+
+ },{
+ shinyCatch({
+
+ palette_plot <- envir_stacomi$palette_plot
+ plot_title <- envir_stacomi$plot_title
+ plot_xlab <- envir_stacomi$xlab
+ plot_ylab <- envir_stacomi$ylab
+ theme_plot <- envir_stacomi$theme_plot
+
+ g_report_dc_4 <- envir_stacomi$g_report_dc_4
+
+ g_report_dc_4 <- g_report_dc_4
+ if (plot_title != "") g_report_dc_4 <- g_report_dc_4 + ggplot2::ggtitle(plot_title)
+ if (plot_ylab != "") g_report_dc_4 <- g_report_dc_4 + ggplot2::ylab(plot_ylab)
+ if (plot_xlab != "") g_report_dc_4 <- g_report_dc_4 + ggplot2::xlab(plot_xlab)
+ if (theme_plot != "aucun") g_report_dc_4 <- g_report_dc_4 + match.fun(theme_plot)()
+ if (palette_plot != "aucun") g_report_dc_4 <- g_report_dc_4 + ggplot2::scale_fill_brewer(palette = palette_plot)
+
+ output$plot_dc_box_2 <- renderPlot({
+ g_report_dc_4
+ })
+
+ },blocking_level = "error"
+ )},
+ ignoreInit=TRUE,
+ ignoreNULL = TRUE
+ )
+
+ }) # end shiny catch
+
+ })
+
+ })
}
-
+
## To be copied in the UI
# mod_bilan_dc_ui("bilan_dc_ui_1")
-
+
## To be copied in the server
# mod_bilan_dc_server("bilan_dc_ui_1")
diff --git a/R/mod_custom_plot.R b/R/mod_custom_plot.R
index 20b4001..837b083 100644
--- a/R/mod_custom_plot.R
+++ b/R/mod_custom_plot.R
@@ -53,16 +53,16 @@ mod_custom_plot_server <- function(id,DD,mytab){
moduleServer( id, function(input, output, session){
ns <- session$ns
observeEvent({
- DD$login_button()
+ DD$login_button()
},{
shinyCatch({
- palette_plot<-rownames(RColorBrewer::brewer.pal.info)
-
+ palette_plot <- rownames(RColorBrewer::brewer.pal.info)
+ palette_plot <- c("aucun", palette_plot)
theme_plot_ggthemes<-ls("package:ggthemes")[grepl("theme_", ls("package:ggthemes"))]
theme_plot_ggplot<-c("theme_gray","theme_bw","theme_linedraw","theme_light","theme_dark","theme_minimal","theme_classic","theme_void","theme_test")
- theme_plot<-append(theme_plot_ggplot,theme_plot_ggthemes)
+ theme_plot<-c("aucun",theme_plot_ggplot,theme_plot_ggthemes)
updateSelectInput(session, "select_palette_plot",
choices = palette_plot
diff --git a/R/mod_custom_plot_interannual.R b/R/mod_custom_plot_interannual.R
index 2f1c514..c64c236 100644
--- a/R/mod_custom_plot_interannual.R
+++ b/R/mod_custom_plot_interannual.R
@@ -87,15 +87,16 @@ mod_custom_plot_interannual_server <- function(id, DD, mytab, show_pas_temps=TRU
shinyCatch({
- palette_plot<-rownames(RColorBrewer::brewer.pal.info)
-
+ palette_plot <- rownames(RColorBrewer::brewer.pal.info)
+ palette_plot <- c("aucun", palette_plot)
theme_plot_ggthemes<-ls("package:ggthemes")[grepl("theme_", ls("package:ggthemes"))]
theme_plot_ggplot<-c("theme_gray","theme_bw","theme_linedraw","theme_light","theme_dark","theme_minimal","theme_classic","theme_void","theme_test")
- theme_plot<-append(theme_plot_ggplot,theme_plot_ggthemes)
+ theme_plot<-c("aucun",theme_plot_ggplot,theme_plot_ggthemes)
updateSelectInput(session, "select_palette_plot",
- choices = palette_plot
+ choices = palette_plot,
+ selected="aucun"
)
updateSelectInput(session, "select_theme_plot",
choices = theme_plot
diff --git a/R/mod_interannuel.R b/R/mod_interannuel.R
index ce9236e..d778a20 100644
--- a/R/mod_interannuel.R
+++ b/R/mod_interannuel.R
@@ -347,12 +347,13 @@ mod_interannuel_server <- function(id,DD){
stacomiR::plot(r_mig_interannual, plot.type = "line", year_choice = year_choice, silent = TRUE)
g_interannuel_line <- envir_stacomi$g_line
- g_interannuel_line <- g_interannuel_line+
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_color_brewer(palette = palette_plot) +
- match.fun(theme_plot)()
+
+ if (plot_title != "") g_interannuel_line <- g_interannuel_line + ggplot2::ggtitle(plot_title)
+ if (plot_ylab != "") g_interannuel_line <- g_interannuel_line + ggplot2::ylab(plot_ylab)
+ if (plot_xlab != "") g_interannuel_line <- g_interannuel_line + ggplot2::xlab(plot_xlab)
+ if (theme_plot != "aucun") g_interannuel_line <- g_interannuel_line + match.fun(theme_plot)()
+ if (theme_plot != "aucun") g_interannuel_line <- g_interannuel_line + ggplot2::scale_color_brewer(palette = palette_plot)
+
output$plot_interannuel_line<-renderPlot({
@@ -378,17 +379,18 @@ mod_interannuel_server <- function(id,DD){
plot_ylab<-envir_stacomi$ylab
theme_plot<-envir_stacomi$theme_plot
- g_interannuel_standard <- envir_stacomi$g_standard
+ g_interannuel_barchart <- envir_stacomi$g_standard
title <- g_interannuel_standard$labels$title
legend_title <- stringr::str_split(title,",")[[1]][3]
the_choice <- stringr::str_split(stringr::str_split(title,",")[[1]][3],"/")[[1]][1]
labels <- stringr::str_split(stringr::str_split(title,",")[[1]][3],"/")[[1]][2]
- g_interannuel_standard <- g_interannuel_standard +
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_fill_brewer(name=legend_title,label=c("Historical amplitude",the_choice),palette = palette_plot)+
- match.fun(theme_plot)()
+
+ if (plot_title != "") g_interannuel_standard <- g_interannuel_standard + ggplot2::ggtitle(plot_title)
+ if (plot_ylab != "") g_interannuel_standard <- g_interannuel_standard + ggplot2::ylab(plot_ylab)
+ if (plot_xlab != "") g_interannuel_standard <- g_interannuel_standard + ggplot2::xlab(plot_xlab)
+ if (theme_plot != "aucun") g_interannuel_standard <- g_interannuel_standard + match.fun(theme_plot)()
+ if (theme_plot != "aucun") g_interannuel_standard <- g_interannuel_standard + ggplot2::scale_color_brewer(palette = palette_plot)
+
output$plot_interannuel_standard<-renderPlot({
@@ -418,12 +420,12 @@ mod_interannuel_server <- function(id,DD){
g_interannuel_step <- envir_stacomi$g_step
- g_interannuel_step <- g_interannuel_step+
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_color_brewer(palette = palette_plot)+
- match.fun(theme_plot)()
+ if (plot_title != "") g_interannuel_step <- g_interannuel_step + ggplot2::ggtitle(plot_title)
+ if (plot_ylab != "") g_interannuel_step <- g_interannuel_step + ggplot2::ylab(plot_ylab)
+ if (plot_xlab != "") g_interannuel_step <- g_interannuel_step + ggplot2::xlab(plot_xlab)
+ if (theme_plot != "aucun") g_interannuel_step <- g_interannuel_step + match.fun(theme_plot)()
+ if (theme_plot != "aucun") g_interannuel_step <- g_interannuel_step + ggplot2::scale_color_brewer(palette = palette_plot)
+
output$plot_interannuel_step<-renderPlot({
@@ -453,13 +455,14 @@ mod_interannuel_server <- function(id,DD){
year_choice <- envir_stacomi$year_choice
stacomiR::plot(r_mig_interannual, plot.type = "barchart", timesplit = pas_temps, year_choice=year_choice, silent = TRUE)
- g_interannuel_barchart <- envir_stacomi$g_barchart
- g_interannuel_barchart <- g_interannuel_barchart+
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_fill_brewer(palette = palette_plot)+
- match.fun(theme_plot)()
+ g_interannuel_barchart <- envir_stacomi$g_barchart
+
+ if (plot_title != "") g_interannuel_standard <- g_interannuel_barchart + ggplot2::ggtitle(plot_title)
+ if (plot_ylab != "") g_interannuel_barchart <- g_interannuel_barchart + ggplot2::ylab(plot_ylab)
+ if (plot_xlab != "") g_interannuel_barchart <- g_interannuel_barchart + ggplot2::xlab(plot_xlab)
+ if (theme_plot != "aucun") g_interannuel_barchart <- g_interannuel_barchart + match.fun(theme_plot)()
+ if (theme_plot != "aucun") g_interannuel_barchart <- g_interannuel_barchart + ggplot2::scale_color_brewer(palette = palette_plot)
+
output$plot_interannuel_barchart <- renderPlot({
g_interannuel_barchart
@@ -487,12 +490,13 @@ mod_interannuel_server <- function(id,DD){
stacomiR::plot(r_mig_interannual, plot.type = "pointrange", timesplit = pas_temps, year_choice=year_choice, silent = TRUE)
g_interannuel_pointrange <- envir_stacomi$g_pointrange
- g_interannuel_pointrange <- g_interannuel_pointrange +
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_fill_brewer(palette = palette_plot) +
- match.fun(theme_plot)()
+
+ if (plot_title != "") g_interannuel_pointrange <- g_interannuel_pointrange + ggplot2::ggtitle(plot_title)
+ if (plot_ylab != "") g_interannuel_pointrange <- g_interannuel_pointrange + ggplot2::ylab(plot_ylab)
+ if (plot_xlab != "") g_interannuel_pointrange <- g_interannuel_pointrange + ggplot2::xlab(plot_xlab)
+ if (theme_plot != "aucun") g_interannuel_pointrange <- g_interannuel_pointrange + match.fun(theme_plot)()
+ if (theme_plot != "aucun") g_interannuel_pointrange <- g_interannuel_pointrange + ggplot2::scale_color_brewer(palette = palette_plot)
+
output$plot_interannuel_pointrange<-renderPlot({
@@ -519,12 +523,13 @@ mod_interannuel_server <- function(id,DD){
g_interannuel_density <- envir_stacomi$g_density
- g_interannuel_density <- g_interannuel_density+
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_fill_brewer(palette = palette_plot)+
- match.fun(theme_plot)()
+ if (plot_title != "") g_interannuel_density <- g_interannuel_density + ggplot2::ggtitle(plot_title)
+ if (plot_ylab != "") g_interannuel_density <- g_interannuel_density + ggplot2::ylab(plot_ylab)
+ if (plot_xlab != "") g_interannuel_density <- g_interannuel_density + ggplot2::xlab(plot_xlab)
+ if (theme_plot != "aucun") g_interannuel_density <- g_interannuel_density + match.fun(theme_plot)()
+ if (theme_plot != "aucun") g_interannuel_density <- g_interannuel_density + ggplot2::scale_color_brewer(palette = palette_plot)
+
+
output$plot_interannuel_density <- renderPlot({
@@ -552,12 +557,12 @@ mod_interannuel_server <- function(id,DD){
stacomiR::plot(r_mig_interannual, plot.type = "seasonal", timesplit = pas_temps, silent = TRUE)
g_interannuel_seasonal <- envir_stacomi$g_seasonal
- g_interannuel_seasonal <- g_interannuel_seasonal+
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_fill_distiller(palette = palette_plot,name="Effectif")+
- match.fun(theme_plot)()
+ if (plot_title != "") g_interannuel_seasonal <- g_interannuel_seasonal + ggplot2::ggtitle(plot_title)
+ if (plot_ylab != "") g_interannuel_seasonal <- g_interannuel_seasonal + ggplot2::ylab(plot_ylab)
+ if (plot_xlab != "") g_interannuel_seasonal <- g_interannuel_seasonal + ggplot2::xlab(plot_xlab)
+ if (theme_plot != "aucun") g_interannuel_seasonal <- g_interannuel_seasonal + match.fun(theme_plot)()
+ if (theme_plot != "aucun") g_interannuel_seasonal <- g_interannuel_seasonal + ggplot2::scale_color_brewer(palette = palette_plot)
+
output$plot_interannuel_seasonal<-renderPlot({
diff --git a/R/mod_migr_mult.R b/R/mod_migr_mult.R
index 3d15358..e81db3c 100644
--- a/R/mod_migr_mult.R
+++ b/R/mod_migr_mult.R
@@ -63,7 +63,7 @@ mod_migr_mult_ui <- function(id){
sidebar = shinydashboardPlus::boxSidebar(
id = ns("box_plot_mm_ms_sidebar"),
width = 25,
- mod_custom_plot_ui("custom_plot_migr_mult_2"),
+ mod_custom_plot_ui("custom_plot_migr_mult_step"),
),
width=8,
plotOutput(ns("plot_migration_mult_step"))
@@ -78,7 +78,7 @@ mod_migr_mult_ui <- function(id){
sidebar = shinydashboardPlus::boxSidebar(
id = ns("box_plot_mm_mm_sidebar"),
width = 25,
- mod_custom_plot_ui("custom_plot_migr_mult_3"),
+ mod_custom_plot_ui("custom_plot_migr_mult_multiple"),
),
width=8,
plotOutput(ns("plot_migration_multiple"))
@@ -231,7 +231,7 @@ mod_migr_mult_server <- function(id, DD){
if (!input$box_tab_mm$collapsed) shinydashboardPlus::updateBox("box_tab_mm", action = "toggle")
}
- observeEvent({DD$button_box_custom_migr_mult_2()
+ observeEvent({DD$button_box_custom_migr_mult_step()
},{
shinyCatch({
@@ -242,18 +242,18 @@ mod_migr_mult_server <- function(id, DD){
plot_ylab<-envir_stacomi$ylab
theme_plot<-envir_stacomi$theme_plot
- g_report_migr_mult_2=envir_stacomi$p
+ g_report_migr_mult_step <- envir_stacomi$p_step
+
+ if (plot_title != "") g_report_migr_mult_multiple <- g_report_migr_mult_step + ggplot2::ggtitle(plot_title)
+ if (plot_ylab != "") g_report_migr_mult_step <- g_report_migr_mult_step + ggplot2::ylab(plot_ylab)
+ if (plot_xlab != "") g_report_migr_mult_step <- g_report_migr_mult_step + ggplot2::xlab(plot_xlab)
+ if (theme_plot != "aucun") g_report_migr_mult_step <- g_report_migr_mult_step + match.fun(theme_plot)()
+ if (palette_plot != "aucun") g_report_migr_mult_step <- g_report_migr_mult_step + ggplot2::scale_color_brewer(palette = palette_plot)
- g_report_migr_mult_2 <- g_report_migr_mult_2+
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_colour_brewer(palette = palette_plot)+
- match.fun(theme_plot)()
output$plot_migration_mult_step<-renderPlot({
- g_report_migr_mult_2
+ g_report_migr_mult_step
})
@@ -263,29 +263,29 @@ mod_migr_mult_server <- function(id, DD){
ignoreNULL = TRUE
)
- observeEvent({DD$button_box_custom_migr_mult_3()
+ observeEvent({DD$button_box_custom_migr_mult_multiple()
},{
shinyCatch({
- palette_plot<-envir_stacomi$palette_plot
- plot_title<-envir_stacomi$plot_title
- plot_xlab<-envir_stacomi$xlab
- plot_ylab<-envir_stacomi$ylab
- theme_plot<-envir_stacomi$theme_plot
+ palette_plot <- envir_stacomi$palette_plot
+ plot_title <- envir_stacomi$plot_title
+ plot_xlab <- envir_stacomi$xlab
+ plot_ylab <- envir_stacomi$ylab
+ theme_plot <- envir_stacomi$theme_plot
+
+ g_report_migr_mult_multiple <- envir_stacomi$p_multiple
- g_report_migr_mult_3=envir_stacomi$p
+ if (plot_title != "") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + ggplot2::ggtitle(plot_title)
+ if (plot_ylab != "") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + ggplot2::ylab(plot_ylab)
+ if (plot_xlab != "") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + ggplot2::xlab(plot_xlab)
+ if (theme_plot != "aucun") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + match.fun(theme_plot)()
+ if (palette_plot != "aucun") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + ggplot2::scale_fill_brewer(palette = palette_plot)
- g_report_migr_mult_3 <- g_report_migr_mult_3+
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_fill_brewer(palette = palette_plot)+
- match.fun(theme_plot)()
output$plot_migration_multiple<-renderPlot({
- g_report_migr_mult_3
+ g_report_migr_mult_multiple
})
diff --git a/R/mod_sample_char.R b/R/mod_sample_char.R
index 2ed404c..f939129 100644
--- a/R/mod_sample_char.R
+++ b/R/mod_sample_char.R
@@ -207,14 +207,14 @@ mod_sample_char_server <- function(id, DD){
plot_ylab<-envir_stacomi$ylab
theme_plot<-envir_stacomi$theme_plot
- g_sample_char_1=envir_stacomi$g
+ g_sample_char_1 <- envir_stacomi$g1
- g_sample_char_1 <- g_sample_char_1+
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_fill_brewer(palette = palette_plot)+
- match.fun(theme_plot)()
+ if (plot_title != "") g_sample_char_1 <- g_sample_char_1 + ggplot2::ggtitle(plot_title)
+ if (plot_ylab != "") g_sample_char_1 <- g_sample_char_1 + ggplot2::ylab(plot_ylab)
+ if (plot_xlab != "") g_sample_char_1 <- g_sample_char_1 + ggplot2::xlab(plot_xlab)
+ if (theme_plot != "aucun") g_sample_char_1 <- g_sample_char_1 + match.fun(theme_plot)()
+ if (palette_plot != "aucun") g_sample_char_1 <- g_sample_char_1 + ggplot2::scale_fill_brewer(palette = palette_plot)
+
output$plot_sample_char_point<-renderPlot({
@@ -239,14 +239,14 @@ mod_sample_char_server <- function(id, DD){
plot_ylab<-envir_stacomi$ylab
theme_plot<-envir_stacomi$theme_plot
- g_sample_char_2=envir_stacomi$g
+ g_sample_char_2=envir_stacomi$g2
- g_sample_char_2 <- g_sample_char_2+
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_fill_brewer(palette = palette_plot)+
- match.fun(theme_plot)()
+ if (plot_title != "") g_sample_char_2 <- g_sample_char_2 + ggplot2::ggtitle(plot_title)
+ if (plot_ylab != "") g_sample_char_2 <- g_sample_char_2 + ggplot2::ylab(plot_ylab)
+ if (plot_xlab != "") g_sample_char_2 <- g_sample_char_2 + ggplot2::xlab(plot_xlab)
+ if (theme_plot != "aucun") g_sample_char_2 <- g_sample_char_2 + match.fun(theme_plot)()
+ if (palette_plot != "aucun") g_sample_char_2 <- g_sample_char_2 + ggplot2::scale_fill_brewer(palette = palette_plot)
+
output$plot_sample_char_density<-renderPlot({
@@ -265,20 +265,20 @@ mod_sample_char_server <- function(id, DD){
},{
shinyCatch({
- palette_plot<-envir_stacomi$palette_plot
- plot_title<-envir_stacomi$plot_title
- plot_xlab<-envir_stacomi$xlab
- plot_ylab<-envir_stacomi$ylab
- theme_plot<-envir_stacomi$theme_plot
+ palette_plot <- envir_stacomi$palette_plot
+ plot_title <- envir_stacomi$plot_title
+ plot_xlab <- envir_stacomi$xlab
+ plot_ylab <- envir_stacomi$ylab
+ theme_plot <- envir_stacomi$theme_plot
- g_sample_char_3=envir_stacomi$g
+ g_sample_char_3 <- envir_stacomi$g3
- g_sample_char_3 <- g_sample_char_3+
- ggplot2::ggtitle(plot_title) +
- ggplot2::ylab(plot_ylab) +
- ggplot2::xlab(plot_xlab) +
- ggplot2::scale_fill_brewer(palette = palette_plot)+
- match.fun(theme_plot)()
+ if (plot_title != "") g_sample_char_3 <- g_sample_char_3 + ggplot2::ggtitle(plot_title)
+ if (plot_ylab != "") g_sample_char_3 <- g_sample_char_3 + ggplot2::ylab(plot_ylab)
+ if (plot_xlab != "") g_sample_char_3 <- g_sample_char_3 + ggplot2::xlab(plot_xlab)
+ if (theme_plot != "aucun") g_sample_char_3 <- g_sample_char_3 + match.fun(theme_plot)()
+ if (palette_plot != "aucun") g_sample_char_3 <- g_sample_char_3 + ggplot2::scale_color_brewer(palette = palette_plot)
+
output$plot_sample_char_boxplot<-renderPlot({
--
GitLab
From c543227a41bc79174326c58c11854b26bfcd5301 Mon Sep 17 00:00:00 2001
From: Marion LEGRAND <marion.legrand@logrami.fr>
Date: Tue, 12 Dec 2023 15:54:06 +0100
Subject: [PATCH 41/47] fix : add getUsername for path marion
---
dev/run_dev.R | 7 ++++++-
1 file changed, 6 insertions(+), 1 deletion(-)
diff --git a/dev/run_dev.R b/dev/run_dev.R
index 103fc57..93078f9 100644
--- a/dev/run_dev.R
+++ b/dev/run_dev.R
@@ -7,7 +7,12 @@ if (getUsername() == "cedric.briand") {
wdshiny <- "C:/workspace/stacoshiny"
wdstacomiR <- "C:\\workspace\\stacomir"
wdstacomirtools <-"C:\\workspace\\stacomirtools"
- }
+ } else if (getUsername() == "marion.legrand"){
+ wdshiny <- "D:/Documents/Workspace_eclipse/stacoshiny"
+ wdstacomiR <- "D:/Documents/Workspace_eclipse/stacomir_gitlab"
+ wdstacomirtools <-"D:/Documents/Workspace_eclipse/stacomirtools_gitlab"
+ }
+
# else if (getUsername() == "xxxx")){
# }
--
GitLab
From 5fc1233f33b04aed4c71ad0424f7c510c7ee5054 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Grall?= <seinormigr.grall@gmail.com>
Date: Tue, 25 Feb 2025 17:41:40 +0100
Subject: [PATCH 42/47] fix issue with plot in mod_ang_arg
---
DESCRIPTION | 2 +-
R/mod_ang_argentee.R | 6 ++++--
dev/run_dev.R | 16 ++++++++++------
inst/golem-config.yml | 2 +-
vignettes/stacoshiny.Rmd | 19 -------------------
5 files changed, 16 insertions(+), 29 deletions(-)
delete mode 100644 vignettes/stacoshiny.Rmd
diff --git a/DESCRIPTION b/DESCRIPTION
index f6dce02..1849444 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -30,7 +30,7 @@ Imports:
pkgload
Encoding: UTF-8
LazyData: true
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
Suggests:
testthat,
spelling,
diff --git a/R/mod_ang_argentee.R b/R/mod_ang_argentee.R
index 085c61d..3691578 100644
--- a/R/mod_ang_argentee.R
+++ b/R/mod_ang_argentee.R
@@ -157,9 +157,11 @@ mod_ang_argentee_server <- function(id, DD) {
assign("r_silver", r_silver, envir = envir_stacomi)
if (nrow(r_silver@data) == 0) {
warning("no data available")
+ shinybusy::remove_modal_spinner()
} else {
r_silver <- calcule(r_silver, silent = TRUE)
- }
+ #}
+
# calculations
shinybusy::remove_modal_spinner() # remove it when done
@@ -217,7 +219,7 @@ mod_ang_argentee_server <- function(id, DD) {
},server = FALSE)
} else {
if (!input$box_tab_angarg$collapsed) shinydashboardPlus::updateBox("box_tab_angarg", action = "toggle")
- }
+ }}
# if ("5" %in% input$choix_sorties) {
# if (input$box_tab_angarg$collapsed) shinydashboardPlus::updateBox("box_tab_angarg", action = "toggle")
diff --git a/dev/run_dev.R b/dev/run_dev.R
index 93078f9..26e48a5 100644
--- a/dev/run_dev.R
+++ b/dev/run_dev.R
@@ -7,18 +7,22 @@ if (getUsername() == "cedric.briand") {
wdshiny <- "C:/workspace/stacoshiny"
wdstacomiR <- "C:\\workspace\\stacomir"
wdstacomirtools <-"C:\\workspace\\stacomirtools"
- } else if (getUsername() == "marion.legrand"){
- wdshiny <- "D:/Documents/Workspace_eclipse/stacoshiny"
- wdstacomiR <- "D:/Documents/Workspace_eclipse/stacomir_gitlab"
- wdstacomirtools <-"D:/Documents/Workspace_eclipse/stacomirtools_gitlab"
- }
+} else if (getUsername() == "marion.legrand"){
+ wdshiny <- "D:/Documents/Workspace_eclipse/stacoshiny"
+ wdstacomiR <- "D:/Documents/Workspace_eclipse/stacomir_gitlab"
+ wdstacomirtools <-"D:/Documents/Workspace_eclipse/stacomirtools_gitlab"
+} else if (getUsername() == "SébastienGrall"){
+ wdshiny <- "C:/Users/SébastienGrall/Documents/Projets Git/stacoshiny"
+ wdstacomiR <- "C:/Users/SébastienGrall/Documents/Projets Git/stacomir"
+ wdstacomirtools <-"C:/Users/SébastienGrall/Documents/Projets Git/stacomirtools"
+}
# else if (getUsername() == "xxxx")){
# }
setwd(wdshiny)
-golem::set_golem_options()
+#golem::set_golem_options()
options(golem.app.prod = FALSE) # TRUE = production mode, FALSE = development mode
# Detach all loaded packages and clean your environment
diff --git a/inst/golem-config.yml b/inst/golem-config.yml
index ba52165..ab67d92 100644
--- a/inst/golem-config.yml
+++ b/inst/golem-config.yml
@@ -5,4 +5,4 @@ default:
production:
app_prod: yes
dev:
- golem_wd: !expr here::here()
+ golem_wd: !expr golem::pkg_path()
diff --git a/vignettes/stacoshiny.Rmd b/vignettes/stacoshiny.Rmd
deleted file mode 100644
index 74c44ea..0000000
--- a/vignettes/stacoshiny.Rmd
+++ /dev/null
@@ -1,19 +0,0 @@
----
-title: "stacoshiny"
-output: rmarkdown::html_vignette
-vignette: >
- %\VignetteIndexEntry{stacoshiny}
- %\VignetteEngine{knitr::rmarkdown}
- %\VignetteEncoding{UTF-8}
----
-
-```{r, include = FALSE}
-knitr::opts_chunk$set(
- collapse = TRUE,
- comment = "#>"
-)
-```
-
-```{r setup}
-library(stacoshiny)
-```
--
GitLab
From a2020943a55f73431e4fbf1cf42496d07403dfa3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Grall?= <seinormigr.grall@gmail.com>
Date: Thu, 27 Feb 2025 15:50:25 +0100
Subject: [PATCH 43/47] generate dynamic tabs and plot
---
R/mod_migr_mult.R | 74 +++++++++++++++++++++++++++++++++++++++++++----
1 file changed, 68 insertions(+), 6 deletions(-)
diff --git a/R/mod_migr_mult.R b/R/mod_migr_mult.R
index e81db3c..8491f4a 100644
--- a/R/mod_migr_mult.R
+++ b/R/mod_migr_mult.R
@@ -12,6 +12,45 @@
#' @importFrom shinydashboard tabItem box
#' @importFrom DT renderDT DTOutput
+
+# Function to generate the plots dynamically
+# On fait une copie de l'objet r_mig_mult, on modifie l'objet pour changer la liste des selected
+# et changer les sorties de la méthode plot, les vrais noms sont dans les slots dc, taxa et stage
+# donc on fait un peu de travail dans les boucles en plus pour aller chercher les noms.
+generateGraphs <- function(r_mig_mult) {
+ graphs <- list() # Liste pour stocker les objets graphiques
+
+ r_mig_mult2<-r_mig_mult
+
+ for (i in seq_along(r_mig_mult@calcdata)) {
+ unique_taxa <- unique(r_mig_mult@calcdata[[i]][["data"]]$lot_tax_code)
+ calcdata <- r_mig_mult@calcdata[[i]][["data"]]
+
+ for (j in seq_along(unique_taxa)) {
+ unique_std <- unique(calcdata[calcdata$lot_tax_code == unique_taxa[j], "lot_std_code"])
+
+ for (k in seq_along(unique_std)) {
+ # Mise à jour de l'objet r_mig_mult avec les valeurs spécifiques
+
+ r_mig_mult2@dc@dc_selected <- unique(calcdata$ope_dic_identifiant)
+ r_mig_mult2@taxa@taxa_selected <- unique_taxa[j]
+ r_mig_mult2@stage@stage_selected <- unique_std[k]
+
+ # Génération du graphique et stockage dans la liste
+ graph_name <- paste0("DC= ", stringi::stri_trans_general(r_mig_mult@dc@data[r_mig_mult@dc@data$dc %in% r_mig_mult2@dc@dc_selected,9], "latin-ascii"),
+ ", taxon= ", stringi::stri_trans_general(r_mig_mult@taxa@data[r_mig_mult@taxa@data$tax_code %in% unique_taxa[j],2], "latin-ascii"),
+ ", stade= ", stringi::stri_trans_general(r_mig_mult@stage@data[r_mig_mult@stage@data$std_code %in% unique_std[k],2], "latin-ascii"))
+ outfile <- tempfile(pattern=grah_name, fileext = '.png')
+ png(outfile,width=8, height=10)
+ stacomiR::plot(r_mig_mult2, plot.type = "standard", silent = TRUE)
+ #graphs[[graph_name]] <- recordPlot()
+ dev.off()
+ }
+ }
+ }
+ return(graphs)
+}
+
mod_migr_mult_ui <- function(id){
ns <- NS(id)
tabItem(tabName = "migr_mult",
@@ -49,9 +88,9 @@ mod_migr_mult_ui <- function(id){
collapsible = TRUE,
collapsed=TRUE,
width=8,
- plotOutput(ns("plot_migration_mult_standard"),
- width = "100%",
- height = "600px")
+ height = 20,
+ uiOutput(ns("dynamicTabs")) # Dynamically generate the tab panels,
+
),
shinydashboardPlus::box(
id=ns("box_plot_mm_ms"),
@@ -108,7 +147,8 @@ mod_migr_mult_server <- function(id, DD){
moduleServer( id, module =function(input, output, session){
ns <- session$ns
observeEvent(input$bttn_migr_mult, {
- shinyCatch({
+ shinyCatch({
+
validate(need(exists("envir_stacomi"), "Le programme stacomi doit être lancé"))
db_connection <- envir_stacomi$db_connection
validate(need(!is.null(db_connection), "db needs connection"))
@@ -136,12 +176,34 @@ mod_migr_mult_server <- function(id, DD){
}
# calculations
r_mig_mult <- calcule(r_mig_mult,silent=TRUE)
+ calcdata <-r_mig_mult@calcdata
+ # Stocke directement les graphiques en tant qu'objets
+ graph_list <- generateGraphs(r_mig_mult)
+
+ #browser()
shinybusy::remove_modal_spinner() # remove it when done
+
if ("1" %in% input$choix_sorties) {
if (input$box_plot_mm_std$collapsed) shinydashboardPlus::updateBox("box_plot_mm_std", action = "toggle")
- output$plot_migration_mult_standard <- renderPlot({
- stacomiR::plot(r_mig_mult, plot.type = "standard", silent = TRUE)
+
+ # Génération dynamique des onglets
+ output$dynamicTabs <- renderUI({
+ tabs <- lapply(names(graph_list), function(name) {
+ tabPanel(name, plotOutput(outputId = ns(paste0("plot_", name)))) # IDs dynamiques
+ })
+ do.call(tabsetPanel, tabs)
})
+
+ # Rendu des graphiques
+ #observe({
+ lapply(names(graph_list), function(name) {
+ output[[paste0("plot_", name)]] <- renderPlot({
+ graph_list[[name]] # Affiche l'objet graphique stocké
+
+ })
+ })
+ #})
+
} else {
if (!input$box_plot_mm_std$collapsed) shinydashboardPlus::updateBox("box_plot_mm_std", action = "toggle")
}
--
GitLab
From 508b2aa3378fc7734b27604784ead91424737519 Mon Sep 17 00:00:00 2001
From: cedricbriandgithub <cedric.briand@eptb-vilaine.fr>
Date: Thu, 27 Feb 2025 16:53:08 +0100
Subject: [PATCH 44/47] dev : pchhhit
---
R/global.R | 2 +-
R/mod_migr_mult.R | 24 ++++++++++++++----------
2 files changed, 15 insertions(+), 11 deletions(-)
diff --git a/R/global.R b/R/global.R
index bca6fee..4698ed7 100644
--- a/R/global.R
+++ b/R/global.R
@@ -2,7 +2,7 @@
# current year, for the UI
CY <- as.numeric(strftime(Sys.time(), format = "%Y"))
-
+dir.create(normalizePath("./data/tempplot"),showWarnings = FALSE)
options(
stacomiR.dbname = "bd_contmig_nat",
stacomiR.host = "localhost",
diff --git a/R/mod_migr_mult.R b/R/mod_migr_mult.R
index 8491f4a..ea4b16e 100644
--- a/R/mod_migr_mult.R
+++ b/R/mod_migr_mult.R
@@ -40,10 +40,9 @@ generateGraphs <- function(r_mig_mult) {
graph_name <- paste0("DC= ", stringi::stri_trans_general(r_mig_mult@dc@data[r_mig_mult@dc@data$dc %in% r_mig_mult2@dc@dc_selected,9], "latin-ascii"),
", taxon= ", stringi::stri_trans_general(r_mig_mult@taxa@data[r_mig_mult@taxa@data$tax_code %in% unique_taxa[j],2], "latin-ascii"),
", stade= ", stringi::stri_trans_general(r_mig_mult@stage@data[r_mig_mult@stage@data$std_code %in% unique_std[k],2], "latin-ascii"))
- outfile <- tempfile(pattern=grah_name, fileext = '.png')
- png(outfile,width=8, height=10)
+ outfile <- file.path("./data/tempplot",paste0(graph_name, '.png'))
+ png(outfile,width=8, height=10, units ="in", res= 300)
stacomiR::plot(r_mig_mult2, plot.type = "standard", silent = TRUE)
- #graphs[[graph_name]] <- recordPlot()
dev.off()
}
}
@@ -167,6 +166,9 @@ mod_migr_mult_server <- function(id, DD){
datefin=input$migr_mult.datefin,
silent=TRUE)
shinybusy::show_modal_spinner(text="please wait") # show the modal window
+ # first clean up the folder
+ ls <- list.files(normalizePath("./data/tempplot"))
+ file.remove(normalizePath(file.path("./data/tempplot",ls)))
r_mig_mult <- charge(r_mig_mult)
# launching charge will also load classes associated with the report
# e.g. report_ope, report_df, report_dc
@@ -178,7 +180,7 @@ mod_migr_mult_server <- function(id, DD){
r_mig_mult <- calcule(r_mig_mult,silent=TRUE)
calcdata <-r_mig_mult@calcdata
# Stocke directement les graphiques en tant qu'objets
- graph_list <- generateGraphs(r_mig_mult)
+ graph_list <- generateGraphs(r_mig_mult)
#browser()
shinybusy::remove_modal_spinner() # remove it when done
@@ -189,20 +191,22 @@ mod_migr_mult_server <- function(id, DD){
# Génération dynamique des onglets
output$dynamicTabs <- renderUI({
tabs <- lapply(names(graph_list), function(name) {
- tabPanel(name, plotOutput(outputId = ns(paste0("plot_", name)))) # IDs dynamiques
+ tabPanel(name, imageOutput(outputId = ns(paste0("image_", name)))) # IDs dynamiques
})
do.call(tabsetPanel, tabs)
})
# Rendu des graphiques
- #observe({
+
lapply(names(graph_list), function(name) {
- output[[paste0("plot_", name)]] <- renderPlot({
- graph_list[[name]] # Affiche l'objet graphique stocké
-
+ output[[paste0("image_", name)]] <- renderImage({
+ validate(need(file.exists(file.path("./data/tempplot",paste0(name,'.png'))),
+ message=strintf("internal error in mod_mig_mult_server, file %s not found",
+ file.path("./data/tempplot",paste0(name,'.png')))))
+ list(normalizePath(file.path("./data/tempplot",paste0(name,'.png'))))
})
})
- #})
+
} else {
if (!input$box_plot_mm_std$collapsed) shinydashboardPlus::updateBox("box_plot_mm_std", action = "toggle")
--
GitLab
From 1a7867a0787c119845ac244c3cbe15da4714afe7 Mon Sep 17 00:00:00 2001
From: cedricbriandgithub <cedric.briand@eptb-vilaine.fr>
Date: Fri, 28 Feb 2025 09:57:32 +0100
Subject: [PATCH 45/47] dev : mod_mig_mult
---
R/mod_migr_mult.R | 16 +++++++++-------
1 file changed, 9 insertions(+), 7 deletions(-)
diff --git a/R/mod_migr_mult.R b/R/mod_migr_mult.R
index ea4b16e..71eb81a 100644
--- a/R/mod_migr_mult.R
+++ b/R/mod_migr_mult.R
@@ -18,7 +18,7 @@
# et changer les sorties de la méthode plot, les vrais noms sont dans les slots dc, taxa et stage
# donc on fait un peu de travail dans les boucles en plus pour aller chercher les noms.
generateGraphs <- function(r_mig_mult) {
- graphs <- list() # Liste pour stocker les objets graphiques
+ graphs <- vector() # Liste pour stocker les objets graphiques
r_mig_mult2<-r_mig_mult
@@ -44,6 +44,7 @@ generateGraphs <- function(r_mig_mult) {
png(outfile,width=8, height=10, units ="in", res= 300)
stacomiR::plot(r_mig_mult2, plot.type = "standard", silent = TRUE)
dev.off()
+ graphs <- c(graphs, graph_name)
}
}
}
@@ -180,31 +181,32 @@ mod_migr_mult_server <- function(id, DD){
r_mig_mult <- calcule(r_mig_mult,silent=TRUE)
calcdata <-r_mig_mult@calcdata
# Stocke directement les graphiques en tant qu'objets
- graph_list <- generateGraphs(r_mig_mult)
+ graphs <- generateGraphs(r_mig_mult)
#browser()
shinybusy::remove_modal_spinner() # remove it when done
if ("1" %in% input$choix_sorties) {
if (input$box_plot_mm_std$collapsed) shinydashboardPlus::updateBox("box_plot_mm_std", action = "toggle")
-
+ browser()
# Génération dynamique des onglets
output$dynamicTabs <- renderUI({
- tabs <- lapply(names(graph_list), function(name) {
+ tabs <- lapply(graphs, function(name) {
tabPanel(name, imageOutput(outputId = ns(paste0("image_", name)))) # IDs dynamiques
})
do.call(tabsetPanel, tabs)
})
# Rendu des graphiques
-
- lapply(names(graph_list), function(name) {
+
+ lapply(graphs, function(name) {
output[[paste0("image_", name)]] <- renderImage({
+
validate(need(file.exists(file.path("./data/tempplot",paste0(name,'.png'))),
message=strintf("internal error in mod_mig_mult_server, file %s not found",
file.path("./data/tempplot",paste0(name,'.png')))))
list(normalizePath(file.path("./data/tempplot",paste0(name,'.png'))))
- })
+ }, deleteFile = FALSE)
})
--
GitLab
From ff3f491103fef58fff993970aa075b79e47b3ef7 Mon Sep 17 00:00:00 2001
From: Marion LEGRAND <marion.legrand@logrami.fr>
Date: Fri, 28 Feb 2025 17:57:43 +0100
Subject: [PATCH 46/47] dev : script OK for mod_migr_mult
---
.gitignore | 1 +
R/mod_migr_mult.R | 183 ++++++++++++++++++++++++----------------------
2 files changed, 95 insertions(+), 89 deletions(-)
diff --git a/.gitignore b/.gitignore
index cfa04f0..34134b0 100644
--- a/.gitignore
+++ b/.gitignore
@@ -9,5 +9,6 @@
/.project
.settings
/.dbeaver/
+*/tempplot
inst/doc
*.log
diff --git a/R/mod_migr_mult.R b/R/mod_migr_mult.R
index 71eb81a..16a2263 100644
--- a/R/mod_migr_mult.R
+++ b/R/mod_migr_mult.R
@@ -18,11 +18,11 @@
# et changer les sorties de la méthode plot, les vrais noms sont dans les slots dc, taxa et stage
# donc on fait un peu de travail dans les boucles en plus pour aller chercher les noms.
generateGraphs <- function(r_mig_mult) {
- graphs <- vector() # Liste pour stocker les objets graphiques
+ graphs <- list()
r_mig_mult2<-r_mig_mult
-
- for (i in seq_along(r_mig_mult@calcdata)) {
+ id <- 0
+ for (i in seq_along(r_mig_mult@calcdata)) {
unique_taxa <- unique(r_mig_mult@calcdata[[i]][["data"]]$lot_tax_code)
calcdata <- r_mig_mult@calcdata[[i]][["data"]]
@@ -31,7 +31,7 @@ generateGraphs <- function(r_mig_mult) {
for (k in seq_along(unique_std)) {
# Mise à jour de l'objet r_mig_mult avec les valeurs spécifiques
-
+ id <- id + 1
r_mig_mult2@dc@dc_selected <- unique(calcdata$ope_dic_identifiant)
r_mig_mult2@taxa@taxa_selected <- unique_taxa[j]
r_mig_mult2@stage@stage_selected <- unique_std[k]
@@ -41,10 +41,10 @@ generateGraphs <- function(r_mig_mult) {
", taxon= ", stringi::stri_trans_general(r_mig_mult@taxa@data[r_mig_mult@taxa@data$tax_code %in% unique_taxa[j],2], "latin-ascii"),
", stade= ", stringi::stri_trans_general(r_mig_mult@stage@data[r_mig_mult@stage@data$std_code %in% unique_std[k],2], "latin-ascii"))
outfile <- file.path("./data/tempplot",paste0(graph_name, '.png'))
- png(outfile,width=8, height=10, units ="in", res= 300)
+ png(outfile,width=6, height=8, units ="in",res=300)
stacomiR::plot(r_mig_mult2, plot.type = "standard", silent = TRUE)
dev.off()
- graphs <- c(graphs, graph_name)
+ graphs[[as.character(id)]] <- graph_name
}
}
}
@@ -79,19 +79,16 @@ mod_migr_mult_ui <- function(id){
style = "fill",
color = "primary"
)
- ),
- shinydashboardPlus::box(
+ ),
+ shinydashboardPlus::box(
id=ns("box_plot_mm_std"),
title="Plot standard",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
collapsed=TRUE,
- width=8,
- height = 20,
uiOutput(ns("dynamicTabs")) # Dynamically generate the tab panels,
-
- ),
+ ),
shinydashboardPlus::box(
id=ns("box_plot_mm_ms"),
title="Plot step",
@@ -147,8 +144,9 @@ mod_migr_mult_server <- function(id, DD){
moduleServer( id, module =function(input, output, session){
ns <- session$ns
observeEvent(input$bttn_migr_mult, {
- shinyCatch({
-
+ #browser()
+ # shinyCatch({
+
validate(need(exists("envir_stacomi"), "Le programme stacomi doit être lancé"))
db_connection <- envir_stacomi$db_connection
validate(need(!is.null(db_connection), "db needs connection"))
@@ -168,6 +166,7 @@ mod_migr_mult_server <- function(id, DD){
silent=TRUE)
shinybusy::show_modal_spinner(text="please wait") # show the modal window
# first clean up the folder
+
ls <- list.files(normalizePath("./data/tempplot"))
file.remove(normalizePath(file.path("./data/tempplot",ls)))
r_mig_mult <- charge(r_mig_mult)
@@ -183,31 +182,37 @@ mod_migr_mult_server <- function(id, DD){
# Stocke directement les graphiques en tant qu'objets
graphs <- generateGraphs(r_mig_mult)
- #browser()
+
shinybusy::remove_modal_spinner() # remove it when done
if ("1" %in% input$choix_sorties) {
if (input$box_plot_mm_std$collapsed) shinydashboardPlus::updateBox("box_plot_mm_std", action = "toggle")
- browser()
+ # browser()
# Génération dynamique des onglets
output$dynamicTabs <- renderUI({
- tabs <- lapply(graphs, function(name) {
- tabPanel(name, imageOutput(outputId = ns(paste0("image_", name)))) # IDs dynamiques
+ tabs <- lapply(names(graphs), function(name) {
+ tabPanel(graphs[[name]], imageOutput(outputId = ns(paste0("image_", name)),inline=TRUE)) # IDs dynamiques
})
do.call(tabsetPanel, tabs)
})
# Rendu des graphiques
-
- lapply(graphs, function(name) {
+ #browser()
+ lapply(names(graphs), function(name) {
output[[paste0("image_", name)]] <- renderImage({
-
- validate(need(file.exists(file.path("./data/tempplot",paste0(name,'.png'))),
- message=strintf("internal error in mod_mig_mult_server, file %s not found",
- file.path("./data/tempplot",paste0(name,'.png')))))
- list(normalizePath(file.path("./data/tempplot",paste0(name,'.png'))))
+
+
+ validate(need(file.exists(file.path("./data/tempplot",paste0(graphs[[name]],'.png'))),
+ #message=strintf("internal error in mod_mig_mult_server, file %s not found",
+ message = sprintf("internal error in mod_mig_mult_server, file %s not found",
+ file.path("./data/tempplot",paste0(graphs[[name]],'.png')))))
+
+ # src=list(normalizePath(file.path("./data/tempplot",paste0(graphs[[name]],'.png'))))
+ list(src=normalizePath(file.path("./data/tempplot",paste0(graphs[[name]],'.png'))),
+ width = 500)
}, deleteFile = FALSE)
})
+
} else {
@@ -299,74 +304,74 @@ mod_migr_mult_server <- function(id, DD){
if (!input$box_tab_mm$collapsed) shinydashboardPlus::updateBox("box_tab_mm", action = "toggle")
}
- observeEvent({DD$button_box_custom_migr_mult_step()
-
- },{
- shinyCatch({
-
- palette_plot<-envir_stacomi$palette_plot
- plot_title<-envir_stacomi$plot_title
- plot_xlab<-envir_stacomi$xlab
- plot_ylab<-envir_stacomi$ylab
- theme_plot<-envir_stacomi$theme_plot
-
- g_report_migr_mult_step <- envir_stacomi$p_step
-
- if (plot_title != "") g_report_migr_mult_multiple <- g_report_migr_mult_step + ggplot2::ggtitle(plot_title)
- if (plot_ylab != "") g_report_migr_mult_step <- g_report_migr_mult_step + ggplot2::ylab(plot_ylab)
- if (plot_xlab != "") g_report_migr_mult_step <- g_report_migr_mult_step + ggplot2::xlab(plot_xlab)
- if (theme_plot != "aucun") g_report_migr_mult_step <- g_report_migr_mult_step + match.fun(theme_plot)()
- if (palette_plot != "aucun") g_report_migr_mult_step <- g_report_migr_mult_step + ggplot2::scale_color_brewer(palette = palette_plot)
-
-
-
- output$plot_migration_mult_step<-renderPlot({
- g_report_migr_mult_step
- })
-
-
- },blocking_level = "error"
- )},
- ignoreInit=TRUE,
- ignoreNULL = TRUE
- )
+ # observeEvent({DD$button_box_custom_migr_mult_step()
+ #
+ # },{
+ # shinyCatch({
+ #
+ # palette_plot<-envir_stacomi$palette_plot
+ # plot_title<-envir_stacomi$plot_title
+ # plot_xlab<-envir_stacomi$xlab
+ # plot_ylab<-envir_stacomi$ylab
+ # theme_plot<-envir_stacomi$theme_plot
+ #
+ # g_report_migr_mult_step <- envir_stacomi$p_step
+ #
+ # if (plot_title != "") g_report_migr_mult_multiple <- g_report_migr_mult_step + ggplot2::ggtitle(plot_title)
+ # if (plot_ylab != "") g_report_migr_mult_step <- g_report_migr_mult_step + ggplot2::ylab(plot_ylab)
+ # if (plot_xlab != "") g_report_migr_mult_step <- g_report_migr_mult_step + ggplot2::xlab(plot_xlab)
+ # if (theme_plot != "aucun") g_report_migr_mult_step <- g_report_migr_mult_step + match.fun(theme_plot)()
+ # if (palette_plot != "aucun") g_report_migr_mult_step <- g_report_migr_mult_step + ggplot2::scale_color_brewer(palette = palette_plot)
+ #
+ #
+ #
+ # output$plot_migration_mult_step<-renderPlot({
+ # g_report_migr_mult_step
+ # })
+ #
+ #
+ # },blocking_level = "error"
+ # )},
+ # ignoreInit=TRUE,
+ # ignoreNULL = TRUE
+ # )
- observeEvent({DD$button_box_custom_migr_mult_multiple()
-
- },{
- shinyCatch({
-
- palette_plot <- envir_stacomi$palette_plot
- plot_title <- envir_stacomi$plot_title
- plot_xlab <- envir_stacomi$xlab
- plot_ylab <- envir_stacomi$ylab
- theme_plot <- envir_stacomi$theme_plot
-
- g_report_migr_mult_multiple <- envir_stacomi$p_multiple
-
- if (plot_title != "") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + ggplot2::ggtitle(plot_title)
- if (plot_ylab != "") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + ggplot2::ylab(plot_ylab)
- if (plot_xlab != "") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + ggplot2::xlab(plot_xlab)
- if (theme_plot != "aucun") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + match.fun(theme_plot)()
- if (palette_plot != "aucun") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + ggplot2::scale_fill_brewer(palette = palette_plot)
-
-
-
- output$plot_migration_multiple<-renderPlot({
- g_report_migr_mult_multiple
- })
-
-
- },blocking_level = "error"
- )},
- ignoreInit=TRUE,
- ignoreNULL = TRUE
- )
+ # observeEvent({DD$button_box_custom_migr_mult_multiple()
+ #
+ # },{
+ # shinyCatch({
+ #
+ # palette_plot <- envir_stacomi$palette_plot
+ # plot_title <- envir_stacomi$plot_title
+ # plot_xlab <- envir_stacomi$xlab
+ # plot_ylab <- envir_stacomi$ylab
+ # theme_plot <- envir_stacomi$theme_plot
+ #
+ # g_report_migr_mult_multiple <- envir_stacomi$p_multiple
+ #
+ # if (plot_title != "") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + ggplot2::ggtitle(plot_title)
+ # if (plot_ylab != "") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + ggplot2::ylab(plot_ylab)
+ # if (plot_xlab != "") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + ggplot2::xlab(plot_xlab)
+ # if (theme_plot != "aucun") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + match.fun(theme_plot)()
+ # if (palette_plot != "aucun") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + ggplot2::scale_fill_brewer(palette = palette_plot)
+ #
+ #
+ #
+ # output$plot_migration_multiple<-renderPlot({
+ # g_report_migr_mult_multiple
+ # })
+ #
+ #
+ # },blocking_level = "error"
+ # )},
+ # ignoreInit=TRUE,
+ # ignoreNULL = TRUE
+ # )
# return(reactive(input$bttn_migr_mult))
- })
+ #})#shinycatch
})
- })
+ })
}
## To be copied in the UI
--
GitLab
From 91630deb95347b027e085d3c4740ec07beef1b4e Mon Sep 17 00:00:00 2001
From: Laurent BEAULATON <laurent.beaulaton@ofb.gouv.fr>
Date: Sun, 2 Mar 2025 18:11:16 +0100
Subject: [PATCH 47/47] Revert "Merge branch '23-fix-ci' into 'develop'"
This reverts merge request !4
---
.gitlab-ci.yml | 67 +++++++++++++++------
gitlab-ci/before_script.gitlab-ci.yml | 6 --
gitlab-ci/build_binary.gitlab-ci.yml | 13 ----
gitlab-ci/build_images_docker.gitlab-ci.yml | 32 ----------
gitlab-ci/check.gitlab-ci.yml | 9 ---
gitlab-ci/documentation.gitlab-ci.yml | 8 ---
gitlab-ci/image.gitlab-ci.yml | 13 ----
gitlab-ci/rules.gitlab-ci.yml | 19 ------
8 files changed, 47 insertions(+), 120 deletions(-)
delete mode 100644 gitlab-ci/before_script.gitlab-ci.yml
delete mode 100644 gitlab-ci/build_binary.gitlab-ci.yml
delete mode 100644 gitlab-ci/build_images_docker.gitlab-ci.yml
delete mode 100644 gitlab-ci/check.gitlab-ci.yml
delete mode 100644 gitlab-ci/documentation.gitlab-ci.yml
delete mode 100644 gitlab-ci/image.gitlab-ci.yml
delete mode 100644 gitlab-ci/rules.gitlab-ci.yml
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 3a836bb..f5298c7 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -1,37 +1,64 @@
-include:
- - local: '/gitlab-ci/rules.gitlab-ci.yml' # generic rules to be used for main branch or others
- - local: '/gitlab-ci/image.gitlab-ci.yml' # image to be used for main branch or others
- - local: '/gitlab-ci/before_script.gitlab-ci.yml'
- - local: '/gitlab-ci/build_binary.gitlab-ci.yml'
- - local: '/gitlab-ci/documentation.gitlab-ci.yml'
- - local: '/gitlab-ci/check.gitlab-ci.yml'
- - local: '/gitlab-ci/build_images_docker.gitlab-ci.yml' # building docker images
+# test config
+image: rocker/tidyverse
stages: # List of stages for jobs, and their order of execution
- build
- document
- check
- covr
- - build_images
variables:
R_LIBS_USER: "$CI_PROJECT_DIR/ci/lib"
CHECK_DIR: "$CI_PROJECT_DIR/ci/logs"
BUILD_DIR: "$CI_PROJECT_DIR/ci/build"
BUILD_LOGS_DIR: "$CI_PROJECT_DIR/ci/logs/$CI_PROJECT_NAME.Rcheck"
- r_image_path: "registry.forgemia.inra.fr/stacomi/stacomi_db"
- r_image_name: "r4stacomi"
- r_image_tagdev: "4.x-dev"
- docker_version: "20.10"
-cache:
- key: $CI_COMMIT_REF_SLUG
- paths:
- - ${R_LIBS_USER}/
+# the .Renviron in the document folder contains the path to the libraries in the form R_LIBS=$CI_PROJECT_DIR/ci/lib
+# there are three lines added there so the uploaded packages will end up there
+before_script:
+ - apt-get update
+ - apt-get install -y qpdf
+ - mkdir -p $R_LIBS_USER $BUILD_LOGS_DIR $BUILD_DIR
+ - echo 'R_LIBS=$R_LIBS_USER' > .Renviron
+ - echo 'R_LIBS_USER=$R_LIBS_USER' >> .Renviron
+ - echo 'R_LIBS_SITE=$R_LIBS_USER' >> .Renviron
+
+# below CI_COMMIT_REF_SLUG is CI_COMMIT_REF_NAME The branch or tag name for which project is built, in lowercase, shortened to 63 bytes
+buildbinary:
+ stage: build
+ script:
+ # dependencies =TRUE only supports one
+ - R -e 'install.packages(pkgs=c("testthat"), dependencies = TRUE, repos ="https://pbil.univ-lyon1.fr/CRAN/")'
+ - R -e 'install.packages(pkgs=c("devtools"), dependencies = TRUE, repos ="https://pbil.univ-lyon1.fr/CRAN/")'
+ # below TRUE is shorthand for "Depends", "Imports", "LinkingTo" and "Suggests".
+ - R -e 'devtools::install_deps(dependencies = TRUE, lib = Sys.getenv("R_LIBS_USER"))'
+ - R -e 'devtools::build(binary = TRUE, path=Sys.getenv("BUILD_DIR"), vignettes=FALSE, manual=FALSE)'
+ cache:
+ key: "$CI_COMMIT_REF_SLUG"
+ paths:
+ - "$R_LIBS_USER"
+ artifacts:
+ paths:
+ - "$BUILD_DIR"
+
+documentation:
+ stage: document
+ script:
+ - R -e 'devtools::document()'
+
+checkerrors:
+ stage: check
+ script:
+ - R -e 'devtools::check(check_dir = Sys.getenv("CHECK_DIR"), document = FALSE, args = "--no-tests")'
+ - R -e 'if (length(devtools::check_failures(path = Sys.getenv("BUILD_LOGS_DIR"), note = FALSE)) > 0) stop()'
+ cache:
+ paths:
+ - $R_LIBS_USER
+
coverage:
stage: covr
- extends:
- - .rules_shut_down
script:
- R -e 'install.packages(pkgs=c("covr"), dependencies = TRUE, repos ="https://pbil.univ-lyon1.fr/CRAN/")'
- - R -e 'covr::package_coverage(Sys.getenv("CI_PROJECT_DIR"))'
\ No newline at end of file
+ - R -e 'covr::package_coverage(Sys.getenv("CI_PROJECT_DIR"))'
+
+
\ No newline at end of file
diff --git a/gitlab-ci/before_script.gitlab-ci.yml b/gitlab-ci/before_script.gitlab-ci.yml
deleted file mode 100644
index 171bab9..0000000
--- a/gitlab-ci/before_script.gitlab-ci.yml
+++ /dev/null
@@ -1,6 +0,0 @@
-# the .Renviron in the document folder contains the path to the libraries in the form R_LIBS=$CI_PROJECT_DIR/ci/lib
-# there are three lines added there so the uploaded packages will end up there
-before_script:
- - apt-get update
- - mkdir -p ${R_LIBS_USER} ${BUILD_LOGS_DIR} ${BUILD_DIR}
- - echo 'R_LIBS_USER=${R_LIBS_USER}' >> .Renviron
\ No newline at end of file
diff --git a/gitlab-ci/build_binary.gitlab-ci.yml b/gitlab-ci/build_binary.gitlab-ci.yml
deleted file mode 100644
index 7e85fa8..0000000
--- a/gitlab-ci/build_binary.gitlab-ci.yml
+++ /dev/null
@@ -1,13 +0,0 @@
-buildbinary:
- stage: build
- extends:
- - .image-dev
- - .rules_other
- script:
- - echo "install packages"
- - R -e 'remotes::install_deps(upgrade = "never")'
- - R -e 'devtools::build(binary = TRUE, path=Sys.getenv("BUILD_DIR"), vignettes=FALSE, manual=FALSE)'
- - cp --recursive /usr/local/lib/R/site-library ${R_LIBS_USER}
- artifacts:
- paths:
- - ${BUILD_DIR}
\ No newline at end of file
diff --git a/gitlab-ci/build_images_docker.gitlab-ci.yml b/gitlab-ci/build_images_docker.gitlab-ci.yml
deleted file mode 100644
index f34dc68..0000000
--- a/gitlab-ci/build_images_docker.gitlab-ci.yml
+++ /dev/null
@@ -1,32 +0,0 @@
-# build docker images
-
-#######################
-# for any branch, but main
-build_stacoshiny-dev:
- image: docker:$docker_version
- stage: build_images
- services:
- - docker:$docker_version_dind
- extends:
- - .rules_shut_down
- script:
- - echo $CI_REGISTRY_PASSWORD | docker login -u $CI_REGISTRY_USER $CI_REGISTRY --password-stdin
- - docker build -t $CI_REGISTRY_IMAGE/${stacoshiny_image_name}:${stacoshiny_version}-$tag_dev -f stacoshiny.dockerfile .
- - docker push --all-tags $CI_REGISTRY_IMAGE/${stacoshiny_image_name}
-
-#######################
-# for main banch only
-build_stacoshiny-prod:
- image: docker:$docker_version
- stage: build_images
- services:
- - docker:$docker_version_dind
- extends:
- - .rules_shut_down
- when: manual
- script:
- - echo $CI_REGISTRY_PASSWORD | docker login -u $CI_REGISTRY_USER $CI_REGISTRY --password-stdin
- - docker build -t $CI_REGISTRY_IMAGE/${stacoshiny_image_name}:${stacoshiny_version} -f stacoshiny.dockerfile .
- - docker tag $CI_REGISTRY_IMAGE/${stacoshiny_image_name}:${stacoshiny_version} $CI_REGISTRY_IMAGE/${stacoshiny_image_name}:latest
- - docker push --all-tags $CI_REGISTRY_IMAGE/${stacoshiny_image_name}
-
\ No newline at end of file
diff --git a/gitlab-ci/check.gitlab-ci.yml b/gitlab-ci/check.gitlab-ci.yml
deleted file mode 100644
index e83d0fd..0000000
--- a/gitlab-ci/check.gitlab-ci.yml
+++ /dev/null
@@ -1,9 +0,0 @@
-checkerrors:
- stage: check
- extends:
- - .image-dev
- - .rules_other
- script:
- - echo 'R_LIBS=$R_LIBS_USER' > .Renviron
- - Rscript -e 'devtools::check(check_dir = Sys.getenv("CHECK_DIR"), document = FALSE, args = "--no-tests")'
- - Rscript -e 'if (length(devtools::check_failures(path = Sys.getenv("BUILD_LOGS_DIR"), note = FALSE)) > 0) stop()'
\ No newline at end of file
diff --git a/gitlab-ci/documentation.gitlab-ci.yml b/gitlab-ci/documentation.gitlab-ci.yml
deleted file mode 100644
index 206678c..0000000
--- a/gitlab-ci/documentation.gitlab-ci.yml
+++ /dev/null
@@ -1,8 +0,0 @@
-documentation:
- stage: document
- extends:
- - .image-dev
- - .rules_other
- script:
- - echo 'R_LIBS=$R_LIBS_USER' > .Renviron
- - R -e 'devtools::document()'
\ No newline at end of file
diff --git a/gitlab-ci/image.gitlab-ci.yml b/gitlab-ci/image.gitlab-ci.yml
deleted file mode 100644
index d4b43ea..0000000
--- a/gitlab-ci/image.gitlab-ci.yml
+++ /dev/null
@@ -1,13 +0,0 @@
-# to use the right docker db image
-
-#######################
-# for any branch, but main
-.image-dev:
- image:
- name: ${r_image_path}/${r_image_name}:${r_image_tagdev}
- entrypoint: ["/usr/sbin/init"]
-
-#######################
-# for main banch only
-.image-prod:
- image: ${r_image_path}/${r_image_name}:latest
\ No newline at end of file
diff --git a/gitlab-ci/rules.gitlab-ci.yml b/gitlab-ci/rules.gitlab-ci.yml
deleted file mode 100644
index f58f838..0000000
--- a/gitlab-ci/rules.gitlab-ci.yml
+++ /dev/null
@@ -1,19 +0,0 @@
-# generic rules to be used for main branch or others
-
-#######################
-# for any branch, but main
-.rules_other:
- rules:
- - if: '$CI_COMMIT_BRANCH != "main"' # only if there is changes in branch other than main
-
-#######################
-# for main banch only
-.rules_main:
- rules:
- - if: '$CI_COMMIT_BRANCH == "main"' # only if there is changes in the main branch
-
-#######################
-# for shutting down the job
-.rules_shut_down:
- rules:
- - when: never # only if there is changes in the main branch
\ No newline at end of file
--
GitLab