七夕特别推文：使用 R 语言制作旅程地图

2483 字 约 10 分钟 课程 地图R 语言

相信大家一定都有和家人一起旅行的难忘经历，值此七夕佳节，给大家分享使用 使用 R 语言制作旅程地图的方法。

在附件中我给大家准备了制作该地图的所有文件和代码。

  • get_coords.R：根据地址生成经纬度的 R 语言函数；
  • get_route.R：生成旅行路线的 R 语言代码；
  • main.R：生成地图的代码；
  • icon 文件夹：地图上图标的文件；
  • path：存放旅行路线的文件夹（简化后）；
  • path_rawdata：存放旅行路线的文件夹（简化后）；
  • photo：存放照片的文集那句；
  • photodata.xlsx：照片经纬度、描述数据；
  • routedata.xlsx：旅行路线描述数据。

根据地址解析经纬度：get_coords.R

为了把重要地点标注在地图上，首先我们就需要把地址转换成经纬度：

library(jsonlite)
library(tidyverse)
library(sf)
key <- Sys.getenv("amap.key")

transform_lon <- function(lon, lat) {
  dlon = 300.0 + lon + 2.0 * lat + 0.1 * lon * lon +
    0.1 * lon * lat + 0.1 * sqrt(abs(lon)) +
    (20.0 * sin(6.0 * lon * pi) + 20.0 * sin(2.0 * lon * pi)) *
    2.0 / 3.0 + (20.0 * sin(lon * pi) + 40.0 * sin(lon / 3.0 * pi)) *
    2.0 / 3.0 + (150.0 * sin(lon / 12.0 * pi) + 300.0 * sin(lon / 30.0 * pi)) *
    2.0 / 3.0
  return(dlon)
}
transform_lat <- function(lon, lat) {
  dlat = -100.0 + 2.0 * lon + 3.0 * lat + 0.2 * lat * lat +
    0.1 * lon * lat  + 0.2 * sqrt(abs(lon)) +
    (20.0 * sin(6.0 * lon * pi) + 20.0 * sin(2.0 * lon * pi)) *
    2.0 / 3.0 + (20.0 * sin(lat * pi) + 40.0 * sin(lat / 3.0 * pi)) *
    2.0 / 3.0 + (160.0 * sin(lat / 12.0 * pi) + 320 * sin(lat * pi / 30.0)) *
    2.0 / 3.0
  return(dlat)
}
GCJ02_WGS84 <- function(lon, lat) {
  pi <- 3.1415926535897932384626
  a <- 6378245
  ee <- 0.00669342162296594323
  dlon = transform_lon(lon - 105, lat - 35)
  dlat = transform_lat(lon - 105, lat - 35)
  radlat = lat / 180.0 * pi
  magic = 1 - ee * (sin(radlat))^2
  sqrtMagic = sqrt(magic)
  dlon = (dlon * 180.0) / (a / sqrtMagic * cos(radlat) * pi)
  dlat = (dlat * 180.0) / ((a * (1 - ee)) / (magic * sqrtMagic) * pi)
  mglon = lon + dlon
  mglat = lat + dlat
  lon <- (lon * 2 - mglon)
  lat <- (lat * 2 - mglat)
  return(paste(lon, lat, sep = ","))
}

get_coords <- function(address = "广州南站"){
  fromJSON(paste0('https://restapi.amap.com/v3/geocode/geo?address=', address, '&key=', key)) -> temp
  as.numeric(unlist(str_split(temp$geocodes$location, ","))) -> vct
  return(GCJ02_WGS84(lon = vct[1], lat = vct[2]))
}

# 使用：
get_coords("北京市")

#> [1] "116.401144744334,39.9027756549798"

注意上面代码里面的 Sys.getenv(“amap.key”) 需要替换成自己的高德地图密钥。关于该密钥的申请可以学习平台上的地理编码课程：

根据起点、终点、途径点获取旅行路线数据：get_route.R

下面的代码展示了三条旅行路线的获取和保存：

library(jsonlite)
library(tidyverse)
library(sf)
source("get_coords.R")

get_coords("上海市")

#> [1] "121.469143822454,31.2324671147726"

# 新锐宝宝：上海到北京的路线
fromJSON(paste0("https://restapi.amap.com/v3/direction/driving?origin=", get_coords("上海市"), "&destination=", get_coords("北京市"), "&key=", key)) -> list1

list1$route$paths$steps %>%
  as.data.frame() %>%
  as_tibble() %>%
  select(polyline) %>%
  tidytext::unnest_tokens(polyline, polyline,
                          token = stringr::str_split, pattern = ";") %>%
  distinct() %>%
  separate(col = "polyline", into = c("lon", "lat"), sep = ",") %>%
  type_convert() %>%
  as.matrix() %>%
  st_linestring() %>%
  st_sfc(crs = 4326) -> pathsf1

pathsf1

#> Geometry set for 1 feature
#> Geometry type: LINESTRING
#> Dimension:     XY
#> Bounding box:  xmin: 116.3996 ymin: 31.22272 xmax: 121.4702 ymax: 39.90296
#> Geodetic CRS:  WGS 84

pathsf1 %>%
  write_rds("path_rawdata/新锐宝宝从上海到北京.rds")

# 知韫宝宝：广州到武汉的路线
fromJSON(paste0("https://restapi.amap.com/v3/direction/driving?origin=", get_coords("广州市"), "&destination=", get_coords("武汉市"), "&key=", key)) -> list2

list2$route$paths$steps %>%
  as.data.frame() %>%
  as_tibble() %>%
  select(polyline) %>%
  tidytext::unnest_tokens(polyline, polyline,
                          token = stringr::str_split, pattern = ";") %>%
  distinct() %>%
  separate(col = "polyline", into = c("lon", "lat"), sep = ",") %>%
  type_convert() %>%
  as.matrix() %>%
  st_linestring() %>%
  st_sfc(crs = 4326) -> pathsf2

pathsf2

#> Geometry set for 1 feature
#> Geometry type: LINESTRING
#> Dimension:     XY
#> Bounding box:  xmin: 113.1682 ymin: 23.13231 xmax: 114.3236 ymax: 30.59605
#> Geodetic CRS:  WGS 84

pathsf2 %>%
  write_rds("path_rawdata/知韫宝宝从广州到武汉.rds")

# 爸爸妈妈：西安到伊犁，途径嘉峪关和敦煌
fromJSON(paste0("https://restapi.amap.com/v5/direction/driving?origin=",
                get_coords("西安市"), "&destination=",
                get_coords("伊犁哈萨克自治州"), "&key=", key,
                "&waypoints=",
                get_coords("嘉峪关"), ";",
                get_coords("敦煌市莫高窟"),
                "&show_fields=polyline")) -> list3

list3$route$paths$steps[1] %>%
  as.data.frame() %>%
  as_tibble() %>%
  select(polyline) %>%
  tidytext::unnest_tokens(polyline, polyline,
                          token = stringr::str_split, pattern = ";") %>%
  distinct() %>%
  separate(col = "polyline", into = c("lon", "lat"), sep = ",") %>%
  type_convert() %>%
  as.matrix() %>%
  st_linestring() %>%
  st_sfc(crs = 4326) -> pathsf3

pathsf3

#> Geometry set for 1 feature
#> Geometry type: LINESTRING
#> Dimension:     XY
#> Bounding box:  xmin: 80.78102 ymin: 34.24228 xmax: 108.935 ymax: 44.64904
#> Geodetic CRS:  WGS 84

pathsf3 %>%
  write_rds("path_rawdata/爸爸妈妈从西安到伊犁.rds")

关于这部分内容，感兴趣的小伙伴可以学习平台上的这个课程：

path_rawdata 文件夹就是存放路径数据的。不过如果旅行路线非常多的话，绘制出来的地图渲染会非常慢，所以还是简化下路径：

# 简化所有的路线
library(tidyverse)
library(sf)
fs::dir_ls("path_rawdata") %>%
  lapply(function(x){
    read_rds(x) %>%
      st_simplify(dTolerance = 1000) %>%
      write_rds(str_replace(x, "_rawdata", ""))
  }) -> tempres

简化后的数据会被存放到 path 文件夹里。

为旅行路线数据添加文本注解

routedata.xlsx 文件存放的是对每条路径的注解：

readxl::read_xlsx("routedata.xlsx")

#> # A tibble: 3 × 6
#>   data                     popup                      color weight opacity group
#>   <chr>                    <chr>                      <chr>  <dbl>   <dbl> <chr>
#> 1 爸爸妈妈从西安到伊犁.rds <div class='scrollableCon… #e64…      8     1   2023…
#> 2 新锐宝宝从上海到北京.rds <div class='scrollableCon… #00a…      4     0.8 2024…
#> 3 知韫宝宝从广州到武汉.rds <div class='scrollableCon… #f39…      6     0.9 2025…

popup 变量是路线的文本提示框（HTML 代码）；color 表示线条的颜色、weight 表示线条的粗细、opacity 表示线条的透明度、group 表示线条的组别，因此可以设定家里不同人的旅行路线不同的颜色、粗细和透明度。group 是最后用于设定图例的。

照片经纬度和描述数据

照片可以存放到 photo 文件夹里面，也可以直接使用在线的网址链接。

photodata.xlsx 存放的是照片的经纬度和描述数据：

readxl::read_xlsx("photodata.xlsx")

#> # A tibble: 4 × 5
#>       x     y popup                                                  img   type
#>   <dbl> <dbl> <chr>                                                  <chr> <chr>
#> 1 115.   33.9 <div class='scrollableContainer'><table class= id='po… phot… 房子
#> 2 122.   37.5 <div class='scrollableContainer'><table class= id='po… phot… 新锐
#> 3  81.2  44.6 <div class='scrollableContainer'><table class= id='po… http… 爸爸妈妈…
#> 4 116.   32.9 <div class='scrollableContainer'><table class= id='po… http… 知韫

xy 分别表示经度和纬度，可以使用上述的 get_coord() 函数获得，img 表示图片的链接，如果是本地图片可以使用 photo/图片文件的名称后缀，如果是互联网图片，直接使用 http 开头的链接即可。type 变量是图片的类别，也是用来后面设置不同类别的图片使用不同的图标。

icon 文件夹：存放不同类别打卡点的图标

由于我家有两个孩子，一个男孩，一个女孩，所以我使用了下面几种图标：

tibble::tibble(
  "旗子" = "![](icon/旗子.png)",
  "爸爸" = "![](icon/爸爸.png)",
  "家" = "![](icon/家.png)",
  "妈妈" = "![](icon/妈妈.png)",
  "新锐宝宝" = "![](icon/新锐宝宝.png)",
  "知韫宝宝" = "![](icon/知韫宝宝.png)"
) %>%
  knitr::kable()

大家也可以替换成自己喜欢的。

绘图旅行地图

做好上面的准备之后就可以绘制旅行地图了～

library(sf)
library(tidyverse)
library(leaflet)
library(leafpop)
library(leafem)
library(jsonlite)

source("get_coords.R")

# 制作标记点图片
# 新锐宝宝点标记
xrbbicon <- makeIcon(
  iconUrl = "icon/新锐宝宝.png",
  iconWidth = 38, iconHeight = 38
)

# 知韫宝宝的标记
zyicon <- makeIcon(
  iconUrl = "icon/知韫宝宝.png",
  iconWidth = 38, iconHeight = 38
)

# 打卡点标记
hqicon <- makeIcon(
  iconUrl = "icon/旗子.png",
  iconWidth = 38, iconHeight = 38
)

# 家的标记
houseicon <- makeIcon(
  iconUrl = "icon/家.png",
  iconWidth = 38, iconHeight = 38
)

# 读取照片及经纬度数据
st_as_sf(readxl::read_xlsx("photodata.xlsx"),
         coords = c("x", "y"),
         crs = 4326) -> pnt

# 添加地图标题
library(htmltools)
tag.map.title <- tags$style(HTML("
  .leaflet-control.map-title {
    transform: translate(-50%,20%);
    position: fixed !important;
    left: 50%;
    text-align: center;
    padding-left: 10px;
    padding-right: 10px;
    background: transparent;
    font-weight: bold;
    font-family: SimSun, 'Songti SC', STSong;
    font-size: 32px;
    color: #f39b7f;
    background-color: white; /* 白底 */
    border: 2px solid #f39b7f; /* 黑框 */
    padding: 5px;
    border-radius: 10px; /* 设置圆角大小 */
  }
"))

title <- tags$div(
  tag.map.title, HTML("水蛋一家人的旅程👨👩👶👶")
)

# 底图链接
gdurl <- "https://webrd04.is.autonavi.com/appmaptile?lang=zh_cn&size=1&scale=1&style=7&x={x}&y={y}&z={z}"

# 使用 leaflet 制作地图
leaflet() %>%
  leaflet::addTiles(url = gdurl,
                    attribution = "水蛋一家的旅程～") %>%
  # addFeatures(data = jdx, color = "#5050ff", weight = 1,
  #             opacity = 1) %>%
  addMarkers(data = subset(pnt, type == "房子"), group = "家",
             popup = subset(pnt, type == "房子") %>% pull(popup),
             icon = houseicon) %>%
  addMarkers(data = subset(pnt, type == "新锐"), group = "新锐",
             popup = subset(pnt, type == "新锐") %>% pull(popup),
             icon = xrbbicon) %>%
  addMarkers(data = subset(pnt, type == "知韫"), group = "知韫",
             popup = subset(pnt, type == "知韫") %>%
               pull(popup),
             icon = zyicon) %>%
  addMarkers(data = subset(pnt, type == "爸爸妈妈"),
             group = "爸爸妈妈",
             popup = subset(pnt, type == "爸爸妈妈") %>%
               pull(popup),
             icon = hqicon) %>%
  addPopupImages(subset(pnt, type == "房子") %>% pull(img),
                 group = "家", width = 300) %>%
  addPopupImages(subset(pnt, type == "新锐") %>% pull(img),
                 group = "新锐", width = 300) %>%
  addPopupImages(subset(pnt, type == "知韫") %>% pull(img),
                 group = "知韫", width = 300) %>%
  addPopupImages(subset(pnt, type == "爸爸妈妈") %>% pull(img),
                 group = "爸爸妈妈", width = 300) -> p

# 添加路线
readxl::read_xlsx("routedata.xlsx") -> routedata
for (i in 1:nrow(routedata)) {
  p %>%
    addFeatures(read_rds(paste0("path/", routedata$data[i])),
                popup = routedata$popup[i],
                color = routedata$color[i],
                weight = routedata$weight[i],
                opacity = routedata$opacity[i],
                group = routedata$group[i]) -> p
}

p %>%
  addControl(title, position = "topleft",
             className = "map-title") %>%
  addLayersControl(
    overlayGroups = c("爸爸妈妈", "家", "知韫", "新锐",
                      "2023年", "2024年", "2025年"),
    # baseGroups = c("2024年", "2023年", "2022年", "2021年", "2020年"),
    position = "bottomleft",
    options = layersControlOptions(collapsed = F, autoZIndex = T)
  ) %>%
  addScaleBar() %>%
  leafem::addLogo(img = "https://mdniceczx.oss-cn-beijing.aliyuncs.com/image_20201220175301.png", width = 80, height = 80) -> p

p
p %>%
  htmlwidgets::saveWidget("index.html")

使用 RPubs 发布为在线网页

绘制出来地图之后就可以点击 Viewer 窗口右上角的 Publish 选择 RPubs 进行发表了：

如果遇到报错，也可以运行下面的代码发表：

rsconnect::rpubsUpload("水蛋一家人的旅程", "index.html", originalDoc = "index.html")

然后把 continueUrl 的内容复制到浏览器、进行后续操作就可以了。

例如我发布的在线网页：https://rpubs.com/rstata/path

另外如果大家其他掌握静态网页的部署方法，也可以把这个 index.html 文件部署到自己的博客网站上。

点击这里跳转到 RStata 短书平台获取附件：七夕特别推文：使用 R 语言制作旅程地图

相关文章

评论