diff --git a/app/logic/disease_outbreaks/disease_leaflet_map.R b/app/logic/disease_outbreaks/disease_leaflet_map.R new file mode 100644 index 0000000..6ff0ed9 --- /dev/null +++ b/app/logic/disease_outbreaks/disease_leaflet_map.R @@ -0,0 +1,68 @@ +box::use( + terra[rast, project], + leaflet[tileOptions, leaflet, addTiles, addRasterImage, setView, addLayersControl, layersControlOptions, addControl, getMapData, addProviderTiles], +) + +#' @export +read_and_project_raster <- function(map_full_path) { + map_raster <- rast(map_full_path) |> project("epsg:3857") +} + +#' @export +disease_leaflet_map_basic <- function(map_raster, + add_control = TRUE, + main_map_features = TRUE) { + leaflet_map <- leaflet() |> + addTiles(group = "Default layer (OpenStreetMap)") |> + setView( + lng = 12.3601, + lat = 51.3402, + zoom = 5 + ) |> + addRasterImage( + map_raster, + opacity = 0.5, + project = FALSE, + options = tileOptions(zIndex = 100), + group = "Input layer" + ) |> + addLayersControl( + baseGroups = c( + "Default layer (OpenStreetMap)" + ), + overlayGroups = c("Input layer"), + options = layersControlOptions(collapsed = FALSE) + ) + + return(leaflet_map) +} + +# #' @export +# disease_leaflet_with_output_layer <- function(map_output_id, input_raster, output_raster) { + + +# leafletProxy(map_output_id) |> # hint: leafletProxy, removeImage, addRasterLegend, addLegend, +# clearImages() |> +# clearControls() |> +# addRasterImage( +# input_raster, +# opacity = 0.5, +# project = FALSE, +# options = tileOptions(zIndex = 100), +# group = "Input layer", +# layerId = "inputLayer" +# ) |> +# addRasterImage( +# output_raster, +# opacity = 0.5, +# project = FALSE, +# options = tileOptions(zIndex = 101), +# group = "Output layer", +# layerId = "outputLayer" +# ) |> +# addLayersControl( +# overlayGroups = c("Input layer", "Output layer"), +# options = layersControlOptions(collapsed = FALSE) +# ) +# } + diff --git a/app/main.R b/app/main.R index 96013f2..ff9c6f7 100644 --- a/app/main.R +++ b/app/main.R @@ -175,7 +175,7 @@ ui <- function(id) { nav_panel( title = i18n$translate("Disease Outbreaks"), class = "p-0", - disease_outbreaks_main_ui(ns("disease_outbreaks_main_ui"), i18n) + disease_outbreaks_main_ui(ns("disease_outbreaks_main"), i18n) ) }, ), @@ -256,6 +256,8 @@ server <- function(id) { "ces_main" ) + disease_outbreaks_main_server("disease_outbreaks_main") + shiny$observeEvent(input$biodt_logo, { nav_select( id = "navbar", diff --git a/app/view/disease_outbreaks/disease_app/disease_app.R b/app/view/disease_outbreaks/disease_app/disease_app.R index 2040331..042f6ac 100644 --- a/app/view/disease_outbreaks/disease_app/disease_app.R +++ b/app/view/disease_outbreaks/disease_app/disease_app.R @@ -1,23 +1,17 @@ box::use( - shiny[NS, tagList, moduleServer, tags], + shiny[NS, tagList, moduleServer, tags, reactiveVal, observeEvent], bslib[layout_column_wrap], htmltools[css], + waiter[Waiter], +) + +box::use( + app / view / disease_outbreaks / disease_app / disease_map[disease_map_ui, disease_map_server], + app / view / disease_outbreaks / disease_app / disease_choose_file[disease_choose_file_ui, disease_choose_file_server], + app / logic / disease_outbreaks / disease_leaflet_map[read_and_project_raster, disease_leaflet_map_basic], + app / logic / waiter[waiter_text], ) -# box::use( -# app/view/grassland/grassland_dynamics/grassland_dynamics_inputmap[ -# grassland_dynamics_inputmap_ui, -# grassland_dynamics_inputmap_server -# ], -# app/view/grassland/grassland_dynamics/grassland_dynamics_location[ -# grassland_dynamics_location_ui, -# grassland_dynamics_location_server -# ], -# app/view/grassland/grassland_dynamics/grassland_dynamics_outputplot[ -# grassland_dynamics_outputplot_ui, -# grassland_dynamics_outputplot_server -# ], -# ) #' @export disease_app_ui <- function(id, i18n) { @@ -27,25 +21,61 @@ disease_app_ui <- function(id, i18n) { width = NULL, fill = FALSE, style = css(grid_template_columns = "3fr 1fr"), - tags$h3(i18n$translate("Input map")), - tags$h3(i18n$translate("Location")), + disease_map_ui( + ns("disease_map"), i18n + ), + disease_choose_file_ui( + ns("disease_select"), i18n + ), ), tags$h3(i18n$translate("Output Plot")) ) } #' @export -disease_app_server <- function(id, r) { +disease_app_server <- function(id, tab_disease_selected) { moduleServer(id, function(input, output, session) { + # Define waiter ---- + msg <- waiter_text(message = tags$h3("Loading data...", + style = "color: #414f2f;" + )) + w <- Waiter$new( + html = msg, + color = "rgba(256,256,256,0.9)" + ) + ns <- session$ns + # Variables ---- + map <- reactiveVal() + leaflet_map <- reactiveVal() + + new_tif_upload <- disease_choose_file_server("disease_select", tab_disease_selected()) + + observeEvent(tab_disease_selected(), + ignoreInit = TRUE, + { + w$show() + "app/data/disease_outbreak/Mosaic_final.tif" |> + read_and_project_raster() |> + map() + + map() |> + disease_leaflet_map_basic( + add_control = TRUE, + main_map_features = TRUE + ) |> + leaflet_map() - # # LOCATION settings ---- - # coordinates <- grassland_dynamics_location_server("location") + w$hide() - # # MAP itself ---- - # grassland_dynamics_inputmap_server("inputmap", coordinates) + } + ) - # # Output PLOT ---- - # grassland_dynamics_outputplot_server("outputplot") + disease_map_server( + "disease_map", + map_original = map, + leaflet_map = leaflet_map, + new_tif_upload = new_tif_upload + ) }) } diff --git a/app/view/disease_outbreaks/disease_app/disease_choose_file.R b/app/view/disease_outbreaks/disease_app/disease_choose_file.R new file mode 100644 index 0000000..ea013e1 --- /dev/null +++ b/app/view/disease_outbreaks/disease_app/disease_choose_file.R @@ -0,0 +1,45 @@ +box::use( + shiny[moduleServer, NS, bootstrapPage, tags, observeEvent, reactiveVal, reactive, fileInput], + bslib[card, card_header, card_body], +) + +#' @export +disease_choose_file_ui <- function(id, theme, i18n) { + ns <- NS(id) + bootstrapPage( + theme = theme, + card( + class = "me-md-3 card-shadow overflow-hidden mt-2", + title = "select_map", + full_screen = FALSE, + card_header( + tags$h2( + class = "card_title", + "Upload a file with raster" + ) + ), + card_body( + fileInput(ns("tif_file"), "Choose .tif file", accept = ".tif"), + ), + ) + ) +} + +#' @export +disease_choose_file_server <- function(id, tab_disease_selected) { + moduleServer(id, function(input, output, session) { + ns <- session$ns + out <- reactiveVal(NULL) + + observeEvent( + input$tif_file, + ignoreInit = TRUE, + ignoreNULL = TRUE, + { + out(input$tif_file$datapath) + } + ) + + reactive(out()) + }) +} \ No newline at end of file diff --git a/app/view/disease_outbreaks/disease_app/disease_map.R b/app/view/disease_outbreaks/disease_app/disease_map.R new file mode 100644 index 0000000..b0efaa6 --- /dev/null +++ b/app/view/disease_outbreaks/disease_app/disease_map.R @@ -0,0 +1,73 @@ +box::use( + shiny[NS, moduleServer, tags, observeEvent, req], + bslib[card, card_header, card_body], + leaflet[leafletOutput, renderLeaflet, leafletProxy, addRasterImage, addLayersControl, layersControlOptions, tileOptions, clearControls, clearImages], +) + +box::use( + app / logic / disease_outbreaks / disease_leaflet_map[read_and_project_raster] +) + +#' @export +disease_map_ui <- function(id, i18n) { + ns <- NS(id) + card( + id = ns("map_wrapper"), + class = "ms-md-3 card-shadow mt-2", + full_screen = TRUE, + card_header( + tags$h2( + class = "card_title", + i18n$translate("Map") + ) + ), + card_body( + leafletOutput( + ns("map_output") + ), + ), + ) +} + +#' @export +disease_map_server <- function(id, map_original, leaflet_map, new_tif_upload) { + moduleServer(id, function(input, output, session) { + ns <- session$ns + + observeEvent(leaflet_map(), { + req(leaflet_map()) + output_map <- leaflet_map() + output$map_output <- renderLeaflet(output_map) + }) + + observeEvent(new_tif_upload(), { + new_tif_raster <- new_tif_upload() |> + read_and_project_raster() + + req(new_tif_raster) + leafletProxy("map_output") |> + clearImages() |> + clearControls() |> + addRasterImage( + map_original(), + opacity = 0.5, + project = FALSE, + options = tileOptions(zIndex = 100), + group = "Input layer", + layerId = "inputLayer" + ) |> + addRasterImage( + new_tif_raster, + opacity = 0.5, + project = FALSE, + options = tileOptions(zIndex = 101), + group = "Output layer", + layerId = "outputLayer" + ) |> + addLayersControl( + overlayGroups = c("Input layer", "Output layer"), + options = layersControlOptions(collapsed = FALSE) + ) + }) + }) +} \ No newline at end of file diff --git a/app/view/disease_outbreaks/disease_contributors.R b/app/view/disease_outbreaks/disease_contributors.R new file mode 100644 index 0000000..d4e1bd9 --- /dev/null +++ b/app/view/disease_outbreaks/disease_contributors.R @@ -0,0 +1,43 @@ +box::use( + shiny[moduleServer, NS, tagList, div, column, tags, fluidRow, icon], +) + +#' @export +disease_contributors_ui <- function(id, i18n) { # nolint + ns <- NS(id) + fluidRow( + class = "align-items-center justify-content-center m-0 p-0", + style = "overflow-x: hidden", + column( + width = 6, + class = "col-sm-12 col-lg-6", + style = "height: 100vh;", + tags$div( + class = "col-sm-10 offset-sm-1 text-center mt-5", + tags$h2(i18n$translate("CONTRIBUTORS"), + style = "greeting display-4 font-weight-bold" + ), + tags$p("TO BE ADDED"), + ) + ), + column( + width = 6, + style = "height: 100vh;", + class = "d-none d-lg-block m-0 p-0", + tags$div( + tags$img( + class = "info-picture", + src = "static/img/Alexis-Lours-Sus-scrofa-Linnaeus.gif", + alt = "Video of wild boar pack", + ) + ) + ) + ) +} + +#' @export +disease_contributors_server <- function(id, r) { # nolint + moduleServer(id, function(input, output, session) { + ns <- session$ns + }) +} \ No newline at end of file diff --git a/app/view/disease_outbreaks/disease_outbreaks_main.R b/app/view/disease_outbreaks/disease_outbreaks_main.R index 5d905e5..a3d803c 100644 --- a/app/view/disease_outbreaks/disease_outbreaks_main.R +++ b/app/view/disease_outbreaks/disease_outbreaks_main.R @@ -1,31 +1,44 @@ box::use( - shiny[moduleServer, icon, NS], + shiny[moduleServer, icon, NS, reactiveVal, observeEvent], bslib[navset_tab, nav_panel], ) box::use( - app/view/disease_outbreaks/info/disease_info[disease_info_ui, disease_info_server], + app/view/disease_outbreaks/info/disease_info[disease_info_ui], app/view/disease_outbreaks/disease_app/disease_app[disease_app_ui, disease_app_server], + app/view/disease_outbreaks/disease_contributors[disease_contributors_ui], ) #' @export disease_outbreaks_main_ui <- function(id, i18n) { ns <- NS(id) navset_tab( + id = ns("tab"), # Info Page --- nav_panel( title = i18n$translate("Info"), - value = "Info", + value = "Info (called from 1st navpanel in disease_outbreaks_main.R)", icon = icon("circle-info"), disease_info_ui( - ns("disease_info_ui"), i18n + ns("disease_info"), i18n ) ), nav_panel( title = i18n$translate("Disease Outbreaks"), + value = "Disease Outbreaks", icon = icon("bugs"), disease_app_ui( - ns("disease_app"), i18n + ns("disease_app"), + i18n + ) + ), + nav_panel( + title = i18n$translate("Contributors"), + value = "Contributors", + icon = icon("sitemap"), + disease_contributors_ui( + ns("disease_contributors"), + i18n ) ) ) @@ -36,6 +49,19 @@ disease_outbreaks_main_server <- function(id) { moduleServer(id, function(input, output, session) { ns <- session$ns - # disease_info_server("disease_info_server") + tab_disease_selected <- reactiveVal(FALSE) + + observeEvent( + input$tab, + { + if (input$tab == "Disease Outbreaks") { + tab_disease_selected(TRUE) + } else { + tab_disease_selected(FALSE) + } + } + ) + + disease_app_server("disease_app", tab_disease_selected) }) } diff --git a/app/view/disease_outbreaks/info/disease_info.R b/app/view/disease_outbreaks/info/disease_info.R index 4a2d87f..856e860 100644 --- a/app/view/disease_outbreaks/info/disease_info.R +++ b/app/view/disease_outbreaks/info/disease_info.R @@ -41,9 +41,8 @@ disease_info_ui <- function(id, i18n) { ) } -#' @export -disease_info_server <- function(id) { - moduleServer(id, function(input, output, session) { +# disease_info_server <- function(id) { +# moduleServer(id, function(input, output, session) { - }) -} +# }) +# }