Search code examples
rshinyr-leaflet

Shiny Leaflet map with reactive slider input


I have a dataset looking something like this:

Dataset <- data.frame(
  "Type" = c("A", "B", "A", "B"),
  "Value" = c(1000000, 200, 4000000, 150),
  "Lat" = c(40.7, 41.8, 42.4, 43.1), 
  "Long" = c(-3.2, -2.1, -1.6, -3.1)
)
Type    Value   Lat   Long
 A     1000000  40.7  -3.2
 B       200    41.8  -2.1
 A     4000000  42.4  -1.6
 B       150    43.1  -3.1

I'm displaying each point as a marker in a leaflet map using Lat and Long as coordinates, but as you can see the Value range varies a lot depending on Type. To make my map more user-friendly I enabled a pickerInput() to let me choose the Type to be displayed on the map and then a sliderInput() to choose the Value. Using reactive() I filter the points for the map.

My problem is that I'm unable to make a reactive sliderInput() range depending on the Type selected in pickerInput. I only managed to get a slider covering the whole range, which in the example data above would be from 150 to 4000000.

I would need to get a slider from 150 to 200 and from 1000000 to 4000000 depending on the pickerInput. My code so far:

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

ui <- bootstrapPage(
  absolutePanel(top = 10, right = 10,
   sliderInput("range", "Value", min(Dataset$Value, na.rm = TRUE), max(Dataset$Value, na.rm = TRUE),
      value = range(Dataset$Value, na.rm = FALSE), step = 1000),
    pickerInput("Type", "Type", choices = c("A", "B"),      selected = c("A", "B"), multiple = T, options = list(`actions-box` = TRUE)),
  ),
  leafletOutput("map", width = "50%")
)

server <- function(input, output) {
  
  filteredData <- reactive({
    Dataset %>% 
    filter(Type %in% input$Type) %>%
    filter(Value >= input$range[1]) %>% 
    filter(Value <= input$range[2])
 })

  output$map <- renderLeaflet({
    leaflet(Dataset) %>% addTiles() %>% addMarkers(data = filteredData(), lng = ~Long, lat = ~Lat)
  })
}

shinyApp(ui, server)

Solution

  • You can use updateSliderInput() (and more generally update*() functions when you want to update the choices). Don't forget to add session in function(input, output). Here, we can filter the data in two steps:

    • first, we choose the type. This will determine the range of the slider.

    • second, after the slider is updated, we choose the range.

    Here's the full example:

    library(shiny)
    library(shinyWidgets)
    library(dplyr)
    library(leaflet)
    
    Dataset <- data.frame(
      "Type" = c("A", "B", "A", "B"),
      "Value" = c(1000000, 200, 4000000, 150),
      "Lat" = c(40.7, 41.8, 42.4, 43.1), 
      "Long" = c(-3.2, -2.1, -1.6, -3.1)
    )
    ui <- bootstrapPage(
      absolutePanel(
        top = 10,
        right = 10,
        sliderInput(
          "range",
          "Value",
          min(Dataset$Value, na.rm = TRUE),
          max(Dataset$Value, na.rm = TRUE),
          value = range(Dataset$Value, na.rm = FALSE),
          step = 1000
        ),
        pickerInput(
          "Type",
          "Type",
          choices = c("A", "B"),
          selected = c("A", "B"),
          multiple = T,
          options = list(`actions-box` = TRUE)
        ),
      ),
      leafletOutput("map", width = "50%")
    )
    
    server <- function(input, output, session) {
      
      filter_type <- reactive({
        Dataset %>%
          filter(Type %in% input$Type)
      })
      
      observeEvent(input$Type, {
        updateSliderInput(
          session = session,
          inputId = "range",
          min = min(filter_type()$Value),
          max = max(filter_type()$Value),
          value = range(filter_type()$Value, na.rm = FALSE)
        )
      })
      
      filter_range <- reactive({
        filter_type() %>% 
          filter(Value >= input$range[1]) %>% 
          filter(Value <= input$range[2])
      })
      
      output$map <- renderLeaflet({
        leaflet(Dataset) %>% 
          addTiles() %>% 
          addMarkers(data = filter_range(), lng = ~Long, lat = ~Lat)
      })
    }
    
    shinyApp(ui, server)