使用 R 语言进行地理编码:地址解析经纬度、坐标转换 & 根据经纬度判断所处的省市区县

由于高德地图接口的更新,之前的代码不再适用了,主要是两个更新:

  1. 高德地图的接口会根据一个地址返回多个结果;
  2. 高德地图不再建议一次解析多个地址了,会返回混乱的结果。
  3. 如果需要进行大量的解析,可以联系李老师帮忙,费用参考这个:https://rstata.duanshu.com/#/course/6b44ce2712af47b6ba7b2a2fd74a4e68

之前给大家讲解过根据地址解析经纬度并根据经纬度判断所处的省市区县的方法,不过那个方法效率较低,面对数百万地址的工作就显得力不从心了。今天再给大家介绍一套无比高效的解析流程。

这套工作流程包含下面几个过程:

  1. 使用高德地图地理编码接口解析(多线程);
  2. 反复重复上述过程,直到筛选出那些无法使用高德地图地理编码接口解析成功的地址;
  3. 然后使用百度地图地理编码接口解析上面的操作没有成功的部分;
  4. 合并所有的解析结果;
  5. GCJ02 坐标转换成 WGS84 坐标;
  6. 使用地理计算根据经纬度判断所处的省市区县。

下面就让我们以金融机构网点数据的地理编码为例进行讲解。

加载所需的 R 包

# 加载 R 包
library(tidyverse)
library(jsonlite)
library(parallel)

读取金融机构网点数据

# 读取 xlsx 文件
readxl::read_xlsx("金融机构网点数据.xlsx") -> df

# 选择前 1000 个
df %>%
slice(1:1000) -> df

# 生成 id 变量来标识观测值
df %>%
mutate(id = row.names(.)) %>%
select(id, everything()) -> df

我们下面就以这一千个地址为例进行讲解。

选择感兴趣的变量:

df %>%
select(id, 机构名称, 机构所在地, 机构地址, 地址代码) -> dfsim

申请高德地图和百度地图的密钥

  1. 高德地图文档:https://lbs.amap.com/api/webservice/guide/api/georegeo
  2. 百度地图文档:https://lbsyun.baidu.com/index.php?title=webapi/guide/webservice-geocoding-base

高德地图的 city 参数既可以是城市名称也可以是城市区划代码,百度地图的 city 参数只能是城市名称,所以我们需要准备两个 city 变量。

准备数据

dfsim %>%
mutate(address = 机构地址,
citygd = 地址代码) %>%
mutate(citybd = str_match(机构所在地, "-+(.*)")[,2],
citybd = if_else(is.na(citybd), 机构所在地, citybd)) %>%
select(id, 机构名称, address, citybd, citygd) -> dfsim
dfsim

#> # A tibble: 1,000 × 5
#> id 机构名称 address citybd citygd
#> <chr> <chr> <chr> <chr> <chr>
#> 1 1 中国农业发展银行北京市分行 北京市丰台区南四环西路1… 北京市 1100
#> 2 2 中国农业发展银行天津市分行 天津市河西区吴家窑大街… 天津市 1200
#> 3 3 中国农业发展银行河北省分行 河北省石家庄市中华南大… 石家… 1301
#> 4 4 中国农业发展银行山西省分行 山西省太原市康乐街38号 太原市 1401
#> 5 5 中国农业发展银行内蒙古自治区分行 内蒙古自治区呼和浩特市… 呼和… 1501
#> 6 6 中国农业发展银行辽宁省分行 辽宁省沈阳市沈河区惠工… 沈阳市 2101
#> 7 7 中国农业发展银行吉林省分行 吉林省长春市解放大路273… 长春市 2201
#> 8 8 中国农业发展银行黑龙江省分行 黑龙江省哈尔滨市道里区… 哈尔… 2301
#> 9 9 中国农业发展银行上海市分行 上海市延安东路45号 上海市 3100
#> 10 10 中国农业发展银行江苏省分行 江苏省南京市汉中路120号… 南京市 3201
#> # ℹ 990 more rows

使用高德地图解析

在这套工作流程中我们会优先使用高德地图地理编码接口进行解析,因为高德地图支持更高的 QPS(每秒请求的次数)。不过不幸运的是现在的高德和百度都只提供每日 5000 次的免费额度,难以进行大量的解析。

这里插播一条广告。如果大家需要大量的解析,可以考虑联系李老师帮忙解析。费用可以参考这个:https://rstata.duanshu.com/#/course/6b44ce2712af47b6ba7b2a2fd74a4e68

例如解析 1 条地址:

dfsim %>%
mutate(address = paste0(address, 机构名称),
address = str_replace_all(address, "#", "号")) -> dfsim2

# 如果数据里面没有城市变量,直接去掉 “&city=...” 即可
paste0("https://restapi.amap.com/v3/geocode/geo?address=", dfsim2$address[1],
"&key=50828d53749c02431a65192f7c092a77&city=", dfsim2$citygd[1]) -> url

# 读取解析 json 文件
fromJSON(url) -> list
list$geocodes %>%
as_tibble() %>%
select(formatted_address, province, city,
district, location, level) -> geodf

# 与之前的 temp 合并
geodf$id <- dfsim2$id[1]

geodf

#> # A tibble: 3 × 7
#> formatted_address province city district location level id
#> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
#> 1 北京市丰台区中国农业发展银行(北… 北京市 北京市 丰台区 116.329… 兴趣… 1
#> 2 北京市丰台区南四环西路186号院 北京市 北京市 丰台区 116.295… 门址 1
#> 3 北京市丰台区南四环西路186号 北京市 北京市 丰台区 116.283… 门牌… 1

这样就完成了 1 个地址的解析,得到了三个结果。我们先把所有的结果都保留,最后再筛选。

由此我们就可以设计一个循环处理所有的了:

# 创建一个文件夹保存结果
dir.create("rds1")
lapply(1:nrow(dfsim2), function(x){
# print(x)
if(!file.exists(paste0("rds1/", x, ".rds"))) {
suppressMessages({
suppressWarnings({
try({
paste0("https://restapi.amap.com/v3/geocode/geo?address=", dfsim2$address[x],
"&key=50828d53749c02431a65192f7c092a77&city=", dfsim2$citygd[x]) -> url

# 读取解析 json 文件
fromJSON(url) -> list
list$geocodes %>%
as_tibble() %>%
select(formatted_address, province, city,
district, location, level) -> geodf

# 添加 id 变量
geodf$id <- dfsim2$id[x]

# 保存
geodf %>%
mutate_all(as.character) %>%
write_rds(paste0("rds1/", x, ".rds"))
})
})
})
}
}) -> res

多线程解析

搭配上多线程,这个解析效率就会被极大的提高,当然这个线程数量得根据你自己电脑的实际情况来设定。

# 查看自己电脑的最大线程数
detectCores()
# 创建线程,也别太高:
makeCluster(36) -> cl

# 分发对象
clusterExport(cl, "dfsim2")
# 加载 R 包
clusterEvalQ(cl, expr = ({
library(tidyverse)
library(jsonlite)
}))

# 循环(可以多运行几次)
parLapply(cl, 1:nrow(dfsim2), function(x){
if(!file.exists(paste0("rds1/", x, ".rds"))) {
suppressMessages({
suppressWarnings({
try({
paste0("https://restapi.amap.com/v3/geocode/geo?address=", dfsim2$address[x],
"&key=50828d53749c02431a65192f7c092a77&city=", dfsim2$citygd[x]) -> url

# 读取解析 json 文件
fromJSON(url) -> list
list$geocodes %>%
as_tibble() %>%
select(formatted_address, province, city,
district, location, level) -> geodf

# 添加 id 变量
geodf$id <- dfsim2$id[x]

# 保存
geodf %>%
mutate_all(as.character) %>%
write_rds(paste0("rds1/", x, ".rds"))
})
})
})
}
}) -> res

合并结果:

parLapply(cl, fs::dir_ls("rds1"), readr::read_rds) %>%
bind_rows() -> df1

df1
#> # A tibble: 1,487 × 7
#> formatted_address province city district location level id
#> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
#> 1 北京市丰台区中国农业发展银行(北… 北京市 北京… 丰台区 116.329… 兴趣… 1
#> 2 北京市丰台区南四环西路186号院 北京市 北京… 丰台区 116.295… 门址 1
#> 3 北京市丰台区南四环西路186号 北京市 北京… 丰台区 116.283… 门牌… 1
#> 4 江苏省南京市鼓楼区汉中路120号青… 江苏省 南京… 鼓楼区 118.777… 兴趣… 10
#> 5 河北省秦皇岛市海港区燕山大街东… 河北省 秦皇… 海港区 119.622… 门牌… 100
#> 6 河北省秦皇岛市 河北省 秦皇… charact… 119.520… 市 100
#> 7 山西省吕梁市岚县向阳路122号 山西省 吕梁… 岚县 111.669… 门址 1000
#> 8 山西省吕梁市交口县农业发展银行(… 山西省 吕梁… 交口县 111.171… 公交… 1000
#> 9 河北省邯郸市丛台区百信大厦 河北省 邯郸… 丛台区 114.540… 兴趣… 101
#> 10 河北省邯郸市丛台区东环北街 河北省 邯郸… 丛台区 114.527… 道路 101
#> # ℹ 1,477 more rows

这一轮中解析成功的:

df1 %>%
inner_join(dfsim2) %>%
dplyr::filter(str_detect(location, ",")) %>%
dplyr::filter(str_sub(city, 1, 2) == str_sub(citybd, 1, 2)) %>%
dplyr::filter(!level %in% c("省", "市", "县")) -> df1success

筛选出没成功的:

dfsim2 %>%
anti_join(select(df1success, id)) -> dfsim2

dfsim2

#> # A tibble: 47 × 5
#> id 机构名称 address citybd citygd
#> <chr> <chr> <chr> <chr> <chr>
#> 1 65 中国农业发展银行天津市武清区支行 天津市武清区… 天津市 1200
#> 2 178 中国农业发展银行巢湖市分行 巢湖市健康东… 巢湖市 3414
#> 3 210 中国农业发展银行莱芜市分行 济南市莱芜区… 莱芜市 3712
#> 4 291 中国农业发展银行重庆市万州分行 重庆市万州区… 万州 5001
#> 5 292 中国农业发展银行重庆市涪陵分行 重庆市涪陵区… 涪陵 5002
#> 6 317 中国农业发展银行黔西南布依族苗族自治州分行 贵州省兴义市… 黔西… 5223
#> 7 328 中国农业发展银行楚雄彝族自治州分行 云南省楚雄市… 楚雄… 5323
#> 8 332 中国农业发展银行大理白族自治州分行 大理市雪人路2… 大理… 5329
#> 9 360 中国农业发展银行海东市分行 青海省平安县… 海东… 6321
#> 10 366 中国农业发展银行海西蒙古族藏族自治州分行 青海省德令哈… 海西… 6328
#> # ℹ 37 more rows

也可以对解析没成功的地址进行调整,反复使用上面的代码尝试,最后实在无法成功的可以用百度地图再试试。

使用百度地图解析

以“新疆石河子市东环路17号”为例:

paste0("https://api.map.baidu.com/geocoding/v3/?address=", "新疆石河子市东环路17号",
"&output=json&ak=h4jN43d3ajnnXGzBHmIowERWwM2o6PIe&ret_coordtype=gcj02ll&city=", "石河子市") -> url
url %>%
fromJSON() -> lst
# 经纬度
tibble(
location = paste0(lst$result$location, collapse = ","),
level = lst$result$level,
precise = lst$result$precise,
confidence = lst$result$confidence,
comprehension = lst$result$comprehension
)

#> # A tibble: 1 × 5
#> location level precise confidence comprehension
#> <chr> <chr> <int> <int> <int>
#> 1 86.0438761147316,44.2956824882995 门址 1 80 100

于是就可以编写程序使用百度地图地理编码接口解析最后的了,百度地图的 QPS 较低,可以设置 5 进程:

dfsim2 %>%
mutate(address = str_remove_all(address, " ")) -> dfsim2

makeCluster(5) -> cl
clusterExport(cl, "dfsim2")
dir.create("rds2")
parLapply(cl, 1:nrow(dfsim2), function(x){
if(!file.exists(paste0("rds2/", dfsim2$id[x], ".json"))) {
try({
download.file(paste0("https://api.map.baidu.com/geocoding/v3/?address=", dfsim2$address[x],
"&output=json&ak=h4jN43d3ajnnXGzBHmIowERWwM2o6PIe&ret_coordtype=gcj02ll"),
paste0("rds2/", dfsim2$id[x], ".json"))
})
}
}) -> res

合并结果:

fs::dir_ls("rds2") %>%
parLapply(cl, ., function(x){
jsonlite::fromJSON(x) -> lst
tibble::tibble(
file = x,
location = paste0(lst$result$location, collapse = ","),
level = lst$result$level,
precise = lst$result$precise,
confidence = lst$result$confidence,
comprehension = lst$result$comprehension
)
}) %>%
bind_rows() -> dfres2
dfres2 %>%
mutate(file = str_match(file, "/(\\d+)")[,2]) %>%
rename(id = file) -> dfres2

# 都成功了
dfsim2 %>%
anti_join(dfres2 %>% select(id))

dfres2 %>%
select(id, location) -> df2success

合并两轮结果

然后就可以一股脑的合并了:

bind_rows(df1success, df2success) %>%
select(id, location) %>%
group_by(id) %>%
slice(1) %>%
ungroup() -> dfall

dfall

#> # A tibble: 1,000 × 2
#> id location
#> <chr> <chr>
#> 1 1 116.329972,39.865275
#> 2 10 118.777444,32.042588
#> 3 100 119.622184,39.954267
#> 4 1000 111.669041,38.278174
#> 5 101 114.540470,36.609797
#> 6 102 114.514144,37.081957
#> 7 103 115.464429,38.877626
#> 8 104 114.876108,40.785560
#> 9 105 117.965845,40.912065
#> 10 106 116.844956,38.282990
#> # ℹ 990 more rows

GCJ02 转 WGS84

解析的结果是 GCJ02 坐标系的,不能直接使用,需要转换成 WGS84。

坐标转换.R 文件中有转换函数,具体函数的编写方法不重要,会使用即可:

source("坐标转换.R")

dfall %>%
separate(location, into = c("lng", "lat"), sep = ",", remove = F) %>%
mutate(经度 = as.numeric(lng),
纬度 = as.numeric(lat),
value2 = map2_chr(经度, 纬度, GCJ02_WGS84)) %>%
select(-contains("度")) %>%
separate(value2, into = c("经度", "纬度"), sep = ",") %>%
type_convert() %>%
select(-lat, -lng) %>%
select(id, lat = 纬度, lng = 经度, everything()) -> dfall2

dfall2

#> # A tibble: 1,000 × 4
#> id lat lng location
#> <dbl> <dbl> <dbl> <chr>
#> 1 1 39.9 116. 116.329972,39.865275
#> 2 10 32.0 119. 118.777444,32.042588
#> 3 100 40.0 120. 119.622184,39.954267
#> 4 1000 38.3 112. 111.669041,38.278174
#> 5 101 36.6 115. 114.540470,36.609797
#> 6 102 37.1 115. 114.514144,37.081957
#> 7 103 38.9 115. 115.464429,38.877626
#> 8 104 40.8 115. 114.876108,40.785560
#> 9 105 40.9 118. 117.965845,40.912065
#> 10 106 38.3 117. 116.844956,38.282990
#> # ℹ 990 more rows

这样我们就完成了这一千个地址解析经纬度的工作。

根据经纬度判断所处的省市区县

虽然上面的代码返回的有省市区县的结果,但是不够“整洁”,所以还不如用地理计算判断下。

这里以 2021 年的数据为例,这里分别把地图数据和坐标数据都转换成了 mycrs 坐标系,这样进行判断的会更快:

library(sf)
mycrs <- "+proj=aea +lat_0=0 +lon_0=105 +lat_1=25 +lat_2=47 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs"
read_sf("2021行政区划/县.shp") %>%
st_transform(mycrs) -> county

dfall2 %>%
select(-location) %>%
st_as_sf(coords = c("lng", "lat"), crs = 4326, remove = F) %>%
st_transform(mycrs) %>%
st_intersection(county) %>%
st_drop_geometry() %>%
select(-contains("类型")) %>%
rename(经度 = lng, 纬度 = lat) -> dfall3

dfall3

#> # A tibble: 1,000 × 9
#> id 纬度 经度 省 省代码 市 市代码 县 县代码
#> <dbl> <dbl> <dbl> <chr> <dbl> <chr> <dbl> <chr> <dbl>
#> 1 173 30.5 117. 安徽省 340000 安庆市 340800 迎江区 340802
#> 2 455 30.5 117. 安徽省 340000 安庆市 340800 迎江区 340802
#> 3 168 32.9 117. 安徽省 340000 蚌埠市 340300 龙子湖区 340302
#> 4 450 32.9 117. 安徽省 340000 蚌埠市 340300 龙子湖区 340302
#> 5 180 33.9 116. 安徽省 340000 亳州市 341600 谯城区 341602
#> 6 181 30.7 117. 安徽省 340000 池州市 341700 贵池区 341702
#> 7 175 32.3 118. 安徽省 340000 滁州市 341100 琅琊区 341102
#> 8 457 32.3 118. 安徽省 340000 滁州市 341100 琅琊区 341102
#> 9 176 32.9 116. 安徽省 340000 阜阳市 341200 颍州区 341202
#> 10 458 32.9 116. 安徽省 340000 阜阳市 341200 颍州区 341202
#> # ℹ 990 more rows

最后再合并原数据即可:

df %>%
select(id, 机构名称) %>%
left_join(dfall3 %>% mutate(id = as.character(id))) -> dfres

dfres

dfres %>%
haven::write_dta("经纬度解析结果.dta")

#> # A tibble: 1,000 × 10
#> id 机构名称 纬度 经度 省 省代码 市 市代码 县 县代码
#> <chr> <chr> <dbl> <dbl> <chr> <dbl> <chr> <dbl> <chr> <dbl>
#> 1 1 中国农业发展银行北… 39.9 116. 北京市 110000 北京… 110000 丰台… 110106
#> 2 2 中国农业发展银行天… 39.1 117. 天津市 120000 天津… 120000 河西… 120103
#> 3 3 中国农业发展银行河… 38.0 114. 河北省 130000 石家… 130100 桥西… 130104
#> 4 4 中国农业发展银行山… 37.9 113. 山西省 140000 太原… 140100 迎泽… 140106
#> 5 5 中国农业发展银行内… 40.8 112. 内蒙… 150000 呼和… 150100 赛罕… 150105
#> 6 6 中国农业发展银行辽… 41.8 123. 辽宁省 210000 沈阳… 210100 沈河… 210103
#> 7 7 中国农业发展银行吉… 43.9 125. 吉林省 220000 长春… 220100 朝阳… 220104
#> 8 8 中国农业发展银行黑… 45.8 127. 黑龙… 230000 哈尔… 230100 道里… 230102
#> 9 9 中国农业发展银行上… 31.2 121. 上海市 310000 上海… 310000 黄浦… 310101
#> 10 10 中国农业发展银行江… 32.0 119. 江苏省 320000 南京… 320100 鼓楼… 320106
#> # ℹ 990 more rows

这样我们就完成了经纬度解析。当然时间操作中经常会遇到更糟糕的情况,例如地址很乱、只有企业名称等。这个时候要非常谨慎,特别是对于只有企业名称的地址,建议先根据企业名称匹配工商注册信息,再根据工商注册信息中的地址解析经纬度。

点击这里跳转到 RStata 短书平台获取附件:使用 R 语言进行地理编码:地址解析经纬度、坐标转换 & 根据经纬度判断所处的省市区县

评论