Skip to content

GitLab

Commit 1b7137b4 authored by Virgile Baudrot's avatar Virgile Baudrot
Browse files

update information

parent d87f699b
Hide whitespace changes
Inline Side-by-side
R/app_server.R
View file @ 1b7137b4
......@@ -31,6 +31,11 @@ app_server <- function(input, output,session) {
"landscape" = "dispersal")
shinydashboard::updateTabItems(session, "tabs", newtab)
})
observeEvent(input$backStartTab, {
newtab <- switch(input$tabs,
"landscape" = "start")
shinydashboard::updateTabItems(session, "tabs", newtab)
})
## OBSERVE
observe({
r$landscapeSOURCE <- sf::st_zm(sf::st_read(req(input$landscapeSOURCE)$datapath))
......@@ -51,6 +56,11 @@ app_server <- function(input, output,session) {
"dispersal" = "emission")
shinydashboard::updateTabItems(session, "tabs", newtab)
})
observeEvent(input$backLandscapeTab, {
newtab <- switch(input$tabs,
"dispersal" = "landscape")
shinydashboard::updateTabItems(session, "tabs", newtab)
})
callModule(mod_tabItemDispersal_server, id="tabItemDispersal_ui_1", session = session, r=r)
##################
## EMISSION
......@@ -61,6 +71,11 @@ app_server <- function(input, output,session) {
"emission" = "host")
updateTabItems(session, "tabs", newtab)
})
observeEvent(input$backDispersalTab, {
newtab <- switch(input$tabs,
"emission" = "dispersal")
updateTabItems(session, "tabs", newtab)
})
observe({
r$sourceEMISSION <- read.csv(file = req(input$sourceEMISSION)$datapath,
header = input$headerEMISSION,
......@@ -77,6 +92,11 @@ app_server <- function(input, output,session) {
"host" = "development")
shinydashboard::updateTabItems(session, "tabs", newtab)
})
observeEvent(input$backEmissionTab, {
newtab <- switch(input$tabs,
"host" = "emission")
shinydashboard::updateTabItems(session, "tabs", newtab)
})
observe({
r$dateEMERGENCE <- read.csv(file = req(input$dateEMERGENCE)$datapath,
header = input$headerEMERGENCE,
......@@ -103,6 +123,11 @@ app_server <- function(input, output,session) {
"development" = "exposure")
shinydashboard::updateTabItems(session, "tabs", newtab)
})
observeEvent(input$backHostTab, {
newtab <- switch(input$tabs,
"development" = "host")
shinydashboard::updateTabItems(session, "tabs", newtab)
})
callModule(mod_tabItemDevelopment_server, "tabItemDevelopment_ui_1", session = session, r=r)
##################
## EXPOSURE
......@@ -113,6 +138,11 @@ app_server <- function(input, output,session) {
"exposure" = "damage")
shinydashboard::updateTabItems(session, "tabs", newtab)
})
observeEvent(input$backDevelopmentTab, {
newtab <- switch(input$tabs,
"exposure" = "development")
shinydashboard::updateTabItems(session, "tabs", newtab)
})
callModule(mod_tabItemExposure_server, "tabItemExposure_ui_1", session = session, r=r)
##################
## DAMAGE
......@@ -123,6 +153,11 @@ app_server <- function(input, output,session) {
"damage" = "interactiveMap")
shinydashboard::updateTabItems(session, "tabs", newtab)
})
observeEvent(input$backExposureTab, {
newtab <- switch(input$tabs,
"damage" = "exposure")
shinydashboard::updateTabItems(session, "tabs", newtab)
})
callModule(mod_tabItemDamage_server, "tabItemDamage_ui_1", session = session, r=r)
##################
## INTERACTIVE MAP
......@@ -133,6 +168,11 @@ app_server <- function(input, output,session) {
"interactiveMap" = "report")
shinydashboard::updateTabItems(session, "tabs", newtab)
})
observeEvent(input$backDamageTab, {
newtab <- switch(input$tabs,
"interactiveMap" = "damage")
shinydashboard::updateTabItems(session, "tabs", newtab)
})
callModule(mod_tabItemInteractiveMap_server, "tabItemInteractiveMap_ui_1", session = session, r=r)
##################
## DATA EXPLORER
......@@ -153,6 +193,11 @@ app_server <- function(input, output,session) {
"report" = "start")
shinydashboard::updateTabItems(session, "tabs", newtab)
})
observeEvent(input$backInteractiveMap, {
newtab <- switch(input$tabs,
"report" = "interactiveMap")
shinydashboard::updateTabItems(session, "tabs", newtab)
})
callModule(mod_tabItemReport_server, "tabItemReport_ui_1", session = session, r=r)
}
\ No newline at end of file
R/app_ui.R
View file @ 1b7137b4
......@@ -102,10 +102,10 @@ sidebar <- dashboardSidebar(
id = "tabs",
menuItem("Getting Started", tabName = "start", icon = icon("home")),
menuItem("1. Landscape", tabName = "landscape", icon = icon("map")),
menuItem("2. Dispersal", tabName = "dispersal", icon = icon("layer-group")),
menuItem("3. Deposition", tabName = "emission", icon = icon("layer-group")),
menuItem("4. Host", tabName = "host", icon = icon("layer-group")),
menuItem("5. Development", tabName = "development", icon = icon("layer-group")),
menuItem("2. Dispersal kernel", tabName = "dispersal", icon = icon("layer-group")),
menuItem("3. Emission & Deposition", tabName = "emission", icon = icon("layer-group")),
menuItem("4. Habitat", tabName = "host", icon = icon("layer-group")),
menuItem("5. Phenology", tabName = "development", icon = icon("layer-group")),
menuItem("6. Exposure", tabName = "exposure", icon = icon("layer-group")),
menuItem("7. Damage", tabName = "damage", icon = icon("layer-group")),
menuItem("Interactive Map", tabName = "interactiveMap", icon = icon("map-marked")),
......
R/mod_tabItemDamage.R
View file @ 1b7137b4
......@@ -31,7 +31,23 @@ mod_tabItemDamage_ui <- function(id){
p("Information about damage ..."),
hr(),
h4("Check list of previous items:"),
verbatimTextOutput(ns("CheckDamage"))
verbatimTextOutput(ns("CheckDamage")),
#
hr(),
column(width = 6,
p("You can come back to the previous page, but before running new simulations, clear the current page." ),
actionButton('backExposureTab',
"Back",
icon = icon("backward"),
style="color: #fff; background-color: #3c8dbc; border-color: #3c8dbc")
),
column(width = 6,
p("If the dispersal seems ok, you can consider to safely click to go to the next step... " ),
actionButton('switchInteractiveMapTab',
"Next",
icon = icon("forward"),
style="color: #fff; background-color: #00a65a; border-color: #00a65a")
)
)
),
fluidRow( # width of fluidrow is 12
......@@ -120,17 +136,6 @@ mod_tabItemDamage_ui <- function(id){
plotOutput(ns("mapDAMAGE"))
)
)
),
fluidRow(
box(title = "Next",
width = 12, status = "primary",
solidHeader = TRUE,
p("If it's ok, click next"),
actionButton('switchInteractiveMapTab',
"Next",
icon = icon("forward"),
style="color: #fff; background-color: #3c8dbc; border-color: #3c8dbc")
)
)
)
}
......
R/mod_tabItemDevelopment.R
View file @ 1b7137b4
......@@ -31,7 +31,23 @@ mod_tabItemDevelopment_ui <- function(id){
p("Information about development ..."),
hr(),
h4("Check list of previous items:"),
verbatimTextOutput(ns("CheckDevelopment"))
verbatimTextOutput(ns("CheckDevelopment")),
#
hr(),
column(width = 6,
p("You can come back to the previous page, but before running new simulations, clear the current page." ),
actionButton('backHostTab',
"Back",
icon = icon("backward"),
style="color: #fff; background-color: #3c8dbc; border-color: #3c8dbc")
),
column(width = 6,
p("If the dispersal seems ok, you can consider to safely click to go to the next step... " ),
actionButton('switchExposureTab',
"Next",
icon = icon("forward"),
style="color: #fff; background-color: #00a65a; border-color: #00a65a")
)
)
),
fluidRow( # width of fluidrow is 12
......
R/mod_tabItemDispersal.R
View file @ 1b7137b4
......@@ -32,7 +32,23 @@ mod_tabItemDispersal_ui <- function(id){
# img(src = 'www/modelScheme_item_2.jpg', title = "item1", width = "800px"),
hr(),
h4("Check list of previous items:"),
verbatimTextOutput(ns("CheckDispersal"))
verbatimTextOutput(ns("CheckDispersal")),
#
hr(),
column(width = 6,
p("You can come back to the previous page, but before running new simulations, clear the current page." ),
actionButton('backLandscapeTab',
"Back",
icon = icon("backward"),
style="color: #fff; background-color: #3c8dbc; border-color: #3c8dbc")
),
column(width = 6,
p("If the dispersal seems ok, you can consider to safely click to go to the next step... " ),
actionButton('switchEmissionTab',
"Next",
icon = icon("forward"),
style="color: #fff; background-color: #00a65a; border-color: #00a65a")
)
)
),
fluidRow( # width of fluidrow is 12
......@@ -106,17 +122,6 @@ mod_tabItemDispersal_ui <- function(id){
plotOutput(ns("plotDISPERSAL"))
)
)
),
fluidRow(
box(title = "Next",
width = 12, status = "primary",
solidHeader = TRUE,
p("If the dispersal seems ok, you can consider to safely click to go to the next step... " ),
actionButton('switchEmissionTab',
"Next",
icon = icon("forward"),
style="color: #fff; background-color: #3c8dbc; border-color: #3c8dbc")
)
)
)
}
......
R/mod_tabItemEmission.R
View file @ 1b7137b4
......@@ -35,7 +35,23 @@ mod_tabItemEmission_ui <- function(id){
# img(src = 'www/modelScheme_item_3.jpg', title = "item1", width = "800px"),
hr(),
h4("Check list of previous items:"),
verbatimTextOutput(ns("CheckEmission"))
verbatimTextOutput(ns("CheckEmission")),
#
hr(),
column(width = 6,
p("You can come back to the previous page, but before running new simulations, clear the current page." ),
actionButton('backDispersalTab',
"Back",
icon = icon("backward"),
style="color: #fff; background-color: #3c8dbc; border-color: #3c8dbc")
),
column(width = 6,
p("If the dispersal seems ok, you can consider to safely click to go to the next step... " ),
actionButton('switchHostTab',
"Next",
icon = icon("forward"),
style="color: #fff; background-color: #00a65a; border-color: #00a65a")
)
)
),
fluidRow( # width of fluidrow is 12
......@@ -78,64 +94,10 @@ mod_tabItemEmission_ui <- function(id){
hr(),
downloadButton(ns("download_sourceEMISSION"),
"Download Emission Profile",
style="color: #fff; background-color: #33595f; border-color: #052327")#,
# hr(),
# # Input: Checkbox if file has header ----
# checkboxInput("headerEMISSION", "Header", TRUE),
# # Input: Select separator ----
# radioButtons("sepEMISSION", "Separator",
# choices = c(Comma = ",",
# Semicolon = ";",
# Tab = "\t"),
# selected = ","),
# # Input: Select quotes ----
# radioButtons("quoteEMISSION", "Quote",
# choices = c(None = "",
# "Double Quote" = '"',
# "Single Quote" = "'"),
# selected = '"')
style="color: #fff; background-color: #33595f; border-color: #052327")
)
)
),
# column(width = 2,
# # plot the Figure
# selectizeInput(ns("ctrlDateEMISSION"),
# label = "Choose Column Date",
# choices = NULL,
# options = list(
# placeholder = 'Please select column below',
# onInitialize = I('function() { this.setValue(""); }')
# )
# ),
# selectizeInput(ns("ctrlAsDateEMISSION"),
# label = "as.Date or Not",
# choices = NULL,
# options = list(
# placeholder = "Choose select 'as.Date' or 'Not'",
# onInitialize = I('function() { this.setValue(""); }')
# )
# ),
# selectizeInput(ns("ctrlEmitEMISSION"),
# label = "Choose Column Emission",
# choices = NULL,
# options = list(
# placeholder = 'Please select column below',
# onInitialize = I('function() { this.setValue(""); }')
# )
# ),
# selectizeInput(ns("ctrlIDsourceEMISSION"),
# label = "Choose Column IDsource",
# choices = NULL,
# options = list(
# placeholder = 'Please select column below',
# onInitialize = I('function() { this.setValue(""); }')
# )
# ),
# actionButton(ns("goSourceEMISSION"), "Table")
# ),
# column(width = 3,
# tableOutput(ns("tableEMISSION"))
# ),
column(width = 6,
plotOutput(ns("plotEMISSION"))
)
......@@ -144,14 +106,40 @@ mod_tabItemEmission_ui <- function(id){
solidHeader = TRUE,
width = 4,
status = "warning",
numericInput(inputId = ns("lossSPREAD"),
label = "Loss",
value = 0.1,
min = 0, max = 1),
numericInput(inputId = ns("betaSPREAD"),
label = "Adherence",
value = 0.2,
min = 0, max = 1),
h4("Loss rate at landscape scale:"),
tabsetPanel(id = ns("tabsetRainfall"),
selected = "GenerateRainfall",
tabPanel(title = "Generate",
value = "GenerateRainfall",
numericInput(inputId = ns("lossSPREAD"),
label = "Global loss rate",
value = 0.1,
min = 0, max = 1)
),
tabPanel(title = "Load",
value = "LoadRainfall",
# ---
fileInput("timeserieRAINFALL",
'Choose CSV file - RAINFALL',
accept=c('text/csv', 'text/comma-separated-values,text/plain')),
numericInput(inputId = ns("lossSPREADload"),
label = "Loss rate to apply",
value = 0.1,
min = 0, max = 1),
numericInput(inputId = ns("lossThresholdSPREADload"),
label = "Thershold for 100% loss",
value = 30,
min = 0),
hr(),
downloadButton(ns("download_timeserieRAINFALL"),
"Download Rainfall Profile",
style="color: #fff; background-color: #33595f; border-color: #052327")
)
),
br(),
actionButton(ns("goRunSPREAD"),
"Run",
......@@ -173,12 +161,6 @@ mod_tabItemEmission_ui <- function(id){
box(title = "Specific Plot",
solidHeader = FALSE,
width = 5, status = "success",
# h4("Once run is done, you can plot"),
# p("Once Run is done, select a specific Plot"),
# sliderInput(inputId = ns("numPlotSPREAD"),
# label = "Select a layer to plot",
# choices = NULL
# ),
selectizeInput(ns("numPlotSPREAD"),
label = "Select a layer to plot",
choices = NULL,
......@@ -192,23 +174,11 @@ mod_tabItemEmission_ui <- function(id){
plotOutput(ns("plotSPREAD"))
)
)
),
fluidRow(
box(title = "Next",
width = 12, status = "primary",
solidHeader = TRUE,
p("If the map on your left seems correct, you can consider to safely click to go to the next step... " ),
actionButton('switchHostTab',
"Next",
icon = icon("forward"),
style="color: #fff; background-color: #3c8dbc; border-color: #3c8dbc")
)
)
)
}
# Module Server
#' @rdname mod_tabItemEmission
#' @export
#' @keywords internal
......
R/mod_tabItemExposure.R
View file @ 1b7137b4
......@@ -31,7 +31,23 @@ mod_tabItemExposure_ui <- function(id){
p("Information about exposure ..."),
hr(),
h4("Check list of previous items:"),
verbatimTextOutput(ns("CheckExposure"))
verbatimTextOutput(ns("CheckExposure")),
#
hr(),
column(width = 6,
p("You can come back to the previous page, but before running new simulations, clear the current page." ),
actionButton('backDevelopmentTab',
"Back",
icon = icon("backward"),
style="color: #fff; background-color: #3c8dbc; border-color: #3c8dbc")
),
column(width = 6,
p("If the dispersal seems ok, you can consider to safely click to go to the next step... " ),
actionButton('switchDamageTab',
"Next",
icon = icon("forward"),
style="color: #fff; background-color: #00a65a; border-color: #00a65a")
)
)
),
fluidRow( # width of fluidrow is 12
......@@ -69,17 +85,6 @@ mod_tabItemExposure_ui <- function(id){
plotOutput(ns("mapEXPOSURE"))
)
)
),
fluidRow(
box(title = "Next",
width = 12, status = "primary",
solidHeader = TRUE,
p("If it's ok, click next"),
actionButton('switchDamageTab',
"Next",
icon = icon("forward"),
style="color: #fff; background-color: #3c8dbc; border-color: #3c8dbc")
)
)
)
}
......
R/mod_tabItemHost.R
View file @ 1b7137b4
......@@ -16,7 +16,7 @@
mod_tabItemHost_ui <- function(id){
ns <- NS(id)
tabItem(tabName = "host",
title = "Host",
title = "Laying site",
# App title ----
fluidRow(
shinydashboardPlus::gradientBox(
......@@ -31,11 +31,27 @@ mod_tabItemHost_ui <- function(id){
p("Location of host plants."),
hr(),
h4("Check list of previous items:"),
verbatimTextOutput(ns("CheckHost"))
verbatimTextOutput(ns("CheckHost")),
#
hr(),
column(width = 6,
p("You can come back to the previous page, but before running new simulations, clear the current page." ),
actionButton('backEmissionTab',
"Back",
icon = icon("backward"),
style="color: #fff; background-color: #3c8dbc; border-color: #3c8dbc")
),
column(width = 6,
p("If the dispersal seems ok, you can consider to safely click to go to the next step... " ),
actionButton('switchDevelopmentTab',
"Next",
icon = icon("forward"),
style="color: #fff; background-color: #00a65a; border-color: #00a65a")
)
)
),
fluidRow( # width of fluidrow is 12
box(title = iconed("Site and Emergence", "database"),
box(title = iconed("Laying Site and Emergence", "database"),
solidHeader = TRUE,
width = 4, status = "warning",
tabsetPanel(id = ns("tabsetIndSite"),
......@@ -43,7 +59,7 @@ mod_tabItemHost_ui <- function(id){
tabPanel(title = "Generate",
value = "GenerateIndSite",
numericInput(inputId = ns("numberIndSITE"),
label = "Nbr Clusters",
label = "Nbr laying sites",
value = 100),
dateRangeInput(inputId = ns("periodEMERGENCE"),
label = "Period - minimum 14 days",
......
R/mod_tabItemInteractiveMap.R
View file @ 1b7137b4
......@@ -29,7 +29,23 @@ mod_tabItemInteractiveMap_ui <- function(id){
collapsible = TRUE,
closable = FALSE,
footer_padding = FALSE,
p("Information on Interactive Map ...")
p("Information on Interactive Map ..."),
#
hr(),
column(width = 6,
p("You can come back to the previous page, but before running new simulations, clear the current page." ),
actionButton('backDamageTab',
"Back",
icon = icon("backward"),
style="color: #fff; background-color: #3c8dbc; border-color: #3c8dbc")
),
column(width = 6,
p("If the dispersal seems ok, you can consider to safely click to go to the next step... " ),
actionButton('switchDataExplorerTab',
"Next",
icon = icon("forward"),
style="color: #fff; background-color: #00a65a; border-color: #00a65a")
)
)
),
fluidRow(
......@@ -60,17 +76,6 @@ mod_tabItemInteractiveMap_ui <- function(id){
leafletOutput(ns("mapDAMAGE"))
)
)
),
fluidRow(
box(title = "Next",
width = 12, status = "primary",
solidHeader = TRUE,
p("If it's ok, click next"),
actionButton('switchDataExplorerTab',
"Next",
icon = icon("forward"),
style="color: #fff; background-color: #3c8dbc; border-color: #3c8dbc")
)
)
)
}
......
R/mod_tabItemLandscape.R
View file @ 1b7137b4
......@@ -35,30 +35,31 @@ mod_tabItemLandscape_ui <- function(id){
footer_padding = FALSE,
p("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."),
tags$video(id="video2", type = "video/mp4",src = "www/maizeFieldMap_VIDEO_small.mp4", controls = "controls"),
# img(src = 'www/modelScheme_item_1.jpg',
# title = "item1", width = "800px"),
hr(),
column(width = 4,
column(width = 6,
p("You can come back to the previous page, but before running new simulations, clear the current page." ),
actionButton('backStartTab',
"Back",
icon = icon("backward"),
style="color: #fff; background-color: #3c8dbc; border-color: #3c8dbc")
),
column(width = 4,
p("If the map has", tags$b("sources"),", ", tags$b("hosts"), " and ",
tags$b("a square frame"), "you can consider to safely click to go to the next step... " ),
actionButton('switchDispersalTab',
"Next",
icon = icon("forward"),
style="color: #fff; background-color: #00a65a; border-color: #00a65a")
),
column(width = 4,
p("Clear this page, and all the next pages if things have already been done." ),
actionButton('clearLandscapeTab',
"CLEAR",
icon = icon("exclamation"),
style="color: #fff; background-color: #dd4b39; border-color: #dd4b39")
column(width = 6,
p("If the map has", tags$b("sources"),", ", tags$b("hosts"), " and ",
tags$b("a square frame"), "you can consider to safely click to go to the next step... " ),
actionButton('switchDispersalTab',
"Next",
icon = icon("forward"),
style="color: #fff; background-color: #00a65a; border-color: #00a65a")
# ),
# column(width = 4,
# p("Clear this page, and all the next pages if things have already been done." ),
# actionButton('clearLandscapeTab',
# "CLEAR",
# icon = icon("exclamation"),
# style="color: #fff; background-color: #dd4b39; border-color: #dd4b39")
)
)
),
......
R/mod_tabItemReport.R
View file @ 1b7137b4
......@@ -31,7 +31,16 @@ mod_tabItemReport_ui <- function(id){
p("Information on report ..."),
downloadButton(ns("downloadReport"),
"Download Report PDF",
style="color: #fff; background-color: #33595f; border-color: #052327")#,
style="color: #fff; background-color: #33595f; border-color: #052327"),
#
hr(),
column(width = 6,
p("You can come back to the previous page, but before running new simulations, clear the current page." ),
actionButton('backInteractiveMap',
"Back",
icon = icon("backward"),
style="color: #fff; background-color: #3c8dbc; border-color: #3c8dbc")
)
)
),
fluidRow(
......