Search code examples
rshinyr-leaflet

Split code of one leaflet map (so that input updates of one part does not affect other part of code)


Is it possible to split the code of a map so that a part of the map only updates if it's own input is changed?

In the reproducible example below, when selecting the "toner" tile and selecting a new station, the whole leaflet map is executed again because addLegend needs to be updated. Which makes the tile jump back to "OSM (default)" tile. I would like to stay at the tile I selected when I select other stations.

library(leaflet)
library(shiny)
library(dplyr)

pal <- colorFactor(
  palette = "YlGnBu",
  domain = quakes$stations
)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      checkboxGroupInput("stations", 
                  "Choose a station",
                  choices=sort(unique(quakes$stations)),
                  selected = c(10, 11))
    ),
    mainPanel(
      leafletOutput("map")
    )
  )
)

server <- function(input, output) {
  points <- reactive({
    quakes %>%
      filter(stations %in% input$stations)
  })
  
  output$map <- renderLeaflet({
    leaflet(quakes) %>%
      addTiles(group = "OSM (default)") %>%
      addProviderTiles(providers$Stamen.Toner, group = "Toner") %>%
      addLayersControl(
        baseGroups = c("OSM (default)", "Toner"),
        options = layersControlOptions(collapsed = FALSE)) %>%
      addLegend("Legend", position = "topleft", pal = pal, values = input$stations)
  })
  
  observe({
    if(nrow(points()) == 0) {
      leafletProxy("map", data = points()) %>%
        clearMarkers()
    } else {
      leafletProxy("map", data = points()) %>%
        clearMarkers() %>%
        addCircleMarkers(radius = 2)
    }
  })
}

shinyApp(ui, server)

I tried several things, including adding addLegend to the else statement, but that does not go well. I'm new to leaflet/shiny, moving addLegend seemed most logic to me.


Solution

  • As far as I get it you were on the right track by trying to move addLegend to the observer. Doing so worked fine for me.

    1. Move addLegend to observe
    2. Before adding the legend use clearControls to remove any existing legend (otherwise you get multiple legends)
    3. I removed the duplicated code in the observe
    4. As far as I get it the condition nrow(points()) > 0 is only needed to decide whether a legend should be drawn or not. For the markers it doesn't matter.
    
        library(leaflet)
        library(shiny)
        library(dplyr)
        
        pal <- colorFactor(
          palette = "YlGnBu",
          domain = quakes$stations
        )
        
        ui <- fluidPage(
          sidebarLayout(
            sidebarPanel(
              checkboxGroupInput("stations", 
                                 "Choose a station",
                                 choices=sort(unique(quakes$stations)),
                                 selected = c(10, 11))
            ),
            mainPanel(
              leafletOutput("map")
            )
          )
        )
        
        server <- function(input, output) {
          points <- reactive({
            quakes %>%
              filter(stations %in% input$stations)
          })
          
          output$map <- renderLeaflet({
            leaflet(quakes) %>%
              addTiles(group = "OSM (default)") %>%
              addProviderTiles(providers$Stamen.Toner, group = "Toner") %>%
              addLayersControl(
                baseGroups = c("OSM (default)", "Toner"),
                options = layersControlOptions(collapsed = FALSE))
          })
          
          observe({
            proxy <- leafletProxy("map", data = points()) %>%
              clearMarkers() %>% 
              clearControls() %>% 
              addCircleMarkers(radius = 2)
            
            if (nrow(points()) > 0) 
              proxy <- proxy %>% addLegend("Legend", position = "topleft", pal = pal, values = input$stations)
            
            proxy
          })
        
        }
        
        shinyApp(ui, server)