Nothing
context("Detailed itineraries function")
# if running manually, please run the following line first:
# source("tests/testthat/setup.R")
testthat::skip_on_cran()
default_tester <- function(r5r_core,
origins = points[1:2, ],
destinations = points[2:1, ],
mode = c("WALK", "TRANSIT"),
departure_datetime = as.POSIXct("13-05-2019 14:00:00",
format = "%d-%m-%Y %H:%M:%S"),
max_walk_time = Inf,
max_bike_time = Inf,
max_trip_duration = 120L,
walk_speed = 3.6,
bike_speed = 12,
max_rides = 3,
shortest_path = TRUE,
n_threads = Inf,
verbose = FALSE,
drop_geometry = FALSE) {
results <- detailed_itineraries(
r5r_core,
origins = origins,
destinations = destinations,
mode = mode,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
max_bike_time = max_bike_time,
max_trip_duration = max_trip_duration,
walk_speed = walk_speed,
bike_speed = bike_speed,
max_rides = max_rides,
shortest_path = shortest_path,
n_threads = n_threads,
verbose = verbose,
drop_geometry = drop_geometry
)
return(results)
}
# errors and warnings -----------------------------------------------------
test_that("detailed_itineraries adequately raises errors", {
# error related to using object with wrong type as r5r_core
expect_error(default_tester("r5r_core"))
# error related to using wrong origins/destinations object type
multipoint_origins <- sf::st_cast(sf::st_as_sf(points[1:2,], coords = c("lon", "lat")), "MULTIPOINT")
multipoint_destinations <- sf::st_cast(sf::st_as_sf(points[2:1,], coords = c("lon", "lat")), "MULTIPOINT")
list_origins <- list(id = c("1", "2"), lat = c(-30.02756, -30.02329), long = c(-51.22781, -51.21886))
list_destinations <- list(id = c("2", "1"), lat = c(-30.02329, -30.02756), long = c(-51.21886, -51.22781))
expect_error(default_tester(r5r_core, origins = multipoint_origins))
expect_error(default_tester(r5r_core, destinations = multipoint_destinations))
expect_error(default_tester(r5r_core, origins = list_origins))
expect_error(default_tester(r5r_core, destinations = list_destinations))
expect_error(default_tester(r5r_core, origins = "origins"))
expect_error(default_tester(r5r_core, destinations = "destinations"))
# error related to using wrong origins/destinations column types
origins <- points[1:2, ]
destinations <- points[2:1, ]
origins_char_lat <- data.frame(id = origins$id, lat = as.character(origins$lat), lon = origins$lon)
origins_char_lon <- data.frame(id = origins$id, lat = origins$lat, lon = as.character(origins$lon))
destinations_char_lat <- data.frame(id = destinations$id, lat = as.character(destinations$lat), lon = destinations$lon)
destinations_char_lon <- data.frame(id = destinations$id, lat = destinations$lat, lon = as.character(destinations$lon))
expect_error(default_tester(r5r_core, origins = origins_char_lat))
expect_error(default_tester(r5r_core, origins = origins_char_lon))
expect_error(default_tester(r5r_core, destinations = destinations_char_lat))
expect_error(default_tester(r5r_core, destinations = destinations_char_lon))
# error related to 'origins' and 'destinations' with distinct number of rows
expect_error(default_tester(r5r_core, origins = points[1:3,], destinations = points[2:1,]))
expect_error(default_tester(r5r_core, origins = points[2:1,], destinations = points[1:3,]))
# error related to nonexistent mode
expect_error(default_tester(r5r_core, mode = "all"))
# errors related to date formatting
numeric_datetime <- as.numeric(as.POSIXct("13-05-2019 14:00:00", format = "%d-%m-%Y %H:%M:%S"))
expect_error(default_tester(r5r_core, departure_datetime = "13-05-2019 14:00:00"))
expect_error(default_tester(r5r_core, numeric_datetime))
# errors related to max_walk_time
expect_error(default_tester(r5r_core, max_walk_time = "1"))
expect_error(default_tester(r5r_core, max_walk_time = NULL))
# errors related to max_bike_time
expect_error(default_tester(r5r_core, max_bike_time = "1"))
expect_error(default_tester(r5r_core, max_bike_time = NULL))
# error/warning related to max_street_time
expect_error(default_tester(r5r_core, max_trip_duration = "120"))
# error related to non-numeric walk_speed
expect_error(default_tester(r5r_core, walk_speed = "3.6"))
# error related to non-numeric bike_speed
expect_error(default_tester(r5r_core, bike_speed = "12"))
# error related to non-logical shortest_path
expect_error(default_tester(r5r_core, shortest_path = "TRUE"))
expect_error(default_tester(r5r_core, shortest_path = 1))
expect_error(default_tester(r5r_core, shortest_path = NULL))
# error related to non-logical verbose
expect_error(default_tester(r5r_core, verbose = "TRUE"))
expect_error(default_tester(r5r_core, verbose = 1))
expect_error(default_tester(r5r_core, verbose = NULL))
# error related to non-logical drop_geometry
expect_error(default_tester(r5r_core, drop_geometry = "TRUE"))
expect_error(default_tester(r5r_core, drop_geometry = 1))
})
test_that("detailed_itineraries adequately raises warnings and messages", {
# message related to expanding origins/destinations dataframe
expect_message(default_tester(r5r_core, origins = points[1, ]))
expect_message(default_tester(r5r_core, destinations = points[1, ]))
# error/warning related to using wrong origins/destinations column types
origins <- points[1:2, ]
destinations <- points[2:1, ]
origins_numeric_id <- data.frame(id = 1:2, lat = origins$lat, lon = origins$lon)
destinations_numeric_id <- data.frame(id = 1:2, lat = destinations$lat, lon = destinations$lon)
expect_warning(default_tester(r5r_core, origins = origins_numeric_id))
expect_warning(default_tester(r5r_core, destinations = destinations_numeric_id))
})
# adequate behaviour ------------------------------------------------------
test_that("detailed_itineraries output is correct", {
# * output class ---------------------------------------------------------
# expect results to be of class 'sf' and 'data.table', independently of the
# class of 'origins'/'destinations', when drop_geometry = FALSE
origins_sf <- sf::st_as_sf(
points[1:2,],
coords = c("lon", "lat"),
crs = 4326
)
destinations_sf <- sf::st_as_sf(
points[2:1,],
coords = c("lon", "lat"),
crs = 4326
)
result_df_input <- default_tester(r5r_core)
result_sf_input <- default_tester(r5r_core, origins_sf, destinations_sf)
expect_true(is(result_df_input, "sf"))
expect_true(is(result_df_input, "data.table"))
expect_true(is(result_sf_input, "sf"))
expect_true(is(result_sf_input, "data.table"))
# expect results to be of class 'data.table', but not 'sf', independently of
# the class of 'origins'/'destinations', when drop_geometry = TRUE
result_df_input <- default_tester(r5r_core, drop_geometry = TRUE)
result_sf_input <- default_tester(r5r_core, origins_sf, destinations_sf, drop_geometry = TRUE)
expect_false(is(result_df_input, "sf"))
expect_true(is(result_df_input, "data.table"))
expect_false(is(result_sf_input, "sf"))
expect_true(is(result_sf_input, "data.table"))
# expect each column to be of right class
expect_true(typeof(result_df_input$from_id) == "character")
expect_true(typeof(result_df_input$from_lat) == "double")
expect_true(typeof(result_df_input$from_lon) == "double")
expect_true(typeof(result_df_input$to_id) == "character")
expect_true(typeof(result_df_input$to_lat) == "double")
expect_true(typeof(result_df_input$to_lon) == "double")
expect_true(typeof(result_df_input$option) == "integer")
expect_true(typeof(result_df_input$segment) == "integer")
expect_true(typeof(result_df_input$mode) == "character")
expect_true(typeof(result_df_input$total_duration) == "double")
expect_true(typeof(result_df_input$segment_duration) == "double")
expect_true(typeof(result_df_input$wait) == "double")
expect_true(typeof(result_df_input$distance) == "integer")
expect_true(typeof(result_df_input$route) == "character")
# * r5r options ----------------------------------------------------------
# expect walking segments to be shorter when setting higher walk speeds
# ps: note that if a very high speed is set then the routes change completely
# and we lose the ability to use lower walking speeds routes as reference
origins <- points[1,]
destinations <- points[3,]
df <- default_tester(r5r_core, origins = origins, destinations = destinations, mode = "WALK", walk_speed = 4)
duration_lower_speed <- data.table::setDT(df)$segment_duration
df <- default_tester(r5r_core, origins = origins, destinations = destinations, mode = "WALK", walk_speed = 5)
duration_higher_speed <- data.table::setDT(df)$segment_duration
expect_true(duration_higher_speed < duration_lower_speed)
# expect bike segments to be shorter when setting higher cycling speeds
# ps: same as with walk_speeds
df <- default_tester(r5r_core, origins = origins, destinations = destinations,
mode = "BICYCLE", bike_speed = 12)
duration_lower_speed <- data.table::setDT(df)$segment_duration
df <- default_tester(r5r_core, origins = origins, destinations = destinations,
mode = "BICYCLE", bike_speed = 13)
duration_higher_speed <- data.table::setDT(df)$segment_duration
expect_true(duration_higher_speed < duration_lower_speed)
# * arguments ------------------------------------------------------------
# expect each OD pair to have only option when shortest_path == TRUE
df <- default_tester(r5r_core, shortest_path = TRUE)
max_n_options <- data.table::setDT(df)[, length(unique(option)), by = .(from_id, to_id)][, max(V1)]
expect_true(max_n_options == 1)
# # expect each OD pair to have (possibly) more than one option when shortest_path == FALSE
#
# df <- default_tester(r5r_core, shortest_path = FALSE)
# max_n_options <- data.table::setDT(df)[, length(unique(option)), by = .(from_id, to_id)][, max(V1)]
#
# expect_true(max_n_options > 1)
# expect all route options to have lower total duration than max_trip_duration
max_trip_duration <- 60L
origins <- points[1:15,]
destinations <- points[15:1,]
df <- default_tester(r5r_core, origins, destinations,
max_trip_duration = max_trip_duration, shortest_path = FALSE)
max_duration <- data.table::setDT(df)[, sum(segment_duration), by = .(from_id, to_id, option)][, max(V1)]
expect_true(max_duration < max_trip_duration)
# expect an empty data.table as output when no routes are found between the pairs
df <- default_tester(r5r_core, origins = points[10,], destinations = points[12,],
mode = "WALK", max_trip_duration = 30L)
expect_true(nrow(df) == 0)
df <- default_tester(r5r_core, origins = points[10:11,], destinations = points[12,],
mode = "WALK", max_trip_duration = 30L)
expect_true(nrow(df) == 0)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.