edits to analysis
This commit is contained in:
parent
c98fe88d40
commit
ba29e58466
2 changed files with 84 additions and 80 deletions
122
.Rhistory
122
.Rhistory
|
@ -1,64 +1,3 @@
|
|||
labs(title = "Metro Route Speed",
|
||||
subtitle = paste0("averaged between ",
|
||||
length(unique(metro_data %>% filter(pid %in% c("422")) %>% pull(origtatripno))),
|
||||
" 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 = segments_sf %>% filter(pid %in% c("422")),
|
||||
inherit.aes = FALSE,
|
||||
aes(color = lag_spd),
|
||||
linewidth = 1) +
|
||||
scale_color_distiller(palette = "RdYlGn", direction = "reverse", limits = c(0,70), name = "Average speed\n(calculated with consecutive points)") +
|
||||
facet_wrap(paste0(rt, "-", des) ~ .)
|
||||
View(metro_summary)
|
||||
metro_summary <- metro_data %>%
|
||||
mutate(pdist_bucket = round(pdist / 500) * 500) %>%
|
||||
group_by(pdist_bucket, rt, des, pid) %>%
|
||||
summarise(lat = median(lat),
|
||||
lon = median(lon),
|
||||
spd = median(spd),
|
||||
lag_spd = median(lag_spd),
|
||||
trip_count = n())
|
||||
metro_summary <- metro_data %>%
|
||||
mutate(pdist_bucket = round(pdist / 500) * 500) %>%
|
||||
group_by(pdist_bucket, rt, des, pid, origtatripno) %>%
|
||||
summarise(lat = median(lat),
|
||||
lon = median(lon),
|
||||
spd = median(spd),
|
||||
lag_spd = median(lag_spd),
|
||||
trip_count = n())
|
||||
trip_count = length(unique(origtatripno))
|
||||
metro_summary <- metro_data %>%
|
||||
mutate(pdist_bucket = round(pdist / 500) * 500) %>%
|
||||
group_by(pdist_bucket, rt, des, pid) %>%
|
||||
summarise(lat = median(lat),
|
||||
lon = median(lon),
|
||||
spd = median(spd),
|
||||
lag_spd = median(lag_spd),
|
||||
trip_count = length(unique(origtatripno)))
|
||||
ggmap(basemap) +
|
||||
labs(title = "Metro Route Speed",
|
||||
subtitle = paste0("averaged between ",
|
||||
segments_sf %>% filter(pid %in% c("422")) %>% pull(trip_count))),
|
||||
ggmap(basemap) +
|
||||
labs(title = "Metro Route Speed",
|
||||
subtitle = paste0("averaged between ",
|
||||
segments_sf %>% filter(pid %in% c("422")) %>% pull(trip_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 = segments_sf %>% filter(pid %in% c("422")),
|
||||
inherit.aes = FALSE,
|
||||
aes(color = lag_spd),
|
||||
|
@ -510,3 +449,64 @@ aes(color = lag_spd),
|
|||
linewidth = 1) +
|
||||
scale_color_distiller(palette = "RdYlGn", direction = "reverse", limits = c(0,70), name = "Average speed\n(calculated with consecutive points)") +
|
||||
facet_wrap(paste0(rt, "-", des) ~ .)
|
||||
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"
|
||||
days <- 1
|
||||
influx_connection <- InfluxDBClient$new(url = "https://influxdb.dendroalsia.net",
|
||||
token = token,
|
||||
org = org)
|
||||
#---
|
||||
# Fields you want to query
|
||||
fields <- c("spd", "pdist", "pid", "lon", "lat", "vid", "dly", "origtatripno")
|
||||
# Creating 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, des, 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)
|
||||
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)) %>%
|
||||
group_by(origtatripno) %>%
|
||||
arrange(time) %>%
|
||||
mutate(lag_pdist = lag(pdist),
|
||||
lag_time = lag(time)) %>%
|
||||
mutate(lag_spd = (pdist - lag_pdist)/as.double(difftime(time, lag_time, units = "hours"))/5280)
|
||||
routes_categorized <- read_csv(file = "routes_categorized.csv", col_types = "cc")
|
||||
bucket_lat <- 364481.35/200
|
||||
bucket_lon <- 267203.05/200
|
||||
metro_summary <- metro_data %>%
|
||||
left_join(routes_categorized, by = "pid") %>%
|
||||
mutate(lat_bucket = round(lat / 200) * 100) %>%
|
||||
group_by(pdist_bucket, rt, des, pid) %>%
|
||||
summarise(lat = median(lat, na.rm = TRUE),
|
||||
lon = median(lon, na.rm = TRUE),
|
||||
spd = median(spd, na.rm = TRUE),
|
||||
lag_spd = median(lag_spd, na.rm = TRUE),
|
||||
trip_count = length(unique(origtatripno)))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue