如何以闪亮方式渲染传单分区统计图？

Question

我已经使用 R 中的 Leaflet 成功创建了一个交互式分区统计图，该地图将单个变量投影到一组多边形上。

library(RSocrata)
library(rgdal)
library(leaflet)
library(sp)
library(dplyr)
#library(mapview)

area_bound <- rgdal::readOGR("https://data.cityofchicago.org/resource/igwz-8jzy.geojson")
area_bound$area_num_1 <- as.numeric(area_bound$area_numbe)
health <- read.socrata("https://data.cityofchicago.org/resource/iqnk-2tcu.json")

data_num <- as.data.frame(apply(health[3:29], 2, as.numeric))
data_num <- bind_cols(health[1:2], data_num)
health_area <- sp::merge(area_bound, data_num, by.x = "area_numbe", by.y = "community_area")

pal <- colorNumeric("viridis", NULL)

leaflet(health_area) %>%
  addTiles() %>%
  addPolygons(stroke = FALSE, smoothFactor = 0.3, fillOpacity = 1,
              fillColor = ~pal(as.numeric(firearm_related)),
              label = ~paste0(community, ": ", formatC(firearm_related, big.mark = ",")))

health

数据集有多个变量，我想创建一个闪亮的应用程序，允许用户选择不同的变量来生成分区统计图。使用 Kyle Walker 提供的代码作为我的服务器的模型，我想出了下面的代码，允许用户从两个变量的列表中进行选择。不幸的是，我在运行它时遇到问题，出现

Warning: Error in min: invalid 'type' (list) of argument

错误。任何解决此问题的帮助将不胜感激。我还查看了 RStudio，Using Leaflet With Shiny 教程，但提供的示例不是 choropleth 地图。

这是我的非工作代码：

## app.R ##
library(shiny)    # for shiny apps
library(leaflet)  # renderLeaflet function
library(RSocrata)
library(rgdal)
library(sp)
library(dplyr)

area_bound <- rgdal::readOGR("https://data.cityofchicago.org/resource/igwz-8jzy.geojson")
area_bound$area_num_1 <- as.numeric(area_bound$area_numbe)
health <- read.socrata("https://data.cityofchicago.org/resource/iqnk-2tcu.json")

data_num <- as.data.frame(apply(health[3:29], 2, as.numeric))
data_num <- bind_cols(health[1:2], data_num)
health_area <- sp::merge(area_bound, data_num, by.x = "area_numbe", by.y = "community_area")

groups <- c("Breast Cancer" = "breast_cancer_in_females", "Firearm" = "firearm_related")

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      radioButtons(
        inputId = "group",
        label = "Select a group to map",
        choices = groups
      )
    ),
    mainPanel(
      leafletOutput("map", height = "600")
    )
  )
)

server = function(input, output) {
  group_to_map <- reactive({
    input$group
  })

output$map <- renderLeaflet({
  
  leaflet(options = leafletOptions(zoomControl = FALSE)) %>%
    addProviderTiles(providers$Stamen.TonerLite) %>%
    setView(lng = -87.623177,
            lat = 41.881832,
            zoom = 8.5)
  
})

observeEvent(input$group, {
  
  pal <- colorNumeric("viridis", group_to_map)
  
  leafletProxy("map") %>%
    clearShapes() %>%
    clearControls() %>%
    addPolygons(data = group_to_map,
                color = ~pal(),
                weight = 0.5,
                fillOpacity = 0.5,
                smoothFactor = 0.2) %>%
    addLegend(
      position = "bottomright",
      pal = pal,
      values = group_to_map,
      title = "% of population"
    )
})

}

shinyApp(ui, server)

Answer 1

您的闪亮代码存在几个问题。首先，要引用

reactive

中的值，您必须像函数一样调用它，即您必须执行

group_to_map()

。接下来，

group_to_map()

只是一个字符。要使用名称存储在

group_to_map()

中的数据列，您必须执行

health_area[[group_to_map()]]

。我还解决了您的调色板功能的问题。最后，请注意，我切换到

sf

来读取地理数据，因为我更熟悉

sf

对象：

## app.R ##
library(shiny)    # for shiny apps
library(leaflet)  # renderLeaflet function
library(RSocrata)
library(dplyr)

area_bound <- sf::st_read("https://data.cityofchicago.org/resource/igwz-8jzy.geojson")
health <- read.socrata("https://data.cityofchicago.org/resource/iqnk-2tcu.json")

health[3:29] <- lapply(health[3:29], as.numeric)
#> Warning in lapply(health[3:29], as.numeric): NAs introduced by coercion
health_area <- left_join(area_bound, health, by = c("area_num_1" = "community_area"))

groups <- c("Breast Cancer" = "breast_cancer_in_females", "Firearm" = "firearm_related")

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      radioButtons(
        inputId = "group",
        label = "Select a group to map",
        choices = groups
      )
    ),
    mainPanel(
      leafletOutput("map", height = "600")
    )
  )
)

server = function(input, output) {
  group_to_map <- reactive({
    input$group
  })
  
  output$map <- renderLeaflet({
    
    leaflet(options = leafletOptions(zoomControl = FALSE)) %>%
      addProviderTiles(providers$Stamen.TonerLite) %>%
      setView(lng = -87.623177,
              lat = 41.881832,
              zoom = 8.5)
    
  })
  
  observeEvent(input$group, {
    
    pal <- colorNumeric("viridis", range(health_area[[group_to_map()]]))
    
    leafletProxy("map") %>%
      clearShapes() %>%
      clearControls() %>%
      addPolygons(data = health_area,
                  color = ~pal(health_area[[group_to_map()]]),
                  weight = 0.5,
                  fillOpacity = 0.5,
                  smoothFactor = 0.2) %>%
      addLegend(
        position = "bottomright",
        pal = pal,
        values = health_area[[group_to_map()]],
        title = "% of population"
      )
  })
  
}

shinyApp(ui, server)
#> 
#> Listening on http://127.0.0.1:5938