Commit 009b4cec authored by Virgile Baudrot's avatar Virgile Baudrot
Browse files

add video to the app

parent f0a8a442
......@@ -31,7 +31,16 @@ mod_tabItemDamage_ui <- function(id){
p("Information about damage ..."),
hr(),
h4("Check list of previous items:"),
verbatimTextOutput(ns("CheckDamage"))
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"),
type = "video/mp4",
src = "www/damage_capture.mp4",
controls = "controls",
height = "300px")
)
),
fluidRow( # width of fluidrow is 12
......
......@@ -31,7 +31,16 @@ mod_tabItemDevelopment_ui <- function(id){
p("Information about development ..."),
hr(),
h4("Check list of previous items:"),
verbatimTextOutput(ns("CheckDevelopment"))
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 emergences:"),
tags$video(id = ns("videoDispersal"),
type = "video/mp4",
src = "www/phenology_capture.mp4",
controls = "controls",
height = "300px")
)
),
fluidRow( # width of fluidrow is 12
......
......@@ -31,11 +31,18 @@ mod_tabItemEmission_ui <- function(id){
collapsible = TRUE,
closable = FALSE,
footer_padding = FALSE,
p("Computing convolution Dispersal with Emission."),
# img(src = 'www/modelScheme_item_3.jpg', title = "item1", width = "800px"),
hr(),
h4("Check list of previous items:"),
verbatimTextOutput(ns("CheckEmission"))
hr(),
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"),
type = "video/mp4",
src = "www/emission_capture.mp4",
controls = "controls",
height = "300px")
)
),
fluidRow( # width of fluidrow is 12
......
......@@ -28,10 +28,19 @@ mod_tabItemExposure_ui <- function(id){
collapsible = TRUE,
closable = FALSE,
footer_padding = FALSE,
p("Information about exposure ..."),
hr(),
h4("Check list of previous items:"),
verbatimTextOutput(ns("CheckExposure"))
p("Information about exposure ..."),
hr(),
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("videoDispersal"),
type = "video/mp4",
src = "www/exposure_capture.mp4",
controls = "controls",
height = "300px")
)
),
fluidRow( # width of fluidrow is 12
......
......@@ -31,7 +31,16 @@ mod_tabItemHost_ui <- function(id){
p("Location of host plants."),
hr(),
h4("Check list of previous items:"),
verbatimTextOutput(ns("CheckHost"))
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"),
type = "video/mp4",
src = "www/habitat_capture.mp4",
controls = "controls",
height = "300px")
)
),
fluidRow( # width of fluidrow is 12
......
......@@ -19,7 +19,25 @@ mod_tabItemInteractiveMap_ui <- function(id){
tabItem(tabName = "interactiveMap",
title = "Interactive Map",
# App title ----
briskaRshinyApp::headerNavigationPage("backDamageTab", "switchDataExplorerTab"),
# briskaRshinyApp::headerNavigationPage("backDamageTab", "switchDataExplorerTab"),
fluidRow(
shinydashboardPlus::gradientBox(
title = "Navigation",
width = 12,
gradientColor = "purple",
boxToolSize = "xs",
collapsible = FALSE,
closable = FALSE,
footer_padding = FALSE,
column(width = 6,
h4("Come back to the previous page," ),
actionButton("backDamageTab",
"Back",
icon = icon("backward"),
style="color: #fff; background-color: #3c8dbc; border-color: #3c8dbc")
)
)
),
fluidRow(
shinydashboardPlus::gradientBox(
title = iconed(" - Information", "info"),
......@@ -29,7 +47,16 @@ mod_tabItemInteractiveMap_ui <- function(id){
collapsible = TRUE,
closable = FALSE,
footer_padding = FALSE,
p("Information on Interactive Map ...")
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"),
type = "video/mp4",
src = "www/interactiveMap_capture.mp4",
controls = "controls",
height = "300px")
)
),
fluidRow(
......@@ -193,51 +220,8 @@ mod_tabItemInteractiveMap_server <- function(input, output, session, r){
updateSelectizeInput( session, "ctrlDATEMapRISK", selected = min(ctrlDATEMapRISK), choices = ctrlDATEMapRISK)
}
})
# observe({
# if(!is.null(r$damageINDIVIDUAL)){
# df <- tidyr::unnest(r$damageINDIVIDUAL, Date)
# ctrlDATEMapRISK <- sort(unique())
# updateSelectizeInput( session, "ctrlDATEMapRISK", selected = min(ctrlDATEMapRISK), choices = ctrlDATEMapRISK)
# }
# })
### --- EXPOSURE
# DFexposureUNNEST <- reactive({
# req(r$exposureINDIVIDUAL)
# r$exposureINDIVIDUAL %>%
# tidyr::unnest(c(Date,EXPOSURE))
# })
# DFexposureRISK <- reactive({
# req(r$exposureINDIVIDUAL)
# DFexposureUNNEST() %>%
# dplyr::filter(Date == input$ctrlDATEMapRISK)
# })
#
# observe({
# req(r$exposureINDIVIDUAL)
#
# # palExposure <- colorNumeric(
# # palette = c('green', 'blue', 'red'),
# # domain = unique(DFexposureRISK()$EXPOSURE)
# # )
#
# # palExposure <- colorBin("Reds", unique(DFexposureUNNEST()$EXPOSURE), 6, pretty = FALSE)
#
# leafletProxy(mapId = "mapEXPOSURE") %>%
# # clearShapes() %>%
# addCircles(data = DFexposureRISK(),
# # color = ~palExposure(EXPOSURE),
# radius = 50,
# stroke = FALSE) #%>%
# # addLegend(position = "bottomright",
# # pal = palExposure,
# # values = ~unique(DFexposureUNNEST()$EXPOSURE))
#
# })
### --- DAMAGE
DFdamageRISK <- reactive({
if(!is.null(r$damageINDIVIDUAL)){
r$damageINDIVIDUAL %>%
......
Supports Markdown
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