Search code examples
rshinyr-leaflet

How to fix (lock) leaflet map view zoom and center?


I am building a similar app to this one. On the map, if you zoom in and then change the slider/input, the zoom level resets to the default automatically. I would like to render new instances of the map without changing the zoom level until the user changes it back. Ideally, I will add a button to reset the zoom to the original setting.

I looked at these posts: 1, 2, and 3.

The code in the 3rd link made sense to me but still didn't work. Thier code, based on the comment, should have fixed the zoom issue but not the centering - neither worked for me. Below, I modified the original app to be as close as possible to my app. I also implemented two changes in an attempt to achieve the desired map view behaviour - I added two reactive functions: zoom and center. Here is the modified repex:

library(shiny)
library(ggplot2)
library(plotly)
library(leaflet)

qDat <- quakes

ui <- fluidPage(
  titlePanel("pyData Shiny Demo"),
  sidebarLayout(
    sidebarPanel(
      h3("Fiji Earthquake Data"),
      selectInput("select01", "Select earthquakes based on:",
                  choices=c("Magnitude"="mag",
                            "Depth"="depth"),
                  selected="mag"),
      conditionalPanel(condition="input.select01=='mag'",
                       sliderInput("sld01_mag",
                                   label="Show earthquakes of magnitude:", 
                                   min=min(qDat$mag), max=max(qDat$mag),
                                   value=c(min(qDat$mag),max(qDat$mag)), step=0.1)
      ),
      conditionalPanel(condition="input.select01=='depth'",
                       sliderInput("sld02_depth",
                                   label="Show earthquakes of depth:", 
                                   min=min(qDat$depth), max=max(qDat$depth),
                                   value=c(min(qDat$depth),max(qDat$depth)), step=5)
      ),
      plotlyOutput("hist01")
      
    ),
    mainPanel(
      leafletOutput("map01"),
      dataTableOutput("table01")
    )
  )
)

server <- shinyServer(function(input, output) {
  
  qSub <- reactive({
    if (input$select01=="mag"){
      subset <- qDat[qDat$mag>=input$sld01_mag[1] & qDat$mag<=input$sld01_mag[2],]
    }else{
      subset <- qDat[qDat$depth>=input$sld02_depth[1] & qDat$depth<=input$sld02_depth[2],]
    }
    subset
  })
  
  output$hist01 <- renderPlotly({
    ggplot(data=qSub(), aes(x=stations))+
      geom_histogram(binwidth=5)+
      xlab("Number of Reporting Stations")+ 
      xlim(min(qDat$stations), max(qDat$stations))+
      ylab("Count")+
      ggtitle("Earthquakes near Fiji")
  })
  
  output$table01 <- renderDataTable({
    qSub()
  })

  zoom <- reactive({
    ifelse(is.null(input$map01_zoom),3,input$map01_zoom)
  })

  center <- reactive({
    ifelse(is.null(input$map01_bounds),
           c(179.462, -20.64275),
           c((input$map01_bounds$bounds$north + input$map01_bounds$bounds$south)/2.0, 
             (input$map01_bounds$bounds$east + input$map01_bounds$bounds$west)/2.0))
  })
  
  
  pal <- colorNumeric("YlOrRd", domain=c(min(quakes$mag), max(quakes$mag)))
  
  output$map01 <- renderLeaflet({
  leaflet(data=qSub()) %>% 
      addTiles() %>%
      addLegend("bottomright", pal = pal, values = ~mag,
                title = "Earthquake Magnitude",
                opacity = 1)
  })
  
  observe({
    
    leafletProxy("map01") %>%
      clearShapes() %>%
      #setView(lng = 179.462, lat =  -20.64275, zoom = 3) %>%
      setView(lng = center()[1],
              lat = center()[2],
              zoom = zoom()) %>%
      addCircleMarkers(
        data=qSub(),
        radius = 2,
        color = ~pal(mag),
        stroke = FALSE, fillOpacity = 1, popup=~as.character(mag))
  })
  
})

shinyApp(ui = ui, server = server)

Do you have any tips on how to achieve this?


Solution

  • You were nearly there. There is just one mistake in you app:

    You'll need to change

    center <- reactive({
        ifelse(is.null(input$map01_bounds),
               c(179.462, -20.64275),
               c((input$map01_bounds$bounds$north + input$map01_bounds$bounds$south)/2.0, 
                 (input$map01_bounds$bounds$east + input$map01_bounds$bounds$west)/2.0))
      })
    

    to

          center <- reactive({
            
            if(is.null(input$map01_center)){
              return(c(179.462, -20.64275))
              }else{
                return(input$map01_center)
            }
    
      })
    

    The first reason being the ifelse does not work when length of vector more than 1 and second is that input$map01_center gives you the center.