Blue Hill Ave ridership

Data Preparation

library(dplyr)
library(ggplot2)
library(jsonlite) #reading json data
library(leaflet)

df_fall <- read.csv("MBTA_Bus_Ridership_by_Time_Period%2C_Season%2C_Route_Line%2C_and_Stop (2).csv")
df_spring <- read.csv("MBTA_Bus_Ridership_by_Time_Period_Season_Route_Line_and_Stop_-_Spring.csv")

#TKeyAPIV3 <- "?api_key=c2502cf752324165b8662a9bf2a486b2"
stops<-data.frame(fromJSON(paste("https://api-v3.mbta.com/stops"), flatten = TRUE)) %>%
  select(data.id, data.attributes.latitude, data.attributes.longitude, data.attributes.name) %>%
  rename("stop_id"="data.id", "stop_lat"="data.attributes.latitude", "stop_lon"="data.attributes.longitude", "stop_name2"="data.attributes.name")

save(df_fall,df_spring,stops,file="MBTA data.Rda")

Total boardings on the Blue Hill Avenue segment between Mattpan Square and Grove Hall

load(file="MBTA data.Rda")

df_fall_a <- df_fall %>% 
  filter(route_id %in% c("22","14","28","29","31","45")) %>%
  group_by(season,route_id,day_type_name) %>% 
  summarise(ons = sum(average_ons*num_trips),offs=sum(average_offs*num_trips)) %>% 
  arrange(day_type_name,season,route_id) %>% 
  mutate(fctr = case_when(
    route_id=="14" ~ .50,
    route_id=="22" ~ .60,
    route_id=="28" ~ .70,
    route_id=="29" ~ .65,
    route_id=="31" ~ .75,
    route_id=="45" ~ .10,
    TRUE ~ 0
    )) %>% 
  mutate(seg = ons * fctr) %>% 
  group_by(day_type_name,season) %>% 
  summarise(tot = sum(seg))

df_spring_a <- df_spring %>% 
  filter(route_id %in% c("28","29","31","22","14","45")) %>%
  group_by(season,route_id,day_type_name) %>% 
  summarise(ons = sum(average_ons*num_trips_for_calculation),offs=sum(average_offs*num_trips_for_calculation)) %>% 
  arrange(day_type_name,season,route_id) %>% 
  mutate(fctr = case_when(
    route_id=="14" ~ .50,
    route_id=="22" ~ .60,
    route_id=="28" ~ .70,
    route_id=="29" ~ .65,
    route_id=="31" ~ .75,
    route_id=="45" ~ .10,
    TRUE ~ 0
    )) %>% 
  mutate(seg = ons * fctr) %>% 
  group_by(day_type_name,season) %>% 
  summarise(tot = sum(seg))

df_all_a <- rbind(df_fall_a,df_spring_a)
df_all_a$season <- factor(df_all_a$season, levels = c("Fall 2016","Fall 2017","Fall 2018","Fall 2019","Early Spring 2020","Late Spring 2020","Fall 2020","Spring 2021","Fall 2021"))

p_all <- ggplot(df_all_a, aes(season, tot, label=round(tot,0))) + 
  geom_point() + 
  geom_text(nudge_y=-3000,size=3) + 
  facet_grid(rows=vars(day_type_name)) + 
  ylab("Total daily riders on BHA segment") +
  theme(axis.text=element_text(size=6))

p_all

Map of average daily boardings by bus stop. Weekday average using Fall 2021 data.

df_fall_b <- df_fall %>% 
  filter(season=="Fall 2021" & day_type_name=="weekday") %>%
  group_by(stop_id, stop_name) %>% 
  summarise(ons = sum(average_ons*num_trips),offs=sum(average_offs*num_trips)) %>% 
  arrange(stop_id)

df_fall_b <- merge(x=df_fall_b, y=stops, by = "stop_id", all.x = TRUE)

m <- leaflet() %>%
  addProviderTiles("CartoDB.Positron") %>%
  setView(lat=42.292, lng=-71.089, zoom=15) %>%
  addCircleMarkers(data = df_fall_b,
                   ~stop_lon, ~stop_lat,
                   layerId = ~stop_id,
                   color = "red",
                   weight=1, fillOpacity = 0.2,
                   radius = ~ons/50,
                   popup = ~paste("<strong>",stop_id,stop_name,"</strong><BR>",
                                    "Total boardings:",round(ons))
                     )

m