as_s2_geography(rnaturalearth)

check_s2_ne.R

# # rnaturaleaerth release
# install.packages("rnaturalearth")
# install.packages("rnaturalearthdata")
# install.packages("rnaturalearthhires",
#                  repos = "http://packages.ropensci.org",
#                  type = "source")

#rnaturaleaerth dev
devtools::install_github("ropensci/rnaturalearth")
devtools::install_github("ropensci/rnaturalearthdata")
devtools::install_github("ropensci/rnaturalearthhires")

library(dplyr)
library(sf)
library(purrr)
library(lwgeom)
library(rnaturalearth)

as_s2_fails <- function(x) {
  res <- tryCatch(s2::as_s2_geography(x), error = function(e) e)
  any(class(res) == "error")
}

s2_prep_script <- function(ne_sf) {
  ne <- ne_sf %>% st_set_precision(1e7)
  # write and read to ensure ring direction
  temp_json <- tempfile(fileext = ".geojson")
  write_sf(ne, temp_json)
  ne <- read_sf(temp_json, check_ring_dir = TRUE)

  # remove the south pole from antarctica
  ant_ind <- which(ne$admin == "Antarctica")
  if (isTRUE(ant_ind)) {
    ne$geometry[[ant_ind]][] <- lapply(ne$geometry[[ant_ind]], function(ply) {
      lapply(ply, function(ring) {
        is_pole <- abs(ring[, 2] + 90) < 1e-6
        ring[!is_pole, ]
      })
    })
  }
  ne_wkb <- st_as_binary(ne$geometry, EWKT = TRUE) %>% wk::wkb()
  s2_data_tbl_countries <- as.data.frame(
    tibble::tibble(
      name = ne$admin,
      continent = ne$continent,
      geometry = ne_wkb
    )
  )
  return(ne)
}

validate_as_s2 <- function(ne_sf) {
  ne_sf %>%
    dplyr::filter(map_lgl(geometry, as_s2_fails)) %>%
    mutate(st_valid = map_lgl(geometry, st_is_valid),
           fixed_prec = !map_lgl(st_set_precision(geometry,1e7), as_s2_fails),
           fixed_prep_script = !map_lgl(s2_prep_script(.)$geometry, as_s2_fails),
           fixed_lwgeom = !map_lgl(lwgeom_make_valid(geometry), as_s2_fails)) %>%
    select(name,st_valid, fixed_prec, fixed_prep_script, fixed_lwgeom)
}

ne_data <- list(ne_countries_110 = ne_countries(returnclass = "sf", type = "countries", scale = 110),
                     ne_countries_50 = ne_countries(returnclass = "sf", type = "countries", scale = 50),
                     ne_countries_10 = ne_countries(returnclass = "sf", type = "countries", scale = 10),
                     ne_map_units_110 = ne_countries(returnclass = "sf", type = "map_units", scale = 110),
                     ne_map_units_50 = ne_countries(returnclass = "sf", type = "map_units", scale = 50),
                     ne_map_units_10 = ne_countries(returnclass = "sf", type = "map_units", scale = 10),
                     ne_sovereignty_110 = ne_countries(returnclass = "sf", type = "sovereignty", scale = 110),
                     ne_sovereignty_50 = ne_countries(returnclass = "sf", type = "sovereignty", scale = 50),
                     ne_sovereignty_10 = ne_countries(returnclass = "sf", type = "sovereignty", scale = 10)
)

ne_s2_fails <- keep(ne_data,as_s2_fails) %>%
  map(validate_as_s2) %>%
  imap_dfr(~mutate(.x, dataset = .y, .before=1))
ne_s2_fails