Построение SpatialPolygonsDataFrame после реактивного поднабора в Leaflet для Shiny retunrs ошибка, когда SPDF пуст - PullRequest
0 голосов
/ 17 декабря 2018

Итак, у меня есть блестящая карта, работающая с использованием данных geoJSON для всех округов США.У меня есть несколько прикрепленных метрик для каждого из этих округов, поэтому я в основном работаю с SpatialPolygonsDataFrames.Карта в настоящее время принимает некоторые входные данные (средний объем и т. Д.) И фильтрует данные geoJSON, поэтому карта отображает только те графы, которые прошли фильтр.Я пытаюсь выяснить, как справиться с ситуацией, когда фильтры в конечном итоге удаляют все полигоны округов (т.е. ни один из округов не проходит через фильтр).Прямо сейчас карта просто падает, когда это происходит, и возвращает эту ошибку:

Предупреждение в polygonData.SpatialPolygonsDataFrame (data): пустой объект SpatialPolygonsDataFrame передан и будет пропущен

Предупреждение: ошибкав сумме: недопустимый «тип» (список) аргумента [трассировка стека недоступна]

Соответствующие части кода находятся здесь: 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"
            )
      })
    }
  })

Я пытался использовать условное выражение, чтобы не отображать что-либо, используя if (is.data.frame(countyborder@data) & nrow(countyborder@data) == 0) {}, но, похоже, это тоже не работает.Есть ли другие обходные пути для этого?К сожалению, я не могу поделиться данными, но файлы форм округов http://eric.clst.org/tech/usgeojson/.

Ответы [ 2 ]

0 голосов
/ 17 декабря 2018

Мне удалось решить, используя условное выражение так:

 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 голосов
/ 17 декабря 2018

Вы можете добавить

req(filteredData()) 

или

req(filteredData()@data)

или

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

или

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

(в зависимости от вашего реактивногонабор данных), в начале вашего последнего наблюдателя, который добавляет полигоны на карту листовки.

Это остановит выполнение, если для построения не осталось данных.

Или в соответствии сreq() docs:

Если какое-либо из указанных значений не соответствует действительности, операция останавливается путем вызова «тихого» исключения

...