Closed #15

uribo · Jun 7, 2018 · 28fa34c · 28fa34c
1 parent e8067b4
commit 28fa34c
Show file tree

Hide file tree

Showing 2 changed files with 36 additions and 9 deletions.
diff --git a/R/export_mesh.R b/R/export_mesh.R
@@ -1,7 +1,7 @@
 #' Export district's mesh polygon
 #'
 #' @param jis_code jis code for prefecture and city identifical number
-#' @importFrom dplyr mutate select everything
+#' @importFrom dplyr filter mutate select everything
 #' @importFrom jpmesh fine_separate mesh_to_coords
 #' @importFrom magrittr use_series
 #' @importFrom purrr map set_names pmap
@@ -26,33 +26,55 @@ mesh_district <- function(jis_code = NULL) {
   df_tmp$id <- 1:nrow(df_tmp)
 
   df_pref10km_mesh <- jpmesh::sf_jpmesh[df_tmp %>%
+                                          dplyr::filter(!is.na(res_contains)) %>%
                                           tidyr::unnest() %>%
                                           magrittr::use_series(id) %>%
                                           unique(), ] %>%
     .$meshcode %>%
     purrr::map(jpmesh::fine_separate) %>%
     rlang::flatten_chr() %>%
-    unique()
-
-  sf_prefmesh <- df_pref10km_mesh %>%
+    unique() %>%
     tibble::as_tibble() %>%
     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)
+    sf::st_sf(crs = 4326, stringsAsFactors = FALSE)
 
   df_tmp <- tibble::tibble(
-    res_contains = suppressMessages(sf::st_intersects(sf_prefmesh,
+    res_contains = suppressMessages(sf::st_intersects(df_pref10km_mesh,
                                                       sf_pref) %>% as.numeric()))
   df_tmp$id <- 1:nrow(df_tmp)
 
-  sf_prefmesh[df_tmp %>%
+  df_pref1km_mesh <-
+    df_pref10km_mesh[df_tmp %>%
+                dplyr::filter(!is.na(res_contains)) %>%
                        tidyr::unnest() %>%
                        magrittr::use_series(id) %>%
                        unique(), ] %>%
+    .$meshcode %>%
+    purrr::map(jpmesh::fine_separate) %>%
+    rlang::flatten_chr() %>%
+    unique() %>%
     tibble::as_tibble() %>%
-    sf::st_sf(crs = 4326)
+    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, stringsAsFactors = FALSE)
+
+  df_tmp <- tibble::tibble(
+    res_contains = suppressMessages(sf::st_intersects(df_pref1km_mesh,
+                                                      sf_pref) %>% as.numeric()))
+  df_tmp$id <- 1:nrow(df_tmp)
+
+  df_pref1km_mesh[df_tmp %>%
+                     dplyr::filter(!is.na(res_contains)) %>%
+                     tidyr::unnest() %>%
+                     magrittr::use_series(id) %>%
+                     unique(), ]
+
 
 }
diff --git a/tests/testthat/test-export.R b/tests/testthat/test-export.R
@@ -1,6 +1,7 @@
 context("test-export.R")
 
 d <- mesh_district(jis_code = 33101)
+d2 <- mesh_district(jis_code = 14401)
 
 test_that("mesh_district", {
   expect_is(
@@ -9,7 +10,11 @@ test_that("mesh_district", {
   )
   expect_equal(
     dim(d),
-    c(11264L, 6L)
+    c(511L, 6L)
+  )
+  expect_equal(
+    dim(d2),
+    c(54L, 6L)
   )
   expect_named(
     d,