diff --git a/.Rbuildignore b/.Rbuildignore
index 4517734e6a4c87325e896a30489b790a8287a01e..74cb3a131290bdbfe13fb4d2a37a5e1b70261c75 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -13,3 +13,5 @@ $run_dev.*
^Jenkinsfile$
^\.gitlab-ci\.yml$
^ci
+^app\.R$
+^rsconnect$
diff --git a/.gitignore b/.gitignore
index cfa04f0172529be41ac5ae8a7c7991091949c335..34134b0d4f27cbf751051ec41b6b01a9f9d0fa42 100644
--- a/.gitignore
+++ b/.gitignore
@@ -9,5 +9,6 @@
/.project
.settings
/.dbeaver/
+*/tempplot
inst/doc
*.log
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 3a836bbceaad4ae3e035e3de68d2c0aecfddebfc..f5298c73903a289af1b5ca18388e16921f828eac 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/DESCRIPTION b/DESCRIPTION
index 5650813921a7c075a4b7f47608945d7c33d0c915..1849444b6f036e00113fa415f94889c5e7493518 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,
@@ -22,15 +22,15 @@ Imports:
spsComps,
pool,
shinipsum,
- stacomiR (>= 0.6.0.5),
+ stacomiR (>= 0.6.0.7),
dplyr,
rlang,
shinybusy,
magrittr,
- ggthemes
+ pkgload
Encoding: UTF-8
LazyData: true
-RoxygenNote: 7.2.1
+RoxygenNote: 7.3.2
Suggests:
testthat,
spelling,
diff --git a/NAMESPACE b/NAMESPACE
index 5a5de8a8f441a499727e6ada58420d5b9f58b097..90aed209baf7fa014cbfa40ba84707dfefa028e0 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)
diff --git a/R/_disable_autoload.R b/R/_disable_autoload.R
new file mode 100644
index 0000000000000000000000000000000000000000..a8c9436ac0d7c31315d1dd10199cca3b570581dc
--- /dev/null
+++ b/R/_disable_autoload.R
@@ -0,0 +1,3 @@
+# Disabling shiny autoload
+
+# See ?shiny::loadSupport for more information
diff --git a/R/app_server.R b/R/app_server.R
index ad9b5adf625d118e7d36484d0c863ea9b7d1731b..034a954653c0d4dd5a33acc89cc4c5744fda5eea 100644
--- a/R/app_server.R
+++ b/R/app_server.R
@@ -15,14 +15,15 @@ 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")
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 ---------------------------------------------------
mod_annuel_server("annuel_ui_1", DD)
@@ -30,24 +31,28 @@ app_server <- function( input, output, session ) {
DD$button_ref_stage_annuel <- mod_ref_stage_server("ref_stage_mod_annuel", DD, mytab="annuel")
DD$button_box_custom_annuel_2<-mod_custom_plot_server("custom_plot_annuel_2",DD,mytab="annuel")
- # interannuel ---------------------------------------------------
+# 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_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_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_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 ---------------------------------------------------
mod_espece_server("espece_ui_1")
DD$button_ref_taxa_espece <- mod_ref_taxa_server("ref_taxa_espece", DD, mytab="espece")
+
# caractéristiques de lots ---------------------------------------------------
mod_sample_char_server("sample_char_ui_1",DD)
@@ -58,6 +63,7 @@ app_server <- function( input, output, session ) {
DD$button_box_custom_sample_car_2<-mod_custom_plot_server("custom_plot_sample_char_2",DD,mytab="sample_char")
DD$button_box_custom_sample_car_3<-mod_custom_plot_server("custom_plot_sample_char_3",DD,mytab="sample_char")
+
# mod_migr_car ---------------------------------------------------
DD$button_quan_to_qual <- mod_migr_car_server("migr_car_ui_1", DD)
@@ -69,35 +75,38 @@ app_server <- function( input, output, session ) {
DD$button_box_custom_mig_char_2<-mod_custom_plot_server("custom_plot_mig_char_2",DD,mytab="migr_car")
DD$button_box_custom_mig_char_3<-mod_custom_plot_server("custom_plot_mig_char_3",DD,mytab="migr_car")
- # mod_mig_env -----------------------------
- mod_migr_env_server("migr_env_ui_1")
- DD$button_ref_stationmesure_mod_migr_env <- mod_ref_stationmesure_server("ref_stationmesure_mod_migr_env", DD, mytab="migr_env")
-
- # mod_sat_age -----------------------------
- mod_sat_age_server("sat_age_ui_1")
- DD$button_ref_parquan_sat_age <- mod_ref_parquan_server("ref_parquan_sat_age",DD, mytab="sat_age")
+ # mod_mig_env -----------------------------
+ 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")
+ DD$button_ref_parquan_sat_age <- mod_ref_parquan_server("ref_parquan_sat_age", DD, mytab = "sat_age")
-
- mod_ang_argentee_server("ang_argentee_ui_1")
- mod_civ_poids_server("civ_poids_ui_1")
+ # mod_ang_argentee -----------------------------
-
+ 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 -----------------------------
+
+ mod_bilan_df_server("bilan_df_ui_1")
+ DD$button_ref_df <- mod_ref_df_server("ref_df_ui_1", DD, mytab = "bilan_df")
+
+
+ # mod_env -----------------------------
+ mod_env_server("env_ui_1")
+ DD$button_ref_stationmesure_mod_env <- mod_ref_stationmesure_server("ref_stationmesure_mod_env", DD, mytab = "env")
- # 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 -----------------------------
-
- mod_bilan_df_server("bilan_df_ui_1")
- DD$button_ref_df<-mod_ref_df_server("ref_df_ui_1",DD,mytab="bilan_df")
-
-
- # mod_env -----------------------------
- mod_env_server("env_ui_1")
- DD$button_ref_stationmesure_mod_env <- mod_ref_stationmesure_server("ref_stationmesure_mod_env", DD, mytab="env")
}
diff --git a/R/global.R b/R/global.R
index bca6feea50de2d37e54dd297f6ab738db9782e69..4698ed7ee0a700f4ee24464b383efd95cc92a0d4 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_ang_argentee.R b/R/mod_ang_argentee.R
index ad27ddc3c47e07dc85e00e867266e19daf25251a..369157877b719be2e2f85f9b921ac8381c4877db 100644
--- a/R/mod_ang_argentee.R
+++ b/R/mod_ang_argentee.R
@@ -136,6 +136,7 @@ mod_ang_argentee_server <- function(id, DD) {
ns <- session$ns
observeEvent(input$bttn_angarg, {
shinyCatch(
+
{
validate(need(exists("envir_stacomi"), "Le programme stacomi doit être lancé"))
db_connection <- envir_stacomi$db_connection
@@ -143,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,
@@ -157,9 +157,13 @@ 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
- 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")
@@ -196,9 +200,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,12 +215,11 @@ mod_ang_argentee_server <- function(id, DD) {
buttons = c('csv', 'excel', 'pdf'),
text = 'Download'
))
-
- ))
- })
+ ))
+ },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/R/mod_annuel.R b/R/mod_annuel.R
index 7810fa49f38f3d38670ddd07f81034f6bd1f6797..ac1e69bf8076abc14932db4fb7e43cc9394e3f79 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"),
@@ -135,19 +136,18 @@ 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'
+ ))
))
- })
+ },server = FALSE)
} else {
if (!input$box_annuel_data$collapsed) shinydashboardPlus::updateBox("box_annuel_data", action = "toggle")
} # end ifelse "3"
@@ -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 6bd507a1af36694e7f16147bdf530b493e4b4d22..8019b368bfa32314dd753ab4580d42629152f045 100644
--- a/R/mod_bilan_dc.R
+++ b/R/mod_bilan_dc.R
@@ -11,392 +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 supé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(
- 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"))
- ))
-
- })
- 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"))
- ))
-
- })
- 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"))
- ))
- })
-
- } 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
-
- })
-
- })
+ 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)
+ 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_bilan_df.R b/R/mod_bilan_df.R
index 9675ecb5e51aa574e2e9f0355a42b2d64f0e3715..3463568bf7a5f995ab717a946f86624275cf20b7 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,
@@ -218,52 +218,51 @@ 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'
+ ))
+ ))
+
+ },server = FALSE)
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'
+ ))
+ ))
+
+ },server = FALSE)
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'
+ ))
+ ))
+ },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 d533db86d8624e4d86f74e2de7c83c27ec0abbac..2d8a2c32374c934a2f1bdece78718a5ef933f67a 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, "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]
+ #browser()
r_gew <- choice_c(
r_gew,
dc = ref_dc@dc_selected,
@@ -178,11 +184,22 @@ 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({
- print(tab2)
- })
+ DT::datatable(data.frame(r_gew@calcdata$data),
+ 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_civpoids$collapsed)
shinydashboardPlus::updateBox("box_tab_civpoids", action = "toggle")
@@ -190,11 +207,22 @@ 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({
- print(tab4)
- })
+ DT::datatable(as.data.frame(r_gew@calcdata$coe),
+ 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_civpoids2$collapsed)
shinydashboardPlus::updateBox("box_tab_civpoids2", action = "toggle")
diff --git a/R/mod_custom_plot.R b/R/mod_custom_plot.R
index 20b4001004339651e4a29f7b9f836adcb0534bcb..837b083c2d9c9fc9ad3db548ceea116bb3be1d1e 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
new file mode 100644
index 0000000000000000000000000000000000000000..c64c2361ec94fc4474755d0a22d1ef09f00d6756
--- /dev/null
+++ b/R/mod_custom_plot_interannual.R
@@ -0,0 +1,152 @@
+#' 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"),
+ uiOutput(ns('pas_temps')),
+ uiOutput(ns("year_choice")),
+ 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
+#' @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)
+ 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<-c("aucun",theme_plot_ggplot,theme_plot_ggthemes)
+
+ updateSelectInput(session, "select_palette_plot",
+ choices = palette_plot,
+ selected="aucun"
+ )
+ updateSelectInput(session, "select_theme_plot",
+ choices = theme_plot
+ )
+
+ DD$annees_disponibles <- envir_stacomi$annees_disponibles
+
+
+
+
+ }, 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)
+ 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")
+ },
+ 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_espece.R b/R/mod_espece.R
index 492750b4ee923fa2d76fbc385d61d88305e0e1b3..4e7c31d8e94d88679b2beafe72279d720ebea596 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,8 +135,21 @@ 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'
+ ))
+ ))
+
+ },server = FALSE)
} else {
if (!input$box_esp_summary$collapsed) shinydashboardPlus::updateBox("box_esp_summary", action = "toggle")
} # end ifelse "3"
diff --git a/R/mod_header.R b/R/mod_header.R
index 673a33cae5872ee42ef6487533c5a1eb11753ed0..6a0459aaef9ab0df8a3c9b79b0648384c5843236 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
},
diff --git a/R/mod_interannuel.R b/R/mod_interannuel.R
index c521c1fc55ea3dd57e5ced647d5f233369447d3d..d778a203067eb4ca34bab08a35ec75755e48e3be 100644
--- a/R/mod_interannuel.R
+++ b/R/mod_interannuel.R
@@ -9,165 +9,163 @@
#' @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",
- shinydashboardPlus::box(
- title = "S\u00e9lections :",
- solidHeader = TRUE,
- #icon("list-alt"),
- collapsible = TRUE,
- status="primary",
- width = 3,
- sliderInput(ns("slider_interannuel_annee"),
- label = h5("Choisissez l\'ann\u00e9e"),
- min = 1980,
- max = CY,
- value = c(2011, CY)),
-
- 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"),
- 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_1"),
- ),
- 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_2"),
- # ),
- 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_3"),
- ),
- 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_4"),
- # ),
- 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_5"),
- # ),
- 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_6"),
- ),
- 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_7"),
- ),
- 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"))
- )
-
-
- )
-
+ 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),
+ 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_interannual_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_interannual_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_interannual_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,
+
+ 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_interannual_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
@@ -175,390 +173,415 @@ 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", 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", 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", 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")
+ 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)
+ annees_disponibles <- unique(r_mig_interannual@data$bjo_annee)
+ assign("annees_disponibles", annees_disponibles, envir=envir_stacomi)
+
+
+ # 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
+ 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
+
+ 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({
+ 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_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]
+
+ 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({
+ 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
+ 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
+
+ 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({
+ g_interannuel_step
+ })
+
+
+ },blocking_level = "error"
+ )},
+ ignoreInit=TRUE,
+ ignoreNULL = TRUE
+ )
+
+ observeEvent({DD$button_box_custom_interannuel_barchart()
+
+ },{
+ 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
+ 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
+
+ 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
+ })
+
+
+ },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
+ 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
+
+ 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({
+ 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
+
+ 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({
+ 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
+ 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
+
+ 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({
+ g_interannuel_seasonal
+ })
+
+
+ },blocking_level = "error"
+ )},
+ ignoreInit=TRUE,
+ ignoreNULL = TRUE
+ )
+
+ }) # end shiny catch
+ }, ignoreInit=TRUE, ignoreNULL = TRUE)# end observeEvent
+ return(reactive(input$bttn_interannuel))
+ }
- 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_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_interannuel_1=envir_stacomi$g
-
- g_interannuel_1 <- g_interannuel_1+
- 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_1
- })
-
-
- },blocking_level = "error"
- )},
- ignoreInit=TRUE,
- ignoreNULL = TRUE
- )
-
- observeEvent({DD$button_box_custom_interannuel_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_interannuel_2=envir_stacomi$g
-
- g_interannuel_2 <- g_interannuel_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_interannuel_standard<-renderPlot({
- g_interannuel_2
- })
-
-
- },blocking_level = "error"
- )},
- ignoreInit=TRUE,
- ignoreNULL = TRUE
- )
-
- observeEvent({DD$button_box_custom_interannuel_3()
-
- },{
- 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_3=envir_stacomi$g
-
- g_interannuel_3 <- g_interannuel_3+
- 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_3
- })
-
-
- },blocking_level = "error"
- )},
- ignoreInit=TRUE,
- 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_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_6()
-
- },{
- 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_6=envir_stacomi$g
-
- g_interannuel_6 <- g_interannuel_6+
- 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_6
- })
-
-
- },blocking_level = "error"
- )},
- ignoreInit=TRUE,
- ignoreNULL = TRUE
- )
-
- observeEvent({DD$button_box_custom_interannuel_7()
-
- },{
- 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_7=envir_stacomi$g
-
- g_interannuel_7 <- g_interannuel_7+
- 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_7
- })
-
-
- },blocking_level = "error"
- )},
- ignoreInit=TRUE,
- ignoreNULL = TRUE
- )
-
- }) # end shiny catch
- }, ignoreInit=TRUE, ignoreNULL = TRUE)# end observeEvent
-}) # end moduleServer
+ ) # end moduleServer
}
## To be copied in the UI
diff --git a/R/mod_mig_char.R b/R/mod_mig_char.R
index 3f3090acd10dd0bd96391270aa37ef7629a7c787..f4fcc43de3504d72d71ff96a23c7085a30a287f9 100644
--- a/R/mod_mig_char.R
+++ b/R/mod_mig_char.R
@@ -351,8 +351,19 @@ 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(r_mig_char@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'
+ ))
+ ))
+ },server = FALSE)
} else {
if (!input$box_migr_car_data$collapsed) shinydashboardPlus::updateBox("box_migr_car_data", action = "toggle")
}
diff --git a/R/mod_migr_env.R b/R/mod_migr_env.R
index 7257b42c7d915532f48e95250f0f36e598c91eb3..907bc4aab29725e3dc980ad49ebffae7c06bd600 100644
--- a/R/mod_migr_env.R
+++ b/R/mod_migr_env.R
@@ -14,25 +14,14 @@ 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),
- 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),
-
- 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_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")),
+ 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"),
@@ -40,15 +29,20 @@ mod_migr_env_ui <- function(id) {
style = "fill",
color = "primary"
)
-
),
- box(collapsible = TRUE,
- width = 9,
- plotOutput(ns("plot_migr_env1")),
- plotOutput(ns("plot_migr_env2"))
-
- )
+ shinydashboardPlus::box(
+ id=ns("box_plot_migr_env"),
+ title="Plot migr env",
+ status = "primary",
+ solidHeader = TRUE,
+ collapsible = TRUE,
+ collapsed=TRUE,
+ width=8,
+ plotOutput(ns("plot_migr_env"),
+ width = "100%",
+ height = "600px")
+)
)
}
@@ -56,19 +50,89 @@ 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
- output$plot_migr_env1 <- renderPlot({
- random_ggplot()
- })
-
- output$plot_migr_env2 <- renderPlot({
- random_ggplot()
- })
-
+ observeEvent(
+ eventExpr = {
+ # 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_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 {
+ 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_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$collapsed) shinydashboardPlus::updateBox("box_plot_migr_env", action = "toggle")
+ } # end ifelse "1"
+
+ }
+
+ # output$plot_migr_env1 <- renderPlot({
+ # random_ggplot()
+ # })
+ #
+ # output$plot_migr_env2 <- renderPlot({
+ # random_ggplot()
+ # })
+ }) ## end shinycatch
})
-}
+})}
## To be copied in the UI
# mod_migr_env_ui("migr_env_ui_1")
diff --git a/R/mod_migr_mult.R b/R/mod_migr_mult.R
index 211da574f4c1713c84098da942fbb12b779c130e..16a2263efa54e5d86ac844ca0bc93152b0578ffa 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()
+
+ r_mig_mult2<-r_mig_mult
+ 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"]]
+
+ 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
+ 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]
+
+ # 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 <- file.path("./data/tempplot",paste0(graph_name, '.png'))
+ png(outfile,width=6, height=8, units ="in",res=300)
+ stacomiR::plot(r_mig_mult2, plot.type = "standard", silent = TRUE)
+ dev.off()
+ graphs[[as.character(id)]] <- graph_name
+ }
+ }
+ }
+ return(graphs)
+}
+
mod_migr_mult_ui <- function(id){
ns <- NS(id)
tabItem(tabName = "migr_mult",
@@ -40,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,
- plotOutput(ns("plot_migration_mult_standard"),
- width = "100%",
- height = "600px")
- ),
+ uiOutput(ns("dynamicTabs")) # Dynamically generate the tab panels,
+ ),
shinydashboardPlus::box(
id=ns("box_plot_mm_ms"),
title="Plot step",
@@ -63,7 +99,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 +114,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"))
@@ -108,7 +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"))
@@ -127,6 +165,10 @@ 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
@@ -136,12 +178,43 @@ 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
+ graphs <- generateGraphs(r_mig_mult)
+
+
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)
+ # browser()
+ # Génération dynamique des onglets
+ output$dynamicTabs <- renderUI({
+ 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
+ #browser()
+ lapply(names(graphs), function(name) {
+ output[[paste0("image_", name)]] <- renderImage({
+
+
+ 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 {
if (!input$box_plot_mm_std$collapsed) shinydashboardPlus::updateBox("box_plot_mm_std", action = "toggle")
}
@@ -216,92 +289,89 @@ 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'
+ ))
+ ))
+ },server = FALSE)
}
} else {
if (!input$box_tab_mm$collapsed) shinydashboardPlus::updateBox("box_tab_mm", action = "toggle")
}
- observeEvent({DD$button_box_custom_migr_mult_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_migr_mult_2=envir_stacomi$p
-
- 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
- })
-
-
- },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_3()
-
- },{
- 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_3=envir_stacomi$p
-
- 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
- })
-
-
- },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
diff --git a/R/mod_ref_dc.R b/R/mod_ref_dc.R
index 14c036bfdde8c11367001210389a63e8d573230e..a78a36de1f953927ea113d627d11f5e9a25b6ae4 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()
},
diff --git a/R/mod_ref_schema.R b/R/mod_ref_schema.R
index f0a63ccf1f1eea34982bff58a21a1db9550e4a85..607e4f76f8f956bf116b88a9b3425a1402545d20 100644
--- a/R/mod_ref_schema.R
+++ b/R/mod_ref_schema.R
@@ -46,25 +46,30 @@ 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"))
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
diff --git a/R/mod_ref_stage.R b/R/mod_ref_stage.R
index 142bcd9429ec73b176136d50a371b3533dcdcf1a..1e4238aa73bbd0d661305c130d76a2a689b6feaf 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 = {
diff --git a/R/mod_sample_char.R b/R/mod_sample_char.R
index 7451df88e787bccc79c78e5dc5732a8aa2c5332e..f939129b02a075f65a7ada1f92c78a13fe3917d6 100644
--- a/R/mod_sample_char.R
+++ b/R/mod_sample_char.R
@@ -180,23 +180,18 @@ 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'
+ ))
+ ))
+ },server = FALSE)
} else {
if (!input$box_tab_sample_char_data$collapsed) shinydashboardPlus::updateBox("box_tab_sample_char_data", action = "toggle")
}
@@ -212,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({
@@ -244,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({
@@ -270,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({
diff --git a/R/mod_sat_age.R b/R/mod_sat_age.R
index fe23a7a3d3f2972c0c7a5d658e028977ad3ca7fa..88e97fce931c42bd2b7424e9001cb5ebd7f4aaf3 100644
--- a/R/mod_sat_age.R
+++ b/R/mod_sat_age.R
@@ -129,8 +129,20 @@ 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'
+ ))
+ ))
+ },server = FALSE)
} else {
if (!input$box_summary_sat_age$collapsed) shinydashboardPlus::updateBox("box_summary_sat_age", action = "toggle")
} # end ifelse "3"
diff --git a/app.R b/app.R
new file mode 100644
index 0000000000000000000000000000000000000000..34d3c1ac7cfcc8763560979239419b190848c5b8
--- /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::stacoshiny() # add parameters here (if any)
diff --git a/dev/02_dev.R b/dev/02_dev.R
index 3be43623d13282ce64866e8f01a02ee6a0c92b4d..6e2350fd20b55f9986fb1ae535116bc1c66fab65 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 2714d8729aa56e4b08a838e1e80d6cfb816948f6..26e48a52bd1aa22735fd9ef67007567a08807935 100644
--- a/dev/run_dev.R
+++ b/dev/run_dev.R
@@ -1,18 +1,43 @@
-# Set options here
-# setwd("C:\\workspace\\stacoshiny")
-golem::set_golem_options()
+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() == "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()
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()
-golem::document_and_reload()
+# remotes::install_deps(upgrade='never')
+#devtools::load_all(path = "D://OneDrive - Seine-Normandie Migrateurs/R/Stacoshiny/stacomir/")
+
-# these options set the scene before connecting to the database
+golem::document_and_reload()
+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)
@@ -21,3 +46,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
diff --git a/gitlab-ci/before_script.gitlab-ci.yml b/gitlab-ci/before_script.gitlab-ci.yml
deleted file mode 100644
index 171bab9de054eb5004093e1db2221913e02ab694..0000000000000000000000000000000000000000
--- 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 7e85fa8b6f1676a0126fd7419c517d19ccd6247a..0000000000000000000000000000000000000000
--- 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 f34dc684954e58bcd00e332c138bfb5367b2e015..0000000000000000000000000000000000000000
--- 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 e83d0fdffeeae82c610ac79edb2a6bc39f3b4b63..0000000000000000000000000000000000000000
--- 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 206678cb505e7813983250775eaf9d1ad32fcb25..0000000000000000000000000000000000000000
--- 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 d4b43ea8e11af7b852cfbeff45325654c3295ce7..0000000000000000000000000000000000000000
--- 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 f58f8389fdcf34661fb447daac60db9916b3219a..0000000000000000000000000000000000000000
--- 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
diff --git a/inst/golem-config.yml b/inst/golem-config.yml
index ba52165d4e944a53ed60048ef113e29706e3eada..ab67d92ab65f8d8b4e708cb532de8f1a687499cc 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 74c44ea9d62f6a64461d279ea49a82fc778ba41e..0000000000000000000000000000000000000000
--- 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)
-```