R Shiny Leaflet How to Change Circles Size Based on Zoom Level

user_4531238 0
Viewed 1115

I'm creating a Shiny app with a Leaflet map. It has thousands of small circles plotted on it, and the colors of the circles tells a story. When zoomed out, the circles are kept small (weight=1) so they overlap less. However, when the user zooms in, the small circles become hard to see. I would like the circles to increase in size depending on the zoom level. I understand that there is a input$MAPID_zoom feature that returns a zoom level as an integer.

Below is some reproducible code that plots 15 random points in Dallas, TX onto a leaflet map with the zoom set to 6. How would I go about changing the weight of the circles from 1 to 2 when the zoom level increases to 8, and from 2 to 3 when the zoom increases to 10?

I've seen some discussion online but nothing that has worked for me. See code below. Thanks in advance.

## app.R ##
library(leaflet)

ui <- dashboardPage(
  dashboardHeader(title = "Basic dashboard"),
  dashboardSidebar(),
  dashboardBody(
    leafletOutput("Map", width = "100%", height = "500px")
    
  )
)

server <- function(input, output) {

  df <- data.frame("Lat"=c(32.921821,32.910853,32.793803,32.995084,32.683745,32.759999,32.800652,32.958861,32.835963,32.762578,32.649651,32.862843,32.862217,32.936876,32.963381),
                   "Long"=c(-96.840609,-96.738831,-96.689232,-96.857858,-96.825345,-96.684475,-96.794144,-96.816111,-96.676371,-96.897331,-96.944426,-96.754719,-96.856976,-96.752718,-96.770249))

   output$Map <- renderLeaflet({
     leaflet(df) %>%
       addTiles(urlTemplate = "//{s}.tiles.mapbox.com/v3/jcheng.map-5ebohr46/{z}/{x}/{y}.png",
                attribution = 'Maps by <a href="http://www.mapbox.com/">Mapbox</a>') %>% 
       setView(lng = -96.84, lat = 32.92, zoom = 6) %>%
       addCircles(lng = ~Long, lat = ~Lat, weight = 1,
                        opacity = 1, fill = TRUE,  fillOpacity = 1 )
   })
}
shinyApp(ui, server)
leaflet shiny r
2 Answers

Alright, this ended up being more involved than I thought but I finally got it to work. There is an observer that is the key. I also had to learn what leafletProxy() is (research it if you don't know). Finally, clearing the shapes with clearShapes() in the observer was key to getting this working when zooming both in and out. See code below.

## app.R ##
library(leaflet)
library(shinydashboard)
library(shinydashboardPlus)
library(dplyr)
ui <- dashboardPage(
  dashboardHeader(title = "Basic dashboard"),
  dashboardSidebar(),
  dashboardBody(
    leafletOutput("map", width = "100%", height = "500px")
    
  )
)

server <- function(input, output,session) {
  
  df <- data.frame("Lat"=c(32.921821,32.910853,32.793803,32.995084,32.683745,32.759999,32.800652,32.958861,32.835963,32.762578,32.649651,32.862843,32.862217,32.936876,32.963381),
                   "Long"=c(-96.840609,-96.738831,-96.689232,-96.857858,-96.825345,-96.684475,-96.794144,-96.816111,-96.676371,-96.897331,-96.944426,-96.754719,-96.856976,-96.752718,-96.770249))
  
  observeEvent(
    eventExpr = input$map_zoom, {
      print(input$map_zoom)           # Display zoom level in the console
      leafletProxy(
        mapId = "map", 
        session = session
      )%>% clearShapes() %>%
        addCircles(data=df,lng = ~Long, lat = ~Lat, 
                   weight = case_when(input$map_zoom <=4 ~1, 
                                      input$map_zoom ==5 ~2, 
                                      input$map_zoom ==6 ~3, 
                                      input$map_zoom ==7 ~5, 
                                      input$map_zoom ==8 ~7, 
                                      input$map_zoom ==9 ~9, 
                                      input$map_zoom >9 ~11),
                   opacity = 1, fill = TRUE, fillOpacity = 1 )
    }
  )
  
  output$map <- renderLeaflet({
    leaflet() %>%
      addTiles(urlTemplate = "//{s}.tiles.mapbox.com/v3/jcheng.map-5ebohr46/{z}/{x}/{y}.png",
               attribution = 'Maps by <a href="http://www.mapbox.com/">Mapbox</a>') %>%
      setView(lng = -96.84, lat = 32.92, zoom = 6) 
  })
}
shinyApp(ui, server)
user_45312380

Try this

output$Map <- renderLeaflet({
    new_zoom <- 6
    wt <- 2
    if(!is.null(input$Map_zoom)) new_zoom <- input$Map_zoom
    
    leaflet(df) %>%
      addTiles(urlTemplate = "//{s}.tiles.mapbox.com/v3/jcheng.map-5ebohr46/{z}/{x}/{y}.png",
               attribution = 'Maps by <a href="http://www.mapbox.com/">Mapbox</a>') %>% 
      setView(lng = -96.84, lat = 32.92, zoom=new_zoom ) %>%
      addCircles(lng = ~Long, lat = ~Lat, weight = wt, # radius=radius,
                 opacity = 1, fill = TRUE,  fillOpacity = 1 )
  })
user_133332790
Related