.Rhistory

r_node_id,
")",
"<br>",
round(volume_percent_difference * 100, digits = 1),
"%"
),
) %>%
group_by(node_type) %>%
group_split()
names(predicted_actual_node_day_part) <- c("Entrance", "Exit", "Freeway_Segment")
usethis::use_data(predicted_actual_node_day_part,
overwrite = TRUE,
compress = "xz", internal = FALSE
)
# Hourly Data: By Node, Aggregated to Day part ------------------------------------------
predicted_actual_corridor_day_part <- hr_node_diff %>%
mutate(
day_part = case_when(
hour >= 7 & hour <= 9 ~ "Morning, 7-9AM",
hour >= 11 & hour <= 13 ~ "Midday, 11AM-1PM",
hour >= 16 & hour <= 18 ~ "Evening, 4-6PM"
) %>%
factor(levels = c("Morning, 7-9AM", "Midday, 11AM-1PM", "Evening, 4-6PM")),
day_part_short = case_when(
hour >= 7 & hour <= 9 ~ "morning",
hour >= 11 & hour <= 13 ~ "midday",
hour >= 16 & hour <= 18 ~ "evening"
),
# year = "2021",
month_year = paste(month.name[month], year),
day_type = "Weekday"
) %>%
group_by(day_part, day_type, day_part_short, month_year, year, corridor_route) %>%
summarize(across(c(actual_volume, predicted_volume), sum)) %>%
ungroup() %>%
group_by(day_part, corridor_route) %>%
mutate(
rollmean_sum = shift(frollapply(actual_volume, 7, mean, align = "right")),
rollmean_pred = shift(frollapply(predicted_volume, 7, mean, align = "right"))
) %>%
mutate(
rollmean_percent = rollmean_sum / rollmean_pred,
volume_percent_difference = (actual_volume - predicted_volume) / predicted_volume
) %>%
filter(
# !is.na(rollmean_percent),
!is.na(day_part),
day_type == "Weekday"
) %>%
mutate(
hover_observe_text = stringr::str_wrap(paste0(
"<b>", month_year, " ", "</b>",
", the ", "<b>observed</b> ", "average total weekday volume in the ",
"<b>", day_part_short, "</b>", " was ",
format(round(actual_volume), big.mark = ","), " vehicles"
), width = 30),
hover_predict_text = stringr::str_wrap(paste0(
"<b>", month_year, " ", year, "</b>",
", the ", "<b>expected</b> ", " average total weekday volume in the ",
"<b>", day_part_short, "</b>", " was ",
format(round(predicted_volume), big.mark = ","), " vehicles"
), width = 30)
)
usethis::use_data(predicted_actual_corridor_day_part,
overwrite = TRUE,
compress = "xz", internal = FALSE
)
predicted_actual_corridor_hour
hr_node_diff
str(hr_node_diff)
# Hourly Data: By Node, Aggregated to Day part ------------------------------------------
predicted_actual_corridor_day_part <- hr_node_diff %>%
mutate(
day_part = case_when(
hour >= 7 & hour <= 9 ~ "Morning, 7-9AM",
hour >= 11 & hour <= 13 ~ "Midday, 11AM-1PM",
hour >= 16 & hour <= 18 ~ "Evening, 4-6PM"
) %>%
factor(levels = c("Morning, 7-9AM", "Midday, 11AM-1PM", "Evening, 4-6PM")),
day_part_short = case_when(
hour >= 7 & hour <= 9 ~ "morning",
hour >= 11 & hour <= 13 ~ "midday",
hour >= 16 & hour <= 18 ~ "evening"
),
# year = "2021",
month_year = paste(month.name[month], year)
) %>%
group_by(day_part, day_type, day_part_short, month_year, year, corridor_route) %>%
summarize(across(c(actual_volume, predicted_volume), sum)) %>%
ungroup() %>%
group_by(day_part, corridor_route) %>%
mutate(
rollmean_sum = shift(frollapply(actual_volume, 7, mean, align = "right")),
rollmean_pred = shift(frollapply(predicted_volume, 7, mean, align = "right"))
) %>%
mutate(
rollmean_percent = rollmean_sum / rollmean_pred,
volume_percent_difference = (actual_volume - predicted_volume) / predicted_volume
) %>%
filter(
# !is.na(rollmean_percent),
!is.na(day_part),
day_type == "Weekday"
) %>%
mutate(
hover_observe_text = stringr::str_wrap(paste0(
"<b>", month_year, " ", "</b>",
", the ", "<b>observed</b> ", "average total weekday volume in the ",
"<b>", day_part_short, "</b>", " was ",
format(round(actual_volume), big.mark = ","), " vehicles"
), width = 30),
hover_predict_text = stringr::str_wrap(paste0(
"<b>", month_year, " ", year, "</b>",
", the ", "<b>expected</b> ", " average total weekday volume in the ",
"<b>", day_part_short, "</b>", " was ",
format(round(predicted_volume), big.mark = ","), " vehicles"
), width = 30)
)
## Hourly Data: By Node -----
# this data aggregates at the monthly level instead of daily level to keep file size reasonable
hr_node_diff <-
ROracle::dbGetQuery(tbidb, "SELECT * FROM RTMC_HOURLY_NODE_DIFF_MON_NOW") %>%
rename(
"r_node_name" = "NODE_NAME",
"year" = "DATA_YEAR",
"month" = "DATA_MONTH",
"hour" = "DATA_HOUR",
"actual_volume" = "TOTAL_VOLUME",
"predicted_volume" = "VOLUME_PREDICT"
) %>%
left_join(node_config, by = c("r_node_name" = "r_node_name")) %>%
mutate(month_year = paste(month.name[month], year)) %>%
# Weekdays only in this particular view due to line in RTMC_HOURLY_NODE_DIFF_MON:
# WHERE TO_CHAR (DATA_DATE, 'DY', 'NLS_DATE_LANGUAGE=ENGLISH') NOT IN ('SAT', 'SUN')
mutate(day_type = "Weekday")
hr_node_diff <- left_join(hr_node_diff, nodes)
predicted_actual_node_day_part <- hr_node_diff %>%
mutate(
day_part = case_when(
hour >= 7 & hour <= 9 ~ "Morning, 7-9AM",
hour >= 11 & hour <= 13 ~ "Midday, 11AM-1PM",
hour >= 16 & hour <= 18 ~ "Evening, 4-6PM"
) %>%
factor(levels = c("Morning, 7-9AM", "Midday, 11AM-1PM", "Evening, 4-6PM")),
day_part_short = case_when(
hour >= 7 & hour <= 9 ~ "morning",
hour >= 11 & hour <= 13 ~ "midday",
hour >= 16 & hour <= 18 ~ "evening"
),
r_node_id = stringr::str_remove_all(r_node_name, "rnd_")
) %>%
filter(
r_node_n_type != "Intersection",
r_node_n_type != ""
) %>%
group_by(
day_part, day_type, day_part_short, month_year,
r_node_lat, r_node_lon,
r_node_name, r_node_id, r_node_n_type, r_node_label, corridor_route
) %>%
summarize(across(c(actual_volume, predicted_volume), sum)) %>%
ungroup() %>%
group_by(day_part, r_node_name) %>%
mutate(
rollmean_sum = shift(frollapply(actual_volume, 7, mean, align = "right")),
rollmean_pred = shift(frollapply(predicted_volume, 7, mean, align = "right"))
) %>%
mutate(
rollmean_percent = rollmean_sum / rollmean_pred,
volume_percent_difference = (actual_volume - predicted_volume) / predicted_volume
) %>%
filter(
# !is.na(rollmean_percent),
!is.na(day_part),
day_type == "Weekday"
) %>%
mutate(
node_type = case_when(
r_node_n_type == "Station" ~ "Freeway Segment",
TRUE ~ r_node_n_type
),
user_month_year = factor(month_year,
levels = c(
## 2020
"January 2020",
"February 2020",
"March 2020",
"April 2020",
"May 2020",
"June 2020",
"July 2020",
"August 2020",
"September 2020",
"October 2020",
"November 2020",
"December 2020",
## 2021
"January 2021",
"February 2021",
"March 2021",
"April 2021",
"May 2021",
"June 2021",
"July 2021",
"August 2021",
"September 2021",
"October 2021",
"November 2021",
"December 2021"
),
ordered = TRUE
),
hover_text = paste(
sep = "",
"<b>",
month_year,
"</b>",
"<br>",
day_part,
"<br>",
node_type,
" on ",
corridor_route,
" at ",
r_node_label,
" (Node ",
r_node_id,
")",
"<br>",
round(volume_percent_difference * 100, digits = 1),
"%"
),
) %>%
group_by(node_type) %>%
group_split()
names(predicted_actual_node_day_part) <- c("Entrance", "Exit", "Freeway_Segment")
# Hourly Data: By Node, Aggregated to Day part ------------------------------------------
predicted_actual_corridor_day_part <- hr_node_diff %>%
mutate(
day_part = case_when(
hour >= 7 & hour <= 9 ~ "Morning, 7-9AM",
hour >= 11 & hour <= 13 ~ "Midday, 11AM-1PM",
hour >= 16 & hour <= 18 ~ "Evening, 4-6PM"
) %>%
factor(levels = c("Morning, 7-9AM", "Midday, 11AM-1PM", "Evening, 4-6PM")),
day_part_short = case_when(
hour >= 7 & hour <= 9 ~ "morning",
hour >= 11 & hour <= 13 ~ "midday",
hour >= 16 & hour <= 18 ~ "evening"
)
) %>%
group_by(day_part, day_type, day_part_short, month_year, year, corridor_route) %>%
summarize(across(c(actual_volume, predicted_volume), sum)) %>%
ungroup() %>%
group_by(day_part, corridor_route) %>%
mutate(
rollmean_sum = shift(frollapply(actual_volume, 7, mean, align = "right")),
rollmean_pred = shift(frollapply(predicted_volume, 7, mean, align = "right"))
) %>%
mutate(
rollmean_percent = rollmean_sum / rollmean_pred,
volume_percent_difference = (actual_volume - predicted_volume) / predicted_volume
) %>%
filter(
# !is.na(rollmean_percent),
!is.na(day_part),
day_type == "Weekday"
) %>%
mutate(
hover_observe_text = stringr::str_wrap(paste0(
"<b>", month_year, " ", "</b>",
", the ", "<b>observed</b> ", "average total weekday volume in the ",
"<b>", day_part_short, "</b>", " was ",
format(round(actual_volume), big.mark = ","), " vehicles"
), width = 30),
hover_predict_text = stringr::str_wrap(paste0(
"<b>", month_year, " ", year, "</b>",
", the ", "<b>expected</b> ", " average total weekday volume in the ",
"<b>", day_part_short, "</b>", " was ",
format(round(predicted_volume), big.mark = ","), " vehicles"
), width = 30)
)
before_rollmean<-
hr_node_diff %>%
mutate(
day_part = case_when(
hour >= 7 & hour <= 9 ~ "Morning, 7-9AM",
hour >= 11 & hour <= 13 ~ "Midday, 11AM-1PM",
hour >= 16 & hour <= 18 ~ "Evening, 4-6PM"
) %>%
factor(levels = c("Morning, 7-9AM", "Midday, 11AM-1PM", "Evening, 4-6PM")),
day_part_short = case_when(
hour >= 7 & hour <= 9 ~ "morning",
hour >= 11 & hour <= 13 ~ "midday",
hour >= 16 & hour <= 18 ~ "evening"
),
r_node_id = stringr::str_remove_all(r_node_name, "rnd_")
) %>%
filter(
r_node_n_type != "Intersection",
r_node_n_type != ""
) %>%
group_by(
day_part, day_type, day_part_short, month_year,
r_node_lat, r_node_lon,
r_node_name, r_node_id, r_node_n_type, r_node_label, corridor_route
) %>%
summarize(across(c(actual_volume, predicted_volume), sum)) %>%
ungroup()
after_rollmean <-
hr_node_diff %>%
mutate(
day_part = case_when(
hour >= 7 & hour <= 9 ~ "Morning, 7-9AM",
hour >= 11 & hour <= 13 ~ "Midday, 11AM-1PM",
hour >= 16 & hour <= 18 ~ "Evening, 4-6PM"
) %>%
factor(levels = c("Morning, 7-9AM", "Midday, 11AM-1PM", "Evening, 4-6PM")),
day_part_short = case_when(
hour >= 7 & hour <= 9 ~ "morning",
hour >= 11 & hour <= 13 ~ "midday",
hour >= 16 & hour <= 18 ~ "evening"
),
r_node_id = stringr::str_remove_all(r_node_name, "rnd_")
) %>%
filter(
r_node_n_type != "Intersection",
r_node_n_type != ""
) %>%
group_by(
day_part, day_type, day_part_short, month_year,
r_node_lat, r_node_lon,
r_node_name, r_node_id, r_node_n_type, r_node_label, corridor_route
) %>%
summarize(across(c(actual_volume, predicted_volume), sum)) %>%
ungroup() %>%
group_by(day_part, r_node_name) %>%
mutate(
rollmean_sum = shift(frollapply(actual_volume, 7, mean, align = "right")),
rollmean_pred = shift(frollapply(predicted_volume, 7, mean, align = "right"))
) %>%
mutate(
rollmean_percent = rollmean_sum / rollmean_pred,
volume_percent_difference = (actual_volume - predicted_volume) / predicted_volume
)
nrow(veh_trips)
library(covid.traffic.trends)
gather_data()
covid.traffic.trends::run_daily_app_data()
run_app()
# Set options here
options(
shiny.launch.browser = TRUE,
scipen = 9999,
warn = -1,
verbose = FALSE,
golem.app.prod = FALSE
) # TRUE = production mode, FALSE = development mode
# Detach all loaded packages and clean your environment
# golem::detach_all_attached()
# rm(list=ls(all.names = TRUE))
# remove.packages("council.skeleton", lib="~/R/win-library/3.6")
# remotes::install_github("Metropolitan-Council/council.skeleton", upgrade = "never")
rmarkdown::render("./ABOUT.Rmd",
output_format = "github_document", # -----
output_file = "ABOUT.md", output_dir = "./inst/app/www",
params = list(
actor_id = "roten",
data_date = Sys.Date(),
sha = system("git rev-parse --short HEAD",
intern = TRUE
)
)
)
# Document and reload your package ----
golem::document_and_reload()
# Run the application
run_app()
predicted_actual_by_region
holiday_data <- predicted_actual_by_node %>%
filter(date %in% c('2021-12-24', '2020-12-24', '2019-12-24'))
str(predicted_actual_by_node)
holiday_data <- predicted_actual_by_region %>%
filter(date %in% c('2021-12-24', '2020-12-24', '2019-12-24'))
holiday_data
holiday_data <- predicted_actual_by_region %>%
filter(date %in% c(as.Date('2021-12-24'), as.Date('2020-12-24'), as.Date('2019-12-24')))
holiday_data
predicted_actual_by_region %>%
filter(date %in% c(as.Date('2021-12-24'), as.Date('2020-12-24'), as.Date('2019-12-24')))
predicted_actual_by_region$date %>% summary()
## Daily Data: Entire Region -----
predicted_actual_by_region <-
ROracle::dbReadTable(tbidb, "RTMC_DAILY_SYSTEM_DIFF_NOW") %>%
rename(
"date" = "DATA_DATE",
"actual_volume" = "TOTAL_VOLUME",
"predicted_volume" = "TOTAL_PREDICTED_VOLUME",
"volume_difference_absolute" = "TOTAL_VOLUME_DIFF"
) %>%
mutate(
volume_difference_percent =
round(100 * volume_difference_absolute / predicted_volume, 2)
) %>%
mutate(
District = "MnDOT Metro Freeways",
weekday = format.Date(date, "%A")
) %>%
arrange(date) %>%
mutate(
roll_avg = zoo::rollmean(volume_difference_percent, k = 7, fill = NA),
month_year = format(date, "%B %Y"),
hover_text_roll_avg = paste(
sep = "",
"<b>",
format.Date(date, "%A, %B %d, %Y"),
"</b>",
"<br>",
"Metro 7-day average ",
"<br>",
round(roll_avg, digits = 1),
"%"
),
hover_text = paste(
sep = "",
"<b>",
format.Date(date, "%A, %B %d, %Y"),
"</b>",
"<br>",
round(volume_difference_percent, digits = 1),
"%"
)
)
## code to prepare `predicted_actual` and node-level dataset series goes here
library(covid.traffic.trends)
library(sf)
library(data.table)
library(dplyr)
library(DBI)
library(lubridate)
# For Database Connection:
library(ROracle)
library(keyring)
library(ggplot2)
## Connect to the Database -----
connect.string <- "(DESCRIPTION=(ADDRESS_LIST = (ADDRESS = (PROTOCOL = TCP)(HOST = fth-exa-scan.mc.local  )(PORT = 1521)))(CONNECT_DATA = (SERVER = DEDICATED)(SERVICE_NAME =  com4te.mc.local)))"
tbidb <- ROracle::dbConnect(
dbDriver("Oracle"),
dbname = connect.string,
username = "mts_planning_data",
# mts_planning_view for viewing data only, no write privileges.
# mts_planning_data is the username for write privileges.
password = keyring::key_get("mts_planning_data_pw")
)
# Configure database time zone -------------------------------
Sys.setenv(TZ = "America/Chicago")
Sys.setenv(ORA_SDTZ = "America/Chicago")
## Daily Data: Entire Region -----
predicted_actual_by_region <-
ROracle::dbReadTable(tbidb, "RTMC_DAILY_SYSTEM_DIFF_NOW") %>%
rename(
"date" = "DATA_DATE",
"actual_volume" = "TOTAL_VOLUME",
"predicted_volume" = "TOTAL_PREDICTED_VOLUME",
"volume_difference_absolute" = "TOTAL_VOLUME_DIFF"
) %>%
mutate(
volume_difference_percent =
round(100 * volume_difference_absolute / predicted_volume, 2)
) %>%
mutate(
District = "MnDOT Metro Freeways",
weekday = format.Date(date, "%A")
) %>%
arrange(date) %>%
mutate(
roll_avg = zoo::rollmean(volume_difference_percent, k = 7, fill = NA),
month_year = format(date, "%B %Y"),
hover_text_roll_avg = paste(
sep = "",
"<b>",
format.Date(date, "%A, %B %d, %Y"),
"</b>",
"<br>",
"Metro 7-day average ",
"<br>",
round(roll_avg, digits = 1),
"%"
),
hover_text = paste(
sep = "",
"<b>",
format.Date(date, "%A, %B %d, %Y"),
"</b>",
"<br>",
round(volume_difference_percent, digits = 1),
"%"
)
)
predicted_actual_by_region
predicted_actual_by_region %>% summary()
predicted_actual_by_region %>%
filter(date %in% c(as.Date('2021-12-24'), as.Date('2020-12-24')))
library(covid.traffic.trends)
covid.traffic.trends::run_daily_app_data()
predicted_actual_by_region
tail(LOD Conducting Successful and Legal Interviews )
tail(predicted_actual_by_region)
table_data
table_data %>% tail()
covid.traffic.trends::deploy_app()
covid.traffic.trends::deploy_app()