-
-
Notifications
You must be signed in to change notification settings - Fork 4
/
is_mesh.R
75 lines (71 loc) · 2.78 KB
/
is_mesh.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
#' @title Predict meshcode format and positions
#' @description Predict meshcode format and positions for utility and certain.
#' @inheritParams mesh_to_coords
#' @name is_mesh
NULL # nolint
#' @export
#' @rdname is_mesh
is_meshcode <- function(meshcode) {
inherits(meshcode, c("meshcode", "subdiv_meshcode"))
}
#' @export
#' @rdname is_mesh
is_corner <- function(meshcode) {
if (is_meshcode(meshcode) == FALSE) {
meshcode <-
meshcode(meshcode)
}
size <-
mesh_size(meshcode) # nolint
if (size == mesh_units[1]) {
rlang::abort("enable 10km or 1km mesh")
} else if (size == mesh_units[2]) {
grepl("(0[0-7]|[0-7]0|7[0-7]|[0-7]7)$",
vctrs::field(meshcode, "mesh_code"))
} else if (size == mesh_units[4]) {
grepl("(0[0-9]|[0-9]0|9[0-9]|[0-9]9)$",
vctrs::field(meshcode, "mesh_code"))
}
}
is_meshcode_regex <- function(meshcode) {
purrr::map_lgl(meshcode,
function(meshcode) {
if (mesh_size(meshcode) == mesh_units[1])
res <- grepl(meshcode_regexp[["80km"]],
vctrs::field(meshcode[1], "mesh_code"))
if (mesh_size(meshcode) == mesh_units[2])
res <- grepl(meshcode_regexp[["10km"]],
vctrs::field(meshcode, "mesh_code"))
if (mesh_size(meshcode) == mesh_units[3])
res <- grepl(meshcode_regexp[["5km"]],
vctrs::field(meshcode, "mesh_code"))
if (mesh_size(meshcode) == mesh_units[4])
res <- grepl(meshcode_regexp[["1km"]],
vctrs::field(meshcode, "mesh_code"))
if (mesh_size(meshcode) == mesh_units[5])
res <- grepl(meshcode_regexp[["500m"]],
vctrs::field(meshcode, "mesh_code"))
if (mesh_size(meshcode) == mesh_units[6])
res <- grepl(meshcode_regexp[["250m"]],
vctrs::field(meshcode, "mesh_code"))
if (mesh_size(meshcode) == mesh_units[7])
res <- grepl(meshcode_regexp[["125m"]],
vctrs::field(meshcode, "mesh_code"))
res
})
}
meshcode_regexp <-
list(`80km` = "^([3-6][0-9][2-5][0-9])") %>%
purrr::list_modify(
`10km` = paste0(.[[1]], "([0-7]{2})")) %>%
purrr::list_modify(
`5km` = paste0(.[[2]], "([1-4]{1})")) %>%
purrr::list_modify(
`1km` = paste0(.[[2]], "([0-9]{2})")
) %>%
purrr::list_modify(
`500m` = paste0(.[[4]], "([1-4]{1})"),
`250m` = paste0(.[[4]], "([1-4]{2})"),
`125m` = paste0(.[[4]], "([1-4]{3})")
) %>%
purrr::map(~ paste0(.x, "$"))