diff --git a/DESCRIPTION b/DESCRIPTION
index ce512ec..f72c5b4 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -43,7 +43,6 @@ Suggests:
forcats,
ggplot2,
here,
- janitor,
openxlsx,
readr,
scales,
@@ -58,4 +57,4 @@ Remotes:
UrbanInstitute/urbnthemes
Encoding: UTF-8
Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
diff --git a/NAMESPACE b/NAMESPACE
index e83ee51..093e685 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -8,3 +8,6 @@ export(create_map)
export(get_output_data)
export(get_status)
export(is_valid_col_type)
+export(plot_geo_bias_map)
+export(tm_plot_geo_bias_map)
+import(rlang)
diff --git a/R/create_demo_chart.R b/R/create_demo_chart.R
index 6746b2d..d7f391a 100644
--- a/R/create_demo_chart.R
+++ b/R/create_demo_chart.R
@@ -9,203 +9,309 @@
#' @param file_path (character) - Default set to "dem_disparity_chart.png".
#' A file path of where to save the file. This should include a data type
#' suffix. EX: "results/visuals/dem_disparity_chart.png"
+#' @inherit sedt-citation details
#' @return plot (ggplot object) - The ggplot object that was created.
#' @export
-#' @details
-#' Please use the following citation for data obtained from the API,
-#' replacing the version number with the current version:
-#'
-#' Stern, Alena, Gabe Morrison, Sonia Torres Rodríguez, Ajjit Narayanan, and Graham MacDonald. 2024.
-#' “Spatial Equity Data Tool API” (Version X.x.x). Washington, DC: Urban Institute.
-#' https://ui-research.github.io/sedt_documentation/. Data originally sourced from various sources,
-#' analyzed at the Urban Institute and made available under the ODC Attribution License.
-
-create_demo_chart <- function(demo_df,
- group = "total",
- save_chart = FALSE,
- file_path = "dem_disparity_chart.png") {
-
- rlang::check_installed(
- c("forcats", "janitor", "scales", "ggplot2", "dplyr", "urbnthemes"),
+create_demo_chart <- function(
+ demo_df,
+ group = "total",
+ ...,
+ save_chart = FALSE,
+ file_path = "dem_disparity_chart.png",
+ pct_abb = "Pct.",
+ ggsave_args = list(
+ width = 11,
+ height = 8.5,
+ units = "in"
+ )) {
+ check_installed(
+ c("forcats", "scales", "ggplot2", "dplyr"),
reason = "to use the `create_demo_chart()` function."
- )
+ )
- #Data is correct class:
+ # Data is correct class:
stopifnot("data.frame" %in% class(demo_df))
stopifnot(is.logical(save_chart))
stopifnot(is.character(file_path))
stopifnot(is.character(group))
- #Other checks:
- stopifnot(group %in% c("total", "poverty", "under18")) #group is one of provided options
- stopifnot(TRUE %in% endsWith(file_path,
- c("eps", "ps", "tex", "pdf", "jpeg",
- "tiff", "png", "bmp", "svg", "wmf"))
- ) #file path is allowed by ggsave
-
- tryCatch(
- #TRY:
- {
- #Handle filtering to one of the baseline groups
- if(group == "total") {
- df <- demo_df |>
- dplyr::filter(!(stringr::str_detect(census_var, "pct_pov"))) |>
- dplyr::filter(!(stringr::str_detect(census_var, "pct_under18")))
- }else if(group == "poverty"){
- df <- demo_df |>
- dplyr::filter(stringr::str_detect(census_var, "pct_pov"))
- }else{
- df <- demo_df |>
- dplyr::filter(stringr::str_detect(census_var, "pct_under18"))
- }
-
- #Convert from percent (ex 10.5%) to decimal (ex: .105)
- df <- dplyr::mutate(df, diff_data_city = diff_data_city / 100)
-
-
- #Edit string names:
- df <- df |>
- dplyr::mutate(census_var = janitor::make_clean_names(census_var, case = "title"),
- census_var = stringr::str_replace_all(census_var, "Pct", "Pct."),
- census_var = stringr::str_replace_all(census_var, "under18", "Under 18"),
- census_var = stringr::str_replace_all(census_var,"Unins", "Uninsured"),
- census_var = stringr::str_replace_all(census_var, "Hisp", "Hispanic"),
- census_var = stringr::str_replace_all(census_var, "under", "Under"),
- census_var = stringr::str_replace_all(census_var, "Unemp$", "Unemployed"),
- census_var = stringr::str_replace_all(census_var, "Cb", "Cost-Burdened"),
- census_var = stringr::str_replace_all(census_var, "Hh", "Household"),
- census_var = stringr::str_replace_all(census_var, "Bach", "Bachelors"),
- census_var = stringr::str_replace_all(census_var, "Pov ", "Poverty ")
- )
-
- # We get max value before filtering bc the limits of all 3 baseline_pops
- # should be equal for comparability
- max_val = max(abs(df$diff_data_city)) * 1.1
-
- df_plot <- df |>
- dplyr::mutate(
- pos_diff = dplyr::case_when(
- diff_data_city > 0 & sig_diff ~ "positive",
- diff_data_city < 0 & sig_diff ~ "negative",
- TRUE ~ "not_stat_sig"
+ # Other checks:
+ stopifnot(TRUE %in% endsWith(
+ file_path,
+ c(
+ "eps", "ps", "tex", "pdf", "jpeg",
+ "tiff", "png", "bmp", "svg", "wmf"
+ )
+ )) # file path is allowed by ggsave
+
+ df <- filter_baseline_group(
+ demo_df,
+ group = group
+ )
+
+ df <- fmt_pos_diff(df)
+
+ # Edit string names
+ df <- fmt_census_var_label(df, pct_abb = pct_abb)
+
+ # We get max value before filtering bc the limits of all 3 baseline_pops
+ # should be equal for comparability
+ max_val <- max(abs(df$diff_data_city)) * 1.1
+
+ demo_lollipop_plot <- plot_demo_lollipop(
+ data = df,
+ max_val = max_val
+ )
+
+ if (save_chart) {
+ rlang::exec(
+ ggplot2::ggsave,
+ filename = file_path,
+ plot = demo_lollipop_plot,
+ !!!ggsave_args
+ )
+ }
+
+ demo_lollipop_plot
+}
+
+#' Create geom for demographic lollipop plot
+#' @noRd
+plot_demo_lollipop <- function(data,
+ max_val,
+ ...,
+ labelled = TRUE,
+ plot_annotation = annotation_demo_lollipop(),
+ plot_theme = theme_demo_lollipop()) {
+ lollipop_plot <- ggplot2::ggplot(
+ data = data,
+ mapping = ggplot2::aes(y = census_var, x = diff_data_city)
+ )
+
+ lollipop_plot_labels <- list()
+
+ if (labelled) {
+ lollipop_plot_labels <- list(
+ # Put text to left/right of 0 line to match equity tool
+ ggplot2::geom_text(
+ data = dplyr::filter(data, diff_data_city >= 0),
+ ggplot2::aes(
+ x = max(diff_data_city) * -0.06,
+ y = census_var,
+ label = census_var
+ ),
+ hjust = "right",
+ size = 3
+ ),
+ ggplot2::geom_text(
+ data = dplyr::filter(data, diff_data_city < 0),
+ ggplot2::aes(
+ x = max(abs(diff_data_city)) * 0.06,
+ y = census_var,
+ label = census_var
+ ),
+ hjust = "left",
+ size = 3
+ )
+ )
+ }
+
+ lollipop_plot +
+ c(
+ list(
+ ggplot2::geom_vline(
+ xintercept = 0,
+ color = "#353535"
+ ),
+ geom_lollipop(
+ ggplot2::aes(
+ x = diff_data_city,
+ y = census_var,
+ color = pos_diff
),
- census_var = forcats::fct_reorder(census_var, diff_data_city)) |>
- dplyr::arrange(dplyr::desc(diff_data_city))
-
-
- last_var = df_plot |>
- dplyr::arrange(dplyr::desc(diff_data_city)) |>
- utils::tail(1) |>
- dplyr::pull(census_var) |>
- as.character()
- first_var = df_plot |>
- dplyr::arrange(dplyr::desc(diff_data_city)) |>
- utils::head(1) |>
- dplyr::pull(census_var) |>
- as.character()
-
- # Generate under/overrep labels to use in annotation_custom. This is the only
- # way we can set x and y relatively to full plot window instead of actual
- # axis numbers which vary with the data
- underrep_label = grid::textGrob(label = "Underrepresented", x = .02, y = 0.02,
- just = c("left", "top"),
- rot = 90,
- gp=grid::gpar(fontface = "bold",
- col = "#ca5800",
- fontsize = 18,
- alpha = .75
- ))
-
- overrep_label = grid::textGrob(label = "Overrepresented", x = .96, y = 0.98,
- just = c("right", "top"),
- rot = 90,
- gp=grid::gpar(fontface = "bold",
- col = "#1696d2",
- fontsize = 18,
- alpha = 0.75))
-
-
-
- plot <-
- df_plot |>
- ggplot2::ggplot(ggplot2::aes(y = census_var, x = diff_data_city)) +
- ggplot2::geom_vline(xintercept = 0,
- color = "#353535"
- ) +
- ggplot2::geom_segment(ggplot2::aes(x = 0,
- xend = diff_data_city,
- y = census_var,
- yend = census_var),
- color = "#9d9d9d"
- ) +
- ggplot2:: geom_point(ggplot2::aes(color = pos_diff),
- size = 3) +
- # Put text to left/right of 0 line to match equity tool
- ggplot2::geom_text(data = df_plot |>
- dplyr::filter(diff_data_city >= 0),
- ggplot2::aes(x = 0, y = census_var, label = census_var),
- nudge_x = -(max_val * 0.01),
- hjust = "right",
- size = 4) +
- ggplot2::geom_text(data = df_plot |>
- dplyr::filter(diff_data_city < 0),
- ggplot2::aes(x = 0, y = census_var, label = census_var),
- nudge_x = max_val * 0.01,
- hjust = "left",
- size = 4) +
- ggplot2::annotation_custom(underrep_label, xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf) +
- ggplot2::annotation_custom(overrep_label, xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf) +
- # ggplot2::scale_color_manual(values = c('positive' = urbnthemes::palette_urbn_diverging[1],
- # 'negative' = urbnthemes::palette_urbn_diverging[7])) +
- ggplot2::scale_x_continuous(position = "top",
- limits = c(-max_val, max_val),
- labels = scales::percent) +
- ggplot2::labs(y = "", x = "") +
- ggplot2::theme(panel.grid.major = ggplot2::element_blank(),
- panel.grid.minor = ggplot2::element_blank(),
- axis.ticks.y = ggplot2::element_blank(),
- axis.text.y = ggplot2::element_blank(),
- panel.background = ggplot2::element_rect(
- fill = "white",
- colour = "black"
- ),
- plot.margin = ggplot2::margin(
- r = 10,
- l = 5,
- t = 5,
- b = 5
- ),
- legend.position = "none") +
- ggplot2::scale_color_manual(values = c(
- "positive" = "#1696d2",
- "not_stat_sig" = "#7f7f7f",
- "negative" = "#ca5800"
- ))
-
- if(save_chart){
- ggplot2::ggsave(filename = file_path,
- plot = plot,
- width = 11,
- height = 8.5,
- units = "in")
- }
-
- return(plot)
- },
-
- #ERROR:
- error=function(e) {
- message('An Error Occurred')
- print(e)
- },
-
- #WARNING
- warning=function(w) {
- message('A Warning Occurred')
- print(w)
- return(NA)
- }
+ size = 2
+ ),
+ ggplot2::scale_x_continuous(
+ position = "top",
+ limits = c(-max_val, max_val),
+ labels = scales::label_percent(scale = 1)
+ ),
+ ggplot2::labs(y = "", x = ""),
+ scale_color_demo_pos_diff()
+ ),
+ lollipop_plot_labels,
+ plot_annotation,
+ plot_theme
+ )
+}
+
+#' ggplot2 theme for create_demo_chart function
+#' @inheritParams ggplot2::theme
+#' @param ... Additional parameters passed to [ggplot2::theme()]
+#' @noRd
+theme_demo_lollipop <- function(
+ plot.margin = ggplot2::margin(
+ t = 5, r = 10, b = 5, l = 5
+ ),
+ panel.background = ggplot2::element_rect(
+ fill = "white",
+ colour = "black"
+ ),
+ legend.position = "none",
+ ...) {
+ list(
+ ggplot2::theme(
+ panel.grid.major = ggplot2::element_blank(),
+ panel.grid.minor = ggplot2::element_blank(),
+ axis.ticks.y = ggplot2::element_blank(),
+ axis.text.y = ggplot2::element_blank(),
+ panel.background = panel.background,
+ plot.margin = plot.margin,
+ legend.position = legend.position,
+ ),
+ ggplot2::theme(
+ ...
+ )
+ )
+}
+
+#' @noRd
+demo_text_label <- function(
+ label = "Underrepresented",
+ x = .02,
+ y = 0.02,
+ just = c("left", "top"),
+ rot = 90,
+ font_face = "bold",
+ font_color = "#ca5800",
+ font_size = 18,
+ font_alpha = 0.75,
+ ...) {
+ grid::textGrob(
+ label = label,
+ x = x,
+ y = y,
+ just = just,
+ rot = rot,
+ gp = grid::gpar(
+ fontface = font_face,
+ col = font_color,
+ fontsize = font_size,
+ alpha = font_alpha
+ ),
+ ...
+ )
+}
+#' Annotations for create_demo_chart function
+#' @noRd
+annotation_demo_lollipop <- function() {
+ # Generate under/overrep labels to use in annotation_custom. This is the only
+ # way we can set x and y relatively to full plot window instead of actual
+ # axis numbers which vary with the data
+ list(
+ ggplot2::annotation_custom(
+ demo_text_label(
+ label = "Underrepresented",
+ x = 0.02,
+ y = 0.02,
+ just = c("left", "top"),
+ font_color = "#ca5800"
+ ),
+ xmin = -Inf,
+ xmax = Inf,
+ ymin = -Inf,
+ ymax = Inf
+ ),
+ ggplot2::annotation_custom(
+ demo_text_label(
+ label = "Overrepresented",
+ x = 0.96,
+ y = 0.98,
+ just = c("right", "top"),
+ font_color = "#1696d2"
+ ),
+ xmin = -Inf,
+ xmax = Inf,
+ ymin = -Inf,
+ ymax = Inf
+ )
+ )
+}
+
+#' Scale color based on pos_diff column derived by `fmt_diff_data_city()`
+#' @noRd
+scale_color_demo_pos_diff <- function(
+ values = c(
+ "positive" = "#1696d2",
+ "not_stat_sig" = "#7f7f7f",
+ "negative" = "#ca5800"
+ ),
+ ...,
+ aesthetics = c("color", "fill")) {
+ ggplot2::scale_color_manual(
+ values = values,
+ aesthetics = aesthetics,
+ ...
)
+}
+#' Use sig_diff and diff_data_city to derive pos_diff column
+#' @noRd
+fmt_pos_diff <- function(data) {
+ data |>
+ dplyr::mutate(
+ pos_diff = dplyr::case_when(
+ !sig_diff ~ "not_stat_sig",
+ diff_data_city > 0 ~ "positive",
+ diff_data_city < 0 ~ "negative"
+ )
+ )
+}
+
+#' Shorten census_var column
+#' @noRd
+fmt_census_var_label <- function(data, pct_abb = "Pct.", call = caller_env()) {
+ check_installed(
+ c("forcats", "dplyr"),
+ reason = "to create plots with `create_demo_chart()`",
+ call = call
+ )
+
+ dplyr::mutate(
+ data,
+ census_var = str_to_label(census_var, case = "title"),
+ census_var = stringr::str_replace_all(census_var, "Pct", pct_abb),
+ census_var = stringr::str_replace_all(census_var, "under18", "Under 18"),
+ census_var = stringr::str_replace_all(census_var, "Unins", "Uninsured"),
+ census_var = stringr::str_replace_all(census_var, "Hisp", "Hispanic"),
+ census_var = stringr::str_replace_all(census_var, "under", "Under"),
+ census_var = stringr::str_replace_all(census_var, "Unemp$", "Unemployed"),
+ census_var = stringr::str_replace_all(census_var, "Cb", "Cost-Burdened"),
+ census_var = stringr::str_replace_all(census_var, "Hs ", "HS "),
+ census_var = stringr::str_replace_all(census_var, "Hh", "Household"),
+ census_var = stringr::str_replace_all(census_var, "Bach", "Bachelors"),
+ census_var = stringr::str_replace_all(census_var, "Pov ", "Poverty "),
+ census_var = forcats::fct_reorder(census_var, diff_data_city)
+ )
+}
+
+#' Match baseline group value
+#' @noRd
+match_baseline_group <- function(group, error_call = caller_env()) {
+ arg_match0(group, c("total", "poverty", "under18"), error_call = error_call)
+}
+
+#' Filter data to baseline group variable
+#' @noRd
+filter_baseline_group <- function(
+ data,
+ group = c("total", "poverty", "under18"),
+ call = caller_env()) {
+ group <- match_baseline_group(group, error_call = call)
+
+ data |>
+ dplyr::filter(
+ stringr::str_detect(baseline_pop, group)
+ )
}
diff --git a/R/create_map.R b/R/create_map.R
index 443ee26..42658e4 100644
--- a/R/create_map.R
+++ b/R/create_map.R
@@ -1,41 +1,40 @@
-#' Function to create a choropleth map to visualize the geographic disparity scores
+#' Create a chloropleth map to visualize the geographic disparity scores
+#'
+#' [create_map()] uses `{tmap}` and `{urbnthemes}` to create a chloropleth map
+#' to visualize the geographic disparity scores returned with the response
+#' object from [call_sedt_api()].
#'
#' @param geo_df (sf dataframe) - a spatial dataframe containing the geographic
#' disparity scores outputted from the Spatial Equity Data Tool.
#' @param col_to_plot (string) - The column in the geo_df to plot in
#' choropleth map.
+#' @param pkg (string) Package to use when creating the map. One of "tmap"
+#' (default) or "ggplot2".
+#' @param interactive (logical) - Default set to TRUE. Whether the map should be
+#' interactive or not.
#' @param save_map (logical) - Default set to FALSE. Whether to save the chart
-#' or not. Note that if interactive is set to true, the map will save as a
-#' .html. Otherwise, the map will save as a .png.
-#' @param interactive (logical) - Default set to TRUE. Whether the map should
-#' be interactive or not.
+#' or not. Note that if `interactive = TRUE` and `pkg = "tmap"`, the map will
+#' save as a .html. Otherwise, the map will save as a .png.
#' @param file_path (character) - Default set to "bias_map". A file path of where
#' to save the file. This should not include a file type as that is controlled
#' by the interactive variable. An example file-path would be,
#' "visuals/interactives/disparity_map".
-#' @return bias_map (tmap map) - the choropleth map created
+#' @return bias_map (tmap map or ggplot2 plot) - the choropleth map created
+#' @inherit sedt-citation details
#' @export
-#' @details
-#' Please use the following citation for data obtained from the API,
-#' replacing the version number with the current version:
-#'
-#' Stern, Alena, Gabe Morrison, Sonia Torres Rodríguez, Ajjit Narayanan, and Graham MacDonald. 2024.
-#' “Spatial Equity Data Tool API” (Version X.x.x). Washington, DC: Urban Institute.
-#' https://ui-research.github.io/sedt_documentation/. Data originally sourced from various sources,
-#' analyzed at the Urban Institute and made available under the ODC Attribution License.
-
create_map <- function(geo_df,
col_to_plot = "diff_pop",
- save_map = FALSE,
+ ...,
+ pkg = "tmap",
interactive = TRUE,
- file_path = "bias_map"
-
- ){
-
- rlang::check_installed(
- c("tmap", "dplyr", "janitor", "urbnthemes"),
- reason = "to use the `create_map()` function. If urbnthemes not installed, we use RdBu color palette"
- )
+ save_map = FALSE,
+ save_args = list(),
+ file_path = "bias_map",
+ file_ext = "png") {
+ check_installed(
+ c("dplyr"),
+ reason = "to use the `create_map()` function. If urbnthemes not installed, we use RdBu color palette."
+ )
# Choose color palette:
if (rlang::is_installed("urbnthemes")) {
@@ -44,88 +43,225 @@ create_map <- function(geo_df,
pal <- "RdBu"
}
-
- #Check all Inputs for correct types:
+ # Check all Inputs for correct types:
stopifnot("sf" %in% class(geo_df))
stopifnot(is.logical(save_map))
stopifnot(is.logical(interactive))
stopifnot(is.character(file_path))
- #Check that col_to_plot is a column in the geo_df
+ # Check that col_to_plot is a column in the geo_df
stopifnot(col_to_plot %in% colnames(geo_df))
-
tryCatch(
- #TRY:
+ # TRY:
{
- #Set file suffix for saving the chart and set tmap to interactive if
+ # Set file suffix for saving the chart and set tmap to interactive if
# interactive is true
- file_suffix = ".png"
- if(interactive){
- tmap::tmap_mode("view")
- file_suffix = ".html"
- } else{
- tmap::tmap_mode("plot")
- file_suffix = ".png"
+ if (interactive && pkg == "tmap") {
+ file_ext <- "html"
}
- # replace observations that are not significantly different with NA
- # multiply by 100 to convert to percentage
- geo_df <- geo_df |>
- dplyr::mutate(!!rlang::sym(col_to_plot) :=
- dplyr::if_else(!!rlang::sym(stringr::str_glue("sig_{col_to_plot}")) == "FALSE",
- NA_real_,
- !!rlang::sym(col_to_plot)*100
- )
- )
-
- # Avoid possible errors by ensuring geometry is valid
- valid_geo_df <- sf::st_make_valid(geo_df)
-
- # Remove empty units to avoid warning. This is caused by tracts that do not have
- # an associated geometry.
- valid_geo_df <- valid_geo_df[!sf::st_is_empty(valid_geo_df),]
-
- bias_map <-
- tmap::tm_basemap("CartoDB.PositronNoLabels") +
- tmap::tm_shape(valid_geo_df) +
- tmap::tm_fill(col = col_to_plot,
- palette = pal,
- midpoint = 0,
- legend.show = TRUE,
- id = "id_col",
- title = "Disparity Score",
- textNA = "Not Stat. Sig.",
- legend.format= list(
- fun=function(x) paste0(formatC(x, digits=1, format="f"), " %")
- )
- ) +
- tmap::tm_borders(lwd = .25) +
- tmap::tm_tiles("CartoDB.PositronOnlyLabels") +
- tmap::tm_layout(legend.outside = TRUE,
- attr.outside = TRUE,
- title = janitor::make_clean_names(string = col_to_plot, case = "title")
- )
-
- if(save_map){
- tmap::tmap_save(tm = bias_map,
- filename = stringr::str_c(file_path, file_suffix))
+ pkg <- arg_match0(pkg, c("tmap", "ggplot2"))
+
+ if (pkg == "tmap") {
+ bias_map <- tm_plot_geo_bias_map(
+ data = geo_df,
+ fill_col = col_to_plot,
+ fill_palette = pal,
+ interactive = interactive,
+ ...
+ )
+ } else {
+ bias_map <- plot_geo_bias_map(
+ data = geo_df,
+ fill_col = col_to_plot,
+ fill_palette = pal,
+ ...
+ )
+ }
+
+ if (save_map) {
+ filename <- stringr::str_c(file_path, ".", file_ext)
+
+ if (pkg == "tmap") {
+ tmap::tmap_save(
+ tm = bias_map,
+ filename = filename,
+ !!!save_args
+ )
+ } else {
+ ggplot2::ggsave(
+ plot = bias_map,
+ filename = filename,
+ !!!save_args
+ )
+ }
}
+
return(bias_map)
},
- #CATCH ERROR:
- error = function(e){
+ # CATCH ERROR:
+ error = function(e) {
message("An Error Occurred")
print(e)
},
- #HANDLE WARNING:
- warning = function(w){
+ # HANDLE WARNING:
+ warning = function(w) {
message("A Warning Occured")
print(w)
return(NA)
}
-
)
+}
+#' Plot a map of geo bias data with `{tmap}` or `{ggplot2}`
+#'
+#' [tm_plot_geo_bias_map()] and [plot_geo_bias_map()] are internal plotting
+#' functions called by the more generic [create_map()] function.
+#'
+#' @param fill_col String with column name to map to fill.
+#' @param fill_label Label to use for fill column. Passed as title for
+#' [tmap::tm_fill()] or fill label for [ggplot2::labs()].
+#' @param fill_palette String with palette name.
+#' @name geo_bias_map
+NULL
+
+#' [tm_plot_geo_bias_map()] uses [tmap::tm_shape()] and [tmap::tm_fill()] to map
+#' the geo bias data returned by [call_sedt_api()].
+#' @inheritParams tmap::tm_layout
+#' @keywords internal
+#' @export
+tm_plot_geo_bias_map <- function(
+ data,
+ fill_col = "diff_pop",
+ fill_label = "Disparity Score",
+ basemap_server = "CartoDB.PositronNoLabels",
+ border_lwd = 0.25,
+ fill_palette = "RdBu",
+ title = NULL,
+ legend.outside = TRUE,
+ attr.outside = TRUE,
+ interactive = FALSE,
+ ...) {
+ check_installed("tmap")
+
+ if (interactive) {
+ tmap::tmap_mode("view")
+ } else {
+ tmap::tmap_mode("plot")
+ }
+
+ data <- data |>
+ fmt_col_to_plot() |>
+ prep_geo_df()
+
+ bias_map <- tmap::tm_basemap(
+ server = basemap_server
+ ) +
+ tmap::tm_shape(data) +
+ tmap::tm_fill(
+ col = fill_col,
+ palette = fill_palette,
+ midpoint = 0,
+ legend.show = TRUE,
+ id = "id_col",
+ title = fill_label,
+ textNA = "Not Stat. Sig.",
+ legend.format = list(
+ fun = function(x) {
+ paste0(
+ formatC(x, digits = 1, format = "f"),
+ " %"
+ )
+ }
+ )
+ ) +
+ tmap::tm_borders(
+ lwd = border_lwd
+ ) +
+ tmap::tm_tiles(
+ server = basemap_server
+ ) +
+ tmap::tm_layout(
+ legend.outside = legend.outside,
+ attr.outside = attr.outside,
+ title = title %||% str_to_label(
+ string = fill_col,
+ case = "title"
+ )
+ )
+
+ bias_map
}
+
+#' [plot_geo_bias_map()] uses [ggplot2::geom_sf()] to map the geo bias data
+#' returned by [call_sedt_api()].
+#' @rdname geo_bias_map
+#' @param fill_scale ggplot2 scale function to use with map.
+#' @param plot_theme ggplot2 theme to use with map.
+#' @keywords internal
+#' @export
+plot_geo_bias_map <- function(
+ data,
+ fill_col = "diff_pop",
+ fill_label = "Disparity Score",
+ fill_palette = "RdBu",
+ fill_scale = ggplot2::scale_fill_distiller(
+ type = "div",
+ palette = fill_palette,
+ labels = scales::label_percent(scale = 1),
+ direction = 1
+ ),
+ plot_theme = ggplot2::theme_void()) {
+ geo_df <- data |>
+ fmt_col_to_plot(
+ col_to_plot = fill_col
+ ) |>
+ prep_geo_df()
+
+ check_installed("ggplot2")
+
+ ggplot2::ggplot(data = geo_df) +
+ ggplot2::geom_sf(
+ ggplot2::aes(fill = .data[[fill_col]]),
+ color = "white"
+ ) +
+ fill_scale +
+ plot_theme +
+ ggplot2::labs(
+ fill = fill_label
+ )
+}
+
+#' Format column to plot on map
+#' @noRd
+fmt_col_to_plot <- function(data, col_to_plot = "diff_pop") {
+ check_installed("dplyr")
+
+ data |>
+ dplyr::mutate(
+ !!sym(col_to_plot) := dplyr::if_else(
+ # Replace observations that are not significantly different with NA
+ !!sym(stringr::str_glue("sig_{col_to_plot}")) == "FALSE",
+ NA_real_,
+ # Otherwise multiply by 100 to convert to percentage
+ !!sym(col_to_plot) * 100
+ )
+ )
+}
+
+#' Prep a sf data frame by ensuring valid geometry and dropping empty geometry
+#' @noRd
+prep_geo_df <- function(data) {
+ check_installed("dplyr")
+
+ data |>
+ # Ensure geometry is valid to avoid possible errors
+ sf::st_make_valid() |>
+ dplyr::filter(
+ # Remove empty units to avoid warning from tracts with no associated
+ # geometry.
+ !sf::st_is_empty(.data[[attr(data, "sf_column")]])
+ )
+}
diff --git a/R/sedtR-package.R b/R/sedtR-package.R
new file mode 100644
index 0000000..d248733
--- /dev/null
+++ b/R/sedtR-package.R
@@ -0,0 +1,7 @@
+#' @keywords internal
+"_PACKAGE"
+
+## usethis namespace: start
+#' @import rlang
+## usethis namespace: end
+NULL
diff --git a/R/utils-ggplot2.R b/R/utils-ggplot2.R
new file mode 100644
index 0000000..dda8f69
--- /dev/null
+++ b/R/utils-ggplot2.R
@@ -0,0 +1,98 @@
+#' @noRd
+GeomLollipop <- ggplot2::ggproto("GeomLollipop", ggplot2::Geom,
+
+ required_aes = c("x", "y"),
+
+ default_aes = ggplot2::aes(
+ xend = 0,
+ colour = "black",
+ linewidth = .5,
+ size = 1,
+ linetype = 1,
+ shape = 19,
+ fill = NA,
+ alpha = NA,
+ stroke = 1
+ ),
+
+ draw_panel = function(data, panel_params, coord, ...) {
+ # Return both the line and point components
+ grid::gList(
+ ggplot2::GeomSegment$draw_panel(data, panel_params, coord, ...),
+ ggplot2::GeomPoint$draw_panel(transform(data), panel_params, coord, ...)
+ )
+ }
+)
+
+#' @noRd
+geom_lollipop <- function(mapping = NULL, data = NULL,
+ stat = "identity", position = "identity",
+ ..., na.rm = FALSE, show.legend = NA,
+ inherit.aes = TRUE) {
+ ggplot2::layer(
+ data = data,
+ mapping = mapping,
+ geom = GeomLollipop,
+ stat = stat,
+ position = position,
+ show.legend = show.legend,
+ inherit.aes = inherit.aes,
+ params = list(na.rm = na.rm, ...)
+ )
+}
+#'
+#' @noRd
+GeomBarbell <- ggplot2::ggproto("GeomBarbell", ggplot2::Geom,
+
+ required_aes = c("x", "y", "xend|yend"),
+
+ default_aes = ggplot2::aes(
+ xend = 0,
+ yend = 0,
+ colour = "black",
+ # linewidth = ggplot2::from_theme(linewidth),
+ size = 1,
+ linetype = 1,
+ shape = 19,
+ fill = NA,
+ alpha = NA,
+ stroke = 1
+ ),
+
+ draw_panel = function(data, panel_params, coord, ...) {
+ # Transformed data for the points
+ point1 <- transform(data)
+ point2 <- transform(data, x = xend, y = yend)
+
+ # Return all three components
+ grid::gList(
+ ggplot2::GeomSegment$draw_panel(data, panel_params, coord, ...),
+ ggplot2::GeomPoint$draw_panel(point1, panel_params, coord, ...),
+ ggplot2::GeomPoint$draw_panel(point2, panel_params, coord, ...)
+ )
+ }
+)
+
+#' @noRd
+geom_barbell <- function(mapping = NULL, data = NULL,
+ stat = "identity", position = "identity",
+ ..., na.rm = FALSE, show.legend = NA,
+ inherit.aes = TRUE) {
+ ggplot2::layer(
+ data = data,
+ mapping = mapping,
+ geom = GeomBarbell,
+ stat = stat,
+ position = position,
+ show.legend = show.legend,
+ inherit.aes = inherit.aes,
+ params = list(na.rm = na.rm, ...)
+ )
+}
+
+# https://github.com/aphalo/ggpmisc
+#' @noRd
+symmetric_limits <- function (x) {
+ max <- max(abs(x))
+ c(-max, max)
+}
diff --git a/R/utils.R b/R/utils.R
index 96811f6..941741a 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -1,3 +1,17 @@
+#' Citation for Spatial Equity Data Tool API Data
+#'
+#' @name sedt-citation
+#' @details
+#' Please use the following citation for data obtained from the API:
+#'
+#' Stern, Alena, Gabe Morrison, Sonia Torres Rodríguez, Ajjit Narayanan, and
+#' Graham MacDonald. 2024. “Spatial Equity Data Tool API” (Version
+#' `r utils::packageVersion("sedtR")`). Washington, DC: Urban Institute.
+#' . Data originally sourced
+#' from various sources, analyzed at the Urban Institute and made available
+#' under the ODC Attribution License.
+NULL
+
#' Get API Response
#'
#' Calls call_upload_user_files() for a given file path, lat col,
@@ -125,3 +139,17 @@ get_api_results <- function(file_id) {
}
}
+
+#' @noRd
+str_to_label <- function(string, case = "title", locale = "en") {
+ case <- arg_match(case, c("title", "upper", "lower", "sentence"))
+ label <- stringr::str_replace_all(string, "_", " ")
+
+ switch (case,
+ title = stringr::str_to_title(label, locale),
+ upper = stringr::str_to_upper(label, locale),
+ lower = stringr::str_to_lower(label, locale),
+ sentence = stringr::str_to_sentence(label, locale)
+ )
+}
+
diff --git a/README.Rmd b/README.Rmd
index f773921..68e7143 100644
--- a/README.Rmd
+++ b/README.Rmd
@@ -85,19 +85,35 @@ sedt_response$demo_bias_data |>
head()
```
-The package allows users to visualize the geographic disparity scores and demographic disparity scores with `create_map()` and `create_demo_chart()`, respectively. By default, these functions do not save the resulting images, but both provide arguments (`save_map` and `save_chart`) which take logicals and allow a user to save the outputted visualization. Like the interactive visualizations on the [SEDT website] (https://apps.urban.org/features/equity-data-tool/), these functions allow users to visualize different geographic or demographic disparity scores. `create_map()` allows interactive or static visualizations.
+The package allows users to visualize the geographic disparity scores and demographic disparity scores with `create_map()` and `create_demo_chart()`, respectively. By default, these functions do not save the resulting images, but both provide arguments (`save_map` and `save_chart`) which take logicals and allow a user to save the outputted visualization. Like the interactive visualizations on the [SEDT website] (https://apps.urban.org/features/equity-data-tool/), these functions allow users to visualize different geographic or demographic disparity scores.
+
+`create_map()` allows interactive or static visualizations. By default, `create_map()` uses `{tmap}`:
```{r}
-create_map(sedt_response$geo_bias_data,
- interactive = FALSE, # optional, defaults to TRUE
- save_map = FALSE, #optional, defaults to FALSE. If TRUE, provide file_path
- col_to_plot = "diff_pop") #optional, default is "diff_pop"
+create_map(
+ sedt_response$geo_bias_data,
+ interactive = FALSE, # optional, defaults to TRUE
+ save_map = FALSE, # optional, defaults to FALSE. If TRUE, provide file_path
+ col_to_plot = "diff_pop" # optional, default is "diff_pop"
+)
```
+
```{r}
-create_demo_chart(sedt_response$demo_bias_data,
- group = "total", # optional, default is "total"
- save_chart = FALSE) # optional, default is FALSE. If TRUE provide file_path
+plot_geo_bias_map(
+ sedt_response$geo_bias_data,
+ fill_col = "diff_pop"
+)
+```
+
+
+```{r}
+create_demo_chart(
+ sedt_response$demo_bias_data,
+ group = "total", # optional, default is "total"
+ save_chart = FALSE,
+ pct_abb = "%" # optional, default is FALSE. If TRUE provide file_path
+)
```
## Where Can I Learn More:
diff --git a/README.md b/README.md
index dcbc7c8..bae7aee 100644
--- a/README.md
+++ b/README.md
@@ -67,7 +67,7 @@ The following example illustrates using the `call_sedt_api()` function
on Minneapolis, MN bikeshare data stored on the Urban Institute’s [Data
Catalog](https://datacatalog.urban.org/).
- #> Loading sedtR - using staging API
+ #> Loading sedtR - using production API
#> [1] "getting output file"
`call_sedt_api()` returns a list object that contains a `sf` object
@@ -76,55 +76,34 @@ storing the geographic disparity scores:
``` r
sedt_response$geo_bias_data |>
head()
-#> prop_cb_renter_hh diff_no_internet prop_pov diff_pov
-#> 1 0.00049 -0.006 0.00345 -0.003
-#> 2 0.00937 -0.008 0.01036 -0.005
-#> 3 0.00158 -0.007 0.00721 -0.007
-#> 4 0.00316 -0.007 0.00515 -0.005
-#> 5 0.00024 -0.006 0.00160 -0.002
-#> 6 0.00487 0.001 0.00384 -0.001
-#> disp_name sig_diff_seniors diff_seniors diff_pop
-#> 1 Census Tract 1.01, Minneapolis, MN TRUE -0.007 -0.008
-#> 2 Census Tract 1.02, Minneapolis, MN FALSE -0.004 -0.007
-#> 3 Census Tract 3, Minneapolis, MN TRUE -0.008 -0.008
-#> 4 Census Tract 6.01, Minneapolis, MN TRUE -0.015 -0.011
-#> 5 Census Tract 6.03, Minneapolis, MN TRUE -0.007 -0.008
-#> 6 Census Tract 11, Minneapolis, MN FALSE 0.000 -0.002
-#> GEOID prop_children prop_pop diff_children diff_cb_renter_hh data_prop
-#> 1 27053000101 0.01043 0.00786 -0.010 0.000 0.00000
-#> 2 27053000102 0.01378 0.01152 -0.009 -0.004 0.00506
-#> 3 27053000300 0.00746 0.00753 -0.007 -0.002 0.00000
-#> 4 27053000601 0.01193 0.01091 -0.012 -0.003 0.00000
-#> 5 27053000603 0.00486 0.00761 -0.005 0.000 0.00000
-#> 6 27053001100 0.00533 0.00493 -0.002 -0.002 0.00253
-#> prop_no_internet diff_under_200_poverty_line prop_seniors
-#> 1 0.00552 -0.008 0.00684
-#> 2 0.01252 -0.010 0.00938
-#> 3 0.00728 -0.006 0.00799
-#> 4 0.00735 -0.009 0.01453
-#> 5 0.00622 -0.002 0.00700
-#> 6 0.00198 -0.002 0.00330
-#> prop_under_200_poverty_line sig_diff_cb_renter_hh sig_diff_children
-#> 1 0.00809 FALSE TRUE
-#> 2 0.01458 FALSE TRUE
-#> 3 0.00563 FALSE TRUE
-#> 4 0.00855 FALSE TRUE
-#> 5 0.00243 FALSE TRUE
-#> 6 0.00517 FALSE FALSE
-#> sig_diff_no_internet sig_diff_pop sig_diff_pov
-#> 1 FALSE TRUE FALSE
-#> 2 FALSE TRUE FALSE
-#> 3 FALSE TRUE TRUE
-#> 4 TRUE TRUE TRUE
-#> 5 TRUE TRUE FALSE
-#> 6 FALSE TRUE FALSE
-#> sig_diff_under_200_poverty_line weighted_counts
-#> 1 TRUE 0
-#> 2 TRUE 2
-#> 3 TRUE 0
-#> 4 TRUE 0
-#> 5 TRUE 0
-#> 6 FALSE 1
+#> sig_diff_seniors data_prop diff_cb_renter_hh diff_pop prop_children
+#> 1 TRUE 0.00000 0.000 -0.008 0.01043
+#> 2 FALSE 0.00506 -0.004 -0.007 0.01378
+#> 3 TRUE 0.00000 -0.002 -0.008 0.00746
+#> 4 TRUE 0.00000 -0.003 -0.011 0.01193
+#> 5 TRUE 0.00000 0.000 -0.008 0.00486
+#> 6 FALSE 0.00253 -0.002 -0.002 0.00533
+#> diff_no_internet diff_under_200_poverty_line GEOID diff_pov
+#> 1 -0.006 -0.008 27053000101 -0.003
+#> 2 -0.008 -0.010 27053000102 -0.005
+#> 3 -0.007 -0.006 27053000300 -0.007
+#> 4 -0.007 -0.009 27053000601 -0.005
+#> 5 -0.006 -0.002 27053000603 -0.002
+#> 6 0.001 -0.002 27053001100 -0.001
+#> diff_seniors diff_children prop_under_200_poverty_line prop_cb_renter_hh
+#> 1 -0.007 -0.010 0.00809 0.00049
+#> 2 -0.004 -0.009 0.01458 0.00937
+#> 3 -0.008 -0.007 0.00563 0.00158
+#> 4 -0.015 -0.012 0.00855 0.00316
+#> 5 -0.007 -0.005 0.00243 0.00024
+#> 6 0.000 -0.002 0.00517 0.00487
+#> prop_no_internet prop_pop
+#> 1 0.00552 0.00786
+#> 2 0.01252 0.01152
+#> 3 0.00728 0.00753
+#> 4 0.00735 0.01091
+#> 5 0.00622 0.00761
+#> 6 0.00198 0.00493
#> geometry
#> 1 -93.31950, -93.31419, -93.30431, -93.29919, -93.29921, -93.29906, -93.30668, -93.31943, -93.31943, -93.31944, -93.31950, 45.05125, 45.05124, 45.05118, 45.05114, 45.04392, 45.03766, 45.03935, 45.04217, 45.04397, 45.04760, 45.05125
#> 2 -93.29919, -93.29409, -93.29153, -93.28223, -93.28083, -93.28343, -93.28321, -93.28270, -93.28673, -93.28811, -93.28811, -93.29041, -93.29403, -93.29489, -93.29906, -93.29921, -93.29919, 45.05114, 45.05113, 45.05113, 45.05116, 45.04357, 45.03536, 45.03345, 45.03243, 45.03151, 45.03151, 45.03272, 45.03473, 45.03646, 45.03674, 45.03766, 45.04392, 45.05114
@@ -132,6 +111,27 @@ sedt_response$geo_bias_data |>
#> 4 -93.26411, -93.26238, -93.26210, -93.25998, -93.25992, -93.24985, -93.24739, -93.24218, -93.23711, -93.23711, -93.23712, -93.23712, -93.23711, -93.24748, -93.24734, -93.26071, -93.26311, -93.26269, -93.26411, 45.02760, 45.02760, 45.02944, 45.03051, 45.03554, 45.03555, 45.03555, 45.03558, 45.03561, 45.02766, 45.02405, 45.02397, 45.02044, 45.02038, 45.01677, 45.01682, 45.01682, 45.02101, 45.02760
#> 5 -93.23712, -93.23711, -93.23711, -93.22693, -93.22690, -93.22690, -93.22688, -93.22687, -93.22686, -93.22686, -93.22961, -93.23328, -93.23712, -93.23712, 45.02405, 45.02766, 45.03561, 45.03567, 45.02773, 45.02771, 45.02410, 45.02047, 45.01951, 45.01892, 45.01922, 45.02226, 45.02397, 45.02405
#> 6 -93.24748, -93.23711, -93.23713, -93.23715, -93.24225, -93.24734, -93.24734, -93.24748, 45.02038, 45.02044, 45.01682, 45.01320, 45.01318, 45.01316, 45.01677, 45.02038
+#> prop_pov prop_seniors sig_diff_cb_renter_hh sig_diff_children sig_diff_pop
+#> 1 0.00345 0.00684 FALSE TRUE TRUE
+#> 2 0.01036 0.00938 FALSE TRUE TRUE
+#> 3 0.00721 0.00799 FALSE TRUE TRUE
+#> 4 0.00515 0.01453 FALSE TRUE TRUE
+#> 5 0.00160 0.00700 FALSE TRUE TRUE
+#> 6 0.00384 0.00330 FALSE FALSE TRUE
+#> sig_diff_no_internet sig_diff_pov disp_name
+#> 1 FALSE FALSE Census Tract 1.01, Minneapolis, MN
+#> 2 FALSE FALSE Census Tract 1.02, Minneapolis, MN
+#> 3 FALSE TRUE Census Tract 3, Minneapolis, MN
+#> 4 TRUE TRUE Census Tract 6.01, Minneapolis, MN
+#> 5 TRUE FALSE Census Tract 6.03, Minneapolis, MN
+#> 6 FALSE FALSE Census Tract 11, Minneapolis, MN
+#> sig_diff_under_200_poverty_line weighted_counts
+#> 1 TRUE 0
+#> 2 TRUE 2
+#> 3 TRUE 0
+#> 4 TRUE 0
+#> 5 TRUE 0
+#> 6 FALSE 1
```
A data frame with demographic information used in the analysis is also
@@ -171,27 +171,43 @@ save the resulting images, but both provide arguments (`save_map` and
visualization. Like the interactive visualizations on the \[SEDT
website\] (), these
functions allow users to visualize different geographic or demographic
-disparity scores. `create_map()` allows interactive or static
-visualizations.
+disparity scores.
+
+`create_map()` allows interactive or static visualizations. By default,
+`create_map()` uses `{tmap}`:
``` r
-create_map(sedt_response$geo_bias_data,
- interactive = FALSE, # optional, defaults to TRUE
- save_map = FALSE, #optional, defaults to FALSE. If TRUE, provide file_path
- col_to_plot = "diff_pop") #optional, default is "diff_pop"
+create_map(
+ sedt_response$geo_bias_data,
+ interactive = FALSE, # optional, defaults to TRUE
+ save_map = FALSE, # optional, defaults to FALSE. If TRUE, provide file_path
+ col_to_plot = "diff_pop" # optional, default is "diff_pop"
+)
#> tmap mode set to plotting
```
``` r
-create_demo_chart(sedt_response$demo_bias_data,
- group = "total", # optional, default is "total"
- save_chart = FALSE) # optional, default is FALSE. If TRUE provide file_path
+plot_geo_bias_map(
+ sedt_response$geo_bias_data,
+ fill_col = "diff_pop"
+)
```
+``` r
+create_demo_chart(
+ sedt_response$demo_bias_data,
+ group = "total", # optional, default is "total"
+ save_chart = FALSE,
+ pct_abb = "%" # optional, default is FALSE. If TRUE provide file_path
+)
+```
+
+
+
## Where Can I Learn More:
The Spatial Equity Data Tool has comprehensive documentation in the form
diff --git a/man/create_demo_chart.Rd b/man/create_demo_chart.Rd
index 33a27b8..d50239f 100644
--- a/man/create_demo_chart.Rd
+++ b/man/create_demo_chart.Rd
@@ -7,8 +7,11 @@
create_demo_chart(
demo_df,
group = "total",
+ ...,
save_chart = FALSE,
- file_path = "dem_disparity_chart.png"
+ file_path = "dem_disparity_chart.png",
+ pct_abb = "Pct.",
+ ggsave_args = list(width = 11, height = 8.5, units = "in")
)
}
\arguments{
@@ -33,11 +36,12 @@ plot (ggplot object) - The ggplot object that was created.
Function to visualize demographic disparity scores on a lollipop chart
}
\details{
-Please use the following citation for data obtained from the API,
-replacing the version number with the current version:
+Please use the following citation for data obtained from the API:
-Stern, Alena, Gabe Morrison, Sonia Torres Rodríguez, Ajjit Narayanan, and Graham MacDonald. 2024.
-“Spatial Equity Data Tool API” (Version X.x.x). Washington, DC: Urban Institute.
-https://ui-research.github.io/sedt_documentation/. Data originally sourced from various sources,
-analyzed at the Urban Institute and made available under the ODC Attribution License.
+Stern, Alena, Gabe Morrison, Sonia Torres Rodríguez, Ajjit Narayanan, and
+Graham MacDonald. 2024. “Spatial Equity Data Tool API” (Version
+0.0.0.4000). Washington, DC: Urban Institute.
+\url{https://ui-research.github.io/sedt_documentation/}. Data originally sourced
+from various sources, analyzed at the Urban Institute and made available
+under the ODC Attribution License.
}
diff --git a/man/create_map.Rd b/man/create_map.Rd
index 5df82c1..f0cca1a 100644
--- a/man/create_map.Rd
+++ b/man/create_map.Rd
@@ -2,14 +2,18 @@
% Please edit documentation in R/create_map.R
\name{create_map}
\alias{create_map}
-\title{Function to create a choropleth map to visualize the geographic disparity scores}
+\title{Create a chloropleth map to visualize the geographic disparity scores}
\usage{
create_map(
geo_df,
col_to_plot = "diff_pop",
- save_map = FALSE,
+ ...,
+ pkg = "tmap",
interactive = TRUE,
- file_path = "bias_map"
+ save_map = FALSE,
+ save_args = list(),
+ file_path = "bias_map",
+ file_ext = "png"
)
}
\arguments{
@@ -19,12 +23,15 @@ disparity scores outputted from the Spatial Equity Data Tool.}
\item{col_to_plot}{(string) - The column in the geo_df to plot in
choropleth map.}
-\item{save_map}{(logical) - Default set to FALSE. Whether to save the chart
-or not. Note that if interactive is set to true, the map will save as a
-.html. Otherwise, the map will save as a .png.}
+\item{pkg}{(string) Package to use when creating the map. One of "tmap"
+(default) or "ggplot2".}
-\item{interactive}{(logical) - Default set to TRUE. Whether the map should
-be interactive or not.}
+\item{interactive}{(logical) - Default set to TRUE. Whether the map should be
+interactive or not.}
+
+\item{save_map}{(logical) - Default set to FALSE. Whether to save the chart
+or not. Note that if \code{interactive = TRUE} and \code{pkg = "tmap"}, the map will
+save as a .html. Otherwise, the map will save as a .png.}
\item{file_path}{(character) - Default set to "bias_map". A file path of where
to save the file. This should not include a file type as that is controlled
@@ -32,17 +39,20 @@ by the interactive variable. An example file-path would be,
"visuals/interactives/disparity_map".}
}
\value{
-bias_map (tmap map) - the choropleth map created
+bias_map (tmap map or ggplot2 plot) - the choropleth map created
}
\description{
-Function to create a choropleth map to visualize the geographic disparity scores
+\code{\link[=create_map]{create_map()}} uses \code{{tmap}} and \code{{urbnthemes}} to create a chloropleth map
+to visualize the geographic disparity scores returned with the response
+object from \code{\link[=call_sedt_api]{call_sedt_api()}}.
}
\details{
-Please use the following citation for data obtained from the API,
-replacing the version number with the current version:
+Please use the following citation for data obtained from the API:
-Stern, Alena, Gabe Morrison, Sonia Torres Rodríguez, Ajjit Narayanan, and Graham MacDonald. 2024.
-“Spatial Equity Data Tool API” (Version X.x.x). Washington, DC: Urban Institute.
-https://ui-research.github.io/sedt_documentation/. Data originally sourced from various sources,
-analyzed at the Urban Institute and made available under the ODC Attribution License.
+Stern, Alena, Gabe Morrison, Sonia Torres Rodríguez, Ajjit Narayanan, and
+Graham MacDonald. 2024. “Spatial Equity Data Tool API” (Version
+0.0.0.4000). Washington, DC: Urban Institute.
+\url{https://ui-research.github.io/sedt_documentation/}. Data originally sourced
+from various sources, analyzed at the Urban Institute and made available
+under the ODC Attribution License.
}
diff --git a/man/figures/README-unnamed-chunk-5-1.png b/man/figures/README-unnamed-chunk-5-1.png
new file mode 100644
index 0000000..20a44e5
Binary files /dev/null and b/man/figures/README-unnamed-chunk-5-1.png differ
diff --git a/man/figures/README-unnamed-chunk-6-1.png b/man/figures/README-unnamed-chunk-6-1.png
new file mode 100644
index 0000000..19ed97b
Binary files /dev/null and b/man/figures/README-unnamed-chunk-6-1.png differ
diff --git a/man/figures/README-unnamed-chunk-7-1.png b/man/figures/README-unnamed-chunk-7-1.png
new file mode 100644
index 0000000..104f2fb
Binary files /dev/null and b/man/figures/README-unnamed-chunk-7-1.png differ
diff --git a/man/geo_bias_map.Rd b/man/geo_bias_map.Rd
new file mode 100644
index 0000000..2b94ab2
--- /dev/null
+++ b/man/geo_bias_map.Rd
@@ -0,0 +1,34 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/create_map.R
+\name{geo_bias_map}
+\alias{geo_bias_map}
+\alias{plot_geo_bias_map}
+\title{Plot a map of geo bias data with \code{{tmap}} or \code{{ggplot2}}}
+\usage{
+plot_geo_bias_map(
+ data,
+ fill_col = "diff_pop",
+ fill_label = "Disparity Score",
+ fill_palette = "RdBu",
+ fill_scale = ggplot2::scale_fill_distiller(type = "div", palette = fill_palette, labels
+ = scales::label_percent(scale = 1), direction = 1),
+ plot_theme = ggplot2::theme_void()
+)
+}
+\arguments{
+\item{fill_col}{String with column name to map to fill.}
+
+\item{fill_label}{Label to use for fill column. Passed as title for
+\code{\link[tmap:tm_polygons]{tmap::tm_fill()}} or fill label for \code{\link[ggplot2:labs]{ggplot2::labs()}}.}
+
+\item{fill_palette}{String with palette name.}
+
+\item{fill_scale}{ggplot2 scale function to use with map.}
+
+\item{plot_theme}{ggplot2 theme to use with map.}
+}
+\description{
+\code{\link[=tm_plot_geo_bias_map]{tm_plot_geo_bias_map()}} and \code{\link[=plot_geo_bias_map]{plot_geo_bias_map()}} are internal plotting
+functions called by the more generic \code{\link[=create_map]{create_map()}} function.
+}
+\keyword{internal}
diff --git a/man/sedt-citation.Rd b/man/sedt-citation.Rd
new file mode 100644
index 0000000..983b868
--- /dev/null
+++ b/man/sedt-citation.Rd
@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{sedt-citation}
+\alias{sedt-citation}
+\title{Citation for Spatial Equity Data Tool API Data}
+\description{
+Citation for Spatial Equity Data Tool API Data
+}
+\details{
+Please use the following citation for data obtained from the API:
+
+Stern, Alena, Gabe Morrison, Sonia Torres Rodríguez, Ajjit Narayanan, and
+Graham MacDonald. 2024. “Spatial Equity Data Tool API” (Version
+0.0.0.4000). Washington, DC: Urban Institute.
+\url{https://ui-research.github.io/sedt_documentation/}. Data originally sourced
+from various sources, analyzed at the Urban Institute and made available
+under the ODC Attribution License.
+}
diff --git a/man/sedtR-package.Rd b/man/sedtR-package.Rd
new file mode 100644
index 0000000..4b13bac
--- /dev/null
+++ b/man/sedtR-package.Rd
@@ -0,0 +1,25 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sedtR-package.R
+\docType{package}
+\name{sedtR-package}
+\alias{sedtR}
+\alias{sedtR-package}
+\title{sedtR: sedtR allows programmers to call the Urban Institute's Spatial Equity Data Tool API}
+\description{
+The Urban Institute has developed the Spatial Equity Data Tool to analyze the equitability of resources across cities, counties, states, and the entirety of the United States. This package allows users to call the Spatial Equity Data Tool API programmatically using R code.
+}
+\author{
+\strong{Maintainer}: Gabriel Morrison \email{gmorrison@urban.org} (\href{https://orcid.org/0009-0008-1815-5920}{ORCID})
+
+Authors:
+\itemize{
+ \item Alena Stern \email{astern@urban.org} (\href{https://orcid.org/0009-0002-7171-8207}{ORCID})
+}
+
+Other contributors:
+\itemize{
+ \item Eli Pousson \email{eli.pousson@gmail.com} (\href{https://orcid.org/0000-0001-8280-1706}{ORCID}) [contributor]
+}
+
+}
+\keyword{internal}
diff --git a/man/tm_plot_geo_bias_map.Rd b/man/tm_plot_geo_bias_map.Rd
new file mode 100644
index 0000000..d58bf03
--- /dev/null
+++ b/man/tm_plot_geo_bias_map.Rd
@@ -0,0 +1,35 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/create_map.R
+\name{tm_plot_geo_bias_map}
+\alias{tm_plot_geo_bias_map}
+\title{\code{\link[=tm_plot_geo_bias_map]{tm_plot_geo_bias_map()}} uses \code{\link[tmap:tm_shape]{tmap::tm_shape()}} and \code{\link[tmap:tm_polygons]{tmap::tm_fill()}} to map
+the geo bias data returned by \code{\link[=call_sedt_api]{call_sedt_api()}}.}
+\usage{
+tm_plot_geo_bias_map(
+ data,
+ fill_col = "diff_pop",
+ fill_label = "Disparity Score",
+ basemap_server = "CartoDB.PositronNoLabels",
+ border_lwd = 0.25,
+ fill_palette = "RdBu",
+ title = NULL,
+ legend.outside = TRUE,
+ attr.outside = TRUE,
+ interactive = FALSE,
+ ...
+)
+}
+\arguments{
+\item{title}{Global title of the map. For small multiples, multiple titles can be specified. The title is drawn inside the map. Alternatively, use \code{panel.labels} to print the map as a panel, with the title inside the panel header (especially useful for small multiples). Another alternative is the \code{main.title} which prints a title above the map. Titles for the legend items are specified at the layer functions (e.g. \code{\link[tmap]{tm_fill}}).}
+
+\item{legend.outside}{Logical that determines whether the legend is plot outside of the map/facets. Especially useful when using facets that have a common legend (i.e. with \code{free.scales=FALSE}).}
+
+\item{attr.outside}{Logical that determines whether the attributes are plot outside of the map/facets.}
+
+\item{...}{other arguments from \code{tm_layout}}
+}
+\description{
+\code{\link[=tm_plot_geo_bias_map]{tm_plot_geo_bias_map()}} uses \code{\link[tmap:tm_shape]{tmap::tm_shape()}} and \code{\link[tmap:tm_polygons]{tmap::tm_fill()}} to map
+the geo bias data returned by \code{\link[=call_sedt_api]{call_sedt_api()}}.
+}
+\keyword{internal}