#' Extract employment statistics from scenario
#'
#' This is an internal function to pull the employment data from a scenario and
#' return it to either the single scenario or scenario comparison functions.
#'
#' @param db The scenario database.
#' @param facet_var The variable in the zone table to facet by. Defaults to MPO
#' @param facet_levels The levels of the facet variable to keep. Defaults to all
#' levels other than external stations.
#' @param type_levels The types of employment to show in the plot.
#' @param employment_categories [Optional] data_frame of employment aggregation categories;
#' if \code{NULL}, uses \code{\link{emp_types}}. Should have columns
#' \code{ACTIVITY} (full code of activity in AA databases) and \code{emp_type}.
#'
#' @export
extract_employment <- function(db, facet_var = NULL, facet_levels = NULL,
type_levels = NULL, employment_categories = 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 %>%
dplyr::group_by(facet_var) %>%
dplyr::collect(n=Inf) %>%
dplyr::slice(1) %>% .$facet_var
facet_levels <- facet_levels[which(facet_levels != "EXTSTA")]
}
employment <- dplyr::tbl(db, "ActivityLocations") %>%
dplyr::select(BZONE, ACTIVITY, TSTEP, Employment) %>%
dplyr::filter(Employment > 0) %>%
# join grouping variable
dplyr::left_join(grouping, by = "BZONE") %>%
dplyr::filter(facet_var %in% facet_levels) %>%
dplyr::group_by(facet_var, ACTIVITY, TSTEP) %>%
dplyr::summarize(emp = sum(Employment)) %>%
dplyr::mutate(year = as.numeric(TSTEP) + 1990) %>%
dplyr::ungroup() %>%
dplyr::collect(n=Inf)
# consolidate employment categories
if(is.null(employment_categories)){ # use included aggregation
employment <-
employment %>%
dplyr::mutate(ACTIVITY = gsub("_.*", "", ACTIVITY)) %>%
dplyr::left_join(emp_types, by = "ACTIVITY") %>%
dplyr::group_by(facet_var, emp_type, year) %>%
dplyr::summarize(emp = sum(emp))
} else { # use custom aggregation
employment <- employment %>%
dplyr::left_join(employment_categories, by = "ACTIVITY") %>%
dplyr::group_by(facet_var, emp_type, year) %>%
dplyr::summarize(emp = sum(emp))
}
if(!is.null(type_levels)){
employment <- employment %>%
dplyr::filter(emp_type %in% type_levels)
}
return(employment)
}
#' Plot Employment by Sector
#'
#' This function plots the employment by type in an area over time between two
#' scenarios.
#'
#' @inheritDotParams extract_employment
#'
#' @return A ggplot2 object showing the employment by type and and year.
#'
#' @export
plot_employment <- function(db, ...){
employment <- extract_employment(db, ...)
# make plot
ggplot2::ggplot(employment,
ggplot2::aes(x = year, y = emp,
group = emp_type, color = emp_type)) +
ggplot2::geom_path() +
ggplot2::facet_wrap( ~ facet_var) +
ggplot2::scale_y_log10() +
ggplot2::xlab("Year") + ggplot2::ylab("Employees") +
ggplot2::scale_color_discrete("Sector") +
ggplot2::theme_bw() + ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 30))
}
#' Compare labor output between two scenarios
#'
#' This function compares the employment by type in an area over time between two
#' scenarios.
#'
#' @param db1 The reference scenario database.
#' @param db2 The current scenario database.
#' @inheritDotParams extract_employment
#'
#' @return A ggplot2 object showing the employment by type and and year.
#'
#' @export
compare_employment <- function(db1, db2, ...){
# get the reference scenario data
fref <- extract_employment(db1, ...) %>%
dplyr::rename(ref = emp)
# get the comparison scenario
fcom <- extract_employment(db2, ...) %>%
dplyr::rename(com = emp)
f <- dplyr::left_join(fref, fcom) %>%
dplyr::mutate(diff = (com - ref) / ref * 100) # percent difference
ggplot2::ggplot(f,
ggplot2::aes(x = year, y = diff, color = emp_type)) +
ggplot2::geom_path() +
ggplot2::facet_wrap( ~ facet_var) +
ggplot2::xlab("Year") +
ggplot2::ylab("Percent difference (current - reference) in Number of Employees") +
ggplot2::scale_color_discrete("Sector") +
ggplot2::theme_bw() + ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 30))
}
#' Compare Employment by sector across multiple scenarios.
#'
#' @param dbset A list of connections to SWIM databases.
#' @param db_names A character vector naming the scenarios.
#' @inheritDotParams extract_employment
#'
#' @return a ggplot2 object.
#'
#' @export
multiple_employment <- function(dbset, db_names, ...) {
# get the employment table for every scenario.
names(dbset) <- db_names
df <- bind_rows(
lapply(seq_along(dbset), function(i)
extract_employment(dbset[[i]], ...) %>%
dplyr::mutate(scenario = names(dbset)[[i]])
)
)
ggplot2::ggplot(
df,
ggplot2::aes_string(x = "year", y = "emp", color = "scenario")
) +
ggplot2::geom_path() +
ggplot2::facet_grid(facet_var ~ emp_type, scale = "free_y") +
ggplot2::xlab("Year") + ggplot2::ylab("Employment") +
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.