如何以防止跨越世界地图的方式分割构造板块边界多边形？答案

【问题标题】：How to split tectonic plate boundary polygon in a way to prevent line across the world map?如何以防止跨越世界地图的方式分割构造板块边界多边形？
【发布时间】：2020-08-27 10:19:50
【问题描述】：

我正在尝试在世界地图上绘制构造板块边界。然而，构造板块的多边形似乎在世界地图上延伸（看起来它们位于世界的另一端，实际上它们在地球是圆的时候并排排列）。

有什么方法可以在盘子周围分开吗？

数据：

library(tibble)

# polygon of tectonic plates
plate <- tibble(lat = c(-42.059, -41.910, -41.756, -41.657, -41.500, -41.188,
                  -40.807, -40.424, -40.087, -39.685, -39.230, -38.889,
                  -38.538, -38.205, -37.476, -36.793, -36.179, -35.542,
                  -35.022, -34.706, -34.485, -34.241, -33.846, -33.580,
                  -33.191, -32.696, -32.203, -31.957, -31.793, -31.452,
                  -31.037, -30.678, -30.322, -29.881, -29.469, -29.065,
                  -28.697, -28.264, -27.784, -27.318, -26.857, -26.437,
                  -26.025, -25.730, -25.426, -25.142, -24.836, -24.472,
                  -24.070, -23.750, -23.750, -23.853, -23.952, -24.029,
                  -24.105, -24.105, -24.242, -24.720, -25.197, -25.976,
                  -26.767, -27.377, -27.985, -28.693, -29.498, -29.792,
                  -30.355, -30.997, -31.333, -31.751, -32.347, -33.019,
                  -33.602, -34.246, -34.786, -35.161, -35.917, -36.461,
                  -37.102, -37.485, -37.885, -38.287, -38.674, -38.762,
                  -39.230, -40.046, -40.311, -40.598, -40.791, -40.979,
                  -41.157, -41.566, -41.757, -42.059, -42.059),
                lon = c(175.503,  176.081 , 176.673,  177.123,  177.607,
                        178.015,  178.284,  178.566,  178.792,  178.950,
                        179.125,  179.215,  179.366,  179.569,  179.838,
                        -179.811, -179.371, -179.044, -178.641, -178.539,
                        -178.413, -178.294, -178.208, -177.981, -177.810,
                        -177.666, -177.649, -177.538, -177.301, -177.108,
                        -176.919, -176.690, -176.547, -176.339, -176.153,
                        -176.078, -175.995, -175.885, -175.785, -175.545,
                        -175.400, -175.423, -175.415, -175.382, -175.297,
                        -175.261, -175.229, -175.209, -175.102, -174.985,
                        -174.985, -175.691, -176.356, -176.887, -177.419,
                        -177.419, -177.448, -177.552, -177.657, -177.793,
                        -178.017, -178.248, -178.482, -178.713, -178.966,
                        -179.074, -179.226, -179.393, -179.515, -179.740,
                        179.980,  179.657,  179.345,  178.996,  178.681,
                        178.403,  177.890,  177.507,  177.049,  176.770,
                        176.509,  176.241,  175.995,  175.932,  175.609,
                        176.074,  175.868,  175.537,  175.324,  175.012,
                        174.632,  174.763,  174.945,  175.503,  175.503)
)

代码：

library(ggplot2)
library(dplyr)

# world data to map world map
world <- map_data("world")

# world map with tectonic plate in green
world %>%
  ggplot() +
  geom_map(map = world,
           aes(x = long, y = lat,
               map_id = region)) +
  geom_polygon(data = plate,
               aes(x = lon,
                   y = lat),
               fill = NA,
               colour = "dark green")
#> Warning: Ignoring unknown aesthetics: x, y

^{由reprex package (v0.3.0) 于 2020 年 8 月 26 日创建}

devtools::session_info()
#> ─ Session info ───────────────────────────────────────────────────────────────
#>  setting  value                       
#>  version  R version 4.0.2 (2020-06-22)
#>  os       macOS Catalina 10.15.6      
#>  system   x86_64, darwin17.0          
#>  ui       X11                         
#>  language (EN)                        
#>  collate  en_AU.UTF-8                 
#>  ctype    en_AU.UTF-8                 
#>  tz       Australia/Melbourne         
#>  date     2020-08-26                  
#> 
#> ─ Packages ───────────────────────────────────────────────────────────────────
#>  package     * version date       lib source        
#>  assertthat    0.2.1   2019-03-21 [1] CRAN (R 4.0.2)
#>  backports     1.1.8   2020-06-17 [1] CRAN (R 4.0.2)
#>  blob          1.2.1   2020-01-20 [1] CRAN (R 4.0.2)
#>  broom         0.7.0   2020-07-09 [1] CRAN (R 4.0.2)
#>  callr         3.4.3   2020-03-28 [1] CRAN (R 4.0.2)
#>  cellranger    1.1.0   2016-07-27 [1] CRAN (R 4.0.2)
#>  cli           2.0.2   2020-02-28 [1] CRAN (R 4.0.2)
#>  colorspace    1.4-1   2019-03-18 [1] CRAN (R 4.0.2)
#>  crayon        1.3.4   2017-09-16 [1] CRAN (R 4.0.2)
#>  curl          4.3     2019-12-02 [1] CRAN (R 4.0.1)
#>  DBI           1.1.0   2019-12-15 [1] CRAN (R 4.0.2)
#>  dbplyr        1.4.4   2020-05-27 [1] CRAN (R 4.0.2)
#>  desc          1.2.0   2018-05-01 [1] CRAN (R 4.0.2)
#>  devtools      2.3.1   2020-07-21 [1] CRAN (R 4.0.2)
#>  digest        0.6.25  2020-02-23 [1] CRAN (R 4.0.2)
#>  dplyr       * 1.0.1   2020-07-31 [1] CRAN (R 4.0.2)
#>  ellipsis      0.3.1   2020-05-15 [1] CRAN (R 4.0.2)
#>  evaluate      0.14    2019-05-28 [1] CRAN (R 4.0.1)
#>  fansi         0.4.1   2020-01-08 [1] CRAN (R 4.0.2)
#>  farver        2.0.3   2020-01-16 [1] CRAN (R 4.0.2)
#>  forcats     * 0.5.0   2020-03-01 [1] CRAN (R 4.0.2)
#>  fs            1.5.0   2020-07-31 [1] CRAN (R 4.0.2)
#>  generics      0.0.2   2018-11-29 [1] CRAN (R 4.0.2)
#>  ggplot2     * 3.3.2   2020-06-19 [1] CRAN (R 4.0.2)
#>  glue          1.4.1   2020-05-13 [1] CRAN (R 4.0.2)
#>  gtable        0.3.0   2019-03-25 [1] CRAN (R 4.0.2)
#>  haven         2.3.1   2020-06-01 [1] CRAN (R 4.0.2)
#>  highr         0.8     2019-03-20 [1] CRAN (R 4.0.2)
#>  hms           0.5.3   2020-01-08 [1] CRAN (R 4.0.2)
#>  htmltools     0.5.0   2020-06-16 [1] CRAN (R 4.0.2)
#>  httr          1.4.2   2020-07-20 [1] CRAN (R 4.0.2)
#>  jsonlite      1.7.0   2020-06-25 [1] CRAN (R 4.0.2)
#>  knitr         1.29    2020-06-23 [1] CRAN (R 4.0.2)
#>  labeling      0.3     2014-08-23 [1] CRAN (R 4.0.2)
#>  lifecycle     0.2.0   2020-03-06 [1] CRAN (R 4.0.2)
#>  lubridate     1.7.9   2020-06-08 [1] CRAN (R 4.0.2)
#>  magrittr      1.5     2014-11-22 [1] CRAN (R 4.0.2)
#>  maps          3.3.0   2018-04-03 [1] CRAN (R 4.0.2)
#>  memoise       1.1.0   2017-04-21 [1] CRAN (R 4.0.2)
#>  mime          0.9     2020-02-04 [1] CRAN (R 4.0.2)
#>  modelr        0.1.8   2020-05-19 [1] CRAN (R 4.0.2)
#>  munsell       0.5.0   2018-06-12 [1] CRAN (R 4.0.2)
#>  pillar        1.4.6   2020-07-10 [1] CRAN (R 4.0.2)
#>  pkgbuild      1.1.0   2020-07-13 [1] CRAN (R 4.0.2)
#>  pkgconfig     2.0.3   2019-09-22 [1] CRAN (R 4.0.2)
#>  pkgload       1.1.0   2020-05-29 [1] CRAN (R 4.0.2)
#>  prettyunits   1.1.1   2020-01-24 [1] CRAN (R 4.0.2)
#>  processx      3.4.3   2020-07-05 [1] CRAN (R 4.0.2)
#>  ps            1.3.3   2020-05-08 [1] CRAN (R 4.0.2)
#>  purrr       * 0.3.4   2020-04-17 [1] CRAN (R 4.0.2)
#>  R6            2.4.1   2019-11-12 [1] CRAN (R 4.0.2)
#>  Rcpp          1.0.5   2020-07-06 [1] CRAN (R 4.0.2)
#>  readr       * 1.3.1   2018-12-21 [1] CRAN (R 4.0.2)
#>  readxl        1.3.1   2019-03-13 [1] CRAN (R 4.0.2)
#>  remotes       2.2.0   2020-07-21 [1] CRAN (R 4.0.2)
#>  reprex        0.3.0   2019-05-16 [1] CRAN (R 4.0.2)
#>  rlang         0.4.7   2020-07-09 [1] CRAN (R 4.0.2)
#>  rmarkdown     2.3     2020-06-18 [1] CRAN (R 4.0.2)
#>  rprojroot     1.3-2   2018-01-03 [1] CRAN (R 4.0.2)
#>  rvest         0.3.6   2020-07-25 [1] CRAN (R 4.0.2)
#>  scales        1.1.1   2020-05-11 [1] CRAN (R 4.0.2)
#>  sessioninfo   1.1.1   2018-11-05 [1] CRAN (R 4.0.2)
#>  stringi       1.4.6   2020-02-17 [1] CRAN (R 4.0.2)
#>  stringr     * 1.4.0   2019-02-10 [1] CRAN (R 4.0.2)
#>  testthat      2.3.2   2020-03-02 [1] CRAN (R 4.0.2)
#>  tibble      * 3.0.3   2020-07-10 [1] CRAN (R 4.0.2)
#>  tidyr       * 1.1.1   2020-07-31 [1] CRAN (R 4.0.2)
#>  tidyselect    1.1.0   2020-05-11 [1] CRAN (R 4.0.2)
#>  tidyverse   * 1.3.0   2019-11-21 [1] CRAN (R 4.0.2)
#>  usethis       1.6.1   2020-04-29 [1] CRAN (R 4.0.2)
#>  vctrs         0.3.2   2020-07-15 [1] CRAN (R 4.0.2)
#>  withr         2.2.0   2020-04-20 [1] CRAN (R 4.0.2)
#>  xfun          0.16    2020-07-24 [1] CRAN (R 4.0.2)
#>  xml2          1.3.2   2020-04-23 [1] CRAN (R 4.0.2)
#>  yaml          2.2.1   2020-02-01 [1] CRAN (R 4.0.2)
#> 
#> [1] /Library/Frameworks/R.framework/Versions/4.0/Resources/library

【问题讨论】：

标签： r ggplot2

【解决方案1】：

要执行拆分，您可以将数据框转换为 sf 对象并利用 st_wrap_dateline 函数：

library(sf)

# convert to sf object & split into 2 polygons
plate.sf <- st_polygon(x = list(as.matrix(plate %>% select(lon, lat)))) %>%
  st_wrap_dateline()

# plot using geom_sf
world %>%
  ggplot() +
  geom_map(map = world,
           aes(x = long, y = lat,
               map_id = region)) +
  geom_sf(data = plate.sf, colour = "dark green")

如果您想坚持使用geom_polygon 而不是geom_sf，请将多边形转换回数据框：

plate2 <- lapply(seq_along(plate.sf), 
                 function(i) as.data.frame(plate.sf[[i]][[1]]) %>%
                   rename(lon = V1, lat = V2) %>%
                   mutate(group = i)) %>%
  data.table::rbindlist()

world %>%
  ggplot() +
  geom_map(map = world,
           aes(x = long, y = lat,
               map_id = region)) +
  geom_polygon(data = plate2,
               aes(x = lon, y = lat, group = group),
               fill = NA, colour = "dark green")

编辑：针对具有多个板块的数据框的扩展答案

# mock up data frame with 2 distinct plates (mirror image of each other)
plates <- rbind(plate %>% mutate(plate = 1),
                plate %>% mutate(lat = -lat, plate = 2)) %>%
  select(plate, lat, lon)

# process data for geom_polygon approach
plates2 <- plates %>%

  # split into separate data frame for each plate
  split(.$plate) %>% 
  
  # convert to polygon & split along date line (as before)
  lapply(function(d) d %>% select(lon, lat) %>%
           as.matrix() %>%
           list() %>%
           st_polygon() %>% 
           st_wrap_dateline()) %>%
  
  # convert each plate back to data frame (as before)
  lapply(function(d) lapply(seq_along(d),
                            function(i) as.data.frame(d[[i]][[1]]) %>%
                              rename(lon = V1, lat = V2) %>%
                              mutate(group = i)) %>%
           data.table::rbindlist()) %>%
  
  # combine into one overall data frame
  bind_rows(.id = "plate") %>%
  mutate(group = paste(plate, group, sep = "."))

# result
world %>%
  ggplot() +
  geom_map(map = world,
           aes(x = long, y = lat,
               map_id = region)) +
  geom_polygon(data = plates2,
               aes(x = lon, y = lat, group = group),
               fill = NA, colour = "dark green")

【讨论】：

非常感谢您的回复@Z.Lin 有没有办法可以将它应用到许多盘子上？在实际数据集中，我有 3 列 plate、lat、long。
扩大了我的答案。
效果很好。感谢您的帮助！