ring_sets added

NAMESPACE

@@ -17,6 +17,7 @@ export(gg_rqs)
 export(maphub_tidy_lines)
 export(maphub_tidy_stations)
 export(maphub_to_sf)
+export(ring_sets)
 export(shp_extract_read)
 export(summarise_set)
 export(theme_abnq)

R/ring_sets.R

@@ -0,0 +1,28 @@
+#' Ring sets
+#' @description
+#' Divide space in concentric rings and one additional category.
+#' @param df A `sf` object.
+#' @param cat1 <data-masking> A numeric vector. Ring order, increasing on the polygon size.
+#'  E.g., the radius for buffers or the time limit for isochrones.
+#' @param cat2 <data-masking> Second category to guide sets classification.
+#' @export
+#' @returns A `sf` object
+
+
+
+# function ------------------------------------------------------------------------------------
+
+ring_sets <- function(df, cat1, cat2) {
+  levels <- sort(unique(dplyr::pull(df, {{cat1}})))
+
+  rings <- rev(seq(levels)) %>%
+    purrr::map(
+      \(x) summarise_set(df, {{cat1}}, {{cat2}}, order = x)
+    )
+
+  rings <- purrr::map2(
+    rings[-length(rings)], rings[-1],
+    \(x, y) trim_set(y, x, {{cat1}})
+  ) %>%
+    dplyr::bind_rows(rings[length(rings)])
+}

inst/examples/ring_sets.R

@@ -0,0 +1,39 @@
+library(magrittr)
+
+# Generate data
+pts <- sf::st_sfc(
+  sf::st_point(c(0,0)),
+  sf::st_point(c(1,1)),
+  sf::st_point(c(1,-1)),
+  sf::st_point(c(-1,1)),
+  sf::st_point(c(-1,-1))
+) %>%
+  sf::st_as_sf() %>%
+  cbind(inaug = c(1970, 1980, 1990, 2000, 2010),
+        status = c("Always treated", "Always treated", "Treated", "Treated", "Never treated")) %>%
+  dplyr::rename(geometry = x)
+
+df <- seq(0.25, 1.25, 0.25) %>%
+  purrr::map(
+    \(x) sf::st_buffer(pts, x) %>%
+      dplyr::mutate(rad = x)
+  ) %>%
+  dplyr::bind_rows()
+
+
+# Make ring sets
+rings <- ring_sets(df, rad, inaug)
+
+
+# Dataviz
+
+## ggplot2
+# rings %>%
+#   ggplot2::ggplot() +
+#   ggplot2::geom_sf(ggplot2::aes(fill = factor(rad)), color = NA, alpha = 0.5) +
+#   ggplot2::scale_fill_viridis_d() +
+#   ggplot2::theme_void()
+
+## base plot
+plot(rings$geometry, col = factor(rings$rad), border = "transparent", axes = F)
+legend("topright", legend = unique(rings$rad), fill = factor(unique(rings$rad)))