uribo / jpmesh

Compare 7ad7182 ... +9 ... 1702b7c

No flags found

Use flags to group coverage reports by test type, project and/or folders.
Then setup custom commit statuses and notifications for each flag.

e.g., #unittest #integration

#production #enterprise

#frontend #backend

Learn more about Codecov Flags here.


@@ -3,12 +3,12 @@
Loading
3 3
#' @inheritParams mesh_to_coords
4 4
#' @importFrom purrr pmap_chr
5 5
#' @importFrom sf st_as_sfc st_polygon st_sfc
6 -
#' @return sfc object
6 +
#' @return [sfc][sf::st_as_sfc] object
7 7
#' @examples
8 8
#' export_mesh("6441427712")
9 9
#' @export
10 10
export_mesh <- function(meshcode) {
11 -
  if (is.mesh(meshcode))
11 +
  if (is_meshcode(meshcode)) {
12 12
    if (mesh_size(meshcode) <= units::as_units(0.5, "km")) {
13 13
      res <- export_mesh(substr(meshcode, 1, nchar(meshcode) - 1)) %>% # nolint 
14 14
        sf::st_make_grid(n = c(2, 2))
@@ -19,6 +19,9 @@
Loading
19 19
                        mesh_to_poly),
20 20
        crs = 4326)
21 21
    }
22 +
  } else {
23 +
    res <- NULL
24 +
  }
22 25
  return(res)
23 26
}
24 27

@@ -17,12 +17,13 @@
Loading
17 17
  if (size < units::as_units(0.5, "km")) {
18 18
    rlang::inform("Too small meshsize. Enable 80km to 500m size.")
19 19
  }
20 -
  res <- if (size >= units::as_units(1, "km"))
20 +
  res <- if (size >= units::as_units(1, "km")) {
21 21
    find_neighbor_mesh(meshcode, contains = contains) # nolint
22 -
  else if (size == units::as_units(0.5, "km"))
22 +
  } else if (size == units::as_units(0.5, "km")) {
23 23
    find_neighbor_finemesh(meshcode, contains = contains) # nolint
24 -
  else
24 +
  } else {
25 25
    NULL
26 +
  }
26 27
  return(res)
27 28
}
28 29
@@ -61,40 +62,45 @@
Loading
61 62
  } else if (size == units::as_units(1, "km")) {
62 63
    if (is_corner(meshcode)) {
63 64
      if (grepl("(00|09|90|99|010[1-8]|[1-8]9|[1-8]0|9[1-8]|0[1-8])$", meshcode)) {
64 -
        res <- meshcode - if (grepl("0000$", meshcode)) 
65 +
        res <- 
66 +
          meshcode - 
67 +
          if (grepl("0000$", meshcode)) {
65 68
          c(9281, -10, -11, 9291, 0, -1, 1002201, 992910, 992909)
66 -
        else if (grepl("0[1-9]00$", meshcode))
69 +
        } else if (grepl("0[1-9]00$", meshcode)) {
67 70
          c(81, -10, -11, 91, 0, -1, 993001, 992910, 992909)
68 -
        else if (grepl("[1-9]000$", meshcode))
71 +
        } else if (grepl("[1-9]000$", meshcode)) {
69 72
          c(9281, -10, -11, 9291, 0, -1, 10201, 910, 909)
70 -
        else if (grepl("[0-9][1-9]00$", meshcode))
71 -
          c(81, -10, -11, 91, 0, -1, 1001, 910, 909)          
72 -
        else if (grepl("[1-9][0-9]09$", meshcode))
73 +
        } else if (grepl("[0-9][1-9]00$", meshcode)) {
74 +
          c(81, -10, -11, 91, 0, -1, 1001, 910, 909)
75 +
        } else if (grepl("[1-9][0-9]09$", meshcode)) {
73 76
          c(-9, -10, -101, 1, 0, -91, 911, 910, 819) # 51331109 
74 -
        else if (grepl("0[0-9]09$", meshcode))
77 +
        } else if (grepl("0[0-9]09$", meshcode)) {
78 +
          c(-9, -10, -101, 1, 0, -91, 992911, 992910, 992819)
79 +
        } else if (grepl("0009$", meshcode)) {
75 80
          c(-9, -10, -101, 1, 0, -91, 992911, 992910, 992819)
76 -
        else if (grepl("0009$", meshcode))
77 -
          c(-9, -10, -101, 1, 0, -91, 992911, 992910, 992819)          
78 -
        else if (grepl("[0-9][1-9]90$", meshcode))
81 +
        } else if (grepl("[0-9][1-9]90$", meshcode)) {
79 82
          c(-819, -910, -911, 91, 0, -1, 101, 10, 9)
80 -
        else if (grepl("[0-9]090$", meshcode))
83 +
        } else if (grepl("[0-9]090$", meshcode)) {
81 84
          c(8381, -910, -911, 9291, 0, -1, 9301, 10, 9)
82 -
        else if (grepl("99$", meshcode))
85 +
        } else if (grepl("99$", meshcode)) {
83 86
          c(-909, -910, -1001, 1, 0, -91, 11, 10, -81)
84 -
        else if (grepl("(0[1-9]0[1-8])$", meshcode))
87 +
        } else if (grepl("(0[1-9]0[1-8])$", meshcode)) {
85 88
          c(-9, -10, -11, 1, 0, -1, 992911, 992910, 992909)
86 -
        else if (grepl("([1-8]9)$", meshcode))
89 +
        } else if (grepl("([1-8]9)$", meshcode)) {
87 90
          c(-9, -10, -101, 1, 0, -91, 11, 10, -81)
88 -
        else if (grepl("[0-9][1-9][1-8]0$", meshcode))
91 +
        } else if (grepl("[0-9][1-9][1-8]0$", meshcode)) {
89 92
          c(81, -10, -11, 91, 0, -1, 101, 10, 9)
90 -
        else if (grepl("[0-9]0[1-8]0$", meshcode))
93 +
        } else if (grepl("[0-9]0[1-8]0$", meshcode)) {
91 94
          c(9281, -10, -11, 9291, 0, -1, 9301, 10, 9)
92 -
        else if (grepl("9[1-8]$", meshcode))
95 +
        } else if (grepl("[0-6][0-9]9[1-8]$", meshcode)) {
93 96
          c(-909, -910, -911, 1, 0, -1, 11, 10, 9) # 53394592
94 -
        else if (grepl("[1-9][0-9]0[1-8]$", meshcode))
97 +
        } else if (grepl("7[0-9]9[1-8]$", meshcode)) {
98 +
          c(-992909, -992910, -992911, 1, 0, -1, 11, 10, 9) # 65417592
99 +
        } else if (grepl("[1-9][0-9]0[1-8]$", meshcode)) {
95 100
          c(-9, -10, -11, 1, 0, -1, 911, 910, 909)
96 -
        else if (grepl("0[0-9]0[1-8]$", meshcode))
101 +
        } else if (grepl("0[0-9]0[1-8]$", meshcode)) {
97 102
          c(-9, -10, -11, 1, 0, -1, 992911, 992910, 992909)
103 +
        }
98 104
      }} else {
99 105
        res <- meshcode + c(9, 10, 11, -1, 0, 1, -9, -10, -11)
100 106
      }}
@@ -109,7 +115,7 @@
Loading
109 115
find_neighbor_finemesh <- function(meshcode, contains = TRUE) {
110 116
  relate <- NULL
111 117
  df_poly <-
112 -
    substr(meshcode, 1, nchar(eval(meshcode)) - 1) %>%
118 +
    coarse_gather(meshcode) %>%
113 119
    find_neighbor_mesh() %>% # nolint
114 120
    purrr::map(bind_meshpolys) %>%
115 121
    purrr::reduce(rbind)

@@ -14,7 +14,7 @@
Loading
14 14
#' @return meshcode as `character`
15 15
#' @export
16 16
fine_separate <- function(meshcode = NULL, ...) {
17 -
  if (is.mesh(meshcode))
17 +
  if (is_meshcode(meshcode))
18 18
    mesh_length <- nchar(meshcode)
19 19
  res <- if (mesh_length == 4) {
20 20
    res <- paste0(meshcode,

@@ -7,25 +7,38 @@
Loading
7 7
#' @export
8 8
#' @rdname is_mesh
9 9
is_meshcode <- function(meshcode) {
10 -
  res <- ifelse(grepl("^[0-9]{4,11}$", meshcode), TRUE, FALSE)
11 -
  if (res == FALSE)
12 -
    rlang::inform(
13 -
      # nolint start
14 -
      paste("meshcode must be numeric ranges", 
15 -
            min(df_mesh_size_unit$mesh_length), 
16 -
            "to",
17 -
            max(df_mesh_size_unit$mesh_length),
18 -
            "digits"))    
19 -
  else
20 -
    res <- ifelse(is.na(units::drop_units(mesh_size(meshcode))), FALSE, TRUE)
21 -
    if (res == FALSE)
22 -
      rlang::inform(paste("meshcode must be follow digits:",
23 -
                          paste(df_mesh_size_unit$mesh_length[1:nrow(df_mesh_size_unit) - 1], # nolint
24 -
                                collapse = ", "),
25 -
                          "and",
26 -
                          df_mesh_size_unit$mesh_length[nrow(df_mesh_size_unit)]))
27 -
  # nolint end
28 -
  return(res)
10 +
  purrr::map_lgl(
11 +
    meshcode,
12 +
    function(meshcode) {
13 +
      res <- ifelse(grepl("^[0-9]{4,11}$", meshcode), TRUE, FALSE)
14 +
      if (res == FALSE) {
15 +
        rlang::inform(
16 +
          # nolint start
17 +
          paste("meshcode must be numeric ranges", 
18 +
                min(df_mesh_size_unit$mesh_length), 
19 +
                "to",
20 +
                max(df_mesh_size_unit$mesh_length),
21 +
                "digits"))
22 +
      } else {
23 +
        res <- ifelse(is.na(units::drop_units(mesh_size(meshcode))), FALSE, TRUE)
24 +
        if (res == FALSE) {
25 +
          rlang::inform(paste("meshcode must be follow digits:",
26 +
                              paste(df_mesh_size_unit$mesh_length[1:nrow(df_mesh_size_unit) - 1], # nolint
27 +
                                    collapse = ", "),
28 +
                              "and",
29 +
                              df_mesh_size_unit$mesh_length[nrow(df_mesh_size_unit)]))
30 +
        } else {
31 +
          res <- 
32 +
            is_meshcode_regex(meshcode)
33 +
          if (res == FALSE) {
34 +
            rlang::inform("There are unavailable numbered digits in the meshcode.")
35 +
          }
36 +
        }
37 +
      }
38 +
      # nolint end
39 +
      return(res)   
40 +
    }
41 +
  )
29 42
}
30 43
31 44
is.mesh <- function(meshcode) { # nolint
@@ -45,3 +58,40 @@
Loading
45 58
  }
46 59
  return(res)
47 60
}
61 +
62 +
is_meshcode_regex <- function(meshcode) {
63 +
  purrr::map_lgl(meshcode,
64 +
                 function(meshcode) {
65 +
                   if (mesh_size(meshcode) == mesh_units[1])
66 +
                     res <- grepl(meshcode_regexp[["80km"]], meshcode)  
67 +
                   if (mesh_size(meshcode) == mesh_units[2])
68 +
                     res <- grepl(meshcode_regexp[["10km"]], meshcode)
69 +
                   if (mesh_size(meshcode) == mesh_units[3])
70 +
                     res <- grepl(meshcode_regexp[["5km"]], meshcode)
71 +
                   if (mesh_size(meshcode) == mesh_units[4])
72 +
                     res <- grepl(meshcode_regexp[["1km"]], meshcode)
73 +
                   if (mesh_size(meshcode) == mesh_units[5])
74 +
                     res <- grepl(meshcode_regexp[["500m"]], meshcode)
75 +
                   if (mesh_size(meshcode) == mesh_units[6])
76 +
                     res <- grepl(meshcode_regexp[["250m"]], meshcode)
77 +
                   if (mesh_size(meshcode) == mesh_units[7])
78 +
                     res <- grepl(meshcode_regexp[["125m"]], meshcode)
79 +
                   res                   
80 +
                 })
81 +
}
82 +
83 +
meshcode_regexp <- 
84 +
  list(`80km` = "^([3-6][0-9][2-5][0-9])")  %>% 
85 +
  purrr::list_modify(
86 +
    `10km` = paste0(.[[1]], "([0-7]{2})")) %>% 
87 +
  purrr::list_modify(
88 +
    `5km` = paste0(.[[2]], "([1-4]{1})")) %>% 
89 +
  purrr::list_modify(
90 +
    `1km` = paste0(.[[2]], "([0-9]{2})")
91 +
  ) %>% 
92 +
  purrr::list_modify(
93 +
    `500m` = paste0(.[[4]], "([1-4]{1})"),
94 +
    `250m` = paste0(.[[4]], "([1-4]{2})"),
95 +
    `125m` = paste0(.[[4]], "([1-4]{3})")
96 +
  ) %>% 
97 +
  purrr::map(~ paste0(.x, "$"))

@@ -38,8 +38,8 @@
Loading
38 38
    code10 <- as.numeric(substring(meshcode, 10, 10))
39 39
  if (size <= units::as_units(0.125, "km"))
40 40
    code11 <- as.numeric(substring(meshcode, 11, 11))
41 -
    lat  <- code12 * 2 / 3
42 -
    long <- code34 + 100
41 +
  lat  <- code12 * 2 / 3
42 +
  long <- code34 + 100
43 43
  if (exists("code5") && exists("code6")) {
44 44
    lat  <- lat  + (code5 * 2 / 3) / 8
45 45
    long <- long +  code6 / 8

Learn more Showing 1 files with coverage changes found.

Changes in R/is_mesh.R
-1
+1
Loading file...
Files Coverage
administration_mesh.R 100.00%
coords_to_mesh.R 100.00%
export_mesh.R -3.33% 96.67%
find_neighbor_mesh.R -5.90% 85.84%
fine_separate.R 100.00%
is_mesh.R -4.08% 95.92%
mesh_convert.R 92.41%
mesh_to_coords.R 100.00%
rmesh.R 100.00%
util.R 100.00%
Folder Totals (10 files) 95.68%
Project Totals (10 files) 95.68%
Loading