Nothing
context ("time formats")
test_all <- (identical (Sys.getenv ("MPADGE_LOCAL"), "true") |
identical (Sys.getenv ("GITHUB_WORKFLOW"), "test-coverage"))
nthr <- data.table::setDTthreads (1L)
test_that ("convert-time", {
berlin_gtfs_to_zip ()
f <- file.path (tempdir (), "vbb.zip")
expect_true (file.exists (f))
expect_silent (g <- extract_gtfs (f, quiet = TRUE))
expect_silent (gt <- gtfs_timetable (g, quiet = TRUE))
days <- c (
"monday", "tuesday", "wednesday", "thursday",
"friday", "saturday", "sunday"
)
day <- days [as.integer (strftime (Sys.time (), "%u"))]
msg <- paste0 (
"Day not specified; extracting timetable for ",
day
)
expect_message (gt <- gtfs_timetable (g, quiet = FALSE), msg)
from <- "Schonlein"
to <- "Berlin Hauptbahnhof"
start_time <- 12 * 3600 + 120 # 12:02 in seconds
expect_silent (route1 <- gtfs_route (gt,
from = from, to = to,
start_time = start_time,
quiet = TRUE
))
if (requireNamespace ("hms", quietly = TRUE)) {
start_time <- hms::hms (0, 2, 12)
expect_silent (route2 <- gtfs_route (gt,
from = from, to = to,
start_time = start_time,
quiet = TRUE
))
expect_identical (route1, route2)
}
if (requireNamespace ("lubridate", quietly = TRUE)) {
start_time <- lubridate::hms ("12:2:0")
expect_silent (route3 <- gtfs_route (gt,
from = from, to = to,
start_time = start_time,
quiet = TRUE
))
expect_identical (route1, route3)
}
start_time <- c (12, 2)
expect_silent (route4 <- gtfs_route (gt,
from = from, to = to,
start_time = start_time,
quiet = TRUE
))
expect_identical (route1, route4)
start_time <- c (12, 2, 0)
expect_silent (route5 <- gtfs_route (gt,
from = from, to = to,
start_time = start_time,
quiet = TRUE
))
expect_identical (route1, route5)
expect_silent (route6 <- gtfs_route (gt,
from = from, to = to,
start_time = "12:02:00",
quiet = TRUE
))
expect_identical (route1, route6)
expect_silent (route7 <- gtfs_route (gt,
from = from, to = to,
start_time = "12:02",
quiet = TRUE
))
expect_identical (route1, route7)
# ------- errors
start_time <- c (12, 2, 0, 0)
expect_error (
route6 <- gtfs_route (gt,
from = from, to = to,
start_time = start_time,
quiet = TRUE
),
"Don't know how to parse time vectors of length 4"
)
expect_error (
route6 <- gtfs_route (gt,
from = from, to = to,
start_time = "blah",
quiet = TRUE
),
"Unrecognized time format"
)
})
test_that ("day param", {
berlin_gtfs_to_zip ()
f <- file.path (tempdir (), "vbb.zip")
expect_true (file.exists (f))
expect_silent (g <- extract_gtfs (f, quiet = TRUE))
expect_silent (gt <- gtfs_timetable (g, quiet = TRUE))
expect_silent (gt <- gtfs_timetable (g, 1, quiet = FALSE))
expect_error (
gt <- gtfs_timetable (g, day = 1.1),
"day must be an integer value"
)
# expect_error (gt <- gtfs_timetable (g, day = 10),
# "numeric days must be between 1 (Sun) and 7 (Sat)")
expect_error (
gt <- gtfs_timetable (g, day = NA),
"day must be a day of the week"
)
})
test_that ("date param", {
berlin_gtfs_to_zip ()
f <- file.path (tempdir (), "vbb.zip")
expect_true (file.exists (f))
expect_silent (g <- extract_gtfs (f, quiet = TRUE))
# date not in feed
expect_error (
gt <- gtfs_timetable (g, date = 20180128),
"Calendar contains no matching dates"
)
# wrong date format
expect_error (
gt <- gtfs_timetable (g, date = 1234),
"Date must be provided in the format YYYYMMDD"
)
expect_error (
gt <- gtfs_timetable (g, date = "abc"),
"Date must be provided in the format YYYYMMDD"
)
gt_day <- gtfs_timetable (g, day = "Monday", quiet = TRUE)
g$calendar_dates <- data.table::data.table (
service_id = "1",
date = 20190128,
exception_type = 1
)
g$calendar <- g$calendar [service_id != 1]
expect_silent (gt <- gtfs_timetable (g, date = 20190128, quiet = TRUE))
expect_identical (gt_day$timetable, gt$timetable)
# sunday added to calendar_dates
g$calendar_dates <- data.table::data.table (
service_id = "1",
date = 2019017,
exception_type = 1
)
expect_silent (gt <- gtfs_timetable (g, date = 20190127, quiet = TRUE))
expect_false (identical (gt_day$timetable, gt$timetable))
})
data.table::setDTthreads (nthr)
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.