Search code examples
rshinyleafletreactive-programmingr-leaflet

Applying leaflet map bounds to filter data, within Shiny


The code below is meant to reproduce that which is found in this example with the exception of adding an additional parameter for "speed". However, my map-datatable link has broken - Can anyone help me spot the bug? The original code updates the table based on the bounds of the map, while in my code changing the map zoom has no effect on my table. I'm also not able to get the "speed" filter to work on the table and map, which is a functionality I am looking for. Any pointers would be appreciated.

library(shiny)
library(magrittr)
library(leaflet)
library(DT)

ships <-
  read.csv(
    "https://raw.githubusercontent.com/Appsilon/crossfilter-demo/master/app/ships.csv"
  )

ui <- shinyUI(fluidPage(
  titlePanel(""),
  sidebarLayout(
    sidebarPanel(width = 3,
                 numericInput(
                   "speed", label = h5("Ship's Speed"), value = 100
                 )),
    mainPanel(tabsetPanel(
      type = "tabs",
      tabPanel(
        "Leaflet",
        leafletOutput("leafletmap", width = "350px"),
        dataTableOutput("tbl")
      )
    ))
  )
))

server <- shinyServer(function(input, output) {
  in_bounding_box <- function(data, lat, long, bounds, speed) {
    data %>%
      dplyr::filter(
        lat > bounds$south &
          lat < bounds$north &
          long < bounds$east & long > bounds$west & ship_speed < input$speed
      )
  }

  output$leafletmap <- renderLeaflet({
    leaflet() %>%
      addProviderTiles("Esri.WorldImagery", group = "ESRI World Imagery") %>%
      addCircleMarkers(
        data = ships,
        ~ long ,
        ~ lat,
        popup =  ~ speed,
        radius = 5 ,
        stroke = FALSE,
        fillOpacity = 0.8,
        popupOptions = popupOptions(closeButton = FALSE)
      )
  })

  data_map <- reactive({
    if (is.null(input$map_bounds)) {
      ships
    } else {
      bounds <- input$map_bounds
      in_bounding_box(ships, lat, long, bounds, speed)
    }
  })

  output$tbl <- DT::renderDataTable({
    DT::datatable(
      data_map(),
      extensions = "Scroller",
      style = "bootstrap",
      class = "compact",
      width = "100%",
      options = list(
        deferRender = TRUE,
        scrollY = 300,
        scroller = TRUE,
        dom = 'tp'
      )
    )
  })


})

shinyApp(ui = ui, server = server)

Solution

  • Two small changes:

    • In the example you linked, input$map_bounds works, because the leaflet output object is called map. However, you renamed it to leafletmap, so we should refer to input$leafletmap_bounds.
    • in the dplyr statement, we should refer to speed, not ship_speed.

    Working code is given below, hope this helps!


    library(shiny)
    library(magrittr)
    library(leaflet)
    library(DT)
    
    ships <-
      read.csv(
        "https://raw.githubusercontent.com/Appsilon/crossfilter-demo/master/app/ships.csv"
      )
    
    ui <- shinyUI(fluidPage(
      titlePanel(""),
      sidebarLayout(
        sidebarPanel(width = 3,
                     numericInput(
                       "speed", label = h5("Ship's Speed"), value = 100
                     )),
        mainPanel(tabsetPanel(
          type = "tabs",
          tabPanel(
            "Leaflet",
            leafletOutput("leafletmap", width = "350px"),
            dataTableOutput("tbl")
          )
        ))
      )
    ))
    
    server <- shinyServer(function(input, output) {
      in_bounding_box <- function(data, lat, long, bounds, speed) {
        data %>%
          dplyr::filter(
            lat > bounds$south &
              lat < bounds$north &
              long < bounds$east & long > bounds$west & speed < input$speed
          )
      }
    
      output$leafletmap <- renderLeaflet({
        leaflet() %>%
          addProviderTiles("Esri.WorldImagery", group = "ESRI World Imagery") %>%
          addCircleMarkers(
            data = ships,
            ~ long ,
            ~ lat,
            popup =  ~ speed,
            radius = 5 ,
            stroke = FALSE,
            fillOpacity = 0.8,
            popupOptions = popupOptions(closeButton = FALSE)
          )
      })
    
      data_map <- reactive({
        if (is.null(input$leafletmap_bounds)) {
          ships
        } else {
          bounds <- input$leafletmap_bounds
          in_bounding_box(ships, lat, long, bounds, speed)
        }
      })
    
      output$tbl <- DT::renderDataTable({
        DT::datatable(
          data_map(),
          extensions = "Scroller",
          style = "bootstrap",
          class = "compact",
          width = "100%",
          options = list(
            deferRender = TRUE,
            scrollY = 300,
            scroller = TRUE,
            dom = 'tp'
          )
        )
      })
    
    
    })
    
    shinyApp(ui = ui, server = server)