Merge pull request #50 from Metropolitan-Council/update-geography-fun…

…ctions

Update geography functions

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: councilR
 Title: Functions and Templates for the Metropolitan Council
-Version: 0.1.4
-Date: 2022-10-14
+Version: 0.1.5
+Date: 2022-10-31
 Authors@R: c(
     person("Metropolitan Council", role = "cph"),
     person("Liz", "Roten", , "[email protected]", role = c("cre", "aut"),
@@ -33,7 +33,9 @@ Imports:
     sf (>= 0.9.5),
     tictoc (>= 1.0),
     tigris (>= 1.6.1),
-    utils
+    utils,
+    ggspatial (>= 1.1.6),
+    dplyr (>= 1.0.10)
 Suggests: 
     citr (>= 0.3.2),
     cowplot (>= 1.1.1),

NAMESPACE

@@ -5,19 +5,25 @@ export(council.pal)
 export(council_pal2)
 export(council_theme)
 export(fetch_county_geo)
+export(fetch_ctu_geo)
 export(import_from_emissions)
 export(import_from_gis)
 export(import_from_gpkg)
+export(map_council_continuous)
 export(scale_color_council)
 export(scale_fill_council)
 export(snippets_install)
 export(theme_council)
+export(theme_council_geo)
 export(theme_council_open)
 importFrom(DBI,dbCanConnect)
 importFrom(DBI,dbConnect)
 importFrom(DBI,dbDisconnect)
 importFrom(DBI,dbGetQuery)
 importFrom(cli,cli_abort)
+importFrom(dplyr,case_when)
+importFrom(dplyr,mutate)
+importFrom(dplyr,transmute)
 importFrom(fs,dir_create)
 importFrom(fs,dir_exists)
 importFrom(fs,dir_ls)
@@ -27,15 +33,23 @@ importFrom(fs,path)
 importFrom(fs,path_file)
 importFrom(fs,path_home_r)
 importFrom(ggplot2,"%+replace%")
+importFrom(ggplot2,aes)
 importFrom(ggplot2,discrete_scale)
 importFrom(ggplot2,element_blank)
 importFrom(ggplot2,element_line)
 importFrom(ggplot2,element_rect)
 importFrom(ggplot2,element_text)
+importFrom(ggplot2,geom_sf)
+importFrom(ggplot2,ggplot)
 importFrom(ggplot2,margin)
 importFrom(ggplot2,rel)
+importFrom(ggplot2,scale_fill_gradient2)
 importFrom(ggplot2,theme)
+importFrom(ggplot2,theme_void)
 importFrom(ggplot2,unit)
+importFrom(ggspatial,annotation_north_arrow)
+importFrom(ggspatial,annotation_scale)
+importFrom(ggspatial,north_arrow_fancy_orienteering)
 importFrom(glue,glue)
 importFrom(magrittr,"%>%")
 importFrom(odbc,odbc)
@@ -45,6 +59,7 @@ importFrom(purrr,map2)
 importFrom(purrr,map_depth)
 importFrom(purrr,reduce)
 importFrom(rlang,abort)
+importFrom(rlang,enquo)
 importFrom(sf,read_sf)
 importFrom(sf,st_as_sf)
 importFrom(sf,st_transform)

R/fetch_county_geo.R

@@ -1,23 +1,45 @@
-#' @title Fetch standardized county geography
+#' @title Fetch standardized geographies
+#'
+#' @description The default `fetch_county_geo()` to return county outlines, plus a suite of other functions to return more niche geographies.
+#'
+#' To get city, township, and unorganized territory (CTU) boundaries, use `fetch_ctu_geo()`.
 #'
 #' @param core logical, whether to include all counties in the MPO.
 #'     Default is `TRUE`.
-#' @param ... Arguments passed to `[tigris::counties]`
+#' @param ... Arguments passed to `[tigris]` functions
 #'
-#' @return An [`sf`] object containing county geographies.
+#' @return An [`sf`] object containing specified geographies.
 #' @export
 #' @family spatial helpers
 #' @examples
 #' \dontrun{
-#' fetch_county_geo()
+#' library(ggplot2)
+#'
+#' fetch_county_geo() %>%
+#'     ggplot() +
+#'     geom_sf() +
+#'     theme_void()
+#'
+#'   fetch_ctu_geo() %>%
+#'   ggplot() +
+#'   geom_sf(fill = "grey90") +
+#'   theme_void() +
+#'   geom_sf_text(aes(label = CTU_NAME),
+#'     colour = "black",
+#'     check_overlap = F,
+#'     size = 2
+#'   )
 #' }
 #'
 #' @note This function relies on `[{rlang}]` internal functions.
 #'
 #' @importFrom tigris counties
 #' @importFrom cli cli_abort
 #' @importFrom purrr map
+#' @importFrom dplyr case_when mutate transmute
 #'
+
+
 fetch_county_geo <- function(core = TRUE, ...) {
   rlang:::check_bool(core)
 
@@ -53,3 +75,77 @@ fetch_county_geo <- function(core = TRUE, ...) {
 
   return(county_sf)
 }
+
+#' @rdname fetch_county_geo
+#' @export
+#'
+
+fetch_ctu_geo <- function(core = TRUE, ...) {
+  rlang:::check_bool(core)
+  NAME <- CTU_NAME <- ALAND <- AWATER <- NULL
+
+  county_list <- if (core == TRUE) {
+    c(
+      "Anoka",
+      "Carver",
+      "Dakota",
+      "Hennepin",
+      "Ramsey",
+      "Scott",
+      "Washington"
+    )
+  } else if (core == FALSE) {
+    c(
+      "Anoka",
+      "Carver",
+      "Dakota",
+      "Hennepin",
+      "Ramsey",
+      "Scott",
+      "Sherburne",
+      "Washington",
+      "Wright"
+    )
+  }
+
+  cities <- tigris::county_subdivisions(
+    state = "MN",
+    county = county_list,
+    class = "sf"
+  ) %>%
+    mutate(NAME = case_when(
+      LSAD == 44 ~ paste(NAME, "Twp."),
+      LSAD == 46 ~ paste(NAME, "(unorg.)"),
+      TRUE ~ NAME
+    )) %>%
+    ## if expanding to greater mn or another region, you do have to do some unions, and further cleaning.
+    #   group_by(NAME) %>%
+    #   mutate(n = n()) %>%
+    #   left_join(st_drop_geometry(county_outline) %>%
+    #               transmute(
+    #                 COUNTYFP = COUNTYFP,
+    #                 CONAME = NAME
+    #               )) %>%
+    #   mutate(NAME = case_when(
+    #     n > 1 & LSAD != 25 ~ paste0(NAME, " - ", CONAME, " Co."), # cities dont get merged
+    #     TRUE ~ NAME
+    #   )) %>%
+    #   group_by(NAME) %>%
+    #   summarise() %>%
+    #   # summarize(geometry = st_union(geom)) %>%
+    #   arrange(NAME) %>%
+    #   rename(GEO_NAME = NAME)
+    transmute(
+      CTU_NAME = NAME,
+      ALAND = ALAND,
+      AWATER = AWATER
+    )
+
+
+  return(cities)
+}
+
+
+#' @rdname fetch_ctu_geo
+#' @export
+#'

R/map_council.R

@@ -0,0 +1,72 @@
+#' @title Council map starters
+#'
+#' @description Building on functionality for creating maps when mapping continuous data, `map_council_continuous()` could save some work.
+#'
+#' @param df The `sf` object to be mapped
+#' @param .fill For continuous data, the variable (column name) which
+#'     should be used to fill polygons
+#' @param .lwd numeric, line width of polygons, default setting is `0.5`.
+#' @param .low character, color name or hex code to fill the lowest number.
+#'     Default is `"#8c510a"` (brown)
+#' @param .mid character, color name or hex code to fill the midpoint number.
+#'     Default is `"white"`
+#' @param .high character,  color name or hex code to fill the highest number.
+#'     Default is `"#01665e"` (teal)
+#' @param .midpoint numeric, midpoint of a diverging color scheme.
+#'     Default is `0`.
+#'
+#' @return a [ggplot2] plot
+#' @export
+#'
+#' @family aesthetics
+#'
+#' @note This function relies on `[{rlang}]` internal functions.
+#'
+#' @examples
+#' \dontrun{
+#' library(ggplot2)
+#' library(councilR)
+#'
+#' fetch_ctu_geo() %>%
+#'   map_council_continuous(.fill = ALAND, .midpoint = 5e7)
+#' }
+#'
+#' @importFrom ggplot2 ggplot geom_sf scale_fill_gradient2 aes
+#' @importFrom ggspatial annotation_north_arrow north_arrow_fancy_orienteering annotation_scale
+#' @importFrom rlang enquo
+#'
+
+map_council_continuous <- function(df,
+                                   .fill,
+                                   .lwd = .5,
+                                   .low = "#8c510a",
+                                   .mid = "white",
+                                   .high = "#01665e",
+                                   .midpoint = 0) {
+
+  rlang:::check_number(.lwd)
+  rlang:::check_number(.midpoint)
+
+  df %>%
+    ggplot2::ggplot() +
+    ggplot2::geom_sf(aes(fill = !!enquo(.fill)), lwd = .lwd) +
+    theme_council_geo() +
+    ggplot2::scale_fill_gradient2(low = .low, mid = .mid,
+                                  high = .high, midpoint = .midpoint) +
+    ggspatial::annotation_scale(
+      location = "bl",
+      bar_cols = c("grey60", "white")
+    ) +
+    ggspatial::annotation_north_arrow(
+      location = "tr", which_north = "true",
+      # pad_x = unit(0.4, "in"), pad_y = unit(0.4, "in"),
+      style = north_arrow_fancy_orienteering(
+        fill = c("grey40"),
+        line_col = "grey20"
+      )
+    )
+}
+
+#' @rdname map_council_continuous
+#' @export
+#'

R/theme_council.R

@@ -1,6 +1,6 @@
 #' @title Council ggplot2 theme
 #'
-#' @description The default `theme_council()` plus a more simple `theme_council_open()` for making MetCouncil figures. `theme_council()` will be appropriate in most cases while `theme_council_open()` is appropriate for single scatter plots or line graphs.
+#' @description The default `theme_council()` plus a more simple `theme_council_open()` for making MetCouncil figures. `theme_council()` will be appropriate in most cases while `theme_council_open()` is appropriate for single scatter plots or line graphs. For geospatial plots, `theme_council_geo()` may be useful to set some initial parameters.
 #'
 #' Please note that the y-axis text is horizontal, and long axis names will need to be wrapped;  [`stringr::str_wrap()`]() is useful for managing length.
 #'  For example, consider using this piece of code: `labs(y = stringr::str_wrap("Axis labels are now horizontal, but you still need to insert some code to wrap long labels", width = 15))`
@@ -66,9 +66,14 @@
 #'     use_showtext = TRUE,
 #'     use_manual_font_sizes = TRUE
 #'   )
+#'
+#' fetch_ctu_geo() %>%
+#'   ggplot() +
+#'   geom_sf() +
+#'   theme_council_geo()
 #' }
 #'
-#' @importFrom ggplot2 theme element_text element_blank element_rect element_line margin unit rel %+replace%
+#' @importFrom ggplot2 theme element_text element_blank element_rect element_line margin unit rel %+replace% theme_void
 #' @importFrom purrr map map2
 #'
 #'
@@ -329,7 +334,7 @@ theme_council <- function(base_size = 11,
     panel.background = ggplot2::element_blank(),
     panel.border = ggplot2::element_blank(),
     panel.grid = ggplot2::element_line(colour = "grey92"),
-    panel.grid.minor = element_blank(), # ggplot2::element_line(size = ggplot2::rel(0.5)),
+    panel.grid.minor = ggplot2::element_blank(), # ggplot2::element_line(size = ggplot2::rel(0.5)),
     panel.grid.major = ggplot2::element_line(size = ggplot2::rel(1)),
     panel.spacing = ggplot2::unit(half_line, "pt"),
     panel.spacing.x = NULL,
@@ -443,6 +448,22 @@ theme_council_open <- function(base_size = 11,
   )
 }
 
-#' @rdname theme_council_open
+#' @rdname theme_council
+#' @export
+#'
+theme_council_geo <- function() {
+  # Starts with theme_void and then modifies some parts
+
+  ggplot2::`%+replace%`(
+    ggplot2::theme_void(),
+    ggplot2::theme(
+      legend.title = ggplot2::element_text(size = 6),
+      legend.text = ggplot2::element_text(size = 6),
+      legend.key.size = ggplot2::unit(.75, "lines")
+    )
+  )
+}
+
+#' @rdname theme_council
 #' @export
 #'