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) -```