#' Extract GDP of Labor
#'
#' This function returns the total dollar value of all the labor sold by a
#' dplyr::collect(n=Inf)ion of zones over time.
#'
#' @param db The scenario sqlite database.
#' @param facet_var Field to facet by: "MPO", "COUNTY", or "STATE".
#' @param facet_levels A character vector of the variable specifiying
#' which levels to include.
#' @param color_levels A character vector of the industry sectors to include.
#' Defaults to all.
#'
#' @return A \code{data_frame} with the participation rate in each facet region
#' in each transport model year.
#'
#' @export
extract_gdp <- function(db,
facet_var = c("MPO", "COUNTY", "STATE"),
facet_levels = NULL, color_levels = NULL) {
# set facet variable; if null then default to MPO
if(is.null(facet_var)){
facet_var = "MPO"
}
grouping <- dplyr::tbl(db, "BZONE") %>%
dplyr::select_("BZONE", "facet_var" = facet_var)
# get levels of facet_var if none given
if(is.null(facet_levels)){
facet_levels <- grouping %>% group_by(facet_var) %>% dplyr::collect(n=Inf) %>%
slice(1) %>% .$facet_var
facet_levels <- facet_levels[which(facet_levels != "EXTSTA")]
}
types <- gsub("BuySell_", "", employment_types$sector)
df <- dplyr::tbl(db, "ExchangeResults") %>%
dplyr::transmute(
BZONE, year = as.numeric(TSTEP) + 1990,
commodity = Commodity,
sold = InternalSold
) %>%
# join faceting variables
dplyr::left_join(grouping ) %>%
dplyr::filter(facet_var %in% facet_levels) %>%
# dplyr::summarize on faceting variable
dplyr::filter(sold > 0) %>%
group_by(facet_var, year, commodity) %>%
dplyr::summarize( sold = sum(sold) ) %>%
dplyr::collect(n=Inf) %>%
# only keep employment types
# some genius is using different labels in different tables. Fix this.
dplyr::mutate(commodity = gsub("-", "_", commodity)) %>%
dplyr::filter(commodity %in% types) %>%
dplyr::left_join(
employment_types %>%
dplyr::mutate(commodity = gsub("BuySell_", "", employment_types$sector)),
by = c("commodity")
) %>%
group_by(facet_var, year, naics_label) %>%
dplyr::summarize(value = sum(sold))
return(df)
}
#' Plot the GDP contribution of Labor over time in a scenario
#'
#' @inheritParams extract_gdp
#'
#' @return a ggplot2 plot object.
#'
#' @export
plot_gdp <- function(db,
facet_var = c("MPO", "COUNTY", "STATE"),
facet_levels = NULL, color_levels = NULL) {
df <- extract_gdp(db, facet_var, facet_levels, color_levels)
ggplot2::ggplot(df, ggplot2::aes(x = year, y = value / 1e9, color = naics_label)) +
ggplot2::geom_path() +
ggplot2::facet_wrap(~facet_var, scale = "free_y") +
ggplot2::xlab("Year") + ggplot2::ylab("GDP of Labor [$B]") +
ggplot2::scale_color_discrete("Sector") +
ggplot2::theme_bw() + ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 30))
}
#' Compare GDP between two scenarios
#'
#' @param db1 The swim database for the "Reference" scenario.
#' @param db2 The swim database for the "Current" scenario.
#' @inheritParams extract_gdp
#'
#' @return ggplot2 object
#' @export
compare_gdp <- function(db1, db2,
facet_var = c("MPO", "COUNTY", "STATE"),
facet_levels = NULL, color_levels = NULL) {
ref <- extract_gdp(db1, facet_var, facet_levels, color_levels) %>%
dplyr::rename(ref = value)
com <- extract_gdp(db2, facet_var, facet_levels, color_levels) %>%
dplyr::rename(com = value)
df <- dplyr::left_join(ref, com) %>%
dplyr::mutate(diff = (com - ref) / ref * 100)
ggplot2::ggplot(df, ggplot2::aes(x = year, y = diff, color = naics_label)) +
ggplot2::geom_path() +
ggplot2::facet_wrap(~ facet_var) +
ggplot2::xlab("Year") + ggplot2::ylab("GDP of Labor [% difference]") +
ggplot2::scale_color_discrete("Sector") +
ggplot2::theme_bw() + ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 30))
}
#' Compare GDP across multiple scenarios.
#'
#' @param dbset A list of connections to SWIM databases.
#' @param db_names A character vector naming the scenarios.
#' @param facet_var Field to facet by.
#' @param facet_levels A character vector of the facet variable specifiying
#' which levels to include.
#'
#' @return a ggplot2 object.
#'
#'
#' @export
multiple_gdp <- function(dbset, db_names,
facet_var = c("MPO", "COUNTY", "STATE"),
facet_levels = NULL ) {
# get the wapr table for every scenario.
names(dbset) <- db_names
df <- bind_rows(
lapply(seq_along(dbset), function(i)
extract_gdp(dbset[[i]], facet_var, facet_levels) %>%
dplyr::mutate(scenario = names(dbset)[[i]])
)
) %>%
group_by(scenario, facet_var, year) %>%
dplyr::summarize(value = sum(value))
ggplot2::ggplot(
df,
ggplot2::aes(x = year, y = value, color = scenario)
) +
ggplot2::geom_path() +
ggplot2::facet_wrap(~ facet_var, scale = "free_y") +
ggplot2::xlab("Year") + ggplot2::ylab("GDP of Labor") +
ggplot2::theme_bw() + ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 30))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.