new functions get_h3_grid, geom_bbox, and geom_sf_toscale

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: spatialops
 Title: Spatial operations that comes in handy
-Version: 0.1.2
+Version: 0.1.3
 Authors@R: 
     person("Arthur", "Bazolli", email = "baarthur0@outlook.com", role = c("aut", "cre"))
 Description: Mainly spatial operations, like calculating distances or classifying catchment areas, 

NAMESPACE

@@ -4,7 +4,10 @@ export("%>%")
 export(coef_rqs)
 export(count_features)
 export(dist_nearest)
+export(geom_bbox)
 export(geom_sf_rais)
+export(geom_sf_toscale)
+export(get_h3_grid)
 export(get_osm_postcodes)
 export(get_osm_rail)
 export(get_osm_roads)
@@ -26,20 +29,33 @@ import(tidyr)
 importFrom(basedosdados,download)
 importFrom(dplyr,bind_cols)
 importFrom(dplyr,bind_rows)
+importFrom(dplyr,filter)
 importFrom(dplyr,left_join)
 importFrom(dplyr,mutate)
+importFrom(dplyr,pull)
+importFrom(dplyr,relocate)
 importFrom(dplyr,rename)
+importFrom(ggplot2,coord_sf)
+importFrom(h3jsr,cell_to_polygon)
+importFrom(h3jsr,polygon_to_cells)
 importFrom(magrittr,"%>%")
 importFrom(purrr,map)
 importFrom(rlang,":=")
 importFrom(rlang,.data)
+importFrom(rlang,enquo)
+importFrom(rlang,quo_is_null)
 importFrom(sf,st_as_sf)
+importFrom(sf,st_bbox)
 importFrom(sf,st_buffer)
+importFrom(sf,st_centroid)
 importFrom(sf,st_crs)
 importFrom(sf,st_nearest_feature)
 importFrom(sf,st_transform)
+importFrom(sf,st_union)
 importFrom(tibble,as_tibble)
 importFrom(tibble,rowid_to_column)
 importFrom(tibble,tibble)
+importFrom(tidyr,crossing)
+importFrom(units,as_units)
 importFrom(units,drop_units)
 importFrom(utils,unzip)

R/geom_bbox.R

@@ -0,0 +1,22 @@
+#' Limit a ggplot map
+#'
+#' @description
+#' This function creates a bounding box from a `sf` object and apply its limits to `coord_sf`.
+#'
+#' @param data An object with classes `sf` and `data.frame`.
+#'
+#' @importFrom sf st_bbox
+#' @importFrom ggplot2 coord_sf
+#'
+#' @export
+#'
+#' @returns A `ggplot` object
+#'
+#' @example inst/examples/geom_bbox.R
+
+
+geom_bbox <- function(data) {
+  bbox <- data %>% st_bbox
+  coord_sf(xlim = c(bbox[1], bbox[3]), ylim = c(bbox[2], bbox[4]))
+}
+

R/geom_sf_toscale.R

@@ -0,0 +1,48 @@
+#' Make a geom_sf layer with a fixed scale
+#'
+#' @description
+#' A wrapper around `ggplot2::geom_sf`, this function generates fixed scale maps, which enhances
+#'  comparison between different plots.
+#'
+#' @param data An object with classes `sf` and `data.frame`. Won't inherit data from previous layer
+#'  since to make the scale, it is necessary to calculate a buffer around the centroid.
+#' @param dist Buffer distance, see `sf::st_buffer`
+#' @param col_ref `<data-masking>` Column in `data` with the filtering reference.
+#'  Optional, provide only if desired output is a subset of original data.
+#' @param ref Filtering reference to be passed on `col_ref`. Either a single value or a vector.
+#' @param ... Other arguments to pass to \code{ggplot2::geom_sf()}.
+#'
+#' @import ggplot2
+#' @importFrom dplyr filter
+#' @importFrom rlang quo_is_null enquo
+#' @importFrom sf st_union st_centroid st_buffer st_bbox
+#'
+#' @export
+#'
+#' @returns A `ggplot` object
+#'
+#' @example inst/examples/geom_sf_toscale.R
+
+geom_sf_toscale <- function(data, dist, col_ref = NULL, ref = NULL, ...) {
+
+  data <- if(!quo_is_null(enquo(col_ref)) & !is.null(ref)) {
+    data %>% filter({{col_ref}} %in% ref)
+  } else {data}
+
+  bbox <- data %>% st_union() %>% st_centroid() %>% st_buffer(dist) %>% st_bbox()
+
+  list(
+    geom_sf(data = data, ...),
+    coord_sf(xlim = c(bbox[1], bbox[3]), ylim = c(bbox[2], bbox[4]))
+  )
+}
+
+# tester <- function(data, col_ref = NULL, ref = NULL) {
+#
+#   if(!rlang::quo_is_null(enquo(col_ref)) & !is.null(ref)) {
+#     data %>% filter({{col_ref}} %in% ref)
+#   } else print("null")
+#
+# }
+
+

R/get_h3_grid.R

@@ -0,0 +1,66 @@
+#' Get a tidy H3 grid in a sf dataframe
+#' @description
+#' More than a wrapper around `h3jsr::polygon_to_cells()`, this function automates the process
+#'  of getting an hexagonal grid for polygons, e.g. cities. It is particularly useful when retrieving
+#'  a grid for intersecting polygons, as it automates the cropping process (optional) to avoid
+#'  duplicates. Based on {aopdata}[https://github.com/ipeaGIT/acesso_oport/].
+#'
+#' @param shp A `sf` object of type `POLYGON` or `MULTIPOLYGON`
+#' @param res Desired H3 resolution, defaults to 9.
+#' @param crop Should the polygons be cropped to the original polygon? If yes, `sf::st_intersection`
+#'  will be used. Defaults to `TRUE`
+#' @param buffer In some polygons, border areas may not be included if they do not cover an hexagon's
+#'  centroid. Creating a border increases the probability of all borders being selected; 
+#'  defaults to `TRUE`
+#' @param buffer_size Allows selecting a custom buffer distance (in meters), when `buffer = TRUE`.
+#'  If left empty, defaults to 300 when `crop = TRUE` and 15 when `crop = FALSE`. To use a unit other
+#'  than metrics, pass as `buffer_size = units::as_units(x, "unit)`.
+#' @param keep_crs Should the original coordinate reference system (`crs`) be preserved? Defaults to
+#'  `TRUE`; otherwise, will return an object with `crs = 4326` (WGS84).
+#'
+#' @import sf
+#' @importFrom dplyr pull relocate
+#' @importFrom h3jsr polygon_to_cells cell_to_polygon
+#' @importFrom magrittr %>%
+#' @importFrom tidyr crossing
+#' @importFrom units as_units
+#'
+#' @export
+#'
+#' @returns An object with classes `sf`, `tbl_df`, `tbl`, and `data.frame`
+#' 
+#' @details
+#' `h3jsr` recommends passing polygons in WGS84 coordinates, `shp` is automatically converted
+#'  to that format if not already in WGS84. Since WGS84's Buffer size is passed in meters since 
+#'  it is the default unit fot WGS84.
+#' 
+#' @example inst/examples/get_h3_grid.R
+
+
+
+# function ------------------------------------------------------------------------------------
+
+get_h3_grid <- function(shp, res = 9, crop = TRUE, buffer = TRUE, buffer_size = NULL, keep_crs = TRUE) {
+
+  buffer_size <- if(is.null(buffer_size)) {
+    if(crop) units::as_units(300,"m") else units::as_units(15,"m")
+  } else buffer_size
+
+  crs_old <- if(keep_crs) st_crs(shp)
+
+  shp <- shp %>% 
+    {if(st_crs(.) != 4326) st_transform(., crs = 4326)} 
+
+  shp %>% 
+    {if(buffer) st_buffer(., buffer_size) else .} %>% 
+    polygon_to_cells(res = res, simple = FALSE) %>% 
+    pull(h3_addresses) %>% 
+    unlist() %>%
+    cell_to_polygon(simple = FALSE) %>% 
+    crossing(st_drop_geometry(shp)) %>% 
+    st_as_sf() %>% 
+    relocate(geometry, .after = everything()) %>% 
+    {if(crop) st_intersection(., shp) else .} %>% 
+    {if(keep_crs) st_transform(., crs = crs_old) else .}
+}
+

R/maphub_to_sf.R

@@ -1,15 +1,21 @@
 #' Widen description from MapHub
+#'
 #' @description
 #' Convert maphub geojson-like description info to tibble columns.
+#'
 #' @param data A `sf` object imported from MapHub and read into R using `sf::st_read`.
 #' @param values <data-masking> Column containing data to be converted into multiple variables.
 #' Defaults to `description`.
 #' @param key_sep Character string that separates a key from its value.
 #' @param pair_sep Character string that separates key-value pairs.
+#'
 #' @import tidyr
 #' @importFrom sf st_as_sf
+#'
 #' @export
+#'
 #' @returns A `sf` object.
+#'
 #' @details
 #' Returns a spatial dataset with separate columns for each key-value pair in the original description
 #' column
@@ -36,6 +42,7 @@ maphub_to_sf <- function(data, values = description, key_sep = ": ", pair_sep =
 
 
 #' Tidy transit lines from Maphub.
+#'
 #' @param data A `sf` object imported from MapHub and already converted using maphub_to_sf
 #' @import dplyr
 #' @import sf

inst/examples/geom_bbox.R

@@ -0,0 +1,10 @@
+data("fortaleza")
+
+# plot the whole city, fill neighborhood "aldeota" in red, and zoom in to region "SER II"
+fortaleza %>%
+  ggplot() +
+  geom_sf(fill = NA) +
+  geom_sf(data = . %>% filter(name_neigh == "aldeota"), fill = "red") +
+  geom_bbox(fortaleza %>% filter(name_region == "SER II")) +
+  theme_void()
+

inst/examples/geom_sf_toscale.R

@@ -0,0 +1,22 @@
+data("fortaleza")
+
+# entire data
+ggplot() +
+  geom_sf_toscale(fortaleza, 15000)
+
+# filtering a few neighborhoods, all at once
+ggplot() +
+  geom_sf_toscale(fortaleza, 3000, name_neigh, c("centro", "aldeota"))
+
+# filtering a few neighborhoods, one per plot
+p <- fortaleza[1:2,] %>%
+  pull(name_neigh) %>%
+  map(
+    \(x) ggplot() +
+      geom_sf(data = fortaleza, fill = "white") +
+      geom_sf_toscale(fortaleza, 2000, name_neigh, x) +
+      labs(title = x)
+  )
+
+## plotting them together
+cowplot::plot_grid(p[[1]], p[[2]])

inst/examples/get_h3_grid.R

@@ -0,0 +1,34 @@
+data("fortaleza")
+
+# grid for only one polygon
+
+## cutting grid edges (default)
+fortaleza %>%
+  filter(name_neigh == "centro") %>%
+  get_h3_grid() %>%
+  ggplot() +
+  geom_sf()
+
+## letting grid cross borders
+fortaleza %>%
+  filter(name_neigh == "centro") %>%
+  get_h3_grid(crop = FALSE) %>%
+  ggplot() +
+  geom_sf()
+
+
+# grid for multiple polygons using purrr::map()
+
+## cutting edges
+fortaleza %>%
+  filter(name_region %in% c("SER III", "SER IV")) %>%
+  pull(name_neigh) %>%
+  map(
+    \(x) fortaleza %>%
+      filter(name_neigh == x) %>%
+      get_h3_grid()
+  ) %>%
+  bind_rows() %>%
+  ggplot() +
+  geom_sf(aes(fill = name_region), alpha = 0.25, linewidth = 0.125) +
+  theme_void()