Skip to content

Instantly share code, notes, and snippets.

@MattSandy
Created December 16, 2022 19:45
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save MattSandy/fdf5df702014cf2d99c4ebc15a54687d to your computer and use it in GitHub Desktop.
Save MattSandy/fdf5df702014cf2d99c4ebc15a54687d to your computer and use it in GitHub Desktop.
SWRLT
library(sf)
library(ggmap)
library(ggplot2)
library(ggthemes)
library(dplyr)
library(magrittr)
library(data.table)
# Fetching
library(rvest)
# Cleaning column names
library(janitor)
# Date/Time formatting
library(lubridate)
# Maps
library(dplyr)
library(tidyverse)
library(leaflet)
library("geosphere")
swlrt <- st_read("import/shp_trans_pland_transitway_station/PlannedTransitwayStations.shp") %>%
filter(Transitway %in% c("Green Line Extension"))
neighborhoods <- st_read("import/neighborhoods/Neighborhoods.shp") %>%
filter(BDNAME %in% c("Harrison","East Isles","Bryn - Mawr"))
test <- as_Spatial(neighborhoods$geometry)
neighborhoods <- unnest(neighborhoods$geometry)
neighborhoods$geometry[[1]][1]
green <- st_read("import/803_Green_Track_0316/803_Track_0316.shp")$geometry
swlrt <- swlrt[order(swlrt$StationID),]
# Stops -------------------------------------------------------------------
typeof(stops$stop_lat)
typeof(swlrt$X)
stops <- read_csv("./import/transit/stops.txt")
stops$Distance <- apply(stops,1,function(stop) {
distances <- c()
for(i in 1:nrow(swlrt)) {
x1 <- stop['stop_lon'] %>% as.character %>% as.numeric
y1 <- stop['stop_lat'] %>% as.character %>% as.numeric
distances <- append(distances,distm(c(x1, y1),
c(swlrt$X[i], swlrt$Y[i]),
fun = distHaversine))
}
return(min(distances))
})
# trips -------------------------------------------------------------------
trips <- read_csv("./import/transit/trips.txt")
trips$trip_id %<>% str_match("^[0-9]+")
# stop times --------------------------------------------------------------
stop_times <- read_csv("./import/transit/stop_times.txt")
stop_times$trip_id %<>% str_match("^[0-9]+")
# merging -----------------------------------------------------------------
stops$trip_id <- sapply(stops$stop_id,function(stop) {
return(stop_times$trip_id[which(stop_times$stop_id==stop)])
})
# shapes ------------------------------------------------------------------
stops_filtered <- stops[which(stops$Distance <= 804),]
shape_ids <- trips$shape_id[which(trips$trip_id %in% unlist(stops_filtered$trip_id))]
shapes <- read_csv("./import/transit/shapes.txt")
shapes_filtered <- shapes[which(shapes$shape_id %in% shape_ids),]
# leaflet -----------------------------------------------------------------
stops_filtered$popup <- sapply(stops_filtered$stop_id,function(stop_id){
trip_ids <- stops_filtered$trip_id[which(stops_filtered$stop_id==stop_id)] %>% unlist
body <- paste0(trips$trip_headsign[which(trips$trip_id %in% trip_ids)] %>% unique,collapse = "</li><li>")
paste0("<li>",body,'</li>') %>% return
})
stops_filtered$popup <- paste0('<strong>',stops_filtered$stop_name,'</strong>',
'<br>',
'<ul>',stops_filtered$popup,'</ul><br>',
'<a href="',
stops_filtered$stop_url,
'">View Stop on MetroTransit</a>')
shapes_tiny <- shapes[which(shapes$shape_id %in% c("30002")),]
iconRail <- icons(
iconUrl = "rail.png",
iconWidth = 23, iconHeight = 35
)
iconBus <- icons(
iconUrl = "bus.png",
iconWidth = 20, iconHeight = 20
)
leaflet() %>%
addProviderTiles(providers$OpenStreetMap) %>% # Add default OpenStreetMap map tiles
addCircles(lng=swlrt$X,
lat=swlrt$Y,
weight = 1,
radius = 804
) %>%
addMarkers(lng=swlrt$X, lat=swlrt$Y, popup=swlrt$Station, icon = iconRail) %>%
addMarkers(lng=stops_filtered$stop_lon,
lat=stops_filtered$stop_lat,
popup=stops_filtered$popup,
icon = iconBus)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment