該当しない場合はメッセージだけを返すようにした

Fixed #10

R/find_city.R

@@ -16,8 +16,9 @@ find_pref <- function(longitude, latitude, ...) {
 
   res <- find_city(longitude, latitude, ...)
 
-  if (nrow(res) >= 1) {
-    df_tmp <- res %>%
+  if (!is.null(res)) {
+    df_tmp <-
+      res %>%
       dplyr::mutate(pref_code = substr(city_code, 1, 2)) %>%
       dplyr::select(pref_code, prefecture)
 
@@ -31,9 +32,8 @@ find_pref <- function(longitude, latitude, ...) {
       dplyr::mutate(pref_code = sprintf("%02d", as.numeric(pref_code))) %>%
       tweak_sf_output()
 
+    return(res)
   }
-
-  return(res)
 }
 
 #' Detect prefectures by coordinates

R/util.R

@@ -166,40 +166,43 @@ collect_cityarea <- function(path = NULL) {
     N03_001 <-
     N03_002 <- N03_003 <- N03_004 <- N03_007 <- tmp_var <- NULL
   pref_name <-
-    city_name_ <- city_name <- city_name_full <- city_code <- NULL
+    city_name_ <- city_name <- city_name_full <- city_code <- geometry <- NULL
 
   res <-
-    sf::st_read(
-      list.files(
-        path,
-        pattern = "shp$",
-        full.names = TRUE,
-        recursive = TRUE
-      ),
-      stringsAsFactors = FALSE,
-      options = c(paste0(
-        "ENCODING=",
-        dplyr::if_else(tolower(Sys.info()[["sysname"]]) == "windows",
-                       "UTF8", "cp932")
-      ))
-    ) %>%
-    mutate(
-      tmp_var = if_else(is.na(N03_003), "", N03_003),
-      city_name_full = gsub("[[:space:]]", "", gsub("NA", "", paste(tmp_var, N03_004))) # nolint
-    ) %>%
-    rename(
-      pref_name = N03_001,
-      city_name_ = N03_003,
-      city_name = N03_004,
-      city_code = N03_007
-    ) %>%
-    select(pref_name,
-           city_name_, city_name, city_name_full, city_code) %>%
-    mutate_at(.vars = vars(contains("name")),
-              iconv,
-              to = "UTF8") %>%
-    sf::st_simplify(preserveTopology = FALSE, dTolerance = 0.001) %>%
-    filter(!is.na(st_dimension(.)))
+    suppressWarnings(
+      sf::st_read(
+        list.files(
+          path,
+          pattern = "shp$",
+          full.names = TRUE,
+          recursive = TRUE
+        ),
+        stringsAsFactors = FALSE,
+        options = c(paste0(
+          "ENCODING=",
+          dplyr::if_else(tolower(Sys.info()[["sysname"]]) == "windows",
+                         "UTF8", "cp932")
+        ))
+      ) %>%
+        sf::st_simplify(preserveTopology = FALSE, dTolerance = 0.001) %>%
+        dplyr::filter(sf::st_is_empty(.) == FALSE) %>%
+        dplyr::mutate(
+          tmp_var = dplyr::if_else(is.na(N03_003), "", N03_003),
+          city_name_full = gsub("[[:space:]]", "", gsub("NA", "", paste(tmp_var, N03_004))) # nolint
+        ) %>%
+        dplyr::rename(
+          pref_name  = N03_001,
+          city_name_ = N03_003,
+          city_name  = N03_004,
+          city_code  = N03_007
+        ) %>%
+        dplyr::mutate_at(.vars = dplyr::vars(dplyr::contains("name")),
+                  iconv,
+                  to = "UTF8") %>%
+        dplyr::select(pref_name,
+                      city_name_, city_name, city_name_full, city_code,
+                      geometry)
+    )
 
   return(res)
   # nocov end
@@ -255,24 +258,35 @@ read_ksj_p34 <- function(pref_code = NULL, path = NULL) {
 #' @importFrom sf st_contains st_point
 #' @name which_pol_min
 which_pol_min <- function(longitude, latitude, ...) {
-  sp_polygon <-
+
+  pref_code_chr <-
     find_prefs(longitude = longitude, latitude = latitude) %>%
-    use_series(pref_code) %>%
-    purrr::map(jpn_pref) %>%
-    purrr::reduce(rbind)
-
-  which_row <-
-    suppressMessages(grep(
-      TRUE,
-      sf::st_intersects(sp_polygon,
-                        sf::st_point(c(
-                          longitude, latitude
-                        ), dim = "XY"),
-                        sparse = FALSE)
-    ))
+    magrittr::use_series(pref_code)
 
-  res <- list(spdf = sp_polygon, which = which_row)
-  return(res)
+  sp_polygon <- NULL
+  which_row  <- integer(0)
+
+  if (identical(pref_code_chr, character(0)) == TRUE) {
+    1
+  } else {
+    sp_polygon <-
+      pref_code_chr %>%
+      purrr::map(jpn_pref) %>%
+      purrr::reduce(rbind)
+
+    which_row <-
+      suppressMessages(grep(
+        TRUE,
+        sf::st_intersects(sp_polygon,
+                          sf::st_point(c(
+                            longitude, latitude
+                          ), dim = "XY"),
+                          sparse = FALSE)
+      ))
+  }
+
+
+  list(spdf = sp_polygon, which = which_row)
 }
 
 

data-raw/shp2sf.R

@@ -110,7 +110,7 @@ pref_modified <- function(prefcode) {
       filter(pref_code == !!pref) %>%
       mutate_at(vars(c("prefecture", "sichyo_sinkyokyoku", "city")), stringi::stri_conv, to = "UTF8") %>%
       st_simplify(preserveTopology = TRUE, dTolerance = 0.0015) %>%
-      filter(!is.na(st_dimension(.)))
+      filter(sf::st_is_empty(.) == FALSE)
   )
   return(res)
 }

tests/testthat/test-find_city.R

@@ -15,19 +15,32 @@ test_that("prefecture", {
                paste(intToUtf8(c(33576, 22478, 30476), multiple = TRUE), collapse = ""))
 })
 
-test_that("city", {
-  test <- find_city(longitude = 130.4412895, latitude = 30.2984335)
-  expect_s3_class(test, "tbl")
-  expect_equal(dim(test), c(1, 4))
-  expect_named(test, c("prefecture", "city_code", "city", "geometry"))
-  expect_equal(test$city_code, "46505")
-  expect_is(test$prefecture, "character")
-
-  test <- find_city(longitude = 140.1137418, latitude = 36.0533957)
-  expect_equal(test$city_code, "08220")
-  expect_equal(test$city,
-               paste(intToUtf8(c(12388, 12367, 12400, 24066), multiple = TRUE), collapse = ""))
-
+test_that("Failed", {
+  expect_message(
+    find_pref(125.2468750000, 24.7145833333),
+    intToUtf8(
+      c(
+        25351,
+        23450,
+        12375,
+        12383,
+        24231,
+        27161,
+        12364,
+        12509,
+        12522,
+        12468,
+        12531,
+        12395,
+        21547,
+        12414,
+        12428,
+        12414,
+        12379,
+        12435
+      )
+    )
+  )
   expect_message(
     find_city(longitude = 140.639815, latitude = 36.108976),
     intToUtf8(
@@ -51,5 +64,23 @@ test_that("city", {
         12379,
         12435
       )
-  ))
+    ))
+  test <-
+    find_pref(125.2468750000, 24.7145833333)
+  expect_identical(test, NULL)
+
+})
+
+test_that("city", {
+  test <- find_city(longitude = 130.4412895, latitude = 30.2984335)
+  expect_s3_class(test, "tbl")
+  expect_equal(dim(test), c(1, 4))
+  expect_named(test, c("prefecture", "city_code", "city", "geometry"))
+  expect_equal(test$city_code, "46505")
+  expect_is(test$prefecture, "character")
+
+  test <- find_city(longitude = 140.1137418, latitude = 36.0533957)
+  expect_equal(test$city_code, "08220")
+  expect_equal(test$city,
+               paste(intToUtf8(c(12388, 12367, 12400, 24066), multiple = TRUE), collapse = ""))
 })

tests/testthat/test-util.R

@@ -1,19 +1,21 @@
 context("utilities")
 
 test_that("return prefecture jis code as string", {
-  test <- pref_code(33)
+  test <-
+    pref_code(33)
   expect_is(test, "character")
   expect_equal(test, "33")
   expect_equal(pref_code(jis_code = 2), "02")
 })
 
 test_that("return prefecture jis code as string", {
-  test <- collect_prefcode(33)
+  test <-
+    collect_prefcode(33)
   expect_is(test, "character")
   expect_equal(test, "33")
 
-
-  char_okym <- paste(intToUtf8(c(23713, 23665, 30476), multiple = TRUE), collapse = "")
+  char_okym <-
+    paste(intToUtf8(c(23713, 23665, 30476), multiple = TRUE), collapse = "")
   expect_identical(
     collect_prefcode(33),
     collect_prefcode(admin_name = char_okym)
@@ -27,7 +29,8 @@ test_that("available kjs data", {
   skip_on_travis()
   skip_on_appveyor()
   skip_on_cran()
-  test <- read_ksj_cityarea(code = 17)
+  test <-
+    read_ksj_cityarea(code = 17)
   expect_is(
     test,
     c("sf", "data.frame")
@@ -36,10 +39,17 @@ test_that("available kjs data", {
     dim(test),
     c(40L, 6L)
   )
+  expect_named(
+    test,
+    c("pref_name",
+      "city_name_", "city_name", "city_name_full", "city_code",
+      "geometry")
+  )
 })
 
 test_that("reverge-geo coding", {
-  test <- which_pol_min(longitude = 130.4412895, latitude = 30.2984335)
+  test <-
+    which_pol_min(longitude = 130.4412895, latitude = 30.2984335)
 
   expect_is(test, "list")
   expect_s3_class(test$spdf, c("tbl"))