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
ShinyApps
briskaRShinyApp
Commits
91bdbc7c
Commit
91bdbc7c
authored
Sep 04, 2020
by
Virgile Baudrot
Browse files
documentation of all items
parent
3fa99c39
Changes
10
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
R/mod_tabItemDamage.R
View file @
91bdbc7c
...
...
@@ -28,15 +28,14 @@ mod_tabItemDamage_ui <- function(id){
collapsible
=
TRUE
,
closable
=
FALSE
,
footer_padding
=
FALSE
,
p
(
"Information about damage ..."
),
hr
(),
h4
(
"Check list of previous items:"
),
verbatimTextOutput
(
ns
(
"CheckDamage"
)),
h4
(
"Check list of previous items"
),
verbatimTextOutput
(
ns
(
"CheckDamage"
)),
hr
(),
h4
(
"Once all elements in Check list is OK, this part allows to compute dispersal probability."
),
br
(),
h3
(
"Computing damage:"
),
tags
$
video
(
id
=
ns
(
"videoDispersal"
),
h4
(
"Computing damage"
),
p
(
"Once all elements in Check list is OK, this part allows to compute damage probability.
There are two options, either a classical dose response model based on LC50 and the Slope,
or through the GUTS modelling approach were the user has to upload the parameters."
),
tags
$
video
(
id
=
ns
(
"videoDamage"
),
type
=
"video/mp4"
,
src
=
"www/damage_capture2.mp4"
,
controls
=
"controls"
,
...
...
@@ -47,11 +46,6 @@ mod_tabItemDamage_ui <- function(id){
box
(
title
=
iconed
(
"Model"
,
"sliders-h"
),
solidHeader
=
TRUE
,
width
=
4
,
status
=
"warning"
,
# actionButton(ns("Xple_DAMAGE"),
# "CLICK HERE FOR EXAMPLE DATA",
# icon("paper-plane"),
# style="color: #fff; background-color: #33595f; border-color: #052327"),
# hr(),
tabsetPanel
(
id
=
ns
(
"tabsetDAMAGEsurv"
),
tabPanel
(
title
=
"Dose Response"
,
value
=
"DRsurvDAMAGE"
,
...
...
R/mod_tabItemDevelopment.R
View file @
91bdbc7c
...
...
@@ -28,15 +28,13 @@ mod_tabItemDevelopment_ui <- function(id){
collapsible
=
TRUE
,
closable
=
FALSE
,
footer_padding
=
FALSE
,
p
(
"Information about development ..."
),
hr
(),
h4
(
"Check list of previous items:"
),
verbatimTextOutput
(
ns
(
"CheckDevelopment"
)),
h4
(
"Check list of previous items"
),
verbatimTextOutput
(
ns
(
"CheckDevelopment"
)),
hr
(),
h4
(
"
Once all elements in Check list is OK, this part allows to compute dispersal probability
."
),
br
(),
h3
(
"Computing site and date of
emer
gences:
"
),
tags
$
video
(
id
=
ns
(
"videoD
ispersal
"
),
h4
(
"
Computing development of the organisms
."
),
p
(
"Once all elements in Check list is OK, this part allows to compute the development of the organisms.
Either by fixing a lifespan, or by uploading a Degree Day model. For the Degree Day model, the user must upload a time serie with t
em
p
er
ature
"
),
tags
$
video
(
id
=
ns
(
"videoD
evelopment
"
),
type
=
"video/mp4"
,
src
=
"www/phenology_capture2.mp4"
,
controls
=
"controls"
,
...
...
R/mod_tabItemDispersal.R
View file @
91bdbc7c
...
...
@@ -28,22 +28,17 @@ mod_tabItemDispersal_ui <- function(id){
collapsible
=
TRUE
,
closable
=
FALSE
,
footer_padding
=
FALSE
,
# img(src = 'www/modelScheme_item_2.jpg', title = "item1", width = "800px"),
hr
(),
h4
(
"Check list of previous items:"
),
h4
(
"Check list of previous items"
),
p
(
"Please, for each step of the app, check that all items of this kind of list is ok."
),
verbatimTextOutput
(
ns
(
"CheckDispersal"
)),
hr
(),
h4
(
"Once all elements in Check list is OK, this part allows to compute dispersal probability."
),
br
(),
# column(width = 6,
# align="center",
h3
(
"Tutorial on running dispersal kernel:"
),
tags
$
video
(
id
=
ns
(
"videoDispersal"
),
type
=
"video/mp4"
,
src
=
"www/dispersal_capture2.mp4"
,
controls
=
"controls"
,
height
=
"300px"
)
# ),
h4
(
"How to run a dispersal kernel"
),
p
(
"Once all elements in Check list is OK, this part allows to compute dispersal probability."
),
tags
$
video
(
id
=
ns
(
"videoDispersal"
),
type
=
"video/mp4"
,
src
=
"www/dispersal_capture2.mp4"
,
controls
=
"controls"
,
height
=
"300px"
)
)
),
fluidRow
(
# width of fluidrow is 12
...
...
R/mod_tabItemEmission.R
View file @
91bdbc7c
...
...
@@ -31,14 +31,12 @@ mod_tabItemEmission_ui <- function(id){
collapsible
=
TRUE
,
closable
=
FALSE
,
footer_padding
=
FALSE
,
hr
(),
h4
(
"Check list of previous items:"
),
h4
(
"Check list of previous items"
),
verbatimTextOutput
(
ns
(
"CheckEmission"
)),
hr
(),
h4
(
"Once all elements in Check list is OK, this part allows to compute dispersal probability."
),
br
(),
h3
(
"Computing convolution dispersal and emission:"
),
tags
$
video
(
id
=
ns
(
"videoDispersal"
),
h4
(
"Computing convolution dispersal and emission"
),
p
(
"Once all elements in Check list is OK, this part allows to compute dispersal probability."
),
tags
$
video
(
id
=
ns
(
"videoEmission"
),
type
=
"video/mp4"
,
src
=
"www/emission_capture2.mp4"
,
controls
=
"controls"
,
...
...
R/mod_tabItemExposure.R
View file @
91bdbc7c
...
...
@@ -28,22 +28,20 @@ mod_tabItemExposure_ui <- function(id){
collapsible
=
TRUE
,
closable
=
FALSE
,
footer_padding
=
FALSE
,
p
(
"Information about exposure ..."
),
hr
(),
h4
(
"Check list of previous items:"
),
h4
(
"Check list of previous items"
),
verbatimTextOutput
(
ns
(
"CheckExposure"
)),
hr
(),
h4
(
"
Once all elements in Check list is OK, this part allows to compute dispersal probability.
"
),
br
(),
h3
(
"Computing exposure:
"
),
tags
$
video
(
id
=
ns
(
"video
Dispersal
"
),
h4
(
"
Computing exposure
"
),
p
(
"Once all elements in Check list is OK, this part allows to compute exposure probability.
Nothing has to be upload or parameterized by the user, just click on the run button if emission and organisms overlap.
"
),
tags
$
video
(
id
=
ns
(
"video
Exposure
"
),
type
=
"video/mp4"
,
src
=
"www/exposure_capture2.mp4"
,
controls
=
"controls"
,
height
=
"300px"
)
)
),
fluidRow
(
# width of fluidrow is 12
fluidRow
(
# width of fluid
-
row is 12
box
(
title
=
iconed
(
"Overlapping"
,
"calendar-check"
),
solidHeader
=
TRUE
,
width
=
4
,
status
=
"warning"
,
...
...
R/mod_tabItemHost.R
View file @
91bdbc7c
...
...
@@ -28,15 +28,12 @@ mod_tabItemHost_ui <- function(id){
collapsible
=
TRUE
,
closable
=
FALSE
,
footer_padding
=
FALSE
,
p
(
"Location of host plants."
),
hr
(),
h4
(
"Check list of previous items:"
),
verbatimTextOutput
(
ns
(
"CheckHost"
)),
h4
(
"Check list of previous items"
),
verbatimTextOutput
(
ns
(
"CheckHost"
)),
hr
(),
h4
(
"Once all elements in Check list is OK, this part allows to compute dispersal probability."
),
br
(),
h3
(
"Computing site and date of emergences:"
),
tags
$
video
(
id
=
ns
(
"videoDispersal"
),
h4
(
"Computing site and date of emergences"
),
p
(
"Once all elements in Check list is OK, this part allows to compute location of habitat (i.e., laying site)."
),
tags
$
video
(
id
=
ns
(
"videoHabitat"
),
type
=
"video/mp4"
,
src
=
"www/habitat_capture2.mp4"
,
controls
=
"controls"
,
...
...
R/mod_tabItemInteractiveMap.R
View file @
91bdbc7c
...
...
@@ -47,12 +47,9 @@ mod_tabItemInteractiveMap_ui <- function(id){
collapsible
=
TRUE
,
closable
=
FALSE
,
footer_padding
=
FALSE
,
p
(
"Information on Interactive Map ..."
),
hr
(),
h4
(
"Once all elements in Check list is OK, this part allows to compute dispersal probability."
),
br
(),
h3
(
"Computing site and date of emergences:"
),
tags
$
video
(
id
=
ns
(
"videoDispersal"
),
h4
(
"Explore the Interactive Map"
),
p
(
"The final risk map is given in the item."
),
tags
$
video
(
id
=
ns
(
"videoInteractiveMap"
),
type
=
"video/mp4"
,
src
=
"www/interactiveMap_capture2.mp4"
,
controls
=
"controls"
,
...
...
@@ -284,26 +281,7 @@ mod_tabItemInteractiveMap_server <- function(input, output, session, r){
})
# Use a separate observer to recreate the legend as needed.
# observe({
#
# req(r$damageINDIVIDUAL)
# DFdamageUNNEST <- r$damageINDIVIDUAL %>%
# tidyr::unnest( c(Date, DAMAGE))
# # req(DFdamageUNNEST())
#
# proxy <- leafletProxy("mapRISK")
#
# proxy %>% clearControls()
# if (input$legend) {
# pal <- colorpalDAMAGE()
# proxy %>% addLegend(data = DFdamageUNNEST,
# position = "bottomright",
# pal = pal, values = ~DAMAGE
# )
# }
# })
}
...
...
R/mod_tabItemLandscape.R
View file @
91bdbc7c
...
...
@@ -32,27 +32,31 @@ mod_tabItemLandscape_ui <- function(id){
collapsible
=
TRUE
,
closable
=
FALSE
,
footer_padding
=
FALSE
,
h4
(
"In this part, you have to download the source file, the host file and to compute
or load a square frame including host and sources in the same spatial square."
),
column
(
width
=
6
,
align
=
"center"
,
h4
(
"Tutorial on building KML landscape files."
),
tags
$
video
(
id
=
ns
(
"videoLandscape_makeKML"
),
type
=
"video/mp4"
,
src
=
"www/maizeFieldMap_VIDEO_medium2.mp4"
,
controls
=
"controls"
,
height
=
"300px"
)
),
column
(
width
=
6
,
align
=
"center"
,
h4
(
"Tutorial on Uploading landscape elements."
),
tags
$
video
(
id
=
ns
(
"videoLandscape_load"
),
type
=
"video/mp4"
,
src
=
"www/load_landscape_medium3.mp4"
,
controls
=
"controls"
,
height
=
"300px"
)
)
)
p
(
"In this part, you have to: (1) download the source file, (2) download the host file and (3) compute
or load a square frame to gather host and source within the same spatial square."
),
hr
(),
h4
(
"Tutorial on building KML landscape files."
),
p
(
"The following video shows how to create a KML filr with umap,"
,
a
(
href
=
"umap"
,
"https://umap.openstreetmap.fr/fr/"
),
". But you can also use Google Earth to create a KML file."
),
tags
$
video
(
id
=
ns
(
"videoLandscape_makeKML"
),
type
=
"video/mp4"
,
src
=
"www/maizeFieldMap_VIDEO_medium2.mp4"
,
controls
=
"controls"
,
height
=
"300px"
),
hr
(),
h4
(
"Tutorial on Uploading landscape elements."
),
p
(
"Once you created a KML file, the following video presents the way to upload it in the
app. While you can change it with the app, make sure 'source' and 'host' jml files
have the same geographic coordinate system."
),
tags
$
video
(
id
=
ns
(
"videoLandscape_load"
),
type
=
"video/mp4"
,
src
=
"www/load_landscape_medium3.mp4"
,
controls
=
"controls"
,
height
=
"300px"
)
)
),
fluidRow
(
# width of fluidrow is 12
box
(
title
=
iconed
(
"Source and Host"
,
"database"
),
...
...
@@ -204,7 +208,7 @@ mod_tabItemLandscape_ui <- function(id){
solidHeader
=
FALSE
,
p
(
"Red: Source"
),
p
(
"Blue: Host"
),
plot
ly
::
plotly
Output
(
ns
(
"plotLANDSCAPE"
))
plotOutput
(
ns
(
"plotLANDSCAPE"
))
),
box
(
width
=
6
,
status
=
"success"
,
...
...
@@ -378,14 +382,12 @@ mod_tabItemLandscape_server <- function(input, output, session, r){
paste
(
"EPSG initial:"
,
sf
::
st_crs
(
r
$
landscapeSQUAREFRAME
$
epsg
))
})
output
$
plotLANDSCAPE
<-
plotly
::
renderPlotly
({
plotly
::
ggplotly
(
p
=
ggplot
()
+
output
$
plotLANDSCAPE
<-
renderPlot
({
ggplot
()
+
theme_minimal
()
+
geom_sf
(
data
=
r
$
landscapeSQUAREFRAME
,
fill
=
NA
)
+
geom_sf
(
data
=
r
$
landscapeSOURCE
,
alpha
=
0.5
,
fill
=
"red"
,
color
=
"red"
)
+
geom_sf
(
data
=
r
$
landscapeHOST
,
alpha
=
0.5
,
fill
=
"blue"
,
color
=
"blue"
)
)
})
output
$
mapLANDSCAPE
<-
renderLeaflet
({
...
...
R/mod_tabItemStart.R
View file @
91bdbc7c
...
...
@@ -64,24 +64,14 @@ of the", strong("dynamics of toxin ingestion on lethal and sublethal effects at
footer_padding
=
FALSE
,
solidHeader
=
TRUE
,
align
=
"center"
,
# solidHeader = TRUE,
# title = iconed("Start", "rocket"),
# status = "success",
actionButton
(
'switchLandscapeTab'
,
label
=
h4
(
"Click Here to Start Modelling"
),
# icon = icon("forward"),
style
=
"color: #fff; background-color: #00a65a; border-color: #00a65a"
)
# hr(),
# actionButton('switchLandscapeTab',
# label = h5("Wait, you may need some", strong("information"), "about how the", strong("application"), "work... what is just the object of the next", strong("blue box.")),
# icon = icon("pause"),
# style="color: #fff; background-color: #00c0ef; border-color: #00c0ef")
)
),
fluidRow
(
hr
(),
shinydashboardPlus
::
gradientBox
(
title
=
iconed
(
" -
How to Run and Explore a Simul
ation"
,
"info"
),
title
=
iconed
(
" -
Inform
ation"
,
"info"
),
width
=
12
,
gradientColor
=
"purple"
,
boxToolSize
=
"xs"
,
...
...
@@ -89,33 +79,34 @@ of the", strong("dynamics of toxin ingestion on lethal and sublethal effects at
closable
=
FALSE
,
footer_padding
=
FALSE
,
solidHeader
=
TRUE
,
column
(
width
=
6
,
# align="center",
p
(
strong
(
"Getting Started"
),
"in the current home page, and follow the"
,
strong
(
"7 steps:"
),
strong
(
"1. Landscape"
),
"you define a landscape with sources and host plant location,"
,
strong
(
"2. Dispersal"
),
": apply a dispersal kernel on sources,"
,
strong
(
"3. Emission"
),
": apply emission function on sources,"
,
strong
(
"4. Host"
),
": define location and phenology,"
,
strong
(
"5. Development"
),
": define development model of organisms,"
,
strong
(
"6. Exposure"
),
": compute exposure of organisms,"
,
strong
(
"7. Damage"
),
": compute lethal and eventually sublethal damages,"
,
strong
(
"Interactive Map"
),
": explore results on maps,"
,
strong
(
"Report"
),
": compose a report of simulation."
),
tags
$
img
(
src
=
'www/modelScheme.jpg'
,
title
=
"EFSA Home"
,
height
=
"350px"
)
# ---
hr
(),
h4
(
"General structure of the application"
),
p
(
"The application is made of 7 steps of computing and an Interactive Map:"
),
tags
$
ul
(
tags
$
li
(
strong
(
"Getting Started"
),
"in the current home page, and follow the"
,
strong
(
"7 steps:"
)),
tags
$
li
(
strong
(
"1. Landscape"
),
"you define a landscape with sources and host plant location,"
),
tags
$
li
(
strong
(
"2. Dispersal"
),
": apply a dispersal kernel on sources,"
),
tags
$
li
(
strong
(
"3. Emission"
),
": apply emission function on sources,"
),
tags
$
li
(
strong
(
"4. Host"
),
": define location and phenology,"
),
tags
$
li
(
strong
(
"5. Development"
),
": define development model of organisms,"
),
tags
$
li
(
strong
(
"6. Exposure"
),
": compute exposure of organisms,"
),
tags
$
li
(
strong
(
"7. Damage"
),
": compute lethal and eventually sublethal damages,"
),
tags
$
li
(
strong
(
"Interactive Map"
),
": explore results on maps,"
)
),
column
(
width
=
6
,
align
=
"center"
,
h4
(
"Video taking a quick look at all simulation steps:"
),
br
(),
tags
$
video
(
id
=
ns
(
"videoStart_all"
),
type
=
"video/mp4"
,
src
=
"www/video_allStart2.mp4"
,
controls
=
"controls"
,
height
=
"350px"
)
)
tags
$
img
(
src
=
'www/modelScheme.jpg'
,
title
=
"EFSA Home"
,
height
=
"350px"
),
hr
(),
h4
(
"Quick look at all simulation steps"
),
p
(
"The following video shows the use of all 7 steps of the application.
In each item, additional video detail its use."
),
br
(),
tags
$
video
(
id
=
ns
(
"videoStart_all"
),
type
=
"video/mp4"
,
src
=
"www/video_allStart2.mp4"
,
controls
=
"controls"
,
height
=
"350px"
)
)
),
briskaRshinyApp
::
footerPage
()
...
...
R/zz_fun.R
View file @
91bdbc7c
...
...
@@ -41,6 +41,9 @@ headerNavigationPage <- function(backNavKey, nextNavKey){
collapsible
=
FALSE
,
closable
=
FALSE
,
footer_padding
=
FALSE
,
p
(
"While you can move between items using the sidebar, we recommand you the use this navigation box with blue and green button.
The reason is that some computing requires previous items to be completed: for instance, dispersal computing in the second item
requires to have a source file downloaded in the first item."
),
column
(
width
=
6
,
h4
(
"Come back to the previous page,"
),
actionButton
(
backNavKey
,
...
...
Write
Preview
Supports
Markdown
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