library(tidyverse) library(influxdbclient) library(glue) library(ggmap) library(sf) # parameters needed to make connection to Database #token <- substr(read_file(file = 'api_keys/influxdb_madison-metro'), 1, 88) #org <- "e2581d54779b077f" #bucket <- "madison-metro" token <- substr(read_file(file = 'api_keys/influxdb_madison-metro_new'), 1, 88) org <- "32b7fde0efd8a3b3" bucket <- "metro_vehicles" days <- 1 influx_connection <- InfluxDBClient$new(url = "https://influxdb.dendroalsia.net", token = token, org = org) #--- # Fields to query fields <- c("des", "spd", "pdist", "lon", "lat", "dly", "origtatripno") # An empty list to store results for each field results <- vector("list", length(fields)) # Loop through each field, get data, and coerce types if needed for (i in seq_along(fields)) { field <- fields[i] query_string <- glue('from(bucket: "{bucket}") ', '|> range(start: -{days}d) ', '|> filter(fn: (r) => r["_measurement"] == "vehicle_data")', '|> filter(fn: (r) => r["_field"] == "{field}")') data <- influx_connection$query(query_string) # Ensure the columns are coerced to consistent types # (Optionally add coercion based on your expected types) data <- bind_rows(data) %>% mutate(value = as.character(`_value`), field = `_field`) %>% select(time, rt, pid, vid, value, field) results[[i]] <- data } # Bind all results together metro_raw <- bind_rows(results) metro_raw <- pivot_wider(metro_raw, values_from = value, names_from = field) %>% distinct(pid, vid, lat, lon, spd, .keep_all = TRUE) routes_categorized <- read_csv(file = "routes_categorized.csv", col_types = "cc") metro_data <- metro_raw %>% mutate(time = with_tz(time, "America/Chicago"), spd = as.double(spd), pdist = as.double(pdist), lon = as.double(lon), lat = as.double(lat)) %>% mutate(date = date(time)) %>% group_by(pid, vid) %>% arrange(time) %>% mutate(pdist_lag = lag(pdist), time_lag = lag(time)) %>% ungroup() %>% mutate(spd_calc = case_when(pdist_lag > pdist ~ NA, pdist_lag <= pdist ~ (pdist - pdist_lag)/as.double(difftime(time, time_lag, units = "hours"))/5280)) %>% left_join(routes_categorized, by = "pid") bucket_feet <- 500 lat_round <- bucket_feet/364481.35 lon_round <- bucket_feet/267203.05 metro_summary <- metro_data %>% mutate(lat_bucket = round(lat / lat_round) * lat_round, lon_bucket = round(lon / lon_round) * lon_round) %>% group_by(rt, name, pid, lat_bucket, lon_bucket) %>% summarise(spd = median(spd, na.rm = TRUE), spd_calc = median(spd_calc, na.rm = TRUE), pdist = median(pdist), trip_count = length(unique(origtatripno))) metro_data_sf <- st_as_sf(metro_data %>% filter(!is.na(lon), !is.na(lat)), coords = c("lon", "lat"), remove = FALSE) metro_summary_sf <- st_as_sf(metro_summary %>% filter(!is.na(lon_bucket), !is.na(lat_bucket)), coords = c("lon_bucket", "lat_bucket"), remove = FALSE) metro_segments <- metro_summary %>% group_by(rt, pid) %>% arrange(pdist) %>% mutate(lat_bucket_lag = lag(lat_bucket), lon_bucket_lag = lag(lon_bucket)) %>% filter(!is.na(lat_bucket) & !is.na(lon_bucket) & !is.na(lat_bucket_lag) & !is.na(lon_bucket_lag)) %>% mutate( geometry = pmap(list(lat_bucket, lon_bucket, lat_bucket_lag, lon_bucket_lag), ~st_linestring(matrix(c(..2, ..1, ..4, ..3), ncol = 2, byrow = TRUE))) ) %>% st_as_sf(sf_column_name = "geometry") %>% group_by(rt, name, lat_bucket, lon_bucket) %>% summarise(spd_calc = weighted.mean(spd_calc, trip_count)) # get counts of routes route_counts <- metro_data %>% group_by(pid, rt, des) %>% summarise(route_count = length(unique(origtatripno))) # make charts ggplot(data = metro_summary %>% filter(pid %in% (routes_categorized %>% filter(name %in% c("B_North", "B_South")) %>% pull (pid))), aes(x = pdist, y = spd_calc)) + geom_point() + geom_smooth() + facet_grid(name ~ .) ggplot(data = metro_summary %>% filter(!is.na(name)), aes(x = name, y = spd_calc)) + geom_boxplot() register_stadiamaps(key = substr(read_file(file = "api_keys/stadia_api_key"), 1, 36)) bbox <- c(left = min(metro_data$lon, na.rm = TRUE), bottom = min(metro_data$lat, na.rm = TRUE), right = max(metro_data$lon, na.rm = TRUE), top = max(metro_data$lat, na.rm = TRUE)) #get basemap basemap <- get_stadiamap(bbox = bbox, zoom = 13, maptype = "stamen_toner_lite") quantile(metro_segments %>% filter(name %in% c("A_West")) %>% pull(spd_calc), c(0,0.25, 0.5, 0.75, 1), na.rm = TRUE) for (route in unique(routes_categorized$name)){ route_focus <- routes_categorized %>% filter(name == route) %>% pull(pid) ggmap(basemap) + labs(title = paste0("Metro Route Speed - ", route), subtitle = paste0("averaged between ", sum(route_counts %>% filter(pid %in% route_focus) %>% pull(route_count)), " bus trips - ", min(date(metro_data$time)), " to ", max(date(metro_data$time))), x = NULL, y = NULL) + theme(axis.text=element_blank(), axis.ticks=element_blank(), plot.caption = element_text(color = "grey")) + geom_sf(data = metro_segments %>% filter(name %in% route), inherit.aes = FALSE, aes(color = spd_calc), linewidth = 1) + scale_color_distiller(palette = "RdYlGn", direction = "reverse", limits = c(0,70), name = "Average speed or segment\n(calculated with locations, not reported speed)") ggsave(file = paste0("figures/", route, "_map.pdf"), title = paste0("Metro Route Speed - ", route), device = pdf, height = 8.5, width = 11, units = "in", create.dir = TRUE) ggplot(data = metro_data %>% filter(name %in% route)) + geom_boxplot(aes(x = date, y = spd_calc, group = date)) ggsave(file = paste0("figures/", route, "_date.pdf"), title = paste0("Metro Route Speed - ", route), device = pdf, height = 8.5, width = 11, units = "in", create.dir = TRUE) }