RHinks
RHinks

Reputation: 41

How to use shiny range slider to filter points on leaflet point map

I'm trying to use shiny and leaflet to filter the points on a point map on/off depending on the value of a numeric variable ('Population')

I load libraries and data


#load libraries

library(shiny)
library(leaflet)

#create fake data

fake_data <- data.frame(Lat = c(51.4, 51.5, 51.7, 53.4, 50.7, 50.9, 51.1, 51.3, 51.4, 51.2),
                        Long = c(-0.1, -0.1, 0.0, -2.1, -2.4, -1.3, -0.3, -0.2, -0.3, 0.1),
                        Population = c(723, 746, 512, 389, 253, 289, 212, 208, 245, 212),
                        Class1 = c(TRUE, TRUE, TRUE, FALSE, FALSE, TRUE, FALSE, TRUE, FALSE, TRUE),
                        Class2 = c(TRUE, FALSE, FALSE, TRUE, TRUE, FALSE, TRUE, FALSE, TRUE, TRUE),
                        TownName = c("Town1", "Town2", "Town3", "Town4", "Town5", "Town6", "Town7", "Town8", "Town9", "Town10"))

and initiate the shiny app in rStudio, creating a range slider based on the range of fake.data$Population


#shiny

##ui

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "100%"),
  absolutePanel(top = 10, right = 10,
                sliderInput("range", "Population", min(fake_data$Population), max(fake_data$Population), value = range(fake_data$Population)
                )
  )
)

I think the issue is occurring on the server-side chunk of code for the shiny app - either when creating sliderData, or using the observe() function.

With observe() taking data from sliderData, how do I add markers based on whether fake_data$Class1 == TRUE?

server <- function(input, output, session) {

  sliderData <- reactive({
    fake_data[fake_data$Population >= input$range[1] & fake_data$Population <= input$range[2],]
  })

  output$map <- renderLeaflet({
    leaflet(fake_data) %>% 
      addProviderTiles(providers$Stamen.TonerLite, options = providerTileOptions(minZoom = 6, maxZoom = 10)) %>%
      setView(lng=-1.7, lat=53.9, zoom=6) 
    })  

  observe({
    leafletProxy("map", data = sliderData()) %>%
    clearMarkers() %>%
      addCircleMarkers(data = fake_data[fake_data$Class1 == TRUE,], group = "Class1", popup = ~as.character(TownName), color = 'black', fillOpacity = 1) %>%
      addCircleMarkers(data = fake_data[fake_data$Class2 == TRUE,], group = "Class2", popup = ~as.character(TownName), color = 'red', fillOpacity = 1) %>%
      addLayersControl(
        overlayGroups = c("Class1", "Class2"),
        options = layersControlOptions(collapsed = FALSE),
        position = "bottomright"
      )
  }) 

I expect to be able to use the slider to set a population range, and have the leaflet map show points for only those "Towns" with a 'Population' that falls within this range.

However, once run, the leaflet map is mapping all points at all times, with the range slider having no effect on the map. Image of app output

Upvotes: 0

Views: 1937

Answers (1)

RHinks
RHinks

Reputation: 41

Sorted it


server <- function(input, output, session) {

  sliderData1 <- reactive({
    fake_data[fake_data$Population >= input$range[1] & fake_data$Population <= input$range[2] & fake_data$Class1 == TRUE,]
  })

  sliderData2 <- reactive({
    fake_data[fake_data$Population >= input$range[1] & fake_data$Population <= input$range[2] & fake_data$Class2 == TRUE,]
  })

...on the server side (two reactive commands, one for each class)

Followed by...


  observe({
    leafletProxy("map", data = sliderData1()) %>%
      clearMarkers() %>%
      addCircleMarkers(data = sliderData1(), group = "Class1", popup = ~as.character(TownName), color = 'black', fillOpacity = 1) %>%
      addCircleMarkers(data = sliderData2(), group = "Class2", popup = ~as.character(TownName), color = 'red', fillOpacity = 1) %>%
      addLayersControl(
        overlayGroups = c("Class1", "Class2"),
        options = layersControlOptions(collapsed = FALSE),
        position = "bottomright"
      )
  }) 

Advise if this is too basic a problem to keep live for prosperity, and I'll delete...

Upvotes: 2

Related Questions