3.1.1 数据准备

首先加载 maps 包，方便后续读取其内置的美国共和党大选数据集 votes.repub 和美国州级地图数据集 state。

library(maps)

加载数据集 votes.repub，并查看数据类型和部分数据。

# 加载数据
data(votes.repub)
# 查看数据
str(votes.repub)
#  num [1:50, 1:31] NA NA NA NA 18.8 ...
#  - attr(*, "dimnames")=List of 2
#   ..$ : chr [1:50] "Alabama" "Alaska" "Arizona" "Arkansas" ...
#   ..$ : chr [1:31] "1856" "1860" "1864" "1868" ...

votes.repub 是一个 50 行 31 列的矩阵，行代表各州，列代表大选年份，进一步查看矩阵数据 votes.repub 的维度信息：

attributes(votes.repub)
# $dim
# [1] 50 31
#
# $dimnames
# $dimnames[[1]]
#  [1] "Alabama"        "Alaska"         "Arizona"        "Arkansas"
#  [5] "California"     "Colorado"       "Connecticut"    "Delaware"
#  [9] "Florida"        "Georgia"        "Hawaii"         "Idaho"
# [13] "Illinois"       "Indiana"        "Iowa"           "Kansas"
# [17] "Kentucky"       "Louisiana"      "Maine"          "Maryland"
# [21] "Massachusetts"  "Michigan"       "Minnesota"      "Mississippi"
# [25] "Missouri"       "Montana"        "Nebraska"       "Nevada"
# [29] "New Hampshire"  "New Jersey"     "New Mexico"     "New York"
# [33] "North Carolina" "North Dakota"   "Ohio"           "Oklahoma"
# [37] "Oregon"         "Pennsylvania"   "Rhode Island"   "South Carolina"
# [41] "South Dakota"   "Tennessee"      "Texas"          "Utah"
# [45] "Vermont"        "Virginia"       "Washington"     "West Virginia"
# [49] "Wisconsin"      "Wyoming"
#
# $dimnames[[2]]
#  [1] "1856" "1860" "1864" "1868" "1872" "1876" "1880" "1884" "1888" "1892"
# [11] "1896" "1900" "1904" "1908" "1912" "1916" "1920" "1924" "1928" "1932"
# [21] "1936" "1940" "1944" "1948" "1952" "1956" "1960" "1964" "1968" "1972"
# [31] "1976"

数据 votes.repub 是 matrix 矩阵类型，为方便后续数据操作，先转化为 data.frame 类型。

# 转为 data.frame 类型
votes_repub <- as.data.frame(votes.repub)

根据数据集 votes.repub 的行名生成两列是为了后续和地图数据集 state 做关联，最终将观测数据映射到地图上。state 列可与 ggplot2::map_data() 生成的地图数据合并，state_name 列可与 tigris 包获取的数据合并。

# 新增 state 和 state_name 列
votes_repub = within(votes_repub, {
  state_name = rownames(votes_repub)
  state = tolower(rownames(votes_repub)) # 州名转小写
})

接下来是非常重要的一步数据操作：数据重塑。顾名思义，就是将数据集重新组织起来，是为了方便后续用 ggplot2 等包绘图。

# 重塑 votes_repub 数据集
us_votes_repub <- reshape(
  data = votes_repub,
  # 需要转行的列，列名构成的向量
  varying = as.character(seq(1856, 1976, by = 4)),
  times = as.character(seq(1856, 1976, by = 4)), # 构成新列 year 的列值
  v.names = "repub_prop", # 列转行 列值构成的新列，指定名称
  timevar = "year", # 列转行 列名构成的新列，指定名称
  idvar = "state", # 州名
  new.row.names = 1:(31 * 50),
  direction = "long"
)
# 查看重塑后的数据集 us_votes_repub
head(us_votes_repub)
#        state state_name year repub_prop
# 1    alabama    Alabama 1856         NA
# 2     alaska     Alaska 1856         NA
# 3    arizona    Arizona 1856         NA
# 4   arkansas   Arkansas 1856         NA
# 5 california California 1856      18.77
# 6   colorado   Colorado 1856         NA

不难看出，数据集 us_votes_repub 不是很完整，一些历史的大选，有些州没有记录。下面统计一下历届大选中数据缺失的情况，如图3.1所示。实际上，阿拉斯加州和夏威夷州是 1959 年正式加入美国的，之前只是美国的领地，没有资格参与美国的大选，其它各州的情况详见网站。

us_votes_repub_na <- aggregate(
  data = us_votes_repub,
  state ~ year,
  subset = is.na(repub_prop),
  FUN = length
)

图 3.1: 历届大选未收集到得票率数据的州有多少

接下来，先挑一个年份的大选数据，绘制一张静态的地区分布图，不妨以 1976 年的数据为例：

us_votes_repub_1976 <- subset(x = us_votes_repub, subset = year == "1976")

ggplot2 包[3] 是基于数据框来作图的，地图也不例外，因此，需要先对 maps 包内置的 state 数据集做转化，ggplot2 包的 map_data() 函数可将 maps 包和 mapdata 包内置的 map 类型地图数据转化为 data.frame 类型地图数据。

library(ggplot2)
# 获取州级地图数据
usa_map <- map_data(map = "state")

map 类型的 state 数据集转化后，如下：

head(usa_map)
#     long   lat group order  region subregion
# 1 -87.46 30.39     1     1 alabama      <NA>
# 2 -87.48 30.37     1     2 alabama      <NA>
# 3 -87.53 30.37     1     3 alabama      <NA>
# 4 -87.53 30.33     1     4 alabama      <NA>
# 5 -87.57 30.33     1     5 alabama      <NA>
# 6 -87.59 30.33     1     6 alabama      <NA>

每一对经度 long 和纬度 lat 对应州的多边形边界上的一个点，按一定顺序 order 连接起来，就能围成一个多边形区域 region， 即州的行政区划边界，usa_map 是州级地图数据，不包含各郡的边界，故而 subregion 列都缺失。

接着，将观测数据以左关联的方式合并到地图数据上。注意将地图数据放左边，观测数据放右边，左侧地图数据最好不要含有缺失值，右侧观测数据并不完整。

# 合并观测数据和地图数据
usa_voting_df <- merge(
  x = usa_map,
  y = us_votes_repub_1976,
  by.x = "region", # region 首字母小写的各州名称
  by.y = "state",
  all.x = TRUE,
  sort = FALSE
)

地图上的每个区域都是有编号顺序的，不能乱，上面合并数据的操作打乱了地图数据的原有顺序，因此，需要恢复一下顺序，重新按照序号 order 列排序，否则地图是乱的，读者可试试看不排序的效果。

usa_voting_df <- usa_voting_df[order(usa_voting_df$order), ]

3.1.2 数据展示

经过上面一系列的数据操作，终于到画图的环节了。与普通的图形不同，绘制地图需要注意底图和坐标投影，ggplot2 提供 geom_map() 和 coord_map() 两个函数实现相应配置。如图3.2所示，是一张根据 maps 包内置的北美州级地图数据生成的多边形区域填充图，灰黑色填充各州区域，浅灰色绘制各州边界。

ggplot(data = usa_voting_df, aes(long, lat, group = subregion)) +
  geom_map(
    map = usa_map, aes(map_id = region),
    color = "gray80", fill = "gray30", size = 0.3
  )

图 3.2: 北美州级地图

接着，设置坐标投影。maps 包内置的 state 数据集，其经纬度坐标来自常见 WGS 84 参考系，即所谓的世界大地测量系统 World Geodetic System，于 1984 制定，全球定位系统 GPS 即采用此坐标参考系。

为了在二维地图上更加形象地体现地球的球型特点，利用 mapproj 包采用以北级为中心的方位角投影，平行线是同心圆，经线是等距径向线，详细描述见帮助文档?mapproj::mapproject，效果如图3.3。

ggplot(data = usa_voting_df, aes(long, lat, group = subregion)) +
  geom_map(
    map = usa_map, aes(map_id = region),
    color = "gray80", fill = "gray30", size = 0.3
  ) +
  coord_map(
    projection = "orthographic",
    orientation = c(latitude = 39, longitude = -98, rotation = 0)
  )

图 3.3: 北美州级地图

接着，利用多边形图层 geom_polygon() 添加共和党得票率数据，填充颜色采用红蓝对比色。最后，设置极简主题去掉灰色背景，添加主标题、图例标题，设置字体样式。

图 3.4: 1976年共和党在各州的得票率

ggplot(data = usa_voting_df, aes(long, lat, group = subregion)) +
  geom_map(
    map = usa_map, aes(map_id = region),
    color = "gray80", fill = "gray30", size = 0.3
  ) +
  coord_map("orthographic", orientation = c(39, -98, 0)) +
  geom_polygon(aes(group = group, fill = repub_prop / 100), color = "black") +
  scale_fill_gradient2(
    low = "blue", mid = "white", high = "red",
    midpoint = 0.5, labels = scales::label_percent()
  ) +
  theme_minimal() +
  labs(
    title = "1976 年共和党在各州的得票率",
    x = "", y = "", fill = "得票率"
  ) +
  theme(
    plot.title = element_text(size = 16, face = "bold", color = "red3"),
    legend.position = "bottom"
  )

实际上，1976 年的大选，共和党在阿拉斯加和夏威夷是有得票数据的，因 maps 包内置的 state 地图数据集缺少这两个州，所以上图 3.4 未能展示，因此，要从美国人口调查局获取完整的地图数据。另外，图中还缺少北纬/南纬、东经/西经的方向指示。因此，接下来采用 sf 包加强的 ggplot2 来制作更加完善的地图。

Kyle Walker 开发的 tigris 包封装了地图数据的下载接口，下面获取 2019 年发布的比例尺为 1:20000000 的州级地图数据，并将阿拉斯加州、夏威夷州和波多黎各适当移动至连续的 48 州下方。

us_state_map <- tigris::states(cb = T, year = 2019, resolution = "20m", class = "sf")
# 移动离岸的地区
us_state_map <- tigris::shift_geometry(us_state_map, geoid_column = "GEOID", position = "below")

下载整理后保存到本地文件 us_state_map.rds，先查看下地图数据情况。

us_state_map
# Simple feature collection with 52 features and 9 fields
# Geometry type: MULTIPOLYGON
# Dimension:     XY
# Bounding box:  xmin: -3112000 ymin: -1698000 xmax: 2258000 ymax: 1559000
# Projected CRS: USA_Contiguous_Albers_Equal_Area_Conic
# First 10 features:
#    STATEFP  STATENS    AFFGEOID GEOID STUSPS         NAME LSAD     ALAND
# 1       53 01779804 0400000US53    53     WA   Washington   00 1.721e+11
# 2       46 01785534 0400000US46    46     SD South Dakota   00 1.963e+11
# 3       39 01085497 0400000US39    39     OH         Ohio   00 1.058e+11
# 4       01 01779775 0400000US01    01     AL      Alabama   00 1.312e+11
# 5       05 00068085 0400000US05    05     AR     Arkansas   00 1.348e+11
# 6       35 00897535 0400000US35    35     NM   New Mexico   00 3.142e+11
# 7       48 01779801 0400000US48    48     TX        Texas   00 6.767e+11
# 8       06 01779778 0400000US06    06     CA   California   00 4.037e+11
# 9       21 01779786 0400000US21    21     KY     Kentucky   00 1.023e+11
# 10      13 01705317 0400000US13    13     GA      Georgia   00 1.495e+11
#       AWATER                       geometry
# 1  1.255e+10 MULTIPOLYGON (((-2e+06 1535...
# 2  3.383e+09 MULTIPOLYGON (((-633753 865...
# 3  1.027e+10 MULTIPOLYGON (((1081987 544...
# 4  4.593e+09 MULTIPOLYGON (((708460 -598...
# 5  2.956e+09 MULTIPOLYGON (((122656 -111...
# 6  7.278e+08 MULTIPOLYGON (((-1226428 -5...
# 7  1.899e+10 MULTIPOLYGON (((-998044 -56...
# 8  2.031e+10 MULTIPOLYGON (((-2066285 -2...
# 9  2.373e+09 MULTIPOLYGON (((571925 -842...
# 10 4.420e+09 MULTIPOLYGON (((939223 -230...

地图数据的坐标参考系是 USA Contiguous Albers Equal Area Conic，感兴趣读者可以点开网页链接了解技术细节。一个州可能有多个独立的地区，比如夏威夷群岛，因此 Geometry 类型是 MULTIPOLYGON 而不是简单的 POLYGON。NAME 列表示各州或领地名称。图 3.5 是这份地图数据的效果图，图中阿拉斯加以一定比例缩小了，而夏威夷和波多黎各以一定比例放大了。

图 3.5: 美国州级地图

地图数据有了后，类似之前的操作，将观测数据以左关联的方式合并到地图数据上。

usa_voting_map_1976 <- merge(
  x = us_state_map,
  y = us_votes_repub_1976,
  by.x = "NAME",
  by.y = "state_name",
  all.x = TRUE
)

在 sf 包的加持下，地理几何图层 geom_sf() 可以替代 geom_map()，坐标投影图层 coord_sf() 可以替代 coord_map()。整个绘图的过程极大地简化下来了，核心部分只有两行，如下：

ggplot() +
  geom_sf(data = usa_voting_map_1976, aes(fill = repub_prop / 100))

最后，添加颜色映射和主题等细节，如图3.6所示。

图 3.6: 1976年共和党在各州的得票率

ggplot() +
  geom_sf(data = usa_voting_map_1976, aes(fill = repub_prop / 100)) +
  scale_fill_gradient2(
    low = "blue", mid = "white", high = "red",
    midpoint = 0.5, labels = scales::label_percent()
  ) +
  theme_minimal() +
  labs(
    title = "1976 年共和党在各州的得票率",
    x = "", y = "", fill = "得票率"
  ) +
  theme(
    plot.title = element_text(size = 16, face = "bold", color = "red3"),
    legend.position = "bottom"
  )

4.1.1 gganimate 包

Thomas Lin Pedersen 从 David Robinson 接手维护gganimate后，大刀阔斧地开发，试图打造一套动态图形语法「A Grammar of Animated Graphics」，让 gganimate 和 ggplot2 无缝衔接。与之前类似，先做些数据准备的操作：

# 将历届大选数据与地图数据合并
usa_voting_map <- merge(
  x = us_state_map,
  y = us_votes_repub,
  by.x = "NAME",
  by.y = "state_name",
  all.x = TRUE
)
# year 为 NA 表示没有波多黎各的观测数据，可以去掉
usa_voting_map <- subset(x = usa_voting_map, subset = !is.na(year))
# year 作为转场时间变量，需要转为整型
usa_voting_map$year <- as.integer(usa_voting_map$year)

从 1856 年到 1976 年，美国共经历 31 次大选，设置总帧数 31，每秒播放 1 帧，最终生成逐帧动画。

options(gganimate.nframes = 31, gganimate.fps = 1)

Gifski 是一个制作 GIF 动图的 Rust 库，Jeroen Ooms 将其引入 R 语言社区，开发了同名的 R 包 gifski，它用于合成 GIF 动图或 MP4 格式视频。

将 ggplot2 制作的静态图形转化为 gganimate 制作的 GIF 动图，只需再加一行代码，指定转场的时间变量。

transition_time(year)

最终效果如图4.1所示。

图 4.1: 1856-1976年共和党在各州的得票率

library(gganimate)
ggplot() +
  geom_sf(data = usa_voting_map, aes(fill = repub_prop / 100)) +
  scale_fill_gradient2(
    low = "blue", mid = "white", high = "red",
    midpoint = 0.5, labels = scales::label_percent()
  ) +
  theme_minimal() +
  theme(
    plot.title = element_text(
      size = 16, face = "bold",
      color = "red3", family = "Noto Serif CJK SC"
    ),
    legend.position = "bottom"
  ) +
  labs(
    title = "{frame_time} 年美国大选共和党得票率",
    x = "", y = "", fill = ""
  ) +
  transition_time(year)

GIF 动图制作过程中有几点需要注意：

1. 调整总帧数和帧率，在图4.1基础上添加过渡效果，需要额外安装 transformr 包，它是通过插值的方式实现中间过渡状态的。

2. GIF 动图4.1 是逐年逐帧显示得票率分布，不需要添加过渡效果，美国大选每四年一届，插值后会很奇怪，但可以调整帧率，即每秒播放地区分布图的幅数。

3. showtext 包支持在 ggplot2 绘制的图形中添加中文字体，但是不支持 gganimate 包的动画制作场景。因此，安装 ragg 包，在生成 GIF 图4.1的代码块选项中，图形设备设置为 dev = "ragg_png"。为操作系统安装 Noto Serif CJK SC 字体，并设置为图中标题字体。

4. 在标题处添加了年份，这样就知道每一帧动画对应的大选之年。

4.1.2 tmap 包

tmap 包功能丰富，支持多种图形展示各种空间数据，如比例符号图（Proportional symbol map）、地区分布图（Choropleth map）、等值线图（Isopleth or contour map）、分类图（Categorical map）、核密度图（Kernel density map）和变形图（Cartogram）等，支持网页展示交互地图、导出高质量图片，借助 gifski 包支持导出时空 GIF 动画等，还可在于 Shiny 应用中交互展示空间数据。

本小节参考了《Geocomputation with R》[12]第 9 章第 3 节动态地图的内容来制作 GIF 动态地图。tmap 制作地图的代码风格和 ggplot2 非常类似，相信理解起来不难。

图 4.2: 1976年共和党在各州的得票率

library(tmap)
tm_shape(usa_voting_map_1976) +
  tm_polygons(
    col = "repub_prop",    # 数据列
    palette = "RdBu",      # 调色板
    border.alpha = 0.2,    # 边界线透明度
    title = "得票率（%）", # 图例标题
    breaks = 10 * 0:9,     # 得票率分段
    colorNA = "gray",      # 表示缺失数据的填充色
    textNA = "NA"          # 表示缺失数据的文本
  ) +
  tm_compass(type = "4star", position = c("left", "top")) + # 指北针
  tm_scale_bar(position = c("right", "bottom"), text.size = 1) + # 比例尺
  tm_credits(text = "数据源：maps 包内置数据集", position = "left", size = 1) + # 版权信息
  tm_layout(
    main.title = "1976年共和党在各州的得票率", # 全局标题
    main.title.size = 1.5, # 全局标题大小
    main.title.position = c("center", "top"), # 全局标题位置
    legend.text.size = 1.0,  # 图例文本大小，相对值
    legend.title.size = 1.2, # 图例标题大小，相对值
    legend.outside = TRUE,   # 图例置于绘图区域外部
    legend.outside.position = "right", # 图例位于右侧
    legend.outside.size = 0.15, # 图例占宽度
    legend.format = list(text.separator = "~"), # 图例中文本分割线
    outer.margins = 0, # 取消外边空
    asp = 0, # 图形横纵比根据设备定
    frame = FALSE # 取消边框
  )

与前面用 gganimate 制作 GIF 动画类似，tmap 包制作 GIF 动画也需要预先安装 R 包 gifski，也只需替换历届大选数据，增加 3-5 行代码而已。

# year 表示时间轴，固定坐标系
tm_facets(along = "year", free.coords = FALSE)

再用函数 tmap_animation() 导出指定格式的动态图形，GIF 图4.3 的设置如下：

tmap_animation(usa_voting_anim,
  filename = "usa_voting_anim.gif",
  width = 1100/1.5, height = 800/1.5, delay = 50
)

其中，参数 height 和 width 分别表示图片的长和宽（以像素计），delay 参数表示两帧画面转场的时间间隔（以 1/100 秒计），delay = 50 意味着间隔时间为 0.2 秒。

图 4.3: 1856-1976年共和党在各州的得票率

library(tmap)
usa_voting_anim <- tm_shape(usa_voting_map) +
  tm_polygons(
    col = "repub_prop",
    palette = "RdBu",
    border.alpha = 0.2,
    title = "得票率（%）",
    breaks = 10 * 0:9,
    colorNA = "gray",
    textNA = "NA"
  ) +
  tm_compass(position = c("right", "bottom")) +
  tm_scale_bar(position = c("right", "bottom")) +
  tm_credits(text = "数据源：maps 包内置数据集", position = "left") +
  tm_layout(
    legend.outside = TRUE,
    legend.outside.position = "right",
    legend.outside.size = 0.15,
    legend.format = list(text.separator = "~"),
    outer.margins = 0,
    asp = 0, frame = FALSE
  ) +
  tm_facets(along = "year", free.coords = FALSE)
# 制作动画
tmap_animation(usa_voting_anim,
  filename = "usa_voting_anim.gif",
  width = 1100/1.5, height = 800/1.5, delay = 50
)

4.2.1 echarts4r 包

echarts4r[11] 是 JavaScript 库 Apache ECharts 的 R 语言接口。截止写作时间，echarts4r 包内置的 Apache ECharts 更新到 5.3.2 版本，已经支持很多 Apache ECharts 的功能，一篇写给初学者的入门文章参见《echarts4r: 从入门到应用》，本节的地图动画是原文暂未涉及的应用案例。

在制作交互式的地图动画之前，先从 Github 下载 echarts4r.maps 包，它内置一份 GeoJSON 格式的美国州级地图数据。

remotes::install_github('JohnCoene/echarts4r.maps')

图4.4 展示 1856-1976 年美国历届大选中，共和党在各州的得票率变化情况。

library(echarts4r)
library(echarts4r.maps)
us_votes_repub |>
  group_by(year) |>
  e_charts(x = state_name, timeline = TRUE) |>
  em_map(map = "USA") |>
  e_map(serie = repub_prop, map = "USA", name = "得票率（%）") |>
  e_visual_map(serie = repub_prop) |>
  e_tooltip()

在上图的制作的基础上，还可以定制一些内容：

• 悬浮提示：仍然采用默认的样式，读者可定制一番。稍注意的是在表达百分比时，JS 函数 Math.round() 会四舍五入抹去小数点，要想保留两位小数，需要做一点变换 Math.round(params.value * 100) / 100。

  e_tooltip(
    formatter = htmlwidgets::JS("
      function(params){
        if(params.value) {
          return('<strong>' + params.name + '</strong>' +
                 '<br />' + Math.round(params.value * 100) / 100 + '%')
        } else
          return('数据缺失')
      }
    ")
  )

  百分数处理参考 SO 帖子，自定义悬浮提示参考SO 帖子。JS 代码中 params.name 对应 e_map() 函数的 name 参数值，params.value 对应 serie 参数值。但是在气泡图中，有点不一样，以 R 内置的数据集 mtcars 为例，params.name 对应 bind，params.value[0] 对应 x， params.value[1] 对应 serie ，params.value[2] 对应 size。不同的图形有不同的对应情况，详见 Apache ECharts 官方文档。

  mtcars |>
    tibble::rownames_to_column("model") |>
    group_by(cyl) |>
    e_charts(x = wt) |>
    e_scatter(serie = mpg, size = qsec, bind = model) |>
    e_tooltip(formatter = htmlwidgets::JS("
            function(params) {
                return (
                    '<strong>' + params.name + '</strong>' +
                    '<br />wt: ' + params.value[0] +
                    '<br />mpg: ' + params.value[1] +
                    '<br />qsec: ' + params.value[2]
                )
            }
            "))

• 视觉映射：修改视觉映射上下两端文本，使用红蓝对撞的调色板，置于左下方。有点体现共和党和民主党对垒的意思。

• 主副标题：在图形上方添加动画标题、左下方说明数据来源。在动画场景下，用 e_timeline_serie() 实现，非动画场景下，可用 e_title() 实现。

• 地图底图：echarts4r.maps 包内置的 GeoJSON 格式美国州级地图。

• 坐标投影：相比于前面展示的动画，最终效果图4.5采用的坐标投影不一样，它是反映实际区域面积大小的。

• 数据映射：注意地图数据中州名 name 字段格式，如阿拉斯加州是 Alaska 而不是 alaska，这个用于匹配观测数据 us_votes_repub 中的 state_name 列。

• 动画播放：设置自动播放动画，播放间隔为 1s。

仅从图4.5不难看出，共和党在北方比较受欢迎。

us_votes_repub |>
  group_by(year) |>
  e_charts(x = state_name, timeline = TRUE) |>
  em_map(map = "USA") |>
  e_map(serie = repub_prop, map = "USA", name = "得票率（%）") |>
  e_visual_map(
    serie = repub_prop,
    left = 80,
    bottom = 40,
    text = c("高", "低"),
    inRange = list(
      color = RColorBrewer::brewer.pal(n = 11, name = "RdBu")
    )
  ) |>
  e_tooltip() |>
  e_timeline_opts(
    autoPlay = TRUE,
    show = TRUE,
    bottom = 20,
    playInterval = 1000
  ) |>
  e_timeline_serie(title = lapply(
    rep("1856-1976 年美国历届大选中共和党在各州的得票率", 31),
    function(title) {
      list(
        text = title,
        left = "center"
      )
    }
  ), index = 1) |>
  e_timeline_serie(title = lapply(
    rep("数据源：maps 包内置数据集 votes.repub", 31),
    function(subtitle) {
      list(
        subtext = subtitle,
        left = 80,
        bottom = 0,
        sublink = "https://cran.r-project.org/package=maps/"
      )
    }
  ), index = 2) |>
  e_timeline_serie(
    title = lapply(
      colnames(votes.repub),
      function(year) {
        list(
          text = year,
          right = 150,
          top = 50,
          textStyle = list(
            fontSize = 100,
            color = "rgb(170, 170, 170, 0.5)",
            fontWeight = "bolder"
          )
        )
      }
    ), index = 3
  )

接下来，将上面的 Web 动画4.5 的坐标投影方式改为以美国为中心的阿尔伯斯等面积圆锥投影，和前面美国人口调查局发布的多边形地图数据采用一样的坐标参考系，效果如图4.6。具体实现如下：

• 自定义坐标投影，要求 echarts4r 包更新至 0.4.4 及以上版本。

• 借助 htmlwidgets::prependContent() 引入 D3 系列的数组操作库 d3-array 和坐标投影库 d3-geo 实现阿尔伯斯等面积圆锥投影，阿拉斯加州移至连续 48 州左下方，面积缩小为原来的 0.35 倍，看起来和美国中部一些州差不多大了，移动夏威夷的位置，面积不变。

• 制作过程中，参考了 Apache ECharts 官网给的示例和帮助文档，同时感谢 John Coene 提供的支持和帮助，详见帖子。

us_votes_repub |>
  group_by(year) |>
  e_charts(x = state_name, timeline = TRUE) |>
  em_map(map = "USA") |>
  e_map(
    serie = repub_prop, map = "USA", name = "得票率（%）",
    projection = list(
      project = htmlwidgets::JS("function(point) {return projection(point);}"),
      unproject = htmlwidgets::JS("function(point) {return projection.invert(point);}")
    )
  ) |>
  e_visual_map(
    serie = repub_prop,
    left = 40,     # 组件与左侧的距离
    bottom = 20,   # 组件与下侧的距离
    text = c("高", "低"),
    inRange = list(
      color = RColorBrewer::brewer.pal(n = 11, name = "RdBu")
    )
  ) |>
  htmlwidgets::prependContent(
    htmltools::tags$script(src = "https://fastly.jsdelivr.net/npm/d3-array")
  ) |>
  htmlwidgets::prependContent(
    htmltools::tags$script(src = "https://fastly.jsdelivr.net/npm/d3-geo")
  ) |>
  htmlwidgets::prependContent(
    htmltools::tags$script("const projection = d3.geoAlbersUsa();")
  ) |>
  e_tooltip() |>
  e_timeline_opts(
    autoPlay = TRUE,    # 自动播放
    show = TRUE,        # 展示时间轴
    playInterval = 1000 # 转场时间
  ) |>
  e_timeline_serie(title = lapply(
    unique(us_votes_repub$year),
    function(year) {
      list(
        text = paste(year, "年共和党在各州的得票率"),
        subtext = "数据源：maps 包内置数据集 votes.repub",
        sublink = "https://cran.r-project.org/package=maps/",
        left = "center",
        subtextStyle = list(
          color = "rgb(170, 170, 170, 0.5)",
          fontWeight = "bolder"
        )
      )
    }
  ), index = 1)