add option to load and render a tif raster via input file

BioDT · Oct 18, 2024 · aa2df58 · aa2df58
1 parent c556765
commit aa2df58
Show file tree

Hide file tree

Showing 3 changed files with 27 additions and 27 deletions.
diff --git a/app/view/disease_outbreaks/disease_app/disease_app.R b/app/view/disease_outbreaks/disease_app/disease_app.R
@@ -1,5 +1,5 @@
 box::use(
-  shiny[NS, tagList, moduleServer, tags, reactiveVal, reactive, observeEvent],
+  shiny[NS, tagList, moduleServer, tags, reactiveVal, reactive, observeEvent, req],
   bslib[layout_column_wrap],
   htmltools[css],
 )
@@ -39,6 +39,8 @@ disease_app_server <- function(id, tab_disease_selected) {
     map <- reactiveVal()
     leaflet_map <- reactiveVal()
 
+    new_tif_upload <- disease_select_server("disease_select", tab_disease_selected())
+
     observeEvent(tab_disease_selected(),
       ignoreInit = TRUE,
       {        
@@ -56,7 +58,8 @@ disease_app_server <- function(id, tab_disease_selected) {
         # MAP itself ----
         disease_map_server(
           "disease_map",
-          leaflet_map = leaflet_map
+          leaflet_map = leaflet_map,
+          new_tif_upload
         ) 
       }
     )

diff --git a/app/view/disease_outbreaks/disease_app/disease_map.R b/app/view/disease_outbreaks/disease_app/disease_map.R
@@ -34,7 +34,7 @@ disease_map_ui <- function(id, i18n) {
 }
 
 #' @export
-disease_map_server <- function(id, leaflet_map) {
+disease_map_server <- function(id, leaflet_map, new_tif_upload) {
   moduleServer(id, function(input, output, session) {
     ns <- session$ns
         # Define waiter ----
@@ -55,5 +55,18 @@ disease_map_server <- function(id, leaflet_map) {
       w$hide()
     })
 
+    observeEvent(new_tif_upload(), {
+      new_tif_rast <- new_tif_upload() |>
+                        read_and_project_raster()
+
+      req(new_tif_rast)
+      leafletProxy("map_output") |>
+        addRasterImage(
+        new_tif_rast,
+        opacity = 1,
+        project = FALSE,
+        group = "File upload"
+      )
+    })
   })
 }
diff --git a/app/view/disease_outbreaks/disease_app/disease_select.R b/app/view/disease_outbreaks/disease_app/disease_select.R
@@ -1,11 +1,7 @@
 box::use(
-  shiny[moduleServer, NS, tagList, checkboxInput, bootstrapPage, tags, observeEvent, reactiveVal, reactive, actionButton],
+  shiny[moduleServer, NS, tagList, checkboxInput, bootstrapPage, tags, observeEvent, reactiveVal, reactive, actionButton, fileInput, req, validate, need],
   bslib[card, card_header, card_body],
-  leaflet[clearImages, leafletProxy]
-)
-
-box::use(
-  # app/logic/disease_outbreaks/disease_leaflet_map[remove_map_layer]
+  leaflet[clearImages, leafletProxy],
 )
 
 #' @export
@@ -23,7 +19,9 @@ disease_select_ui <- function(id, theme, i18n) {
           "File input"
         )
       ),
-      card_body(),
+      card_body(
+        fileInput(ns("tif_file"), "Choose .tif file", accept = ".tif"),
+      ),
     )
   )
 }
@@ -34,26 +32,12 @@ disease_select_server <- function(id, tab_disease_selected) {
     ns <- session$ns
     out <- reactiveVal(NULL)
 
-    events <- reactive({
-      tab_disease_selected()
-      input$mosaic_final
-      input$outfirst_infection
-    })
-
     observeEvent(
-      events(),
+      input$tif_file,
       ignoreInit = TRUE,
       ignoreNULL = TRUE,
-    {        
-        if (input$mosaic_final == TRUE) {
-          "Mosaic_final" |>
-            out()
-        }
-
-        if (input$outfirst_infection == TRUE) {
-          "outfirst_infection" |>
-            out()
-        }
+    {
+      out(input$tif_file$datapath)      
     })
 
     reactive(out())