library(knitr) opts_chunk$set( echo = FALSE, message = FALSE, warning = FALSE, fig.keep = TRUE, fig.path = params$fig.path, fig.width=8, fig.height=6 ) library(RSQLite) library(tidyverse) library(leaflet) library(swimr)
# This is the path to the scenario SWIM databases; direct these to your # local paths. ref_db <- params$ref_db cur_db <- params$current_db # These are the names for the scenarios that will show up in the scenario # information table and other places. scenario_names <- c(params$ref_name, params$current_name) # Update to reflect scope of analysis. # If you wish to focus on the Metro and Bend MPOs, for instance, change `facet` # to "MPO" and facet_levels to `c("Metro", "Bend")` facet <- params$facet facet_levels <- c("Multnomah", "Washington", "Clackamas") # The tables will only show data from these years. years <- c(2010, 2025, 2040) # The leaflet plots show a comparison between the scenarios in a specific year. # Set this to the year you wish to study. For bridge scenarios, it should be the # year after the bridge breaks. For others, it should probably be the last year # version of the simulation. diff_year <- params$diff_year MPOs <- c("Albany","Bend", "Corvallis", "Eugene/Springfield","Medford", "METRO", "METRO_CLARK","Middle Rogue", "NonMPO", "Halo", "Salem/Keizer") MPOs <- c("Bend", "Corvallis", "EugeneSpringfield","Metro", "RougeValley", "NonMPO", "OOO", "SalemKeizer") # show leaflet plots; FALSE will skip them (saving disk space and time) use_leaflet <- params$use_leaflet
db1 <- dbConnect(SQLite(), dbname=ref_db) db2 <- dbConnect(SQLite(), dbname=cur_db) # update to reflect current scenario scen_info <- data_frame( Name = scenario_names, Scenario = c(basename(ref_db), basename(cur_db)), `File Date` = c(file.info(ref_db)$mtime, file.info(cur_db)$mtime) ) kable(scen_info, caption = "Scenario Information")
se <- left_join( extract_se(db1, "MPO") %>% rename(reference = y), extract_se(db2, "MPO") %>% rename(current = y) ) %>% filter(year %in% years) %>% mutate(diff = (current - reference) / reference * 100)
pop <- se %>% filter(var == "population") %>% select(color_var, year, Reference = reference, Current = current) %>% mutate(`Pct diff` = (Current - Reference)/Reference * 100) %>% gather(key = scenario, value=value, -color_var, -year) %>% unite(scenario_year, scenario, year, sep = ' ') %>% spread(key=scenario_year, value=value) %>% select(MPO = color_var, starts_with('Reference'), starts_with('Current'), starts_with('Pct')) kable(pop, caption = "Population by MPO", digits = 2)
emp <- se %>% filter(var == "employment") %>% select(color_var, year, Reference = reference, Current = current) %>% mutate(`Pct diff` = (Current - Reference)/Reference * 100) %>% gather(key = scenario, value=value, -color_var, -year) %>% unite(scenario_year, scenario, year, sep = ' ') %>% spread(key=scenario_year, value=value) %>% select(MPO = color_var, starts_with('Reference'), starts_with('Current'), starts_with('Pct')) kable(emp, caption = "Employment by MPO", digits = 2)
compare_sevar(db1, db2, color_var = facet, color_levels = facet_levels)
compare_sevar(db1, db2, color_var = "MPO")
if(use_leaflet){ diff_leaflet(db1, db2, year = diff_year, variable = "pop", scen_names = scenario_names) } else { message("Leaflet plots skipped with `use_leaflet` option") }
vmt <- left_join( extract_vmt(db1, "MPO") %>% rename(reference = vmt), extract_vmt(db2, "MPO") %>% rename(current = vmt) ) %>% filter(year %in% years) ref <- yearly_summary(vmt, "MPO", "reference") %>% gather(key = 'year', value = 'Reference', -MPO) cur <- yearly_summary(vmt, "MPO", "current") %>% gather(key = 'year', value = 'Current', -MPO) vmt <- left_join(ref, cur, by = c("MPO", "year")) %>% mutate(`Pct diff` = (Current - Reference) / Reference * 100) %>% gather(key='scenario', value='vmt', -MPO, -year) %>% unite(col = 'scenario_year', scenario, year, sep = ' ') %>% spread(key=scenario_year, value=vmt) %>% select(MPO, starts_with('Reference'), starts_with('Current'), starts_with('Pct')) kable(vmt, caption = "VMT by MPO", digits = 2)
compare_vmt(db1, db2, facet, facet_levels)
compare_vmt(db1, db2, "MPO")
trips <- left_join( extract_trips(db1, "MPO") %>% rename(reference = trips), extract_trips(db2, "MPO") %>% rename(current = trips) ) %>% filter(year %in% years) %>% mutate( diff = (current - reference) / reference * 100, diff = ifelse(is.na(diff), 0, diff)) ref <- yearly_summary(trips, "facet_var", "reference") %>% gather(key = 'year', value = 'Reference', -facet_var) cur <- yearly_summary(trips, "facet_var", "current") %>% gather(key = 'year', value = 'Current', -facet_var) trips <- left_join(ref, cur, by = c("facet_var", "year")) %>% mutate(`Pct diff` = (Current - Reference) / Reference * 100) %>% gather(key='scenario', value='value', -facet_var, -year) %>% unite(col = 'scenario_year', scenario, year, sep = ' ') %>% spread(key=scenario_year, value=value) %>% select(MPO = facet_var, starts_with('Reference'), starts_with('Current'), starts_with('Pct')) kable(trips, caption = "Total Trips by MPO", digits = 2)
compare_trips(db1, db2, facet_var = facet, facet_levels = facet_levels)
compare_trips(db1, db2, facet_var = "MPO")
compare_tlfd(db1, db2, facet, facet_levels, cumulative = TRUE, years = years)
compare_tlfd(db1, db2, "MPO", years = years, cumulative = TRUE, MPOs)
compare_logsums(db1, db2, facet, facet_levels)
compare_logsums(db1, db2, "MPO", MPOs)
compare_floorspace(db1, db2, facet, facet_levels)
compare_floorspace(db1, db2)
compare_floorspace(db1, db2, facet, facet_levels, price = TRUE)
compare_floorspace(db1, db2, price = TRUE)
compare_occupancy(db1, db2, facet, facet_levels)
compare_occupancy(db1, db2)
compare_employment(db1, db2, facet, facet_levels)
compare_employment(db1, db2)
compare_gdp(db1, db2, facet, facet_levels)
compare_gdp(db1, db2)
compare_wapr(db1, db2, facet, facet_levels)
compare_wapr(db1, db2, "MPO")
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.