uribo / jpmesh
1
#' @title Separate more fine mesh order
2
#' @description Return contains fine mesh codes
3
#' @inheritParams mesh_to_coords
4
#' @param ... other parameters for paste
5
#' @return character vector
6
#' @importFrom purrr map
7
#' @importFrom rlang inform
8
#' @examples
9
#' fine_separate("5235")
10
#' fine_separate("523504")
11
#' fine_separate("52350432")
12
#' fine_separate("523504321")
13
#' fine_separate("5235043211")
14
#' @return meshcode as `character`
15
#' @export
16
fine_separate <- function(meshcode = NULL, ...) {
17 6
  if (is.mesh(meshcode))
18 6
    mesh_length <- nchar(meshcode)
19 6
  res <- if (mesh_length == 4) {
20 6
    res <- paste0(meshcode,
21 6
                  rep(seq.int(0, 7), each = 8),
22 6
                  rep(seq.int(0, 7), times = 8))
23 6
  } else if (mesh_length == 6) {
24 6
    res <- paste0(meshcode,
25 6
                  rep(seq.int(0, 9), each = 10),
26 6
                  rep(seq.int(0, 9), times = 10))
27 6
  } else if (mesh_length >= 8 & mesh_length <= 10) {
28 6
    res <- paste0(meshcode, seq_len(4))
29
  } else {
30 6
    rlang::inform("A value greater than the supported mesh size was inputed.") # nolint
31 6
    NA_character_
32
  }
33 6
  return(res)
34
}
35

36
#' @title Gather more coarse mesh
37
#' @description Return coarse gather mesh codes
38
#' @inheritParams mesh_to_coords
39
#' @param distinct return unique meshcodes
40
#' @return character vector
41
#' @importFrom purrr map_chr
42
#' @importFrom rlang is_true
43
#' @importFrom units as_units
44
#' @examples
45
#' m <- c("493214294", "493214392", "493215203", "493215301")
46
#' coarse_gather(m)
47
#' coarse_gather(coarse_gather(m))
48
#' coarse_gather(coarse_gather(m), distinct = TRUE)
49
#' @return meshcode as `character`
50
#' @export
51
coarse_gather <- function(meshcode, distinct = FALSE) {
52 6
  res <- purrr::map_chr(meshcode, function(x) {
53 6
    if (mesh_size(x) == units::as_units(0.5, "km")) {
54 6
      substr(x, 1, 8)
55 6
    } else if (mesh_size(x) %in% units::as_units(c(1, 5), "km")) {
56 6
      substr(x, 1, 6)
57 6
    } else if (mesh_size(x) == units::as_units(10, "km")) {
58 6
      substr(x, 1, 4)
59
    }
60
  }
61
  )
62 6
  if (rlang::is_true(distinct))
63 6
    res <- unique(res)
64 6
  return(res)
65
}

Read our documentation on viewing source code .

Loading