Skip to content
GitLab
Explore
Sign in
Primary navigation
Search or go to…
Project
S
stacoshiny
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Package Registry
Container Registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Stacomi
stacoshiny
Commits
ff3f4911
Commit
ff3f4911
authored
2 weeks ago
by
Marion LEGRAND
Browse files
Options
Downloads
Patches
Plain Diff
dev : script OK for mod_migr_mult
parent
1a7867a0
No related branches found
Branches containing commit
No related tags found
1 merge request
!5
Fix issues when connected but not enough permissions to read tables =>
Pipeline
#300820
failed
2 weeks ago
Changes
2
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
.gitignore
+1
-0
1 addition, 0 deletions
.gitignore
R/mod_migr_mult.R
+94
-89
94 additions, 89 deletions
R/mod_migr_mult.R
with
95 additions
and
89 deletions
.gitignore
+
1
−
0
View file @
ff3f4911
...
...
@@ -9,5 +9,6 @@
/.project
.settings
/.dbeaver/
*/tempplot
inst/doc
*.log
This diff is collapsed.
Click to expand it.
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
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment