Applying leaflet map bounds to filter data, within Shiny

Question

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)

score 3 · Accepted Answer · answered May 01 '18 at 06:30

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)

thanks for pointing out the bug. The "speed" filter however does not seem to work. Should I be posting as a separate question? — val, May 01 '18 at 15:19
I would expect the data_map() reactive to update based on the "speed" input. — val, May 01 '18 at 15:33
Hi @val, one thing that might help is changing `in_bounding_box(ships, lat, long, bounds, speed)` to `in_bounding_box(ships, lat, long, bounds, input$speed)` and then checking the body of your `in_bounding_box` function, since you have a parameter `speed` and also `speed` is used to refer to a column in the dplyr chain - that's my bad, I changed `ship_speed` to `speed` as required, but I did not check if that name was already used. If you keep struggling with this, I think opening a separate question for that issue may be a good idea, where you can specify the exact desired behavior. — Florian, May 01 '18 at 19:04
thx - tried your suggestion but does not appear to work. have re-posted for that issue here https://stackoverflow.com/questions/50128349/filtering-leaflet-map-data-in-shiny — val, May 02 '18 at 06:28

score 2 · Answer 2 · answered May 01 '18 at 06:29

The leaflet map you are rendering is called leafletmap. So rather than referring to map_bounds try changing it to leafletmap_bounds:

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

Also in the filter, change ship_speed to speed. Should hopefully work.

Applying leaflet map bounds to filter data, within Shiny

2 Answers2

Linked