[modify]use native pipe

uribo · Jan 27, 2025 · 549f675 · 549f675
1 parent e673c14
commit 549f675
Show file tree

Hide file tree

Showing 23 changed files with 173 additions and 165 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -11,7 +11,7 @@ License: MIT + file LICENSE
 URL: https://uribo.github.io/jpmesh/
 BugReports: https://github.com/uribo/jpmesh/issues/
 Depends: 
-    R (>= 3.1)
+    R (>= 4.1)
 Imports: 
     leaflet (>= 1.1.0),
     memoise (>= 1.1.0),
@@ -22,7 +22,6 @@ Imports:
     shiny (>= 1.0.5),
     tibble (>= 3.0.0),
     units (>= 0.5-1),
-    magrittr (>= 1.5),
     vctrs (>= 0.3.4)
 Suggests: 
     knitr (>= 1.20),

diff --git a/NAMESPACE b/NAMESPACE
@@ -4,7 +4,6 @@ S3method(as.character,meshcode)
 S3method(as.character,subdiv_meshcode)
 S3method(format,meshcode)
 S3method(format,subdiv_meshcode)
-export("%>%")
 export(administration_mesh)
 export(as_meshcode)
 export(coarse_gather)
@@ -32,7 +31,6 @@ importFrom(leaflet,addTiles)
 importFrom(leaflet,leaflet)
 importFrom(leaflet,leafletOutput)
 importFrom(leaflet,renderLeaflet)
-importFrom(magrittr,"%>%")
 importFrom(miniUI,gadgetTitleBar)
 importFrom(miniUI,miniContentPanel)
 importFrom(miniUI,miniPage)

diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,9 @@
 # jpmesh (development version)
 
+## Internal
+
+- Changed the pipe operator used in the package from magrittr's to the built-in one. Therefore, R 4.1.0 or higher is required to use this package.
+
 # jpmesh 2.1.0
 
 - Reviewed the handling of meshcode in the data.frame [#59](https://github.com/uribo/jpmesh/pull/59). Added *.keep_class* to the argument of the function to be returned as a data.frame (`FALSE` by default), and changed it so that the user can select the class.

diff --git a/R/administration_mesh.R b/R/administration_mesh.R
@@ -37,32 +37,32 @@ administration_mesh <- function(code, to_mesh_size) {
                  function(.x) {
                    subset(df_city_mesh,
                           grepl(paste0("^(", .x, ")"),
-                                city_code)) %>%
+                                city_code)) |> 
                      purrr::pluck("meshcode")
                  }
-               )) %>%
-    purrr::flatten_chr() %>%
+               )) |> 
+    purrr::flatten_chr() |> 
     unique()
   if (to_mesh_size == mesh_units[1]) {
     res_meshes <-
-      res_meshes %>%
+      res_meshes |> 
       substr(1, 4)
   } else if (to_mesh_size == mesh_units[2]) {
     res_meshes <-
-      res_meshes %>%
+      res_meshes |> 
       substr(1, 6)
   } else if (to_mesh_size <= mesh_units[5] & to_mesh_size >= mesh_units[7]) {
     res_meshes <- 
-      res_meshes %>% 
       purrr::map(
-        ~ mesh_convert(.x, to_mesh_size = units::drop_units(to_mesh_size))) %>% 
+        res_meshes,
+        mesh_convert(res_meshes, to_mesh_size = units::drop_units(to_mesh_size))) |> 
       purrr::reduce(c)
   } else if (to_mesh_size == mesh_units[8]) {
     res_meshes <-
-      res_meshes %>% 
+      res_meshes |> 
       fine_separate(.type = "subdivision")
   }
-  res_meshes %>%
-    unique() %>%
+  res_meshes |> 
+    unique() |> 
     export_meshes()
 }
diff --git a/R/coords_to_mesh.R b/R/coords_to_mesh.R
@@ -48,10 +48,10 @@ coords_to_mesh <- function(longitude, latitude, to_mesh_size = 1, geometry = NUL
     if (!rlang::is_missing(longitude) | !rlang::is_missing(latitude))
       rlang::inform("the condition assigned coord and geometry, only the geometry will be used") # nolint
     longitude <-
-      coords %>%
+      coords |> 
       purrr::map("longitude")
     latitude <-
-      coords %>%
+      coords |> 
       purrr::map("latitude")
   } else {
     longitude <- rlang::quo_squash(longitude)
@@ -61,7 +61,7 @@ coords_to_mesh <- function(longitude, latitude, to_mesh_size = 1, geometry = NUL
     list(longitude = longitude,
          latitude = latitude,
          to_mesh_size = to_mesh_size),
-    ~ .coord2mesh(..1, ..2, ..3)) %>% 
+    ~ .coord2mesh(..1, ..2, ..3)) |> 
     purrr::reduce(c)
 }
 
@@ -83,8 +83,8 @@ coords_to_mesh <- function(longitude, latitude, to_mesh_size = 1, geometry = NUL
     code12 <- (latitude * 60L) %/% 40L
     code34 <- as.integer(longitude - 100L)
     check_80km_ares <- 
-      paste0(code12, code34) %>%
-      match(meshcode_80km_num) %>% # nolint
+      paste0(code12, code34) |> 
+      match(meshcode_80km_num) |> # nolint
       any()
     if (rlang::is_true(check_80km_ares)) {
       code_a <- (latitude * 60L) %% 40L
@@ -119,6 +119,27 @@ coords_to_mesh <- function(longitude, latitude, to_mesh_size = 1, geometry = NUL
                          code9,
                          code10,
                          code11)
+      # meshcode <- 
+      #   dplyr::case_when(
+      #   to_mesh_size == mesh_units[1] ~ substr(meshcode, 1L, 4L),
+      #   to_mesh_size == mesh_units[2] ~ substr(meshcode, 1L, 6L),
+      #   to_mesh_size == mesh_units[3] ~ paste0(substr(meshcode, 1L, 6L),
+      #                                          (code_b %/% (5L / 2L) * 2L) + (code_g %/% (7.5 / 2L) + 1L)),
+      #   to_mesh_size == mesh_units[4] ~ substr(meshcode, 1L, 8L),
+      #   to_mesh_size == mesh_units[5] ~ substr(meshcode, 1L, 9L),
+      #   to_mesh_size == mesh_units[6] ~ substr(meshcode, 1L, 10L),
+      #   to_mesh_size == mesh_units[7] ~ meshcode,
+      #   to_mesh_size == mesh_units[8] ~ paste0(
+      #     substr(meshcode, 1L, 8L),
+      #     sprintf("%02d",
+      #             sf::st_intersects(
+      #               sf::st_sfc(sf::st_point(c(longitude, 
+      #                                         latitude)),
+      #                          crs = 4326),
+      #               st_mesh_grid(substr(meshcode, 1L, 8L), 
+      #                            to_mesh_size = 0.1),
+      #               sparse = FALSE) %>% 
+      #               which() - 1L)))
       meshcode <-
         if (to_mesh_size == mesh_units[1]) {
           substr(meshcode, 1L, 4L)
@@ -145,7 +166,7 @@ coords_to_mesh <- function(longitude, latitude, to_mesh_size = 1, geometry = NUL
                                  crs = 4326),
                       st_mesh_grid(substr(meshcode, 1L, 8L),
                                    to_mesh_size = 0.1),
-                      sparse = FALSE) %>%
+                      sparse = FALSE) |> 
                       which() - 1L)
           )
         }

diff --git a/R/export_mesh.R b/R/export_mesh.R
@@ -20,24 +20,26 @@ export_mesh <-
         size <- 
           mesh_size(meshcode)
         if (size >= units::as_units(1, "km")) {
-          mesh_to_coords(meshcode) %>% 
-            purrr::discard(names(.) %in% "meshcode") %>% 
-            purrr::pmap_chr(mesh_to_poly) %>% 
+          x <- 
+            mesh_to_coords(meshcode)
+          x |> 
+            purrr::discard(names(x) %in% "meshcode") |> 
+            purrr::pmap_chr(mesh_to_poly) |> 
             sf::st_as_sfc(crs = 4326)                  
         } else {
           mesh1km <-
             mesh_convert(meshcode, to_mesh_size = 1)
           x <- 
             mesh_to_coords(meshcode)
           st_mesh_grid(meshcode, 
-                       to_mesh_size = units::drop_units(size)) %>% 
-            st_sf() %>% 
+                       to_mesh_size = units::drop_units(size)) |> 
+            st_sf() |> 
             sf::st_join(
               sf::st_sfc(sf::st_point(c(x$lng_center, 
                                         x$lat_center)),
-                         crs = 4326) %>% 
+                         crs = 4326) |>  
                 sf::st_sf(), 
-              left = FALSE) %>% 
+              left = FALSE) |> 
             sf::st_geometry()
         }
       }
@@ -78,7 +80,7 @@ export_mesh_subdiv <- function(meshcode) {
                                  sprintf("%02d", seq.int(0, 99))),
                    geometry = sf::st_make_grid(
                      export_mesh(m1km), n = c(10, 10))), 
-         subset = mesh == as.character(meshcode)) %>% 
+         subset = mesh == as.character(meshcode)) |> 
     purrr::pluck("geometry")
 }
 
@@ -92,7 +94,7 @@ export_mesh_subdiv <- function(meshcode) {
 #' @return [sf][sf::st_sf] object
 #' @examples
 #' export_meshes("4128")
-#' find_neighbor_mesh("37250395") %>%
+#' find_neighbor_mesh("37250395") |> 
 #'   export_meshes()
 #' @export
 #' @name export_mesh
@@ -104,28 +106,28 @@ export_meshes <- function(meshcode, .keep_class = FALSE) {
   df_meshes <-
     tibble::tibble("meshcode" = meshcode)
   size <-
-    vctrs::field(df_meshes$meshcode, "mesh_size") %>% 
+    vctrs::field(df_meshes$meshcode, "mesh_size") |> 
     unique()
   if (size == 0.1) {
     df_meshes$geometry <- 
       purrr::map_chr(vctrs::field(df_meshes$meshcode, "mesh_code"),
-                   ~ export_mesh_subdiv(meshcode = .x) %>%
-                     sf::st_as_text()) %>%
+                   ~ export_mesh_subdiv(meshcode = .x) |> 
+                     sf::st_as_text()) |> 
       sf::st_as_sfc()
   } else {
     df_meshes$geometry <-
       purrr::map_chr(vctrs::field(df_meshes$meshcode, "mesh_code"),
-                     ~ export_mesh(meshcode = .x) %>%
-                       sf::st_as_text()) %>%
-      sf::st_as_sfc()    
+                     ~ export_mesh(meshcode = .x) |> 
+                       sf::st_as_text()) |> 
+      sf::st_as_sfc()
   }
   res <- 
-    df_meshes %>% 
-    sf::st_sf(crs = 4326) %>% 
+    df_meshes |> 
+    sf::st_sf(crs = 4326) |> 
     tibble::new_tibble(class = "sf", nrow = nrow(df_meshes))
   if (.keep_class == FALSE) {
     res <-
-      res %>% 
+      res |> 
       purrr::modify_at(1, ~ as.character(.x))
   }
   res
@@ -149,25 +151,25 @@ meshcode_sf <- function(data, mesh_var, .type, .keep_class = FALSE) {
   meshcode <-
     rlang::quo_name(rlang::enquo(mesh_var))
   meshes <-
-    data %>%
+    data |> 
     purrr::pluck(meshcode)
   if (is_meshcode(meshes) == FALSE) {
     meshes <- 
-      meshes %>%
-      as.character() %>% 
+      meshes |> 
+      as.character() |> 
       as_meshcode(.type = .type)
   }
   res <- 
     sf::st_sf(
       data,
-      geometry = meshes %>%
-        export_meshes() %>%
+      geometry = meshes |> 
+        export_meshes() |> 
         sf::st_geometry(),
-      crs = 4326) %>%
+      crs = 4326) |> 
     tibble::new_tibble(nrow = nrow(data), class = "sf")
   if (.keep_class == FALSE) {
     res <- 
-      res %>% 
+      res |> 
       purrr::modify_at(which(names(res) %in% meshcode),
                        ~ as.character(.x))
   }

diff --git a/R/find_neighbor_mesh.R b/R/find_neighbor_mesh.R
@@ -127,8 +127,8 @@ find_neighbor_finemesh <- function(meshcode, contains = TRUE) {
       meshcode(meshcode)
   }
   df_poly <-
-    coarse_gather(meshcode) %>%
-    find_neighbor_mesh() %>% # nolint
+    coarse_gather(meshcode) |> 
+    find_neighbor_mesh() |>  # nolint
     bind_meshpolys()
   df_poly$n <- 
     seq_len(nrow(df_poly))

diff --git a/R/fine_separate.R b/R/fine_separate.R
@@ -29,11 +29,11 @@ fine_separate <- function(meshcode = NULL, .type = "standard", ...) {
         if (mesh_size == 1 && .type == "subdivision") {
           paste0(meshcode,
                  rep(seq.int(0, 9), each = 10),
-                 rep(seq.int(0, 9), times = 10)) %>% 
+                 rep(seq.int(0, 9), times = 10)) |> 
             purrr::map(
               ~ meshcode_vector(.x,
                                 .type = .type)
-            ) %>% 
+            ) |> 
             purrr::reduce(c)
         } else if (mesh_size == 80) {
           meshcode_vector(paste0(meshcode,
@@ -63,7 +63,7 @@ fine_separate <- function(meshcode = NULL, .type = "standard", ...) {
           NA_character_
         }
       }
-    ) %>% 
+    ) |> 
       purrr::reduce(c) 
   }
 }

diff --git a/R/is_mesh.R b/R/is_mesh.R
@@ -59,17 +59,22 @@ is_meshcode_regex <- function(meshcode) {
 }
 
 meshcode_regexp <- 
-  list(`80km` = "^([3-6][0-9][2-5][0-9])")  %>% 
   purrr::list_modify(
-    `10km` = paste0(.[[1]], "([0-7]{2})")) %>% 
+    list(`80km` = "^([3-6][0-9][2-5][0-9])"),
+    `10km` = paste0(list(`80km` = "^([3-6][0-9][2-5][0-9])")[[1]], "([0-7]{2})"))  
+meshcode_regexp <- 
   purrr::list_modify(
-    `5km` = paste0(.[[2]], "([1-4]{1})")) %>% 
+    meshcode_regexp,
+    `5km` = paste0(meshcode_regexp[[2]], "([1-4]{1})")) 
+meshcode_regexp <-
   purrr::list_modify(
-    `1km` = paste0(.[[2]], "([0-9]{2})")
-  ) %>% 
+    meshcode_regexp,
+    `1km` = paste0(meshcode_regexp[[2]], "([0-9]{2})"))
+meshcode_regexp <-
   purrr::list_modify(
-    `500m` = paste0(.[[4]], "([1-4]{1})"),
-    `250m` = paste0(.[[4]], "([1-4]{2})"),
-    `125m` = paste0(.[[4]], "([1-4]{3})")
-  ) %>% 
+    meshcode_regexp,
+    `500m` = paste0(meshcode_regexp[[4]], "([1-4]{1})"),
+    `250m` = paste0(meshcode_regexp[[4]], "([1-4]{2})"),
+    `125m` = paste0(meshcode_regexp[[4]], "([1-4]{3})")
+  ) |>  
   purrr::map(~ paste0(.x, "$"))