如何渲染闪亮的传单等值线图？

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 as a model for my server, I came up with the code below that allows users to choose from a list of two variables. Unfortunately I am having problems running it, getting a Warning: Error in min: invalid 'type' (list) of argument error. Any help in resolving this would be appreciated. I have also looked at the RStudio, Using Leaflet With Shiny 教程提供的代码，但提供的示例不是等值线图。

这是我的非工作代码：

## 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

如何渲染闪亮的传单等值线图？

How to render a leaflet choropleth map in shiny?

gis

r

leaflet

shiny