Update to WI-schools-cycle.Rmd

Trying to get through all grade 9-12 schools in WI. Some schools have no routes, no coordinates, etc. Working my way through all the special cases.
This commit is contained in:
syounkin 2024-11-21 14:48:22 -06:00
parent 7d7a980400
commit 0c9b3e070f
2 changed files with 93 additions and 36 deletions

View file

@ -36,40 +36,50 @@ getLTSForRoute <- function(i, route_table) {
routeChar <- function(route){
text <- as.data.frame(route)$messages
text <- gsub(x = text, pattern = "\\\"", replacement = "")
text <- gsub(x = text, pattern = "\ ", replacement = "")
text <- gsub(x = text, pattern = "\\[\\[", replacement = "")
text <- gsub(x = text, pattern = "\\]\\]", replacement = "")
foobar <- strsplit(text, split = "],[", fixed = TRUE)
x <- lapply(foobar, function(x){strsplit(x, split = ",", fixed = TRUE)})
xx <- unlist(x)
m <- matrix(xx, ncol = 13, byrow = TRUE)
df <- data.frame(m[-1,])
names(df) <- m[1,]
if(is.na(route$messages)){
return(NA)
}
text <- route$messages
text <- gsub(x = text, pattern = "\\\"", replacement = "")
text <- gsub(x = text, pattern = "\ ", replacement = "")
text <- gsub(x = text, pattern = "\\[\\[", replacement = "")
text <- gsub(x = text, pattern = "\\]\\]", replacement = "")
foobar <- strsplit(text, split = "],[", fixed = TRUE)
x <- lapply(foobar, function(x){strsplit(x, split = ",", fixed = TRUE)})
xx <- unlist(x)
m <- matrix(xx, ncol = 13, byrow = TRUE)
names.vec <- m[1,]
if(nrow(m) == 2){
df <- data.frame(t(m[-1,]))
}else{
df <- data.frame(m[-1,])
}
names(df) <- names.vec
df2 <- within(df, {
Time <- as.numeric(Time)
stageTime <- diff(c(0,Time))
path <- grepl("highway=path", df$WayTags)
residential <- grepl("highway=residential", df$WayTags)
footway <- grepl("highway=footway", df$WayTags)
primary <- grepl("highway=primary", df$WayTags)
service <- grepl("highway=service", df$WayTags)
cycleway <- grepl("highway=cycleway", df$WayTags)
bike <- grepl("bicycle=designated", df$WayTags)
})
df2 <- within(df, {
Time <- as.numeric(Time)
stageTime <- diff(c(0,Time))
path <- grepl("highway=path", df$WayTags)
residential <- grepl("highway=residential", df$WayTags)
footway <- grepl("highway=footway", df$WayTags)
primary <- grepl("highway=primary", df$WayTags)
service <- grepl("highway=service", df$WayTags)
cycleway <- grepl("highway=cycleway", df$WayTags)
bike <- grepl("bicycle=designated", df$WayTags)
})
foo <- function(x){
ifelse(x$path, "path", ifelse(x$residential, "residential", ifelse(x$footway, "footway", ifelse(x$primary, "primary", ifelse(x$service, "service", ifelse(x$cycleway, "cycleway", "other"))))))
}
df2 <- cbind(df2, highway = foo(df2))
df2 <- df2 %>% group_by(highway) %>% summarize(T = sum(stageTime))
foo <- function(x){
ifelse(x$path, "path", ifelse(x$residential, "residential", ifelse(x$footway, "footway", ifelse(x$primary, "primary", ifelse(x$service, "service", ifelse(x$cycleway, "cycleway", "other"))))))
}
df2 <- cbind(df2, highway = foo(df2))
df2 <- df2 %>% group_by(highway) %>% summarize(T = sum(stageTime))
df2 <- df2 %>% filter(!is.na(highway))
df2 <- df2 %>% filter(!is.na(highway))
if(!("cycleway" %in% df2$highway)){