R Shiny reactive subsetting of data in a leaflet plot

Question

I'm building an R Shiny tool to visualize flight data. I built a data table with observations containing an aircraft's lat, long, speed, heading, altitude, etc. I then plot these observations on a leaflet map. A series of sliders and boxes can subset these observations so that only the desired observations are plotted (eg, only those observations with a certain altitude). I had no trouble rendering the observations until I added selectInput() widgets with the ability to select multiple values. Below is a minimal, reproducible example of my code.

server.R

library(shiny)
library(data.table)
library(leaflet)

shinyServer(function(input, output){

  # sample data set
  dt <- data.table(altitude = c(1,1,3,3,4,5,6,7,3,2),
                   long = c(-85.2753, -85.4364, -85.5358, -85.6644, -85.8208, 
                            -89.9233, -90.0456, -90.2775, -90.5800, -90.8761),
                   lat = c(45.3222, 45.3469, 45.3764, 45.4089, 45.4503,
                           44.0489, 44.1878, 44.3378, 44.4383, 44.5197),
                   origin = c('a', 'a', 'a', 'a', 'a', 'b', 'b', 'b', 'b', 'b'),
                   destination = c('c', 'c', 'c', 'c', 'c', 'd', 'd', 'd', 'd', 'd'))

  # subset the data on various inputs from ui.R
  subsetData <- reactive({
    new_data <- dt[altitude > input$alt_cut[1] &
                   altitude < input$alt_cut[2] &
                   origin %in% input$origin &
                   destination %in% input$dest, ]
    return(new_data)
  })

  # display the data in real time to identify if the subsetting
  # is occurring as expected.
  output$viewData <- renderTable({
    subsetData()
  })

  # plot the data points
  output$mapPlot <- renderLeaflet({
    leaflet() %>%
      fitBounds(-90.8761, 44.0489, -85.2753, 45.4503)
  })

  observe({
    leafletProxy('mapPlot') %>%
      clearGroup('A') %>%  # I think this line may not be functioning as I expect...
      addCircles(data = subsetData(),
                 group = 'A',
                 lng = ~long,
                 lat = ~lat,
                 radius = 2,
                 weight = 2)
  })
})

ui.R

shinyUI(fluidPage(
  titlePanel('Aircraft Flights'),
  sidebarLayout(
    sidebarPanel(
      sliderInput('alt_cut',
                  'Altitude range:',
                  min = 0,
                  max = 10,
                  value = c(0, 10),
                  step = 1),
      selectInput('origin',
                  'Filter on origin',
                  choices = c('a', 'b'),
                  selected = c('a', 'b'),
                  multiple = TRUE,
                  selectize = FALSE),
      selectInput('dest',
                  'Filter on destination',
                  choices = c('c', 'd'),
                  selected = c('c', 'd'),
                  multiple = TRUE,
                  selectize = FALSE)
    ),
    mainPanel(
      leafletOutput('mapPlot'),  # leaflet output for plotting the points
      tags$hr(),
      tableOutput('viewData')  # table for sanity check
    )
  )
))

After clicking through some combinations of origins and destinations, the plot ceases to reflect the data which is properly displayed in the table below the map. For instance, try the following sequence of actions.

1. run the app
2. select origin: a (upper right series is displayed)
3. select destination: d (plot is empty because a and d are not linked)
4. select destination: c (upper right series reappears because a and c are linked)
5. select destination: d (upper right series incorrectly remains)

Subsetting on altitude using the slider no longer works either. Since the data in the table is changing, but the plot is not, it makes me think that the clearGroup('A') line is not deleting the circles.

Why is there a disparity between what the table and plot are displaying?

Screenshot of the problem: no data in the table but points still plotted on the map.

Answer 1

I don't have enough rep to comment, or else I would post there. I could not reproduce your errors with that code. Your test case worked as it should. The only change is I put your code into a single file:

library(shiny)
library(data.table)
library(leaflet)

ui <- (fluidPage(
  titlePanel('Aircraft Flights'),
  sidebarLayout(
    sidebarPanel(
      sliderInput('alt_cut',
                  'Altitude range:',
                  min = 0,
                  max = 10,
                  value = c(0, 10),
                  step = 1),
      selectInput('origin',
                  'Filter on origin',
                  choices = c('a', 'b'),
                  selected = c('a', 'b'),
                  multiple = TRUE,
                  selectize = FALSE),
      selectInput('dest',
                  'Filter on destination',
                  choices = c('c', 'd'),
                  selected = c('c', 'd'),
                  multiple = TRUE,
                  selectize = FALSE)
    ),
    mainPanel(
      leafletOutput('mapPlot'),  # leaflet output for plotting the points
      tags$hr(),
      tableOutput('viewData')  # table for sanity check
    )
  )
))

server <- function(input, output) {

  # sample data set
  dt <- data.table(altitude = c(1,1,3,3,4,5,6,7,3,2),
                   long = c(-85.2753, -85.4364, -85.5358, -85.6644, -85.8208, 
                            -89.9233, -90.0456, -90.2775, -90.5800, -90.8761),
                   lat = c(45.3222, 45.3469, 45.3764, 45.4089, 45.4503,
                           44.0489, 44.1878, 44.3378, 44.4383, 44.5197),
                   origin = c('a', 'a', 'a', 'a', 'a', 'b', 'b', 'b', 'b', 'b'),
                   destination = c('c', 'c', 'c', 'c', 'c', 'd', 'd', 'd', 'd', 'd'))

  # subset the data on various inputs from ui.R
  subsetData <- reactive({
    new_data <- dt[altitude > input$alt_cut[1] &
                     altitude < input$alt_cut[2] &
                     origin %in% input$origin &
                     destination %in% input$dest, ]
    return(new_data)
  })

  # display the data in real time to identify if the subsetting
  # is occurring as expected.
  output$viewData <- renderTable({
    subsetData()
  })

  # plot the data points
  output$mapPlot <- renderLeaflet({
    leaflet() %>%
      fitBounds(-90.8761, 44.0489, -85.2753, 45.4503)
  })

  observe({
    leafletProxy('mapPlot') %>%
      clearGroup('A') %>%  # I think this line may not be functioning as I expect...
      addCircles(data = subsetData(),
                 group = 'A',
                 lng = ~long,
                 lat = ~lat,
                 radius = 2,
                 weight = 2)
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 2

I found the problem. Apologies for duplicating this question . Apparently, when all of the observations are filtered from the data table, the unexpected behavior I described in my question can occur. Including the nrow check in @NicE's answer solves the problem.

The cause of the problem still escapes me, but this is the present workaround.