uribo / jpmesh
1
#' @title Mesh unit converter
2
#' @description Return different meshcode values included in the mesh.
3
#' @inheritParams mesh_to_coords
4
#' @param to_mesh_size target mesh type. From 80km to 0.125km. If `NULL`,
5
#' the meshcode of one small scale will be returned.
6
#' If it is the same as the original size, the meshcode of the input
7
#' will be return.
8
#' @examples
9
#' mesh_convert(meshcode = "52350432", to_mesh_size = 80)
10
#' mesh_convert("52350432", 10)
11
#' # Scale down
12
#' mesh_convert("52350432", 0.500)
13
#' mesh_convert("52350432", 0.250)
14
#' mesh_convert(meshcode = "52350432", 0.125)
15
#' mesh_convert("523504323", 0.250)
16
#' mesh_convert("5235043213", 0.125)
17
#' mesh_convert("52350432", 1)
18
#' mesh_convert("52350432131", 0.125)
19
#' @export
20
#' @rdname converter
21
mesh_convert <- function(meshcode = NULL, to_mesh_size = NULL) { # nolint
22 6
  . <- NULL
23 6
  if (rlang::is_false(is_meshcode(meshcode))) {
24 6
    return(NA_character_)
25
  }
26 6
  from_mesh_size <- df_mesh_size_unit$mesh_size[which(df_mesh_size_unit$mesh_size == mesh_size(meshcode))] # nolint
27 6
    if (rlang::is_null(to_mesh_size))
28 6
      to_mesh_size <-
29 6
        units::drop_units(
30 6
          df_mesh_size_unit$mesh_size[which(df_mesh_size_unit$mesh_size == mesh_size(meshcode)) + 1]) # nolint
31 6
    to_mesh_size <- units::as_units(to_mesh_size, "km")
32 6
    if (from_mesh_size == to_mesh_size) {
33 6
      res <- meshcode
34 6
    } else if (from_mesh_size > to_mesh_size) {
35 6
      if (to_mesh_size == units::as_units(10, "km"))
36 0
        res <- grep(pattern = paste0("^(", meshcode, ")"),
37 0
                    x = meshcode_set_10km, value = TRUE)
38 6
      if (to_mesh_size == units::as_units(1, "km"))
39 0
        res <- grep(pattern = paste0("^(", meshcode, ")"),
40 0
                    x = meshcode_set_1km, value = TRUE)
41 6
      if (to_mesh_size <= units::as_units(0.500, "km"))
42 6
        res <- grep(pattern = paste0("^(",
43 6
                                     substr(meshcode, 1, 8),
44
                                     ")"),
45 6
                    x = meshcode_set_1km, value = TRUE) %>%
46 6
          purrr::map(
47 6
            ~ paste0(.x, seq_len(4))) %>%
48 6
          purrr::reduce(c)
49 6
      if (to_mesh_size <= units::as_units(0.250, "km"))
50 6
        res <- res %>%
51 6
          grep(substr(meshcode, 1, 9), ., value = TRUE) %>%
52 6
          purrr::map(
53 6
            ~ paste0(.x, seq_len(4))) %>%
54 6
          purrr::reduce(c)
55 6
      if (to_mesh_size == units::as_units(0.125, "km"))
56 6
        res <- res %>%
57 6
          grep(substr(meshcode, 1, 10), ., value = TRUE) %>%
58 6
          purrr::map(
59 6
            ~ paste0(.x, seq_len(4))) %>%
60 6
          purrr::reduce(c)
61
    } else {
62 6
      fine_mesh_set <-
63 6
        grep(pattern = paste0("^(",
64 6
                              substr(meshcode, 1, 8),
65
                              ")"),
66 6
             x = meshcode_set_1km, value = TRUE) %>%
67 6
        fine_separate() %>%
68 6
        purrr::map(fine_separate) %>%
69 6
        purrr::reduce(c) %>%
70 6
        purrr::map(fine_separate) %>%
71 6
        purrr::reduce(c)
72 6
      if (to_mesh_size == units::as_units(80, "km"))
73 6
        res <- grep(pattern = paste0("^(",
74 6
                                     substr(meshcode, 1, 4),
75
                                     ")"),
76 6
                    x = meshcode_set_80km, value = TRUE)
77 6
      if (to_mesh_size == units::as_units(10, "km"))
78 6
        res <- grep(pattern = paste0("^(",
79 6
                                     substr(meshcode, 1, 6),
80
                                     ")"),
81 6
                    x = meshcode_set_10km, value = TRUE)
82 6
      if (to_mesh_size == units::as_units(1, "km"))
83 0
        res <- grep(pattern = paste0("^(",
84 0
                                     substr(meshcode, 1, 8),
85
                                     ")"),
86 0
                    x = meshcode_set_1km, value = TRUE)
87 6
      if (to_mesh_size <= units::as_units(0.500, "km"))
88 0
        res <-
89 0
        grep(pattern = paste0("^(",
90 0
                            substr(meshcode, 1, 9),
91
                            ")"),
92 0
           x = substr(fine_mesh_set, 1, 9), value = TRUE) %>%
93 0
        unique() %>%
94 0
        paste0(seq_len(4))
95 6
      if (to_mesh_size <= units::as_units(0.250, "km"))
96 0
        res <-  grep(substr(meshcode, 1, 9),
97 0
                     res,
98 0
                     value = TRUE) %>%
99 0
          purrr::map(
100 0
            ~ paste0(.x, seq_len(4))) %>%
101 0
          purrr::reduce(c)
102 6
      if (to_mesh_size <= units::as_units(0.125, "km"))
103 0
        res <-  grep(substr(meshcode, 1, 10),
104 0
                     res,
105 0
                     value = TRUE) %>%
106 0
          purrr::map(
107 0
            ~ paste0(.x, seq_len(4))) %>%
108 0
          purrr::reduce(c)
109
    }
110 6
    res
111
}

Read our documentation on viewing source code .

Loading