1
votes

So I've got a shiny map up and running using geoJSON data for all US counties. I have some attached metrics to each of these counties so I'm essentially working with SpatialPolygonsDataFrames. The map currently takes some input (avg. volume, etc.) and filters the geoJSON data so the map only renders the counties that pass the filter. I'm trying to figure out how to deal with the situation where the filters end up removing all the county polygons (i.e, none of the counties pass the filter). Right now, the map just crashes when that happens and returns this error:

Warning in polygonData.SpatialPolygonsDataFrame(data) :   Empty SpatialPolygonsDataFrame object passed and will be skipped

Warning: Error in sum: invalid 'type' (list) of argument   [No stack trace available]

The relevant parts of the code are here: global.R:

data_sets <- list(countyborder2006,
                  countyborder2007,
                  countyborder2008,
                  countyborder2009,
                  countyborder2010,
                  countyborder2011,
                  countyborder2012,
                  countyborder2013,
                  countyborder2014,
                  countyborder2015,
                  countyborder2016,
                  countyborder2017,
                  countyborder2018,
                  countyborder_all)

ui.R:

conditionalPanel("input.level == 'County level'",

                 selectInput("year", "Year:",
                             choices = c("2006","2007","2008","2009","2010","2011", "2012",
                                         "2013","2014","2015","2016","2017","2018", "All years" = "2019"),
                             selected = "2019"
                 ),
                 numericInput("opcrange", 
                              label = "Minimum ops vol:",
                              min = 0, max = 10000000, value = 0
                 ),
                 numericInput("opppcrange",
                                               label = "Minimum ops ppa:",
                                               min = 0, max = 150, value = 0
                                  )
                 ),                  
                 numericInput("oppcrange",
                              label = "Minimum % of ops:",
                              min = -1, max = 1, value = -1
                 ),
                 numericInput("ohpcrange",
                              label = "Minimum % of others:",
                              min = -1, max = 1, value = -1)
)

server.R:

# filter data according to parameters set for customer level
  filteredData <- reactive({
    req(input$opcrange)
    req(input$opppcrange)
    req(input$oppcrange)
    req(input$ohpcrange)
    else if (input$level == "County level") {
      countyborder <- data_sets[[(as.numeric(input$year) - 2005)]]
      if (input$oporoh == "Opioids") {
        countyborder[countyborder@data$avg_opioid >= input$opcrange &
                       countyborder@data$avg_oxy_hydro >= input$ohcrange &
                       countyborder@data$avg_opioid_ppp >= input$opppcrange &
                       countyborder@data$avg_opioid_perc >= input$oppcrange &
                       countyborder@data$avg_oxy_hydro_perc >= input$ohpcrange,]
      } else {
        countyborder[countyborder@data$avg_opioid >= input$opcrange &
                       countyborder@data$avg_oxy_hydro >= input$ohcrange &
                       countyborder@data$avg_oxy_hydro_ppp >= input$ohppcrange &
                       countyborder@data$avg_opioid_perc >= input$oppcrange &
                       countyborder@data$avg_oxy_hydro_perc >= input$ohpcrange,]
      }
    }
  })

# render base map that isn't redrawn every time
  output$map <- renderLeaflet({
    leaflet() %>%
      addProviderTiles("CartoDB.Positron",
                       options = providerTileOptions(noWrap = TRUE)) %>%  #Add default OpenStreetMap map tiles
      setView(-99, 45, zoom = 4) %>% #set view over US
      addScaleBar(position = "topleft") %>%
      addMeasure(position = "topleft")
  })

  # this observer controls all the markers for customer level info
  observe({
    else if (input$level == "County level") {
      withProgress(message = "Rendering...", value = 0.1, {
          pal <- colorBin("YlOrRd", bins = c(0, 1, 2, 3, 4, 5, 6, 10, 20, Inf), filteredData()$avg_ops_ppp,pretty = FALSE)

          leafletProxy("map", data = filteredData()) %>%
            clearMarkers() %>%
            clearMarkerClusters() %>%
            clearShapes() %>%
            addPolygons(
              stroke = TRUE,
              color = "white",
              highlight = highlightOptions(
                weight = 2,
                fillOpacity = 0.6,
                color = "#666",
                opacity = 0.8,
                bringToFront = TRUE,
                sendToBack = TRUE
              ),
              opacity = 1,
              weight = 0.5,
              smoothFactor = 0.2,
              fillOpacity = 0.8,
              fillColor = pal(filteredData()$avg_ops_ppp),
              label = lapply(countyInfo, HTML)
            ) %>%
            clearControls() %>%
            addLegend(
              "bottomleft",
              pal = pal,
              values = filteredData()$avg_ops_ppp,
              title = "Ops ppa per month",
              layerId = "countyLegend"
            )
      })
    }
  })

I have tried using a conditional to not map anything using if (is.data.frame(countyborder@data) & nrow(countyborder@data) == 0) {} but that doesn't seem to work either. Are there any other workarounds for this? Unfortunately, I cannot share the data but the county shape files are from http://eric.clst.org/tech/usgeojson/.

2
You could add a req(filteredData ()) in your last observer. But why are you starting your conditionals with else if ? - SeGa
Oh there are if blocks above these else ifs but I didn't include them since it was getting a bit cluttered. - ANam

2 Answers

1
votes

I managed to solve it using a conditional like so:

 observe({
    else if (input$level == "County level") {
      withProgress(message = "Rendering...", value = 0.1, {
       if (is.data.frame(filteredData()@data) & nrow(filteredData()@data) == 0){
        leafletProxy("map") %>%
          clearMarkers() %>%
          clearMarkerClusters() %>%
          clearShapes()
         } else {
          pal <- colorBin("YlOrRd", bins = c(0, 1, 2, 3, 4, 5, 6, 10, 20, Inf), filteredData()$avg_ops_ppp,pretty = FALSE)

          leafletProxy("map", data = filteredData()) %>%
            clearMarkers() %>%
            clearMarkerClusters() %>%
            clearShapes() %>%
            addPolygons(
              stroke = TRUE,
              color = "white",
              highlight = highlightOptions(
                weight = 2,
                fillOpacity = 0.6,
                color = "#666",
                opacity = 0.8,
                bringToFront = TRUE,
                sendToBack = TRUE
              ),
              opacity = 1,
              weight = 0.5,
              smoothFactor = 0.2,
              fillOpacity = 0.8,
              fillColor = pal(filteredData()$avg_ops_ppp),
              label = lapply(countyInfo, HTML)
            ) %>%
            clearControls() %>%
            addLegend(
              "bottomleft",
              pal = pal,
              values = filteredData()$avg_ops_ppp,
              title = "Ops ppa per month",
              layerId = "countyLegend"
            )
         }
      })
    }
  })
0
votes

You can add

req(filteredData()) 

or

req(filteredData()@data)

or

req(length(filteredData()@data) != 0)

or

req(nrow(filteredData()@data) != 0)

(depending on your reactive dataset), at the beginning of your last observer, which adds the polygons to the leaflet map.

This will stop the execution, if no data is left to plot.

Or according to the req() docs:

If any of the given values is not truthy, the operation is stopped by raising a "silent" exception