11

我在 www.betydb.org 上看到了美国县级的交互式等值线地图。我想使用 R 重现类似的地图。我只想要地图和工具提示（不是所有不同缩放级别的图块，或切换地图的能力）

该地图当前是在ruby​​ 中创建的，弹出窗口（在左下角）查询 MySQL 数据库。写它的程序员已经走了，我对 Ruby 并不熟悉。

地图

在这里，我将从一个 csv 文件开始。数据包括州和县名称，以及州和县 FIPS。我想情节Avg_yield。

mydata <- read.csv("https://www.betydb.org/miscanthus_county_avg_yield.csv")
colnames(mydata)
#  [1] "OBJECTID"    "Join_Count"  "TARGET_FID"  "COUNTY_NAME" "STATE_NAME"  "STATE_FIPS" 
#  [7] "CNTY_FIPS"   "FIPS"        "Avg_lat"     "Avg_lon"     "Avg_yield"

googleVis我可以使用包在州级绘图

library(googleVis)
p <- gvisGeoChart(data = mydata, locationvar="STATE_NAME", colorvar = 'Avg_yield',
                  options= list(region="US", displayMode="regions", 
                  resolution="provinces"))
plot(p)

在此处输入图像描述

这提供了状态级着色。我的问题是，我怎样才能在县级（而不是州级）分辨率下获得这样的颜色和工具提示？

gvisGeoChart帮助（在区域和分辨率下）和谷歌图表文档表明这可能是不可能的，但是文档是如此广泛，以至于不清楚我在 R 中的其他选项是什么。

那么，有没有办法在县级获得带有工具提示和着色的地图？

4

1 回答 1

6

这是一个来自 2013 年的问题。我不确定leaflet当时是否有包裹。现在已经是2017年末了，你的任务是有可能完成的。如果您仍需要执行类似的任务，我想为您留下以下内容。在这种情况下，数据集中有一些缺失的县。这些县存在于美国多边形数据中，但在mydata. 所以我将这些县添加到mydata使用setdiff()and bind_rows()。当您绘制传单地图时，您需要指定您的调色板。Avg_yield是一个连续变量。所以你使用colorNumeric(). 我留下了一个屏幕截图，显示了传单地图的一部分。

library(raster)
library(leaflet)
library(tidyverse)

# Get USA polygon data
USA <- getData("GADM", country = "usa", level = 2)

### Get data
mydata <- read.csv("https://www.betydb.org/miscanthus_county_avg_yield.csv",
                   stringsAsFactors = FALSE) %>%
          dplyr::select(COUNTY_NAME, Avg_yield)

### Check counties that exist in USA, but not in mydata
### Create a dummy data frame and bind it with mydata

mydata <- data.frame(COUNTY_NAME = setdiff(USA$NAME_2, mydata$COUNTY_NAME),
                     Avg_yield = NA,
                     stringsAsFactors = FALSE) %>%
          bind_rows(mydata)

### Create a color palette
mypal <- colorNumeric(palette = "viridis", domain = mydata$Avg_yield)

leaflet() %>% 
addProviderTiles("OpenStreetMap.Mapnik") %>%
setView(lat = 39.8283, lng = -98.5795, zoom = 4) %>%
addPolygons(data = USA, stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
            fillColor = ~mypal(mydata$Avg_yield),
            popup = paste("Region: ", USA$NAME_2, "<br>",
                          "Avg_yield: ", mydata$Avg_yield, "<br>")) %>%
 addLegend(position = "bottomleft", pal = mypal, values = mydata$Avg_yield,
           title = "Avg_yield",
           opacity = 1)

在此处输入图像描述

在此处输入图像描述

于 2017-12-16T16:03:25.030 回答