How to split tectonic plate boundary polygon in a way to prevent line across the world map?

user_14167684 0
Viewed 70

I am trying to plot tectonic plate boundaries on the world map. However, the tectonic plate's polygons seem to stretch across the world map (looking like they're at the opposite ends of the world, when they're actually side to side as the globe is round).

Is there a way I can split the plate where it wraps around?

Data:

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)
)

Code:

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

Created on 2020-08-26 by the reprex package (v0.3.0)

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
ggplot2 r
1 Answers

To perform the split, you can convert your data frame to a sf object & take advantage of the st_wrap_dateline function:

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")

If you want to stick with geom_polygon instead of geom_sf, convert the polygons back to dataframe:

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")

result

Edit: expanded answer for dataframe with multiple plates

# 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")
user_84496290
Related