Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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

Tags:

r

shiny

r-leaflet

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?

like image 788
M_M Avatar asked Oct 15 '25 16:10

M_M


1 Answers

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.

like image 75
SBista Avatar answered Oct 17 '25 07:10

SBista



Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!