Refactor move.R and sf.R

UchidaMizuki · Oct 5, 2024 · d275f37 · d275f37
1 parent 7db3b89
commit d275f37
Show file tree

Hide file tree

Showing 2 changed files with 15 additions and 14 deletions.
diff --git a/R/move.R b/R/move.R
@@ -45,14 +45,15 @@ grid_neighborhood <- function(grid,
   }
 
   n_XY <- n |>
-    purrr::map_dfr(function(n) {
+    purrr::map(\(n) {
       n_XY <- tidyr::expand_grid(n = n,
                                  n_X = -n:n,
                                  n_Y = -n:n)
       vec_slice(n_XY,
                 (type != "von_neumann" | (abs(n_XY$n_X) + abs(n_XY$n_Y)) == n) &
                   (type != "moore" | abs(n_XY$n_X) == n | abs(n_XY$n_Y) == n))
-    })
+    }) |>
+    purrr::list_rbind()
 
   neighbor <- tibble::tibble(grid = grid) |>
     vec_unique() |>
@@ -66,7 +67,7 @@ grid_neighborhood <- function(grid,
 
   if (simplify) {
     neighbor$neighbor <- neighbor$neighbor |>
-      purrr::map(function(neighbor) {
+      purrr::map(\(neighbor) {
         neighbor |>
           purrr::chuck("grid_neighborhood")
       })
@@ -92,22 +93,22 @@ grid_neighborhood <- function(grid,
 grid_components <- function(grid,
                             n = 0:1,
                             type = NULL) {
-  edges <- tibble::tibble(grid_from = grid,
-                          grid_to = grid_neighborhood(grid,
+  grid_unique <- vec_unique(grid)
+
+  nodes <- tibble::tibble(grid = grid_unique)
+  edges <- tibble::tibble(grid_from = grid_unique,
+                          grid_to = grid_neighborhood(grid_unique,
                                                       n = n,
                                                       type = type)) |>
     tidyr::unnest("grid_to") |>
-    dplyr::filter(.data$grid_to %in% grid)
-
-  grid_unique <- vec_unique(c(edges$grid_from, edges$grid_to))
-
-  edges <- edges |>
+    dplyr::filter(.data$grid_to %in% grid_unique) |>
     dplyr::mutate(grid_from = vec_match(.data$grid_from, grid_unique),
                   grid_to = vec_match(.data$grid_to, grid_unique))
 
-  group <- tidygraph::tbl_graph(edges = edges) |>
+  group_nodes <- tidygraph::tbl_graph(nodes = nodes,
+                                      edges = edges) |>
     dplyr::mutate(group = tidygraph::group_components()) |>
-    dplyr::pull("group")
+    tibble::as_tibble()
 
-  vec_slice(group, vec_match(grid, grid_unique))
+  vec_slice(group_nodes$group, vec_match(grid, group_nodes$grid))
 }
diff --git a/R/sf.R b/R/sf.R
@@ -122,7 +122,7 @@ st_as_sfc.grid <- function(x,
     coords <- grid_to_coords(geometry$grid,
                              center = FALSE)
     geometry$geometry <- list(coords$X_min, coords$Y_min, coords$X_max, coords$Y_max) |>
-      purrr::pmap(function(X_min, Y_min, X_max, Y_max) {
+      purrr::pmap(\(X_min, Y_min, X_max, Y_max) {
         sf::st_bbox(c(xmin = X_min,
                       ymin = Y_min,
                       xmax = X_max,