Skip to content
Snippets Groups Projects
Commit ff3f4911 authored by Marion LEGRAND's avatar Marion LEGRAND
Browse files

dev : script OK for mod_migr_mult

parent 1a7867a0
No related branches found
No related tags found
1 merge request!5Fix issues when connected but not enough permissions to read tables =>
Pipeline #300820 failed
Hide whitespace changes
Inline Side-by-side
.gitignore
+ 1
− 0
View file @ ff3f4911
......@@ -9,5 +9,6 @@
/.project
.settings
/.dbeaver/
*/tempplot
inst/doc
*.log
R/mod_migr_mult.R
+ 94
− 89
View file @ ff3f4911
......@@ -18,11 +18,11 @@
# et changer les sorties de la méthode plot, les vrais noms sont dans les slots dc, taxa et stage
# donc on fait un peu de travail dans les boucles en plus pour aller chercher les noms.
generateGraphs <- function(r_mig_mult) {
graphs <- vector() # Liste pour stocker les objets graphiques
graphs <- list()
r_mig_mult2<-r_mig_mult
for (i in seq_along(r_mig_mult@calcdata)) {
id <- 0
for (i in seq_along(r_mig_mult@calcdata)) {
unique_taxa <- unique(r_mig_mult@calcdata[[i]][["data"]]$lot_tax_code)
calcdata <- r_mig_mult@calcdata[[i]][["data"]]
......@@ -31,7 +31,7 @@ generateGraphs <- function(r_mig_mult) {
for (k in seq_along(unique_std)) {
# Mise à jour de l'objet r_mig_mult avec les valeurs spécifiques
id <- id + 1
r_mig_mult2@dc@dc_selected <- unique(calcdata$ope_dic_identifiant)
r_mig_mult2@taxa@taxa_selected <- unique_taxa[j]
r_mig_mult2@stage@stage_selected <- unique_std[k]
......@@ -41,10 +41,10 @@ generateGraphs <- function(r_mig_mult) {
", taxon= ", stringi::stri_trans_general(r_mig_mult@taxa@data[r_mig_mult@taxa@data$tax_code %in% unique_taxa[j],2], "latin-ascii"),
", stade= ", stringi::stri_trans_general(r_mig_mult@stage@data[r_mig_mult@stage@data$std_code %in% unique_std[k],2], "latin-ascii"))
outfile <- file.path("./data/tempplot",paste0(graph_name, '.png'))
png(outfile,width=8, height=10, units ="in", res= 300)
png(outfile,width=6, height=8, units ="in",res=300)
stacomiR::plot(r_mig_mult2, plot.type = "standard", silent = TRUE)
dev.off()
graphs <- c(graphs, graph_name)
graphs[[as.character(id)]] <- graph_name
}
}
}
......@@ -79,19 +79,16 @@ mod_migr_mult_ui <- function(id){
style = "fill",
color = "primary"
)
),
shinydashboardPlus::box(
),
shinydashboardPlus::box(
id=ns("box_plot_mm_std"),
title="Plot standard",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
collapsed=TRUE,
width=8,
height = 20,
uiOutput(ns("dynamicTabs")) # Dynamically generate the tab panels,
),
),
shinydashboardPlus::box(
id=ns("box_plot_mm_ms"),
title="Plot step",
......@@ -147,8 +144,9 @@ mod_migr_mult_server <- function(id, DD){
moduleServer( id, module =function(input, output, session){
ns <- session$ns
observeEvent(input$bttn_migr_mult, {
shinyCatch({
#browser()
# shinyCatch({
validate(need(exists("envir_stacomi"), "Le programme stacomi doit être lancé"))
db_connection <- envir_stacomi$db_connection
validate(need(!is.null(db_connection), "db needs connection"))
......@@ -168,6 +166,7 @@ mod_migr_mult_server <- function(id, DD){
silent=TRUE)
shinybusy::show_modal_spinner(text="please wait") # show the modal window
# first clean up the folder
ls <- list.files(normalizePath("./data/tempplot"))
file.remove(normalizePath(file.path("./data/tempplot",ls)))
r_mig_mult <- charge(r_mig_mult)
......@@ -183,31 +182,37 @@ mod_migr_mult_server <- function(id, DD){
# Stocke directement les graphiques en tant qu'objets
graphs <- generateGraphs(r_mig_mult)
#browser()
shinybusy::remove_modal_spinner() # remove it when done
if ("1" %in% input$choix_sorties) {
if (input$box_plot_mm_std$collapsed) shinydashboardPlus::updateBox("box_plot_mm_std", action = "toggle")
browser()
# browser()
# Génération dynamique des onglets
output$dynamicTabs <- renderUI({
tabs <- lapply(graphs, function(name) {
tabPanel(name, imageOutput(outputId = ns(paste0("image_", name)))) # IDs dynamiques
tabs <- lapply(names(graphs), function(name) {
tabPanel(graphs[[name]], imageOutput(outputId = ns(paste0("image_", name)),inline=TRUE)) # IDs dynamiques
})
do.call(tabsetPanel, tabs)
})
# Rendu des graphiques
lapply(graphs, function(name) {
#browser()
lapply(names(graphs), function(name) {
output[[paste0("image_", name)]] <- renderImage({
validate(need(file.exists(file.path("./data/tempplot",paste0(name,'.png'))),
message=strintf("internal error in mod_mig_mult_server, file %s not found",
file.path("./data/tempplot",paste0(name,'.png')))))
list(normalizePath(file.path("./data/tempplot",paste0(name,'.png'))))
validate(need(file.exists(file.path("./data/tempplot",paste0(graphs[[name]],'.png'))),
#message=strintf("internal error in mod_mig_mult_server, file %s not found",
message = sprintf("internal error in mod_mig_mult_server, file %s not found",
file.path("./data/tempplot",paste0(graphs[[name]],'.png')))))
# src=list(normalizePath(file.path("./data/tempplot",paste0(graphs[[name]],'.png'))))
list(src=normalizePath(file.path("./data/tempplot",paste0(graphs[[name]],'.png'))),
width = 500)
}, deleteFile = FALSE)
})
} else {
......@@ -299,74 +304,74 @@ mod_migr_mult_server <- function(id, DD){
if (!input$box_tab_mm$collapsed) shinydashboardPlus::updateBox("box_tab_mm", action = "toggle")
}
observeEvent({DD$button_box_custom_migr_mult_step()
},{
shinyCatch({
palette_plot<-envir_stacomi$palette_plot
plot_title<-envir_stacomi$plot_title
plot_xlab<-envir_stacomi$xlab
plot_ylab<-envir_stacomi$ylab
theme_plot<-envir_stacomi$theme_plot
g_report_migr_mult_step <- envir_stacomi$p_step
if (plot_title != "") g_report_migr_mult_multiple <- g_report_migr_mult_step + ggplot2::ggtitle(plot_title)
if (plot_ylab != "") g_report_migr_mult_step <- g_report_migr_mult_step + ggplot2::ylab(plot_ylab)
if (plot_xlab != "") g_report_migr_mult_step <- g_report_migr_mult_step + ggplot2::xlab(plot_xlab)
if (theme_plot != "aucun") g_report_migr_mult_step <- g_report_migr_mult_step + match.fun(theme_plot)()
if (palette_plot != "aucun") g_report_migr_mult_step <- g_report_migr_mult_step + ggplot2::scale_color_brewer(palette = palette_plot)
output$plot_migration_mult_step<-renderPlot({
g_report_migr_mult_step
})
},blocking_level = "error"
)},
ignoreInit=TRUE,
ignoreNULL = TRUE
)
# observeEvent({DD$button_box_custom_migr_mult_step()
#
# },{
# shinyCatch({
#
# palette_plot<-envir_stacomi$palette_plot
# plot_title<-envir_stacomi$plot_title
# plot_xlab<-envir_stacomi$xlab
# plot_ylab<-envir_stacomi$ylab
# theme_plot<-envir_stacomi$theme_plot
#
# g_report_migr_mult_step <- envir_stacomi$p_step
#
# if (plot_title != "") g_report_migr_mult_multiple <- g_report_migr_mult_step + ggplot2::ggtitle(plot_title)
# if (plot_ylab != "") g_report_migr_mult_step <- g_report_migr_mult_step + ggplot2::ylab(plot_ylab)
# if (plot_xlab != "") g_report_migr_mult_step <- g_report_migr_mult_step + ggplot2::xlab(plot_xlab)
# if (theme_plot != "aucun") g_report_migr_mult_step <- g_report_migr_mult_step + match.fun(theme_plot)()
# if (palette_plot != "aucun") g_report_migr_mult_step <- g_report_migr_mult_step + ggplot2::scale_color_brewer(palette = palette_plot)
#
#
#
# output$plot_migration_mult_step<-renderPlot({
# g_report_migr_mult_step
# })
#
#
# },blocking_level = "error"
# )},
# ignoreInit=TRUE,
# ignoreNULL = TRUE
# )
observeEvent({DD$button_box_custom_migr_mult_multiple()
},{
shinyCatch({
palette_plot <- envir_stacomi$palette_plot
plot_title <- envir_stacomi$plot_title
plot_xlab <- envir_stacomi$xlab
plot_ylab <- envir_stacomi$ylab
theme_plot <- envir_stacomi$theme_plot
g_report_migr_mult_multiple <- envir_stacomi$p_multiple
if (plot_title != "") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + ggplot2::ggtitle(plot_title)
if (plot_ylab != "") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + ggplot2::ylab(plot_ylab)
if (plot_xlab != "") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + ggplot2::xlab(plot_xlab)
if (theme_plot != "aucun") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + match.fun(theme_plot)()
if (palette_plot != "aucun") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + ggplot2::scale_fill_brewer(palette = palette_plot)
output$plot_migration_multiple<-renderPlot({
g_report_migr_mult_multiple
})
},blocking_level = "error"
)},
ignoreInit=TRUE,
ignoreNULL = TRUE
)
# observeEvent({DD$button_box_custom_migr_mult_multiple()
#
# },{
# shinyCatch({
#
# palette_plot <- envir_stacomi$palette_plot
# plot_title <- envir_stacomi$plot_title
# plot_xlab <- envir_stacomi$xlab
# plot_ylab <- envir_stacomi$ylab
# theme_plot <- envir_stacomi$theme_plot
#
# g_report_migr_mult_multiple <- envir_stacomi$p_multiple
#
# if (plot_title != "") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + ggplot2::ggtitle(plot_title)
# if (plot_ylab != "") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + ggplot2::ylab(plot_ylab)
# if (plot_xlab != "") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + ggplot2::xlab(plot_xlab)
# if (theme_plot != "aucun") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + match.fun(theme_plot)()
# if (palette_plot != "aucun") g_report_migr_mult_multiple <- g_report_migr_mult_multiple + ggplot2::scale_fill_brewer(palette = palette_plot)
#
#
#
# output$plot_migration_multiple<-renderPlot({
# g_report_migr_mult_multiple
# })
#
#
# },blocking_level = "error"
# )},
# ignoreInit=TRUE,
# ignoreNULL = TRUE
# )
# return(reactive(input$bttn_migr_mult))
})
#})#shinycatch
})
})
})
}
## To be copied in the UI
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment