library(tidyverse)
library(lubridate)
library(plotly)
library(kableExtra)
library(scales)The purpose of this analysis is to evaluate changes in vehicle traffic across the Verrazzano-Narrows Bridge before and after the implementation of congestion pricing policies in New York City. We focus on comparing traffic volumes from January through March of 2024 and 2025, highlighting monthly trends, custom aligned periods, and weekly behavior for all vehicles and truck traffic specifically. To ensure accurate representation and eliminate calendar variation bias, data is presented using both calendar months and aligned 4-week periods.
Source: MTA Bridges and Tunnels — Hourly Traffic Crossings Open Data.
File used: MTA_Bridges_and_Tunnels_Hourly_Crossings__Beginning_2019_20250426.csv
Filters applied:
Only Verrazzano Narrows Bridge crossings selected.
January–March 2024 and January–March 2025.
Analysis by vehicle type, focusing on both all vehicle traffic and trucks only.
Methods:
Traffic data aggregated by:
Calendar months (January, February, March).
Aligned 4-week periods to account for week and holiday variations.
Full week comparisons for consistent weekday/weekend distribution.
Interactive charts created using Plotly.
Absolute and percent changes calculated for 2025 vs 2024 for each metric.
## Verrazzano Monthly Crossings: All Vehicles
# Load and format data
vz_path <- "D:/Spring2025Hunter/GTECH785_Final_Project/MTA_Bridges_and_Tunnels_Hourly_Crossings__Beginning_2019_20250426.csv"
vz_raw <- read_csv(vz_path, show_col_types = FALSE)
vz <- vz_raw %>%
filter(Facility == "Verrazano Narrows Bridge") %>%
mutate(
Date = mdy(Date),
Year = year(Date),
Month = month(Date, label = TRUE, abbr = FALSE)
)
vz_monthly <- vz %>%
filter(Month %in% c("January", "February", "March"), Year %in% c(2024, 2025)) %>%
group_by(Month, Year) %>%
summarise(Total_Crossings = sum(`Traffic Count`, na.rm = TRUE), .groups = "drop") %>%
mutate(Month = factor(Month, levels = c("January", "February", "March"), ordered = TRUE))
vz_change <- vz_monthly %>%
pivot_wider(names_from = Year, values_from = Total_Crossings) %>%
mutate(
Abs_Change = `2025` - `2024`,
Pct_Change = (`2025` - `2024`) / `2024` * 100,
Change_Label = paste0(comma(Abs_Change), " (", round(Pct_Change, 1), "%)")
)
vz_monthly <- vz_monthly %>%
left_join(vz_change %>% select(Month, Change_Label), by = "Month") %>%
mutate(
Tooltip = ifelse(Year == 2025,
paste0("Year: ", Year, "<br>Total: ", comma(Total_Crossings), "<br>Change: ", Change_Label),
paste0("Year: ", Year, "<br>Total: ", comma(Total_Crossings)))
)
p1 <- ggplot(vz_monthly, aes(x = Month, y = Total_Crossings, fill = as.factor(Year), text = Tooltip)) +
geom_col(position = position_dodge(width = 0.9)) +
geom_text(
aes(
label = paste0(round(Total_Crossings / 1e6, 2), "M"),
y = Total_Crossings + 100000
),
position = position_dodge(width = 0.9),
color = "black",
fontface = "bold",
size = 4
) +
scale_fill_manual(values = c("2024" = "#1f77b4", "2025" = "#ff7f0e")) +
scale_y_continuous(labels = comma, expand = expansion(mult = c(0, 0.15))) +
labs(title = "Monthly Vehicle Crossings (All Types)", x = "Month", y = "Total Crossings", fill = "Year") +
theme_minimal()
ggplotly(p1, tooltip = "text")## All Crossings by 4-Week Aligned Periods
periods <- tribble(
~Month, ~Start, ~End,
"January", "2024-01-08", "2024-02-04",
"February", "2024-02-05", "2024-03-03",
"March", "2024-03-04", "2024-03-31",
"January", "2025-01-06", "2025-02-02",
"February", "2025-02-03", "2025-03-02",
"March", "2025-03-03", "2025-03-30"
) %>%
mutate(Start = as.Date(Start), End = as.Date(End), Period_Year = year(Start))
vz_aligned <- vz %>%
rowwise() %>%
mutate(Period = {
matched <- periods %>% filter(Date >= Start & Date <= End) %>% slice(1)
if (nrow(matched) > 0) paste0(matched$Month, " ", matched$Period_Year) else NA
}) %>%
filter(!is.na(Period)) %>%
ungroup()
vz_period_summary <- vz_aligned %>%
separate(Period, into = c("Month", "Year"), sep = " ", convert = TRUE) %>%
group_by(Month, Year) %>%
summarise(Total_Crossings = sum(`Traffic Count`, na.rm = TRUE), .groups = "drop") %>%
mutate(Month = factor(Month, levels = c("January", "February", "March")))
vz_period_change <- vz_period_summary %>%
pivot_wider(names_from = Year, values_from = Total_Crossings) %>%
mutate(
Abs_Change = `2025` - `2024`,
Pct_Change = (`2025` - `2024`) / `2024` * 100,
Change_Label = paste0(comma(Abs_Change), " (", round(Pct_Change, 1), "%)")
)
vz_period_summary <- vz_period_summary %>%
left_join(vz_period_change %>% select(Month, Change_Label), by = "Month") %>%
mutate(
Tooltip = ifelse(Year == 2025,
paste0("Year: ", Year, "<br>Total: ", comma(Total_Crossings), "<br>Change: ", Change_Label),
paste0("Year: ", Year, "<br>Total: ", comma(Total_Crossings)))
)
p1a <- ggplot(vz_period_summary, aes(x = Month, y = Total_Crossings, fill = as.factor(Year), text = Tooltip)) +
geom_col(position = position_dodge(width = 0.9)) +
geom_text(
aes(
label = paste0(round(Total_Crossings / 1e6, 2), "M"),
y = Total_Crossings + 100000
),
position = position_dodge(width = 0.9),
color = "black",
fontface = "bold",
size = 4
) +
scale_fill_manual(values = c("2024" = "#1f77b4", "2025" = "#ff7f0e")) +
scale_y_continuous(labels = comma, expand = expansion(mult = c(0, 0.15))) +
labs(title = "Crossings by 4-Week Aligned Periods", x = "Period", y = "Total Crossings", fill = "Year") +
theme_minimal()
ggplotly(p1a, tooltip = "text")## Weekly Crossings (All Vehicles)
start_2024 <- as.Date("2024-01-08")
end_2024 <- as.Date("2024-03-31")
start_2025 <- as.Date("2025-01-06")
end_2025 <- as.Date("2025-03-30")
vz_week <- vz %>%
filter((Date >= start_2024 & Date <= end_2024 & Year == 2024) |
(Date >= start_2025 & Date <= end_2025 & Year == 2025)) %>%
mutate(
Week_Block = if_else(Year == 2024,
floor(as.numeric(difftime(Date, start_2024, units = "days")) / 7) + 1,
floor(as.numeric(difftime(Date, start_2025, units = "days")) / 7) + 1)
)
vz_weekly <- vz_week %>%
group_by(Year, Week_Block) %>%
summarise(Total_Crossings = sum(`Traffic Count`, na.rm = TRUE), .groups = "drop")
weekly_change <- vz_weekly %>%
pivot_wider(names_from = Year, values_from = Total_Crossings) %>%
mutate(
Abs_Change = `2025` - `2024`,
Pct_Change = (`2025` - `2024`) / `2024` * 100
)
vz_weekly <- vz_weekly %>%
left_join(weekly_change %>% select(Week_Block, Abs_Change, Pct_Change), by = "Week_Block") %>%
mutate(
Tooltip = if_else(
Year == 2025,
paste0("Week: ", Week_Block,
"<br>Year: ", Year,
"<br>Total: ", comma(Total_Crossings),
"<br>Change: ", comma(Abs_Change), " (", round(Pct_Change, 1), "%)"),
paste0("Week: ", Week_Block,
"<br>Year: ", Year,
"<br>Total: ", comma(Total_Crossings))
)
)
p_week <- ggplot(vz_weekly, aes(x = Week_Block, y = Total_Crossings, color = as.factor(Year))) +
geom_line(size = 1.2) +
geom_point(aes(text = Tooltip), size = 2) +
scale_color_manual(values = c("2024" = "#1f77b4", "2025" = "#ff7f0e")) +
scale_y_continuous(labels = comma) +
labs(title = "Weekly Vehicle Crossings (with % Change)",
x = "Week Block", y = "Total Crossings", color = "Year") +
theme_minimal()## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## Warning in geom_point(aes(text = Tooltip), size = 2): Ignoring unknown
## aesthetics: textggplotly(p_week, tooltip = "text")## Monthly Crossings: Trucks Only
vz_trucks <- vz %>%
filter(`Vehicle Class Category` == "Truck")
truck_monthly <- vz_trucks %>%
filter(Month %in% c("January", "February", "March"), Year %in% c(2024, 2025)) %>%
group_by(Month, Year) %>%
summarise(Total_Trucks = sum(`Traffic Count`, na.rm = TRUE), .groups = "drop") %>%
mutate(Month = factor(Month, levels = c("January", "February", "March"), ordered = TRUE))
truck_monthly_change <- truck_monthly %>%
pivot_wider(names_from = Year, values_from = Total_Trucks) %>%
mutate(
Abs_Change = `2025` - `2024`,
Pct_Change = (`2025` - `2024`) / `2024` * 100,
Change_Label = paste0(comma(Abs_Change), " (", round(Pct_Change, 1), "%)")
)
truck_monthly <- truck_monthly %>%
left_join(truck_monthly_change %>% select(Month, Change_Label), by = "Month") %>%
mutate(
Tooltip = ifelse(Year == 2025,
paste0("Year: ", Year,
"<br>Total Trucks: ", comma(Total_Trucks),
"<br>Change: ", Change_Label),
paste0("Year: ", Year,
"<br>Total Trucks: ", comma(Total_Trucks)))
)
p_truck_monthly <- ggplot(truck_monthly, aes(x = Month, y = Total_Trucks, fill = as.factor(Year), text = Tooltip)) +
geom_col(position = position_dodge(width = 0.9)) +
geom_text(
aes(label = paste0(round(Total_Trucks / 1e3, 1), "K"), y = Total_Trucks + 10000),
position = position_dodge(width = 0.9),
vjust = 0, fontface = "bold", color = "black", size = 4
) +
scale_fill_manual(values = c("2024" = "#1f77b4", "2025" = "#ff7f0e")) +
scale_y_continuous(labels = comma, expand = expansion(mult = c(0, 0.15))) +
labs(title = "Monthly Truck Crossings (Jan–Mar)", x = "Month", y = "Total Truck Crossings", fill = "Year") +
theme_minimal()
ggplotly(p_truck_monthly, tooltip = "text")## Truck Crossings by 4-Week Aligned Periods
periods <- tribble(
~Month, ~Start, ~End,
"January", "2024-01-08", "2024-02-04",
"February", "2024-02-05", "2024-03-03",
"March", "2024-03-04", "2024-03-31",
"January", "2025-01-06", "2025-02-02",
"February", "2025-02-03", "2025-03-02",
"March", "2025-03-03", "2025-03-30"
) %>% mutate(Start = as.Date(Start), End = as.Date(End), Period_Year = year(Start))
truck_aligned <- vz_trucks %>%
rowwise() %>%
mutate(Period = {
matched <- periods %>% filter(Date >= Start & Date <= End) %>% slice(1)
if (nrow(matched) > 0) paste0(matched$Month, " ", matched$Period_Year) else NA
}) %>%
filter(!is.na(Period)) %>%
ungroup()
truck_period_summary <- truck_aligned %>%
separate(Period, into = c("Month", "Year"), sep = " ", convert = TRUE) %>%
group_by(Month, Year) %>%
summarise(Total_Trucks = sum(`Traffic Count`, na.rm = TRUE), .groups = "drop") %>%
mutate(Month = factor(Month, levels = c("January", "February", "March"), ordered = TRUE))
truck_period_change <- truck_period_summary %>%
pivot_wider(names_from = Year, values_from = Total_Trucks) %>%
mutate(
Abs_Change = `2025` - `2024`,
Pct_Change = (`2025` - `2024`) / `2024` * 100,
Change_Label = paste0(comma(Abs_Change), " (", round(Pct_Change, 1), "%)")
)
truck_period_summary <- truck_period_summary %>%
left_join(truck_period_change %>% select(Month, Change_Label), by = "Month") %>%
mutate(
Tooltip = ifelse(Year == 2025,
paste0("Year: ", Year,
"<br>Total Trucks: ", comma(Total_Trucks),
"<br>Change: ", Change_Label),
paste0("Year: ", Year,
"<br>Total Trucks: ", comma(Total_Trucks)))
)
p_truck_period <- ggplot(truck_period_summary, aes(x = Month, y = Total_Trucks, fill = as.factor(Year), text = Tooltip)) +
geom_col(position = position_dodge(width = 0.9)) +
geom_text(
aes(label = paste0(round(Total_Trucks / 1e3, 1), "K"), y = Total_Trucks + 10000),
position = position_dodge(width = 0.9),
vjust = 0, fontface = "bold", color = "black", size = 4
) +
scale_fill_manual(values = c("2024" = "#1f77b4", "2025" = "#ff7f0e")) +
scale_y_continuous(labels = comma, expand = expansion(mult = c(0, 0.15))) +
labs(title = "Truck Crossings by 4-Week Aligned Periods", x = "Custom Period", y = "Total Truck Crossings", fill = "Year") +
theme_minimal()
ggplotly(p_truck_period, tooltip = "text")## Weekly Truck Crossings
truck_week <- vz_trucks %>%
filter((Date >= start_2024 & Date <= end_2024) |
(Date >= start_2025 & Date <= end_2025)) %>%
mutate(Week_Block = if_else(Year == 2024,
floor(as.numeric(difftime(Date, start_2024, units = "days")) / 7) + 1,
floor(as.numeric(difftime(Date, start_2025, units = "days")) / 7) + 1))
truck_weekly <- truck_week %>%
group_by(Year, Week_Block) %>%
summarise(Total_Trucks = sum(`Traffic Count`, na.rm = TRUE), .groups = "drop")
# Step 1: Pivot wider to calculate change
truck_week_change <- truck_weekly %>%
pivot_wider(names_from = Year, values_from = Total_Trucks) %>%
mutate(
Abs_Change = `2025` - `2024`,
Pct_Change = (`2025` - `2024`) / `2024` * 100
)
# Step 2: Join changes back to original for tooltips
truck_weekly <- truck_weekly %>%
left_join(
truck_week_change %>% select(Week_Block, Abs_Change, Pct_Change),
by = "Week_Block"
) %>%
mutate(
Tooltip = if_else(
Year == 2025,
paste0("Week: ", Week_Block,
"<br>Year: ", Year,
"<br>Trucks: ", comma(Total_Trucks),
"<br>Change: ", comma(Abs_Change), " (", round(Pct_Change, 1), "%)"),
paste0("Week: ", Week_Block,
"<br>Year: ", Year,
"<br>Trucks: ", comma(Total_Trucks))
)
)
# Step 3: Final plot with tooltip
p_truck_weekly <- ggplot(truck_weekly, aes(x = Week_Block, y = Total_Trucks, color = as.factor(Year))) +
geom_line(size = 1.2) +
geom_point(aes(text = Tooltip), size = 2) +
scale_color_manual(values = c("2024" = "#1f77b4", "2025" = "#ff7f0e")) +
scale_y_continuous(labels = comma) +
labs(
title = "Weekly Truck Crossings (Aligned Weeks)",
x = "Week Block", y = "Total Truck Crossings", color = "Year"
) +
theme_minimal()## Warning in geom_point(aes(text = Tooltip), size = 2): Ignoring unknown
## aesthetics: textggplotly(p_truck_weekly, tooltip = "text")## Truck Summary Table
truck_period_change %>%
select(Month, `2024`, `2025`, Abs_Change, Pct_Change) %>%
mutate(
`2024` = comma(`2024`),
`2025` = comma(`2025`),
Abs_Change = comma(Abs_Change),
Pct_Change = paste0(round(Pct_Change, 1), "%")
) %>%
rename(
`Custom Period` = Month,
`Total Trucks 2024` = `2024`,
`Total Trucks 2025` = `2025`,
`Absolute Change` = Abs_Change,
`Percent Change` = Pct_Change
) %>%
arrange(factor(`Custom Period`, levels = c("January", "February", "March"))) %>%
kable("html", escape = FALSE, align = "c", caption = "Truck Traffic Changes by 4-Week Aligned Periods (2024 vs 2025)") %>%
kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover", "condensed", "responsive"))| Custom Period | Total Trucks 2024 | Total Trucks 2025 | Absolute Change | Percent Change |
|---|---|---|---|---|
| January | 295,229 | 310,676 | 15,447 | 5.2% |
| February | 297,382 | 310,876 | 13,494 | 4.5% |
| March | 297,725 | 317,189 | 19,464 | 6.5% |
The analysis reveals a slight increase in Verrazzano Bridge total vehicle crossings in January 2025 following the introduction of congestion pricing. However, the effect was not sustained, as crossings declined slightly in February and March. Truck traffic, on the other hand, showed a consistent increase across January–March, suggesting that congestion pricing may have had less of a deterrent effect on commercial vehicles.
Understanding that truck crossings increased post-congestion pricing highlights the need to reconsider freight and delivery policies. Possible measures could include special toll structures for trucks, investment in alternative freight corridors, or expanded ferry cargo options to minimize truck dependency on the bridge.