Nothing
context('Time manipulation')
create_empty_gtfs_obj <- function() {
g <- list()
class(g) <- "gtfs"
attributes(g)$validation_result <- data.frame()
return(g)
}
test_that('set_hms_times() works with valid data', {
gtest <- create_empty_gtfs_obj()
gtest$stop_times_df <- dplyr::tibble(
arrival_time = c("08:00:00", "14:00:00", "26:10:00"),
departure_time = c("08:00:10", "14:00:20", "26:10:30"))
# gtest$frequencies_df = dplyr::tibble(
# start_time = c("06:00:00"),
# end_time = c("12:00:00")
# )
gtest <- set_hms_times(gtest)
expect_is(gtest$stop_times_df$arrival_time_hms, "hms")
expect_is(gtest$stop_times_df$departure_time_hms, "hms")
expect_is(gtest$stop_times_df$arrival_time, "character")
expect_is(gtest$stop_times_df$departure_time, "character")
expect_false(is.na(gtest$stop_times_df$arrival_time_hms[3]))
expect_equal(gtest$stop_times_df$departure_time_hms[3], hms::hms(26*3600+10*60+30))
# expect_is(gtest$frequencies_df$start_time_hms, "hms")
# expect_is(gtest$frequencies_df$end_time_hms, "hms")
# expect_is(gtest$frequencies_df$start_time, "character")
# expect_is(gtest$frequencies_df$end_time, "character")
})
test_that('get_date_service_table() uses the right dates', {
gtest <- create_empty_gtfs_obj()
gtest$calendar_df <- dplyr::tibble(
service_id = "s1",
monday = 1,
tuesday = 0,
wednesday = 1,
thursday = 0,
friday = 0,
saturday = 0,
sunday = 0,
start_date = lubridate::ymd("20180101"), # monday
end_date = lubridate::ymd("20180131")) # wednesday
date_service <- trread:::get_date_service_table(gtest)
expect_true(lubridate::ymd("20180101") %in% date_service$date)
expect_false(lubridate::ymd("20180102") %in% date_service$date)
expect_true(lubridate::ymd("20180131") %in% date_service$date)
})
test_that('get_date_service_table() works with additions and exceptions', {
gtest <- create_empty_gtfs_obj()
gtest$calendar_df <- dplyr::tibble(
service_id = c("wdays", "wend"),
monday = c(1, 0),
tuesday = c(1, 0),
wednesday = c(1, 0),
thursday = c(1, 0),
friday = c(1, 1),
saturday = c(0, 1),
sunday = c(0, 1),
start_date = c(lubridate::ymd("20180201"), lubridate::ymd("20180401")),
end_date = c(lubridate::ymd("20180430"), lubridate::ymd("20180430")))
gtest$calendar_dates_df = dplyr::tibble(
service_id = c("wdays", "wend"),
date = c(lubridate::ymd("20180314"), lubridate::ymd("20180226")),
exception_type = c(2, 1)
)
date_service <- get_date_service_table(gtest)
# exception
mar14 <- date_service[date_service$date == lubridate::ymd("20180613"),]
expect_equal(nrow(mar14), 0)
# addition
feb26 <- date_service[date_service$date == lubridate::ymd("20180226"),] # monday
expect_equal(nrow(feb26), 2)
# overlaps
apr05 <- date_service[date_service$date == lubridate::ymd("20180405"),] # thursday
expect_equal(apr05 %>% dplyr::group_by(date) %>% dplyr::count() %>% dplyr::pull(n), 1)
apr06 <- date_service[date_service$date == lubridate::ymd("20180406"),] # friday
expect_equal(apr06 %>% dplyr::group_by(date) %>% dplyr::count() %>% dplyr::pull(n), 2)
range <- date_service %>%
dplyr::group_by(service_id) %>%
dplyr::summarise(min = min(date), max=max(date))
expect_equal(range[range$service_id == "wdays", "min"], dplyr::tibble(min=lubridate::ymd("20180201")))
expect_equal(range[range$service_id == "wend", "max"], dplyr::tibble(max=lubridate::ymd("20180429")))
})
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.