Merge pull request #51 from Metropolitan-Council/test-improve

Improve tests, general tidying

DESCRIPTION

@@ -2,16 +2,16 @@ Type: Package
 Package: councilR
 Title: Functions and Templates for the Metropolitan Council
 Version: 0.1.5
-Date: 2022-10-31
+Date: 2022-11-04
 Authors@R: c(
     person("Metropolitan Council", role = "cph"),
     person("Liz", "Roten", , "[email protected]", role = c("cre", "aut"),
            comment = c(ORCID = "0000-0002-5346-3549")),
-    person("Garrick", "Aden-Buie", , "[email protected]", role = "ctb",
-           comment = c(ORCID = "0000-0002-7111-0077")),
     person("Ellen", "Esch", , "[email protected]", role = "ctb",
            comment = c(ORCID = "0000-0002-4253-0910")),
-    person("Mauricio", "León", , "[email protected]", role = "ctb")
+    person("Mauricio", "León", , "[email protected]", role = "ctb"),
+    person("Garrick", "Aden-Buie", , "[email protected]", role = "ctb",
+           comment = c(ORCID = "0000-0002-7111-0077"))
   )
 Description: A collection of commonly used templates, color palettes, and
     functions for R users at the Metropolitan Council.
@@ -22,8 +22,10 @@ Depends:
 Imports: 
     cli (>= 3.3.0),
     DBI (>= 1.1.0),
+    dplyr (>= 1.0.10),
     fs (>= 1.4),
     ggplot2 (>= 3.3.0),
+    ggspatial (>= 1.1.6),
     glue (>= 1.4.0),
     magrittr (>= 1.5),
     odbc (>= 1.2.2),
@@ -33,9 +35,7 @@ Imports:
     sf (>= 0.9.5),
     tictoc (>= 1.0),
     tigris (>= 1.6.1),
-    utils,
-    ggspatial (>= 1.1.6),
-    dplyr (>= 1.0.10)
+    utils
 Suggests: 
     citr (>= 0.3.2),
     cowplot (>= 1.1.1),

NEWS.md

@@ -1,3 +1,14 @@
+# v.0.1.5 (2022-11-04)
+
+Geography and plotting function expansion
+
+- `fetch_ctu_geo()` fetches CTU geographies
+- `theme_council_geo()` provides a ggplot2 theme for maps
+- `map_council_continuous()` allows you to map a given geography using a specific variable/column.
+
+Significant improvements in testing.  
+
+
 # v.0.1.4 (2022-10-14)
 
 ## `theme_council()` font patch

R/fetch_county_geo.R

@@ -16,11 +16,11 @@
 #' library(ggplot2)
 #'
 #' fetch_county_geo() %>%
-#'     ggplot() +
-#'     geom_sf() +
-#'     theme_void()
+#'   ggplot() +
+#'   geom_sf() +
+#'   theme_void()
 #'
-#'   fetch_ctu_geo() %>%
+#' fetch_ctu_geo() %>%
 #'   ggplot() +
 #'   geom_sf(fill = "grey90") +
 #'   theme_void() +
@@ -45,32 +45,32 @@ fetch_county_geo <- function(core = TRUE, ...) {
 
   county_list <- if (core == TRUE) {
     c(
-      "Anoka",
-      "Carver",
-      "Dakota",
-      "Hennepin",
-      "Ramsey",
-      "Scott",
-      "Washington"
+      "003", # "Anoka",
+      "019", # "Carver",
+      "037", # "Dakota",
+      "053", # "Hennepin",
+      "123", # "Ramsey",
+      "139", # "Scott",
+      "163" # "Washington"
     )
   } else if (core == FALSE) {
     c(
-      "Anoka",
-      "Carver",
-      "Dakota",
-      "Hennepin",
-      "Ramsey",
-      "Scott",
-      "Sherburne",
-      "Washington",
-      "Wright"
+      "003", # "Anoka",
+      "019", # "Carver",
+      "037", # "Dakota",
+      "053", # "Hennepin",
+      "123", # "Ramsey",
+      "139", # "Scott",
+      "163", # "Washington"
+      "141", # "Sherburne",
+      "171" # "Wright"
     )
   }
 
   # fetch county geograp
-  mn_counties <- tigris::counties(state = "MN", ...)
+  mn_counties <- tigris::counties(state = 27, ...)
 
-  county_sf <- mn_counties[mn_counties$NAME %in% county_list, ]
+  county_sf <- mn_counties[mn_counties$COUNTYFP %in% county_list, ]
 
 
   return(county_sf)
@@ -86,66 +86,72 @@ fetch_ctu_geo <- function(core = TRUE, ...) {
 
   county_list <- if (core == TRUE) {
     c(
-      "Anoka",
-      "Carver",
-      "Dakota",
-      "Hennepin",
-      "Ramsey",
-      "Scott",
-      "Washington"
+      "003", # "Anoka",
+      "019", # "Carver",
+      "037", # "Dakota",
+      "053", # "Hennepin",
+      "123", # "Ramsey",
+      "139", # "Scott",
+      "163" # "Washington"
     )
   } else if (core == FALSE) {
     c(
-      "Anoka",
-      "Carver",
-      "Dakota",
-      "Hennepin",
-      "Ramsey",
-      "Scott",
-      "Sherburne",
-      "Washington",
-      "Wright"
+      "003", # "Anoka",
+      "019", # "Carver",
+      "037", # "Dakota",
+      "053", # "Hennepin",
+      "123", # "Ramsey",
+      "139", # "Scott",
+      "163", # "Washington"
+      "141", # "Sherburne",
+      "171" # "Wright"
     )
   }
 
-  cities <- tigris::county_subdivisions(
-    state = "MN",
+  cities_geo <- tigris::county_subdivisions(
+    state = 27,
     county = county_list,
-    class = "sf"
+    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
+    dplyr::mutate(
+      NAME = dplyr::case_when(
+        LSAD == 44 ~ paste(NAME, "Twp."),
+        LSAD == 46 ~ paste(NAME, "(unorg.)"),
+        TRUE ~ NAME
+      )
     )
 
+  cities <- if (core == TRUE) {
+    cities_geo %>%
+      dplyr::transmute(
+        CTU_NAME = NAME,
+        ALAND = ALAND,
+        AWATER = AWATER
+      )
+  } else if (core == FALSE) {
+    cities_geo %>%
+      dplyr::group_by(NAME) %>%
+      dplyr::mutate(n = dplyr::n()) %>%
+      dplyr::left_join(sf::st_drop_geometry(cities_geo) %>%
+        dplyr::transmute(
+          COUNTYFP = COUNTYFP,
+          CONAME = NAME
+        )) %>%
+      dplyr::mutate(CTU_NAME = dplyr::if_else(
+        n > 1 & LSAD != 25,
+        paste0(NAME, " - ", CONAME, " Co."), # cities dont get merged
+        NAME
+      )) %>%
+      dplyr::group_by(CTU_NAME) %>%
+      dplyr::summarise(
+        geometry = sf::st_union(geometry),
+        ALAND = sum(ALAND, na.rm = T),
+        AWATER = sum(AWATER, na.rm = T)
+      ) %>%
+      dplyr::arrange(CTU_NAME)
+  }
+
 
   return(cities)
 }
-
-
-#' @rdname fetch_ctu_geo
-#' @export
-#'

R/import_from_emissions.R

@@ -50,7 +50,6 @@ import_from_emissions <- function(table_name,
                                   local = TRUE,
                                   serv = "dbsqlcl11t.test.local,65414",
                                   db = "CD_Emissions") {
-
   # check input types
   purrr::map(
     c(table_name, serv, uid, pwd, db),

R/import_from_gis.R

@@ -5,6 +5,7 @@
 #'     Must match the database name in `query`.
 #' @param uid character, user ID. Default is `getOption("councilR.uid")`
 #' @param pwd character, user password. Default is `getOption("councilR.pwd")`.
+#' @param .quiet logical, whether to print time elapsed message.
 #'
 #' @note See `vignette("Options")` to review package options.
 #'     You must be set up with the appropriate database drivers
@@ -35,13 +36,16 @@
 import_from_gis <- function(query,
                             dbname = "GISLibrary",
                             uid = getOption("councilR.uid"),
-                            pwd = getOption("councilR.pwd")) {
+                            pwd = getOption("councilR.pwd"),
+                            .quiet = FALSE) {
   purrr::map(
     c(query, dbname, uid, pwd),
     rlang:::check_string
   )
 
-  tictoc::tic()
+  if (.quiet == FALSE) {
+    tictoc::tic()
+  }
   if (DBI::dbCanConnect(odbc::odbc(),
     # driver = "FreeTDS",
     dbname,

R/import_from_gpkg.R

@@ -36,7 +36,6 @@ import_from_gpkg <- function(link,
                              .crs = 4326,
                              keep_temp = FALSE,
                              .quiet = TRUE) {
-
   # check input types
   purrr::map(
     c(link),

R/map_council.R

@@ -20,7 +20,6 @@
 #'
 #' @family aesthetics
 #'
-#' @note This function relies on `[{rlang}]` internal functions.
 #'
 #' @examples
 #' \dontrun{
@@ -43,16 +42,14 @@ map_council_continuous <- function(df,
                                    .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) +
+    ggplot2::scale_fill_gradient2(
+      low = .low, mid = .mid,
+      high = .high, midpoint = .midpoint
+    ) +
     ggspatial::annotation_scale(
       location = "bl",
       bar_cols = c("grey60", "white")