uribo / jpmesh
1
#' Extract administration mesh
2
#'
3
#' @param code administration code
4
#' @inheritParams mesh_convert
5
#' @examples
6
#' \dontrun{
7
#' administration_mesh(code = "35201", to_mesh_size = 1)
8
#' administration_mesh(code = "08220", to_mesh_size)
9
#' administration_mesh(code = c("08220", "08221"), to_mesh_size = 10)
10
#' administration_mesh(code = "35", to_mesh_size = 80)
11
#' administration_mesh(code = c("33", "34"), to_mesh_size = 80)
12
#' }
13
#' @name administration_mesh
14
#' @export
15
administration_mesh <- function(code, to_mesh_size) {
16 6
  to_mesh_size_chr <-
17 6
    as.character(to_mesh_size)
18 6
  rlang::arg_match(to_mesh_size_chr,
19 6
                   c("80", "10", "1"))
20 6
  to_mesh_size <-
21 6
    units::as_units(as.numeric(to_mesh_size), "km")
22 6
  checked_code <-
23 6
    code_reform(code)
24 6
  mis_match <-
25 6
    checked_code[!checked_code %in% c(sprintf("%02d", seq_len(47)),
26 6
                                      unique(df_city_mesh$city_code))]
27 6
  if (rlang::is_false(identical(mis_match, character(0))))
28 6
    rlang::inform(paste(length(mis_match), "matching code were not found."))
29 6
  checked_code <- checked_code[!checked_code %in% mis_match]
30 6
  if (length(unique(nchar(checked_code))) > 1)
31 6
    rlang::inform("The city and the prefecture including it was givend.\nWill return prefecture's meshes.") # nolint
32 6
  res_meshes <-
33 6
    purrr::map(checked_code,
34 6
               ~ subset(df_city_mesh,
35 6
                        grepl(paste0("^(", .x, ")"),
36 6
                              city_code)) %>%
37 6
                 purrr::pluck("meshcode")) %>%
38 6
    purrr::flatten_chr() %>%
39 6
    unique()
40 6
  if (to_mesh_size == units::as_units(80, "km")) {
41 6
    res_meshes <-
42 6
      res_meshes %>%
43 6
      substr(1, 4)
44 6
  } else if (to_mesh_size == units::as_units(10, "km")) {
45 6
    res_meshes <-
46 6
      res_meshes %>%
47 6
      substr(1, 6)
48
  }
49 6
  res_meshes %>%
50 6
    unique() %>%
51 6
    purrr::map(~ export_meshes(.x)) %>%
52 6
    purrr::reduce(rbind)
53
}

Read our documentation on viewing source code .

Loading