Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
CSIRO-INRA
landsepi
Commits
a2d0fde6
Commit
a2d0fde6
authored
Jun 23, 2021
by
Jean-Francois Rey
☕
Browse files
update shiny app
parent
6d57478a
Changes
1
Hide whitespace changes
Inline
Side-by-side
inst/shiny-landsepi/server.R
View file @
a2d0fde6
...
...
@@ -331,7 +331,7 @@ server <- function(input, output, session) {
simul_params
<<-
setPathogen
(
simul_params
,
loadPathogen
(
disease
=
tolower
(
input
$
defaultPathogen
)))
updateNumericInput
(
session
=
session
,
inputId
=
"patho_survival_prob"
,
value
=
simul_params
@
Pathogen
$
survival_prob
)
updateNumericInput
(
session
=
session
,
inputId
=
"patho_repro_sex_prob"
,
value
=
simul_params
@
Pathogen
$
repro_sex_prob
)
updateNumericInput
(
session
=
session
,
inputId
=
"patho_infection_rate"
,
value
=
simul_params
@
Pathogen
$
infection_rate
)
updateNumericInput
(
session
=
session
,
inputId
=
"patho_infection_rate"
,
value
=
simul_params
@
Pathogen
$
infection_rate
)
updateNumericInput
(
session
=
session
,
inputId
=
"patho_propagule_prod_rate"
,
value
=
simul_params
@
Pathogen
$
propagule_prod_rate
)
updateNumericInput
(
session
=
session
,
inputId
=
"patho_latent_period_exp"
,
value
=
simul_params
@
Pathogen
$
latent_period_exp
)
updateNumericInput
(
session
=
session
,
inputId
=
"patho_latent_period_var"
,
value
=
simul_params
@
Pathogen
$
latent_period_var
)
...
...
@@ -679,7 +679,7 @@ server <- function(input, output, session) {
# Handle the "Run simulation" button
shiny
::
observeEvent
(
input
$
runSimulation
,
{
shinyjs
::
click
(
"showOutputside"
)
printVerbose
(
simul_params
,
level
=
2
)
withProgress
(
message
=
"Running Simulation, please wait..."
,
value
=
0
,
{
progressBar
<-
Progress
$
new
()
...
...
@@ -693,7 +693,7 @@ server <- function(input, output, session) {
shinyjs
::
disable
(
"showInputside"
)
shinyjs
::
disable
(
"showBothside"
)
shinyjs
::
click
(
"showOutputside"
)
# seems not working -> force it
#
shinyjs::click("showOutputside") # seems not working -> force it
shinyjs
::
showElement
(
id
=
"outputside"
)
shinyjs
::
hideElement
(
id
=
"inputside"
)
removeCssClass
(
"inputside"
,
"col-sm-12"
)
...
...
@@ -702,6 +702,7 @@ server <- function(input, output, session) {
removeCssClass
(
"outputside"
,
"col-sm-0"
)
removeCssClass
(
"outputside"
,
"col-sm-6"
)
addCssClass
(
"outputside"
,
"col-sm-12"
)
shinyBS
::
removeTooltip
(
session
,
"runSimulation"
)
## avoid tooltip to stay active
progressBar
$
set
(
value
=
0.4
)
...
...
@@ -740,6 +741,7 @@ server <- function(input, output, session) {
shinyjs
::
enable
(
"showInputside"
)
shinyjs
::
enable
(
"showBothside"
)
shinyjs
::
click
(
"showOutputside"
)
shinyBS
::
addTooltip
(
session
,
"runSimulation"
,
title
=
RUN_SIMULATION
,
placement
=
"top"
,
trigger
=
"hover"
)
# setwd(dirname(getwd()))
},
onRejected
=
function
(
err
)
{
...
...
@@ -750,6 +752,7 @@ server <- function(input, output, session) {
shinyjs
::
enable
(
"showBothside"
)
shinyjs
::
click
(
"showBothside"
)
shinyjs
::
enable
(
id
=
"generateLandscape"
)
shinyBS
::
addTooltip
(
session
,
"runSimulation"
,
title
=
RUN_SIMULATION
,
placement
=
"top"
,
trigger
=
"hover"
)
can_run_simul
$
landscape
<<-
FALSE
future_process
<-
NULL
0
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment