# script to generate `data/hampi.rda` 

```{r load, echo = FALSE}
library (magrittr)
library (osmdata)
```
```{r}
hampi <- opq ("hampi india") %>%
    add_osm_feature (key = "highway") %>%
    osmdata_sf (quiet = FALSE) %>%
    osm_poly2line () %>%
    extract2 ("osm_lines")
```
Then need to get rid of columns, especially the ones with Kannada names which
are non-UTF8
```{r}
nms <- c ("osm_id", "bicycle", "covered", "foot", "highway", "incline",
          "motorcar", "motorcycle", "motor_vehicle", "oneway", "surface",
          "tracktype", "tunnel", "width", "geometry")
hampi <- hampi [, match (nms, names (hampi))]
```
```{r}
usethis::use_data (hampi, overwrite = TRUE, compress = 'xz')
```

# generate `data/weight_profiles`

additional values from OSRM profiles at
https://github.com/Project-OSRM/osrm-backend/blob/master/profiles/

```{r}
library (magrittr)
theurl <- "https://www.routino.org/xml/routino-profiles.xml"
dat <- xml2::read_html (theurl) %>%
    rvest::html_nodes("profile") %>%
    xml2::as_list ()
```

### initial routino profiles

```{r}
weighting_profiles <- lapply (dat, function (i) {
                 di <- i$preferences
                 res <- lapply (di, function (j) 
                         c (attr (i, "name"),
                            attr (j, "highway"),
                            attr (j, "percent")))
                 do.call (rbind, res)
          })
# Then add living_street, bridleway, and footway to all profiles
# https://wiki.openstreetmap.org/wiki/Tag:highway%3Dliving_street
nms <- sapply (weighting_profiles, function (i) i [1, 1])

#               living_street   footway     bridleway
# "foot"        95              100         100
# "horse"       80              100         100
# "wheelchair"  95              100         50
# "bicycle"     95              90          70
# "moped"       60              0           0
# "motorcycle"  50              0           0
# "motorcar"    40              0           0
# "goods"       30              0           0
# "hgv"         30              0           0
# "psv"         30              0           0

wt_ls <- c (95, 80, 95, 95, 60, 50, 40, 30, 30, 30) # living street
wt_br <- c (100, 100, 50, 70, 0, 0, 0, 0, 0, 0) # bridleway
wt_fw <- c (100, 100, 100, 90, 0, 0, 0, 0, 0, 0) # footway
wt_ped <- c (100, 20, 100, 80, 0, 0, 0, 0, 0, 0) # pedestrian
names (wt_ls) <- names (wt_br) <- names (wt_fw) <- names (wt_ped) <- nms
newrows <- data.frame ("living_street" = wt_ls,
                       "bridleway" = wt_br,
                       "footway" = wt_fw,
                       "pedestrian" = wt_ped)
weighting_profiles <- lapply (weighting_profiles, function (i) {
            newdat <- t (newrows [rownames (newrows) == i [1, 1], ])
            newdat <- cbind (i [seq (ncol (newrows)), 1],
                             rownames (newdat),
                             newdat [, 1])
            rbind (i, newdat)
                       })

# plus all of the "link" types defaulting to same as parent entities
links <- c ("motorway", "trunk", "primary", "secondary", "tertiary")
nms <- paste0 (links, "_link")
weighting_profiles <- lapply (weighting_profiles, function (i)
                              {
                                  index <- match (links, i [, 2])
                                  newrows <- cbind (i [index, 1],
                                                    nms,
                                                    i [index, 3])
                                  res <- rbind (i, newrows)
                                  rownames (res) <- rep ("preference",
                                                         nrow (res))
                                  return (res)
                              })

weighting_profiles <- do.call (rbind, weighting_profiles)
weighting_profiles <- data.frame (name = weighting_profiles [, 1],
                           way = weighting_profiles [, 2],
                           value = as.numeric (weighting_profiles [, 3]),
                           stringsAsFactors = FALSE)

# bike: steps is set to 0, but here increased to 50; foot:steps = 80
weighting_profiles$value [weighting_profiles$name == "bicycle" &
                          weighting_profiles$way == "steps"] <- 50
```

### speeds from OSRM

```{r}
ways <- weighting_profiles$way [weighting_profiles$name == "foot"]
speeds <- rep (NA, length (ways))
weighting_profiles$max_speed <- NA_real_
# car, from
# https://github.com/Project-OSRM/osrm-backend/blob/master/profiles/car.lua
speeds [ways == "motorway"]         <- 90
speeds [ways == "trunk"]            <- 85
speeds [ways == "primary"]          <- 65
speeds [ways == "secondary"]        <- 55
speeds [ways == "tertiary"]         <- 40
speeds [ways == "unclassified"]     <- 25
speeds [ways == "residential"]      <- 25
speeds [ways == "service"]          <- 15
speeds [ways == "track"]            <- NA_real_
speeds [ways == "cycleway"]         <- NA_real_
speeds [ways == "path"]             <- NA_real_
speeds [ways == "steps"]            <- NA_real_
speeds [ways == "ferry"]            <- NA_real_
speeds [ways == "living_street"]    <- 10
speeds [ways == "bridleway"]        <- NA_real_
speeds [ways == "footway"]          <- NA_real_
speeds [ways == "motorway_link"]    <- 45
speeds [ways == "trunk_link"]       <- 40
speeds [ways == "primary_link"]     <- 30
speeds [ways == "secondary_link"]   <- 25
speeds [ways == "tertiary_link"]    <- 20

weighting_profiles$max_speed [weighting_profiles$name == "motorcar"] <- speeds
weighting_profiles$max_speed [weighting_profiles$name == "goods"] <- speeds
weighting_profiles$max_speed [weighting_profiles$name == "hgv"] <- speeds
weighting_profiles$max_speed [weighting_profiles$name == "psv"] <- speeds
weighting_profiles$max_speed [weighting_profiles$name == "motorcycle"] <- speeds

# moped; simply reduce max speeds to 50
speeds [speeds > 50] <- 50
weighting_profiles$max_speed [weighting_profiles$name == "moped"] <- speeds

# bicycle, from 
# https://github.com/Project-OSRM/osrm-backend/blob/master/profiles/bicycle.lua
speeds <- rep (15, length (ways))
speeds [ways == "motorway"]         <- NA_real_
speeds [ways == "trunk"]            <- NA_real_
speeds [ways == "motorway_link"]    <- NA_real_
speeds [ways == "trunk_link"]       <- NA_real_
speeds [ways == "track"]            <- 12
speeds [ways == "path"]             <- 12
speeds [ways == "steps"]            <- 4
speeds [ways == "bridleway"]        <- 8
speeds [ways == "footway"]          <- 4
speeds [ways == "pedestrian"]       <- 4
weighting_profiles$max_speed [weighting_profiles$name == "bicycle"] <- speeds

# wheelchair
speeds <- rep (5, length (ways))
speeds [ways == "motorway"]         <- NA_real_
speeds [ways == "trunk"]            <- NA_real_
speeds [ways == "motorway_link"]    <- NA_real_
speeds [ways == "trunk_link"]       <- NA_real_
speeds [ways == "track"]            <- 2
speeds [ways == "steps"]            <- NA_real_
speeds [ways == "bridleway"]        <- NA_real_
speeds [ways == "footway"]          <- 4
speeds [ways == "pedestrian"]       <- 4
weighting_profiles$max_speed [weighting_profiles$name == "wheelchair"] <- speeds

# horse
speeds <- rep (6.4, length (ways))
speeds [ways == "motorway"]         <- NA_real_
speeds [ways == "trunk"]            <- NA_real_
speeds [ways == "motorway_link"]    <- NA_real_
speeds [ways == "trunk_link"]       <- NA_real_
speeds [ways == "steps"]            <- 2
weighting_profiles$max_speed [weighting_profiles$name == "horse"] <- speeds

# foot
speeds <- rep (5, length (ways))
speeds [ways == "motorway"]         <- NA_real_
speeds [ways == "trunk"]            <- NA_real_
speeds [ways == "motorway_link"]    <- NA_real_
speeds [ways == "trunk_link"]       <- NA_real_
speeds [ways == "steps"]            <- 2
weighting_profiles$max_speed [weighting_profiles$name == "foot"] <- speeds
```


### Surfaces

Max speeds for different kinds of surfaces, from OSRM
https://github.com/Project-OSRM/osrm-backend/tree/master/profiles
```{r}
s <- rbind (c ("motorcar", "surface", "cement", 80),
            c ("motorcar", "surface", "compacted", 80),
            c ("motorcar", "surface", "fine_gravel", 80),
            c ("motorcar", "surface", "paving_stones", 60),
            c ("motorcar", "surface", "metal", 60),
            c ("motorcar", "surface", "bricks", 60),
            c ("motorcar", "surface", "grass", 40),
            c ("motorcar", "surface", "wood", 40),
            c ("motorcar", "surface", "sett", 40),
            c ("motorcar", "surface", "grass_paver", 40),
            c ("motorcar", "surface", "gravel", 40),
            c ("motorcar", "surface", "unpaved", 40),
            c ("motorcar", "surface", "ground", 40),
            c ("motorcar", "surface", "dirt", 40),
            c ("motorcar", "surface", "pebblestone", 40),
            c ("motorcar", "surface", "tartan", 40),
            c ("motorcar", "surface", "cobblestone", 30),
            c ("motorcar", "surface", "clay", 30),
            c ("motorcar", "surface", "earth", 20),
            c ("motorcar", "surface", "stone", 20),
            c ("motorcar", "surface", "rocky", 20),
            c ("motorcar", "surface", "sand", 20),
            c ("motorcar", "surface", "mud", 10),

            c ("bicycle", "surface", "cobblestone:flattened", 10),
            c ("bicycle", "surface", "paving_stones", 10),
            c ("bicycle", "surface", "compacted", 10),
            c ("bicycle", "surface", "cobblestone", 6),
            c ("bicycle", "surface", "unpaved", 6),
            c ("bicycle", "surface", "fine_gravel", 6),
            c ("bicycle", "surface", "gravel", 6),
            c ("bicycle", "surface", "pebblestone", 6),
            c ("bicycle", "surface", "ground", 6),
            c ("bicycle", "surface", "dirt", 6),
            c ("bicycle", "surface", "earth", 6),
            c ("bicycle", "surface", "grass", 6),
            c ("bicycle", "surface", "mud", 3),
            c ("bicycle", "surface", "sand", 3),
            c ("bicycle", "surface", "sett", 10),

            c ("foot", "surface", "fine_gravel", 4),
            c ("foot", "surface", "gravel", 4),
            c ("foot", "surface", "pebblestone", 4),
            c ("foot", "surface", "mud", 2),
            c ("foot", "surface", "sand", 2))
surface_speeds <- data.frame ("name" = s [, 1],
                              "key" = s [, 2],
                              "value" = s [, 3],
                              "max_speed" = as.numeric (s [, 4]),
                              stringsAsFactors = FALSE)
                              
```

### traffic light and turn penalties

These are calculated in OSRM based on turn angles. The `dodgr` algorithm uses
turn ordering across traffic, and so only needs to implement a fixed traffic
light waiting time cost. The equivalent values can be obtained from the OSRM
profiles with a turn angle of 0 as:
```{r traffic-light-penalties, eval = FALSE}
traffic_light_penalty <- 2
turn_duration = traffic_light_penalty
turn_bias <- 1.075 # car
turn_duration <- turn_duration + 6.5 / turn_bias # = 8

# for both bike and car:
turn_duration <- traffic_light_penalty # = 2
```

```{r}
nms <- unique (weighting_profiles$name)
#nms <- c ("foot", "horse", "wheelchair", "bicycle", "moped", "motorcycle",
#          "motorcar", "goods", "hgv", "psv")
traffic_lights <- rep (8, length (nms))
traffic_lights [nms %in% c ("foot", "wheelchair", "bicycle")] <- 2
turn_penalty <- rep (7.5, length (nms))
turn_penalty [nms %in% c ("foot", "horse", "wheelchar")] <- 0
turn_penalty [nms == "bicycle"] <- 6
penalties <- data.frame ("name" = nms,
                         "traffic_lights" = traffic_lights,
                         "turn" = turn_penalty,
                         stringsAsFactors = FALSE)
penalties$restrictions <- TRUE
index <- which (penalties$name %in%
                c ("foot", "horse", "wheelchair", "bicycle"))
penalties$restrictions [index] <- FALSE
```

Note that the following link describes waiting times at traffic lights with an
average value of 40s:
http://dx.doi.org/10.1016/j.trb.2013.02.002
see also National Assoc. City Transportation Officials guidelines:
https://nacto.org/publication/urban-street-design-guide/intersection-design-elements/traffic-signals/signal-cycle-lengths/
recommended "Short cycle length" of 60-90 seconds

### save the data:

```{r}
# change percentage value to 0-1
weighting_profiles$value <- weighting_profiles$value / 100
weighting_profiles <- list ("weighting_profiles" = weighting_profiles,
                            "surface_speeds" = surface_speeds,
                            "penalties" = penalties)
usethis::use_data (weighting_profiles, overwrite = TRUE, compress = 'xz')
```
