daily pastebin goal
42%
SHARE
TWEET

Untitled

a guest Feb 14th, 2018 61 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. #' Inside of National Park Meshes
  2. #'
  3. #' @param d data
  4. #' @param mesh_size
  5. #' @importFrom dplyr everything filter mutate select
  6. #' @importFrom jpmesh fine_separate mesh_to_coords mesh_to_poly sf_jpmesh
  7. #' @importFrom magrittr use_series
  8. #' @importFrom purrr map pmap set_names
  9. #' @importFrom rlang flatten_chr
  10. #' @importFrom sf st_intersects st_sf
  11. #' @importFrom tibble as_data_frame tibble
  12. #' @importFrom tidyr unnest
  13. np_area_meshed <- function(d, mesh_size = c("10km", "1km")) {
  14.  
  15.   df_tmp <- tibble::tibble(res_contains = suppressMessages(sf::st_intersects(jpmesh::sf_jpmesh,
  16.                                                                              d,
  17.                                                                              sparse = FALSE,
  18.                                                                              prepared = TRUE)) %>%
  19.                              as.numeric())
  20.   df_tmp$id <- 1:nrow(df_tmp)
  21.  
  22.   df_pref_mesh <- jpmesh::sf_jpmesh[df_tmp %>%
  23.                                       dplyr::filter(res_contains == 1) %>%
  24.                                       magrittr::use_series(id) %>% unique(), ] %>%
  25.     magrittr::use_series(meshcode) %>%
  26.     purrr::map(jpmesh::fine_separate) %>% rlang::flatten_chr() %>%
  27.     unique()
  28.  
  29.   if (mesh_size == "1km") {
  30.     # 10km -> 1km mesh
  31.     df_pref_mesh <- df_pref_mesh %>%
  32.       purrr::map(jpmesh::fine_separate) %>%
  33.       purrr::flatten_chr()
  34.   }
  35.  
  36.   sf_prefmesh <- df_pref_mesh %>%
  37.     tibble::as_data_frame() %>%
  38.     purrr::set_names("meshcode") %>%
  39.     dplyr::mutate(out = purrr::pmap(.,
  40.                                                                      ~jpmesh::mesh_to_coords(...))) %>% tidyr::unnest() %>%
  41.     dplyr::select(meshcode, dplyr::everything()) %>% dplyr::mutate(geometry = purrr::pmap(.,
  42.                                                                                           ~jpmesh:::mesh_to_poly(...))) %>% sf::st_sf(crs = 4326)
  43.   df_tmp <- tibble::tibble(res_contains = suppressMessages(sf::st_intersects(sf_prefmesh,
  44.                                                                              d)) %>%
  45.                              as.numeric())
  46.  
  47.   df_tmp$id <- 1:nrow(df_tmp)
  48.   res <- sf_prefmesh[df_tmp %>% dplyr::filter(!is.na(res_contains)) %>% magrittr::use_series(id) %>%
  49.                        unique(), ]
  50.  
  51.   return(res)
  52. }
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top