diff --git a/DESCRIPTION b/DESCRIPTION index 3b24a32..f4c23ba 100644 --- 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 index f5fd66b..e773217 100644 --- 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 index 2c38829..011d10b 100644 --- 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 index 17f792c..97ca1e6 100644 --- 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 index 5b42dbf..01fa4de 100644 --- 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 index dabc4e9..dba8d9a 100644 --- a/R/export_mesh.R +++ b/R/export_mesh.R @@ -20,9 +20,11 @@ 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 <- @@ -30,14 +32,14 @@ export_mesh <- 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 index 1527f8d..1a2dba3 100644 --- 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 index f4e5e6f..761e189 100644 --- 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 index 990802e..908481a 100644 --- 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, "$")) diff --git a/R/mesh_convert.R b/R/mesh_convert.R index fab0dc2..8121d7f 100644 --- a/R/mesh_convert.R +++ b/R/mesh_convert.R @@ -23,7 +23,7 @@ #' @return [meshcode][meshcode] #' @rdname converter mesh_convert <- function(meshcode = NULL, to_mesh_size = NULL) { # nolint - . <- .x <- NULL + .x <- NULL if (is_meshcode(meshcode) == FALSE) { meshcode <- meshcode(meshcode) @@ -55,13 +55,13 @@ mesh_convert <- function(meshcode = NULL, to_mesh_size = NULL) { # nolint grep(pattern = paste0("^(", mesh_code, ")"), x = meshcode_set(1, .raw = TRUE), value = TRUE) } - mesh_code %>% + mesh_code |> purrr::map( ~ paste0(.x, rep(seq.int(0, 9), each = 10), - rep(seq.int(0, 9), times = 10))) %>% - purrr::reduce(c) %>% - purrr::map(~ meshcode(.x, .type = type)) %>% + rep(seq.int(0, 9), times = 10))) |> + purrr::reduce(c) |> + purrr::map(~ meshcode(.x, .type = type)) |> purrr::reduce(c) } else { if (from_mesh_size == to_mesh_size) { @@ -85,39 +85,37 @@ mesh_convert <- function(meshcode = NULL, to_mesh_size = NULL) { # nolint } if (to_mesh_size <= mesh_units[5]) { res <- - substr(mesh_code, 1, 8) %>% + substr(mesh_code, 1, 8) |> purrr::map( - ~ paste0(.x, seq_len(4))) %>% + ~ paste0(.x, seq_len(4))) |> purrr::reduce(c) if (to_mesh_size <= mesh_units[6]) { res <- - res %>% - grep(substr(mesh_code, 1, 9), ., value = TRUE) %>% + grep(substr(mesh_code, 1, 9), res, value = TRUE) |> purrr::map( - ~ paste0(.x, seq_len(4))) %>% + ~ paste0(.x, seq_len(4))) |> purrr::reduce(c) } if (to_mesh_size == mesh_units[7]) { res <- - res %>% - grep(substr(mesh_code, 1, 10), ., value = TRUE) %>% + grep(substr(mesh_code, 1, 10), res, value = TRUE) |> purrr::map( - ~ paste0(.x, seq_len(4))) %>% + ~ paste0(.x, seq_len(4))) |> purrr::reduce(c) } } } else { if (to_mesh_size == mesh_units[1]) { res <- - mesh_code %>% + mesh_code |> substr(1, 4) } else if (to_mesh_size == mesh_units[2]) { res <- - mesh_code %>% + mesh_code |> substr(1, 6) } else if (to_mesh_size == mesh_units[4]) { # nolint res <- - mesh_code %>% + mesh_code |> substr(1, 8) } else { fine_mesh_set <- @@ -125,20 +123,20 @@ mesh_convert <- function(meshcode = NULL, to_mesh_size = NULL) { # nolint substr(mesh_code, 1, 8), ")"), x = meshcode_set(1, .raw = TRUE), - value = TRUE) %>% - fine_separate() %>% - purrr::map(fine_separate) %>% - purrr::reduce(c) %>% - purrr::map(fine_separate) %>% - purrr::reduce(c) %>% + value = TRUE) |> + fine_separate() |> + purrr::map(fine_separate) |> + purrr::reduce(c) |> + purrr::map(fine_separate) |> + purrr::reduce(c) |> vctrs::field("mesh_code") if (to_mesh_size <= mesh_units[5]) res <- grep(pattern = paste0("^(", substr(mesh_code, 1, 9), ")"), - x = substr(fine_mesh_set, 1, 9), value = TRUE) %>% - unique() %>% + x = substr(fine_mesh_set, 1, 9), value = TRUE) |> + unique() |> paste0(seq_len(4)) } } diff --git a/R/mesh_to_coords.R b/R/mesh_to_coords.R index 04fa7f5..2e10942 100644 --- a/R/mesh_to_coords.R +++ b/R/mesh_to_coords.R @@ -21,14 +21,14 @@ mesh_to_coords <- function(meshcode, ...) { # nolint mesh_size(meshcode) # nolint d <- tibble::tibble(meshcode = meshcode) - d %>% + d |> cbind( purrr::map2( mesh_code, size, .mesh_to_coords - ) %>% - purrr::reduce(rbind)) %>% + ) |> + purrr::reduce(rbind)) |> tibble::as_tibble() } .mesh_to_coords <- function(mesh_code, size) { diff --git a/R/mesh_viewer.R b/R/mesh_viewer.R index f6fbe40..51153c5 100644 --- a/R/mesh_viewer.R +++ b/R/mesh_viewer.R @@ -31,10 +31,10 @@ mesh_viewer <- function(...) { output$my_map <- leaflet::renderLeaflet({ d <- coords_to_mesh(as.numeric(input$lng), as.numeric(input$lat), - mesh_size = as.numeric(input$mesh_size)) %>% + mesh_size = as.numeric(input$mesh_size)) |> export_meshes() - leaflet::leaflet() %>% - leaflet::addTiles() %>% + leaflet::leaflet() |> + leaflet::addTiles() |> leaflet::addPolygons(data = d) }) } diff --git a/R/meshcode.R b/R/meshcode.R index ae01a6c..814bd27 100644 --- a/R/meshcode.R +++ b/R/meshcode.R @@ -22,7 +22,7 @@ meshcode_vector <- function(x = character(), vctrs::vec_assert(x, character()) vctrs::vec_assert(size, double()) x <- - x %>% + x |> purrr::map_chr( function(x) { if ( @@ -63,7 +63,7 @@ meshcode <- function(x, .type = "standard") { size <- 0.1 } else { size <- - x %>% + x |> purrr::map_dbl( ~ units::drop_units(mesh_length(as.character(nchar(.x))))) } diff --git a/R/util.R b/R/util.R index 95faa55..7ba28ba 100644 --- a/R/util.R +++ b/R/util.R @@ -26,8 +26,8 @@ mesh_to_poly <- function(lng_center, lat_center, lng_error, lat_error, ...) { c(lng_center - lng_error, lat_center + lat_error), c(lng_center - lng_error, - lat_center - lat_error)))) %>% - sf::st_sfc(crs = 4326) %>% + lat_center - lat_error)))) |> + sf::st_sfc(crs = 4326) |> sf::st_as_text() } @@ -56,7 +56,7 @@ mesh_size <- function(meshcode, .type = "standard") { "0.5" = mesh_units[5], "0.25" = mesh_units[6], "0.125" = mesh_units[7], - "0.1" = mesh_units[8])) %>% + "0.1" = mesh_units[8])) |> purrr::reduce(c) if (rlang::is_null(res)) { res <- @@ -134,21 +134,21 @@ meshcode_set <- as.character(meshcode_80km_num) } else { meshcode_10km <- - as.character(meshcode_80km_num) %>% + as.character(meshcode_80km_num) |> purrr::map( ~ paste0(.x, sprintf("%02s", sort(paste0(rep(seq.int(0, 7), each = 8), seq.int(0, 7)))) - )) %>% + )) |> purrr::flatten_chr() } if (mesh_size == 1) { meshcode_1km <- - meshcode_10km %>% + meshcode_10km |> purrr::map( ~ paste0(.x, sprintf("%02d", seq.int(0, 99)) - )) %>% + )) |> purrr::flatten_chr() } if (.raw == TRUE) { @@ -164,12 +164,12 @@ meshcode_set <- meshcode_set_80km } else if (mesh_size <= 10) { meshcode_set_10km <- - meshcode_set_80km %>% + meshcode_set_80km |> fine_separate() if (mesh_size == 10) { meshcode_set_10km } else if (mesh_size == 1) { - meshcode_set_10km %>% + meshcode_set_10km |> fine_separate() } } @@ -187,7 +187,7 @@ cut_off <- function(meshcode) { vctrs::field(meshcode, "mesh_code") } mesh_80km <- - meshcode %>% + meshcode |> substr(1, 4) res <- meshcode[mesh_80km %in% meshcode_set(80, .raw = TRUE)] @@ -200,12 +200,12 @@ cut_off <- function(meshcode) { validate_neighbor_mesh <- function(meshcode) { df_bbox <- - find_neighbor_mesh(meshcode) %>% + find_neighbor_mesh(meshcode) |> export_meshes() df_bbox <- - df_bbox %>% - sf::st_sf() %>% - sf::st_union() %>% + df_bbox |> + sf::st_sf() |> + sf::st_union() |> sf::st_bbox() tibble::tibble( xlim = as.numeric(df_bbox[3] - df_bbox[1]), @@ -213,30 +213,33 @@ validate_neighbor_mesh <- function(meshcode) { } bind_meshpolys <- function(meshcode) { - meshcode %>% - fine_separate() %>% - unique() %>% + meshcode |> + fine_separate() |> + unique() |> export_meshes(.keep_class = TRUE) } code_reform <- function(jis_code) { - . <- NULL checked <- - jis_code %>% - purrr::map(nchar) %>% - purrr::keep(~ .x %in% c(1, 2, 5)) %>% + jis_code |> + purrr::map(nchar) |> + purrr::keep(~ .x %in% c(1, 2, 5)) |> length() if (length(jis_code) != checked) rlang::abort("Input jis-code must to 2 or 5 digits.") - jis_code %>% - purrr::map(as.numeric) %>% - purrr::map_if(.p = nchar(.) %in% c(1, 2), ~ sprintf("%02d", .x)) %>% - purrr::map_if(.p = nchar(.) %in% c(4, 5), ~ sprintf("%05d", .x)) %>% + jis_code_num <- + jis_code |> + purrr::map(as.numeric) + jis_code_num <- + jis_code_num |> + purrr::map_if(.p = nchar(jis_code_num) %in% c(1, 2), ~ sprintf("%02d", .x)) + jis_code_num |> + purrr::map_if(.p = nchar(jis_code_num) %in% c(4, 5), ~ sprintf("%05d", .x)) |> purrr::flatten_chr() } mesh_length <- function(mesh_length) { - mesh_length %>% + mesh_length |> purrr::map_dbl( ~ switch(.x, "4" = mesh_units[1], @@ -246,6 +249,6 @@ mesh_length <- function(mesh_length) { "9" = mesh_units[5], "10" = mesh_units[6], "11" = mesh_units[7], - "10" = mesh_units[8])) %>% + "10" = mesh_units[8])) |> units::set_units("km") } diff --git a/R/utils-pipe.R b/R/utils-pipe.R deleted file mode 100644 index fb8c818..0000000 --- a/R/utils-pipe.R +++ /dev/null @@ -1,11 +0,0 @@ -#' Pipe operator -#' -#' See \code{magrittr::\link[magrittr]{\%>\%}} for details. -#' -#' @name %>% -#' @rdname pipe -#' @keywords internal -#' @export -#' @importFrom magrittr %>% -#' @usage lhs \%>\% rhs -NULL diff --git a/jpmesh.Rproj b/jpmesh.Rproj index 1f225be..622c6dd 100644 --- a/jpmesh.Rproj +++ b/jpmesh.Rproj @@ -1,4 +1,5 @@ Version: 1.0 +ProjectId: 2f68baf8-cfd9-45e5-ad1d-f0c65169e567 RestoreWorkspace: No SaveWorkspace: No @@ -18,4 +19,4 @@ BuildType: Package PackageUseDevtools: Yes PackageInstallArgs: --no-multiarch --with-keep.source -UseNativePipeOperator: No +UseNativePipeOperator: Yes diff --git a/man/export_mesh.Rd b/man/export_mesh.Rd index 97e882b..1b06de9 100644 --- a/man/export_mesh.Rd +++ b/man/export_mesh.Rd @@ -26,6 +26,6 @@ Convert and export meshcode area to \code{sfc_POLYGON} and \code{sf}. \examples{ export_mesh("6441427712") export_meshes("4128") -find_neighbor_mesh("37250395") \%>\% +find_neighbor_mesh("37250395") |> export_meshes() } diff --git a/man/pipe.Rd b/man/pipe.Rd deleted file mode 100644 index b7daf6a..0000000 --- a/man/pipe.Rd +++ /dev/null @@ -1,12 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils-pipe.R -\name{\%>\%} -\alias{\%>\%} -\title{Pipe operator} -\usage{ -lhs \%>\% rhs -} -\description{ -See \code{magrittr::\link[magrittr]{\%>\%}} for details. -} -\keyword{internal} diff --git a/tests/testthat/test-converter.R b/tests/testthat/test-converter.R index c8d8499..0b44a87 100644 --- a/tests/testthat/test-converter.R +++ b/tests/testthat/test-converter.R @@ -10,8 +10,8 @@ test_that("scale up", { mesh_convert("52350432", to_mesh_size = 10) expect_equal(mesh_size(res), units::as_units(10, "km")) res_area <- - res %>% - export_meshes() %>% + res |> + export_meshes() |> sf::st_area() expect_equal(res_area, units::as_units(10000000, "m2"), @@ -35,9 +35,9 @@ test_that("scale down", { res <- mesh_convert(meshcode = "52350432", 0.125) res_area <- - res %>% - export_meshes() %>% - sf::st_union() %>% + res |> + export_meshes() |> + sf::st_union() |> sf::st_area() expect_length(res, 64L) expect_equal(res_area, diff --git a/tests/testthat/test-coords_to_meshcode.R b/tests/testthat/test-coords_to_meshcode.R index f851d72..8211c90 100644 --- a/tests/testthat/test-coords_to_meshcode.R +++ b/tests/testthat/test-coords_to_meshcode.R @@ -154,7 +154,7 @@ test_that("vectorize", { meshcode(c("54400098", "53394611"))) meshes <- c("51337793", "54387643") d <- - meshes %>% + meshes |> export_meshes() d$longitude <- purrr::pmap_dbl(d, ~ mesh_to_coords(..1)[[2]]) diff --git a/tests/testthat/test-internal.R b/tests/testthat/test-internal.R index 499e789..1a90d12 100644 --- a/tests/testthat/test-internal.R +++ b/tests/testthat/test-internal.R @@ -40,16 +40,16 @@ test_that( fine_separate(4028) target2 <- vctrs::field(target, - "mesh_code")[target %>% - vctrs::field("mesh_code") %>% + "mesh_code")[target |> + vctrs::field("mesh_code") |> purrr::map_lgl( is_corner ) != TRUE] df_check <- - target2 %>% - purrr::map(validate_neighbor_mesh) %>% - purrr::map(round, digits = 2) %>% - purrr::reduce(rbind) %>% + target2 |> + purrr::map(validate_neighbor_mesh) |> + purrr::map(round, digits = 2) |> + purrr::reduce(rbind) |> unique() expect_gte( nrow(df_check), @@ -57,8 +57,8 @@ test_that( ) target3 <- vctrs::field(target, - "mesh_code")[target %>% - vctrs::field("mesh_code") %>% + "mesh_code")[target |> + vctrs::field("mesh_code") |> purrr::map_lgl( is_corner ) == TRUE] diff --git a/tests/testthat/test-mesh_to_coords.R b/tests/testthat/test-mesh_to_coords.R index c447d3a..059c36f 100644 --- a/tests/testthat/test-mesh_to_coords.R +++ b/tests/testthat/test-mesh_to_coords.R @@ -74,7 +74,7 @@ test_that("fine mesh", { # Misc. -------------------------------------------------- test_that("Combine other function", { res <- - coords_to_mesh(135.527193, 34.688732) %>% + coords_to_mesh(135.527193, 34.688732) |> mesh_to_coords() expect_that(res, is_a("data.frame")) expect_equal(names(res), @@ -86,8 +86,8 @@ test_that("Combine other function", { test_that("fine mesh", { res <- - fine_separate("36233799") %>% - tibble::enframe(name = NULL) %>% + fine_separate("36233799") |> + tibble::enframe(name = NULL) |> purrr::set_names(c("meshcode")) res <- mesh_to_coords(res$meshcode) diff --git a/tests/testthat/test-neighborhood.R b/tests/testthat/test-neighborhood.R index d0fd0f4..5ab94e3 100644 --- a/tests/testthat/test-neighborhood.R +++ b/tests/testthat/test-neighborhood.R @@ -80,7 +80,7 @@ test_that("corners", { "53390090", "53390091", "53391001", "53391010", "53391011"))) res <- - neighbor_mesh(53390109) %>% + neighbor_mesh(53390109) |> export_meshes() res$relate <- c(sf::st_relate(res$geometry, res$geometry[5], sparse = FALSE)) @@ -91,10 +91,10 @@ test_that("corners", { "FF2F11212", "FF2F11212", "FF2F01212")) skip_if_not_installed("lwgeom") expect_equivalent( - neighbor_mesh(53390009) %>% - export_meshes() %>% - sf::st_union() %>% - sf::st_area() %>% + neighbor_mesh(53390009) |> + export_meshes() |> + sf::st_union() |> + sf::st_area() |> units::drop_units(), 9455968, tolerance = 0.002