Skip to content

Commit

Permalink
Merge pull request #51 from Metropolitan-Council/test-improve
Browse files Browse the repository at this point in the history
Improve tests, general tidying
  • Loading branch information
eroten authored Nov 4, 2022
2 parents c9e6b51 + eb86a44 commit a195749
Show file tree
Hide file tree
Showing 23 changed files with 382 additions and 176 deletions.
14 changes: 7 additions & 7 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand All @@ -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),
Expand All @@ -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),
Expand Down
11 changes: 11 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -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
Expand Down
150 changes: 78 additions & 72 deletions R/fetch_county_geo.R
Original file line number Diff line number Diff line change
Expand Up @@ -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() +
Expand All @@ -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)
Expand All @@ -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
#'
1 change: 0 additions & 1 deletion R/import_from_emissions.R
Original file line number Diff line number Diff line change
Expand Up @@ -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),
Expand Down
8 changes: 6 additions & 2 deletions R/import_from_gis.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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,
Expand Down
1 change: 0 additions & 1 deletion R/import_from_gpkg.R
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,6 @@ import_from_gpkg <- function(link,
.crs = 4326,
keep_temp = FALSE,
.quiet = TRUE) {

# check input types
purrr::map(
c(link),
Expand Down
11 changes: 4 additions & 7 deletions R/map_council.R
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,6 @@
#'
#' @family aesthetics
#'
#' @note This function relies on `[{rlang}]` internal functions.
#'
#' @examples
#' \dontrun{
Expand All @@ -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")
Expand Down
Loading

0 comments on commit a195749

Please sign in to comment.