使用 `leaflet` 绘制可交互地图

使用 leaflet 来绘制可交互的地图，使用说明见：https://rstudio.github.io/leaflet/

加载数据

Code

library(tidyverse)

data <- read.csv("data/地址经纬度数据.csv", encoding = 'UTF-8')
data <- data %>%
  filter(!is.na(longitude), !is.na(latitude))

data %>% head() %>% knitr::kable()

company_type	name	clean_address	longitude	latitude
共建研究院	浙江大学绍兴研究院	浙江省绍兴市越城区迪荡湖隧道科学园3号楼26-27层	120.6082	30.01323
共建研究院	天津大学浙江国际创新设计与智造研究院	浙江省绍兴市越城区洋泾湖科创园1号楼	120.6354	30.05344
共建研究院	上海大学绍兴研究院	浙江省绍兴市越城区三江路78号	120.6241	30.10052
共建研究院	浙江工业大学绍兴研究院	浙江省绍兴市越城区洋泾湖科创园2号楼	120.6354	30.05344
共建研究院	江南大学(绍兴)产业技术研究院	浙江省绍兴市越城区洋江东路19号	120.6075	30.04988
共建研究院	中国纺织科学研究院江南分院	浙江省绍兴市越城区双堰路30号	120.6113	30.09832

一点数据处理

由于企业/机构种类繁多，这里只选取频数最多的前 4 种类型：

Code

top4 <- data %>%
  group_by(company_type) %>% 
  summarise(freq = n()) %>%
  arrange(desc(freq)) %>%
  slice(1:4) %>%
  select(company_type)

top4 <- top4$company_type

print(top4)
## [1] "省科技型中小企业"             "高企"                        
## [3] "市级企业研究开发中心"         "省级高新技术企业研究开发中心"

Code

data <- data %>%
  filter(company_type %in% top4)

使用 leaflet 绘制可交互地图

添加底图

Code

library(leaflet)
library(leafletCN)

Code

m1 <- leaflet() %>% 
  setView(lng = median(data$longitude), lat = median(data$latitude), zoom = 11) %>%
  amap()

m1

需要注意的是，一般而言使用 leaflet 绘制地图的套路如下：

leaflet() %>% 
  addTiles() %>%
  setView(lng, lat, zoom)

leaflet 中的 addTiles() 会使用默认的、国外的地图作为底图。但是在绘制中国地图时尽量不要使用国外平台的地图，这里我们使用了 leafletCN 来设置中国地图，其中 amap() 使用高德地图作为底图。当然也可以通过 addTiles() 来指定调用高德地图、百度地图或者腾讯地图等，见：https://zhuanlan.zhihu.com/p/38168955?utm_oi=945412109924909056。

添加点标记

Code

m2 <- m1 %>%
  addMarkers(
    lng = data$longitude,
    lat = data$latitude,
    popup = data$name,
    label = data$name
  )

m2

可以看出：在数据量较大、点比较密集时，使用默认的 pin 标记会显得非常拥挤。更麻烦的是无法更改这些 pin 的颜色。

另外，popup 参数用于设置 pin 的信息，只要将鼠标移动到 pin 图标上就可以看到设置的信息了。还可以做一些改进：popup = ~paste("企业名称:", name, "<br>地址:", clean_address) 来丰富显示的信息。

除了 pin 标记，还可以使用点标记。其中 radius 设置点的大小，fillOpacity 设置点的透明度。

Code

m3 <- m1 %>% 
  addCircleMarkers(
    data = data, 
    lng = ~longitude, 
    lat = ~latitude,
    color = "blue",
    stroke = FALSE,
    radius = 4,
    fillOpacity = 0.3
  )

m3

多类别点标记

设置调色盘：

Code

pal <- colorFactor(
  c("blue", "green", "red", "orange"), 
  domain = data$company_type
)

Code

m4 <- m1 %>% 
  addCircleMarkers(
    data = data,
    color = ~pal(data$company_type),
    lng = ~longitude, 
    lat = ~latitude, 
    #popup = ~paste("企业名称:", name, "<br>地址:", clean_address),
    popup = ~paste0("<b>企业名称：</b>", name, "<br>",
                    "<b>企业类型：</b>", company_type, "<br>",
                    "<b>地址：</b>", clean_address),
    stroke = FALSE, 
    radius = 3,
    fillOpacity = 0.5
  )


m4

还可以使用以下代码创建一个复选框来过滤企业类型：

m4 <- m4 %>% 
  addLayersControl(
    overlayGroups = unique(data$company_type), 
    options = layersControlOptions(collapsed = FALSE)
  )

但是这在 Rmarkdown 和 Quarto 中仅仅显示复选框，不能够真正过滤数据。只能依靠 shiny 或者 JavaScript 来实现。

绘制热力图

还可以根据点的密集程度绘制热力图，需要使用 leaflet.extras 这个拓展包：

Code

library(leaflet.extras)

m1 %>%
  addHeatmap(lng = data$longitude, lat = data$latitude, radius = 8)

加入区域边界

绘制边界的原理和在地图中标点是一样的。首先需要获得区域边界点的坐标，再通过连接这些点创建多边形区域，最后填充颜色。

使用 leaflet 内置数据

Code

# 获取绍兴市行政区信息
region <- regionNames("绍兴市")

# 将越城区标记为 1，其他区域标记为 0 
dat <- data.frame(region) %>% 
  mutate(value = if_else(region == "越城区", 1, 0))

因为只需要绘制出越城区边界，所以将越城区的值设置为 1（其实可以设定为任意的数），其他区域的值设置为 0。

Code

dat %>% knitr::kable()

region	value
上虞市	0
绍兴县	0
新昌县	0
越城区	1
诸暨市	0
嵊州市	0

Code

# 创建地理信息dataframe
map <- leafletGeo("绍兴市", dat) 

map %>% knitr::kable()

name	id	label	value	popup
上虞市	330682	上虞	0	上虞市
绍兴县	330621	绍兴	0	绍兴县
新昌县	330624	新昌	0	新昌县
越城区	330602	越城	1	越城区
诸暨市	330681	诸暨	0	诸暨市
嵊州市	330683	嵊州	0	嵊州市

Note

map 中包含的信息绝不仅限于表格中的内容。

Code

# 设置调色盘 
pal <- colorNumeric(palette = "Blues", domain = map$value) 

# 使用高德地图，设置缩放大小
m5 <- leaflet(map) %>% 
  setView(lng = median(data$longitude), lat = median(data$latitude), zoom = 11) %>%
  amap() %>%
  #加入边界及颜色
  addPolygons(
    stroke = TRUE,
    smoothFactor = 1,
    fillOpacity = 0.2,
    weight = 1,
    color = ~pal(value),
    popup = ~htmltools::htmlEscape(popup)
  )

m5

Note

可能是因为函数所使用的数据源没有更新，图中的区域比目前绍兴市越城区要小。
同时区域形状过于简单，并不符合真实的行政区边界情况。

使用外部数据

还有一种方法，那就是导入外部数据，并通过外部数据来创建多边形区域。那么在哪里可以找到越城区的边界点数据呢？

个人推荐一个比较便捷的做法：进入阿里云数据可视化平台DataV.GeoAtlas ，点击范围选择器，找到并点击”越城区”。

可以通过 rvest 包调用 API，也可以直接点击下载 JSON 文件。我选择下载 JSON 文件。

可以使用 rjson 来读取 JSON 文件。

Warning

除了 rjson 以外，jsonlite 和 tidyjson 也可以处理 JSON 文件。但要注意的是：jsonlite 在读取中文名的 JSON 文件时会报错。

Code

library(rjson)
area_json <- fromJSON(file = "data/越城区.json")

可以使用 addGeoJSON 将 GeoJSON 文件中的信息加入到地图中：

Code

m1 %>%
  addGeoJSON(area_json)

也可以将 JSON 文件中的经纬度数据提取到数据框中，通过 addPolygons 函数绘制多边形区域。可以使用 View() 来查看读取的 JSON 文件都包含哪些信息：

可以发现读取进来的 JSON 文件被 R 保存为一个嵌套列表。通过一级一级向下查看，可以定位到边界点的经纬度坐标。

Code

area_list <- area_json[["features"]][[1]][["geometry"]][["coordinates"]][[1]][[1]]

这些点的坐标被存储在列表中。为了方便调用，需要将它们提取到一个数据框中。一个非常便捷、强大、优雅的实现方式是使用 purrr 包中的 map 类函数。这里使用的是 map_dfr 函数，它可以将提取出来的数据以数据框的形式返回，并按行合并为一个数据框。 purrr 包的用法参考：https://zhuanlan.zhihu.com/p/168772624

Code

library(purrr)
# 使用 map 函数将经纬度数据从列表提取到数据框中
area_df <- map_dfr(area_list, ~data.frame(longitude = .x[1], latitude = .x[2]))

Code

m1 %>%
  addPolygons(
    lng = area_df$longitude,
    lat = area_df$latitude,
    fillColor = "seagreen",
    fillOpacity = 0.2,
    color = "darkseagreen",
    weight = 2
  )

函数 addGeoJSON 和 addPolygons 中一些常用的、共有的参数：

参数 fillColor 设置区域填充颜色
参数 fillOpacity 设置区域填充颜色的透明度
参数 color 设置区域边界线的颜色
参数 weight 设置区域边界线的粗细