adjustNetwork.R

#!/usr/bin/env Rscript

# load libraries and functions --------------------------------------------
suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(tidyr))
suppressPackageStartupMessages(library(sf))
options(dplyr.summarise.inform = FALSE) # make dplyr stop blabbing about summarise


# Reading inputs
nodesmel = st_read("data/melbourneClipped_nodes.sqlite")
edgesmel = st_read("data/melbourneClipped_edges.sqlite")
# shouldn't be any multi-linestrings, but better to be certain
edgesmel <- edgesmel %>%
  st_cast("LINESTRING") %>%
  mutate(osm_id_full=osm_id)
edgesmel$osm_id <- gsub("_.*", "", edgesmel$osm_id)

streetnames <- readRDS("data/network_streetnames.rds")

# Nodes adjustment --------------------------------------------------------

# CODE FOR ADDING ELEVATION TO NODES. It should already be present
# library(raster)
# # Adjusting nodes
# addElevation2Nodes <- function(nodes, rasterFile, multiplier=10){
#   elevation <- raster(rasterFile) 
#   nodes$z <- round(raster::extract(elevation ,as(nodes, "Spatial"),method='bilinear'))/multiplier
#   return(nodes)
# }
# 
# st_crs(nodesmel) <- 28355
# nodes_crs <- nodesmel %>% st_as_sf() %>%  st_transform(crs =  28355)
# 
# nodesmel <- addElevation2Nodes(nodes = nodes_crs, rasterFile = "./data/DEMx10EPSG28355.tif" )

nodes <- nodesmel %>%
  mutate(cyc_cros = case_when(type %in% c("signalised_intersection","signalised_roundabout") ~ "Car signal")) %>%
  mutate(ped_cros = cyc_cros) %>%
  mutate(z=ifelse(is.na(z),0,z)) %>% # a few of the points land outside of the study area so setting their height to 0
  mutate(id=as.integer(id)) %>%
  mutate(z=as.integer(z)) %>%
  select(nodeID=id,z_coor=z,ped_cros,cyc_cros)

st_write(nodes, "nodesMelbourne.gpkg", delete_dsn = T)


# Edges adjustment --------------------------------------------------------

# determine the number of pedestrian and cycling crossings
crossing_count <- edgesmel %>%
  st_drop_geometry() %>%
  dplyr::select(edgeID=id,from=from_id,to=to_id) %>%
  pivot_longer(cols=c(from,to)) %>%
  dplyr::select(edgeID,nodeID=value) %>%
  inner_join(nodes%>%st_drop_geometry()%>%dplyr::select(nodeID,ped_cros,cyc_cros), by="nodeID") %>%
  mutate(ped_cros=ifelse(is.na(ped_cros),0,1)) %>%
  mutate(cyc_cros=ifelse(is.na(cyc_cros),0,1)) %>%
  group_by(edgeID) %>%
  summarise(crs_cnt=sum(ped_cros,na.rm=T),bik_cnt=sum(cyc_cros,na.rm=T)) %>%
  ungroup()

# attributes calculated in processNetwork.R
edge_attributes <- readRDS("data/POIs_joined.rds")

# VGVI results
vgvi_results <- readRDS("data/vgvi.rds")

edges <- edgesmel %>%
  left_join(streetnames, by="osm_id") %>%
  rename(name = streetname) %>%
  # st_drop_geometry() %>%
  left_join(edge_attributes, by="id") %>%
  left_join(vgvi_results, by="id") %>%
  rename(edgeID=id,
         from=from_id,
         to=to_id) %>%
  mutate(junctn = "no") %>%
  mutate(onwysmm = case_when(
    is_car==0 & is_walk==1 & is_cycle==0  ~ "Not Applicable",
    is_oneway==1                          ~ "One Way",
    is_oneway==0                          ~ "Two Way",
  )) %>%
  mutate(elevatn = "ground") %>%
  mutate(maxspeed = freespeed * 2.23694) %>%
  mutate(surface = ifelse(surface=="concrete:lanes","concrete",surface)) %>%
  mutate(surface = ifelse(is.na(surface),"asphalt",surface)) %>%
  mutate(segrgtd = ifelse(cycleway%in%c("separated_lane","bikepath"),"yes","no")) %>%
  mutate(sidewlk = case_when(
    is_car==0                              ~ "Not Applicable",
    is_car==1 & (is_walk==1 | is_cycle==1) ~ "both",
    is_car==1 & is_walk==0 & is_cycle==0   ~ "no"
  )) %>%
  mutate(lns_psv_f = 0) %>%
  mutate(lns_no_f = permlanes) %>% 
  mutate(lns_no_b = ifelse(is_oneway==0,lns_no_f,0)) %>% 
  mutate(lns_psv_b = 0) %>%
  rename(quitnss=quietness) %>%
  mutate(avg_wdt_mp = round(permlanes * (1.976000 + 0.102142*freespeed),3)) %>%
  mutate(slope=ifelse(is.na(fwd_slope_pct),0,fwd_slope_pct)) %>% # setting edges with no slope to 0
  left_join(crossing_count, by="edgeID") %>%
  mutate(cros_rt=crs_cnt/length) %>%
  mutate(bike_rt=bik_cnt/length) %>%
  mutate(RtSrf_m=ifelse(is_walk==1 | is_cycle==1,"all-weather",NA)) %>%
  mutate(cyclesm=case_when(
    is_car == 0 ~ "offroad",
    cycleway == "shared_path" ~ "offroad",
    cycleway == "bikepath" ~ "kerbed",
    cycleway == "separated_lane" ~ "kerbed",
    cycleway == "simple_lane" ~ "painted",
    TRUE ~ "integrated"
  )) %>%
  rename(indp_sc=positpoi_score) %>%
  rename(ngp_scr=negpoi_score) %>%
  dplyr::relocate(edgeID,from,to,osm_id,name,highway,junctn,onwysmm,elevatn,
                  length,maxspeed,surface,segrgtd,sidewlk,
                  lns_psv_f,lns_no_f,lns_no_b,lns_psv_b,
                  quitnss,avg_wdt_mp,slope,
                  negpoi_hgv_score,crs_cnt,cros_rt,bik_cnt,bike_rt,RtSrf_m,cyclesm,
                  highstr,indp_sc,ngp_scr,shannon,simpson,VGVI_mean,urban) %>%
  mutate(across(c(edgeID,from,to,osm_id,quitnss,permlanes), as.integer)) %>%
  mutate(across(c(is_oneway,is_cycle,is_walk,is_car,is_truck), as.logical))


st_write(edges, "edgesMelbourne.gpkg", delete_dsn = T)