Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #' Inside of National Park Meshes
- #'
- #' @param d data
- #' @param mesh_size
- #' @importFrom dplyr everything filter mutate select
- #' @importFrom jpmesh fine_separate mesh_to_coords mesh_to_poly sf_jpmesh
- #' @importFrom magrittr use_series
- #' @importFrom purrr map pmap set_names
- #' @importFrom rlang flatten_chr
- #' @importFrom sf st_intersects st_sf
- #' @importFrom tibble as_data_frame tibble
- #' @importFrom tidyr unnest
- np_area_meshed <- function(d, mesh_size = c("10km", "1km")) {
- df_tmp <- tibble::tibble(res_contains = suppressMessages(sf::st_intersects(jpmesh::sf_jpmesh,
- d,
- sparse = FALSE,
- prepared = TRUE)) %>%
- as.numeric())
- df_tmp$id <- 1:nrow(df_tmp)
- df_pref_mesh <- jpmesh::sf_jpmesh[df_tmp %>%
- dplyr::filter(res_contains == 1) %>%
- magrittr::use_series(id) %>% unique(), ] %>%
- magrittr::use_series(meshcode) %>%
- purrr::map(jpmesh::fine_separate) %>% rlang::flatten_chr() %>%
- unique()
- if (mesh_size == "1km") {
- # 10km -> 1km mesh
- df_pref_mesh <- df_pref_mesh %>%
- purrr::map(jpmesh::fine_separate) %>%
- purrr::flatten_chr()
- }
- sf_prefmesh <- df_pref_mesh %>%
- tibble::as_data_frame() %>%
- purrr::set_names("meshcode") %>%
- dplyr::mutate(out = purrr::pmap(.,
- ~jpmesh::mesh_to_coords(...))) %>% tidyr::unnest() %>%
- dplyr::select(meshcode, dplyr::everything()) %>% dplyr::mutate(geometry = purrr::pmap(.,
- ~jpmesh:::mesh_to_poly(...))) %>% sf::st_sf(crs = 4326)
- df_tmp <- tibble::tibble(res_contains = suppressMessages(sf::st_intersects(sf_prefmesh,
- d)) %>%
- as.numeric())
- df_tmp$id <- 1:nrow(df_tmp)
- res <- sf_prefmesh[df_tmp %>% dplyr::filter(!is.na(res_contains)) %>% magrittr::use_series(id) %>%
- unique(), ]
- return(res)
- }
Add Comment
Please, Sign In to add comment