leafletOutput in uiOutput is only clickable once

[Cipolla]

Dear all,

I am trying to embed a leaflet object in a renderUI (which perhaps is not so sensible but I haven't come up with other options yet) and it seems when you run the code for the first time, you can click on the leaflet map. However, after you refresh your input (e.g. choosing "Option 2"), the map is refreshed and not clickable anymore. Any suggestion here?

Thank you very much in advance!
Cipolla

---

I have tried to generate a minimal working example here:

library(shiny)
library(shinydashboard)
library(leaflet)


ui <- dashboardPage(
  title = "Minimal Working Example",
  dashboardHeader(title = "Example"),
  dashboardSidebar(disable = FALSE,
                   sidebarMenu(id = "sidebarmenu",
                               menuItem("Tab 1",
                                        tabName = "tab1",
                                        icon = icon("gear")),
                               menuItem("Tab 2", tabName = "tab2", icon = icon("list-ol")),
                               conditionalPanel("input.sidebarmenu == 'tab1'",
                                                selectInput(
                                                  inputId = "option",
                                                  label = "Options",
                                                  choices = c("Option 1", "Option 2"),
                                                ),
                               )
                   )
  ),
  dashboardBody(
    fluidRow(
      uiOutput("test")
    )
  )
  
)

server <- function(input, output){
  
  output$test <- renderUI({
    tagList(
      if (input$option == "Option 1"){
        print(input$option)
        leafletOutput("map")
      },
      if (input$option == "Option 2"){
        print(input$option)
        leafletOutput("map")
      }
    )
  })
    
  
  output$map <- renderLeaflet({
    leaflet() %>%
      addProviderTiles(providers$Esri.WorldTopoMap) %>%
      setView(lng = -174.349645, lat = 40.529522, zoom = 5) %>%
      addMarkers(lng=c(-174.349645), lat=c(40.529522))
  })
  
  
  observe({
    click = input$map_click
    print(click)
    if(is.null(click))
      return()
    text<-paste("Latitude: ", click$lat, ", Longtitude: ", click$lng)
    distPlot_proxy = leafletProxy("map") %>%
      clearMarkers() %>%
      addMarkers(click$lng, click$lat) %>%
      clearPopups() %>%
      addPopups(click$lng, click$lat, text)
  })
  
}

shinyApp(ui = ui, server = server)

[craig.parylo]

Hi @Cipolla, thank you for posting your question with a helpful working example.

I've adjusted the UI to set your map to be a leafletOutput() instead of a uiOutput(), then tweaked your server function so that:

• The map is defined reactively based on input$option (I'm assuming you want a completely new map depending on user choice, so here have set new lat/lon coords to illustrate how I'd do this).

• A separate process to update the map in the UI,

• A third process to respond to clicks on the map.

UI:

dashboardBody(
    fluidRow(
      leafletOutput("test")
    )
  )

server:

server <- function(input, output){
  
  # redefine the map based on option selection in a reactive expression
  map <- reactive({
    if(input$option == 'Option 1') {
      # default map
      leaflet() |> 
        addProviderTiles(providers$Esri.WorldTopoMap) |> 
        setView(lng = -174.349645, lat = 40.529522, zoom = 5) |> 
        addMarkers(lng=c(-174.349645), lat=c(40.529522))
    } else if (input$option == 'Option 2') {
      # a map with different coords
      leaflet() |> 
        addProviderTiles(providers$Esri.WorldTopoMap) |> 
        setView(lng = -0, lat = 0, zoom = 5) |> 
        addMarkers(lng=c(0), lat=c(0))
    }
  })
  
  # update the map in the ui
  output$test <- renderLeaflet(map())
  
  # respond to clicks on the map
  observeEvent(input$test_click, {
    click <- input$test_click
    if(is.null(click))
      return()
    text<-paste("Latitude: ", click$lat, ", Longtitude: ", click$lng)
    leafletProxy("test") %>%
      clearMarkers() %>%
      addMarkers(click$lng, click$lat) %>%
      clearPopups() %>%
      addPopups(click$lng, click$lat, text)
  })
  
}

[Cipolla]

Thank you Craig, your remedy works!