tests/testthat/test-read_gtfs.R

In gtfstools: General Transit Feed Specification (GTFS) Editing and Analysing Tools

# fix this later - necessary to conditionally run tests that require {zip}
if (requireNamespace("zip", quietly = TRUE)) {

# setup -------------------------------------------------------------------


data_path <- system.file("extdata/spo_gtfs.zip", package = "gtfstools")
gtfs_url  <- "https://github.com/ipeaGIT/gtfstools/raw/master/inst/extdata/spo_gtfs.zip"

gtfs <- read_gtfs(data_path)

# create gtfs with empty table

et_temp_file <- tempfile(pattern = "gtfs", fileext = ".zip")
on.exit(file.remove(et_temp_file))

et_gtfs <- gtfs
et_gtfs$trips <- et_gtfs$trips[trip_id == "def_no_trip"]
write_gtfs(et_gtfs, et_temp_file)
et_gtfs <- read_gtfs(et_temp_file)

# create gtfs with empty file

ef_temp_file <- tempfile(pattern = "gtfs", fileext = ".zip")
on.exit(file.remove(ef_temp_file), add = TRUE)

ef_temp_dir <- file.path(tempdir(), "test_ef_gtfsdir")
on.exit(unlink(ef_temp_dir, recursive = TRUE), add = TRUE)

zip::unzip(data_path, exdir = ef_temp_dir, overwrite = TRUE)
file.remove(file.path(ef_temp_dir, "trips.txt"))
file.create(file.path(ef_temp_dir, "trips.txt"))
zip::zipr(ef_temp_file, file.path(ef_temp_dir, list.files(ef_temp_dir)))
suppressWarnings(ef_gtfs <- read_gtfs(ef_temp_file))

# create gtfs with extra file

ext_temp_file <- tempfile(pattern = "gtfs", fileext = ".zip")
on.exit(file.remove(ext_temp_file), add = TRUE)

ext_temp_dir <- file.path(tempdir(), "test_ext_gtfsdir")
on.exit(unlink(ext_temp_dir, recursive = TRUE), add = TRUE)

zip::unzip(data_path, exdir = ext_temp_dir, overwrite = TRUE)
calendar_txt <- file.path(ext_temp_dir, "calendar.txt")
calendar_extra_txt <- file.path(ext_temp_dir, "calendar_extra.txt")
file.copy(from = calendar_txt, to = calendar_extra_txt)
zip::zipr(ext_temp_file, file.path(ext_temp_dir, list.files(ext_temp_dir)))
ext_gtfs <- read_gtfs(ext_temp_file)

# create gtfs with file that results in parsing failure

pf_temp_file <- tempfile(pattern = "gtfs", fileext = ".zip")
on.exit(file.remove(pf_temp_file), add = TRUE)

pf_temp_dir <- file.path(tempdir(), "test_pf_gtfsdir")
on.exit(unlink(pf_temp_dir, recursive = TRUE), add = TRUE)

zip::unzip(data_path, exdir = pf_temp_dir, overwrite = TRUE)
agency_txt <- file.path(pf_temp_dir, "agency.txt")
invisible(file.remove(agency_txt))
invisible(file.create(agency_txt))
writeLines(
  c(
    "agency_id,agency_name,agency_url,agency_timezone,agency_lang,extracol",
    "1,SPTRANS,http://www.sptrans.com.br/?versao=011019,America/Sao_Paulo,pt",
    "1,SPTRANS,http://www.sptrans.com.br/?versao=011019,America/Sao_Paulo,pt"
  ),
  agency_txt
)
zip::zipr(pf_temp_file, file.path(pf_temp_dir, list.files(pf_temp_dir)))
suppressWarnings(pf_gtfs <- read_gtfs(pf_temp_file))


# tests -------------------------------------------------------------------


test_that("raises errors due to incorrect input types", {
  expect_error(read_gtfs(as.factor(data_path)))
  expect_error(read_gtfs(data_path, files = NA))
  expect_error(read_gtfs(data_path, files = as.factor("stop_times")))
  expect_error(read_gtfs(data_path, fields = NA))
  expect_error(read_gtfs(data_path, skip = as.factor("stop_times")))
  expect_error(read_gtfs(data_path, skip = NA))
  expect_error(read_gtfs(data_path, quiet = "TRUE"))
  expect_error(read_gtfs(data_path, quiet = NA))
  expect_error(read_gtfs(data_path, quiet = c(TRUE, TRUE)))
  expect_error(read_gtfs(data_path, encoding = as.factor("unknown")))
  expect_error(read_gtfs(data_path, encoding = "wrong_encoding"))
  expect_error(read_gtfs(data_path, encoding = c("unknown", "UTF-8")))
})

test_that("raises warnings and messages adequately", {
  expect_silent(read_gtfs(data_path))
  expect_silent(read_gtfs(gtfs_url))
  expect_silent(read_gtfs(ext_temp_file))

  expect_message(read_gtfs(data_path, quiet = FALSE))
  expect_message(read_gtfs(gtfs_url, quiet = FALSE))
  expect_message(read_gtfs(ext_temp_file, quiet = FALSE))
  expect_message(
    suppressWarnings(read_gtfs(ef_temp_file, quiet = FALSE))
  )

  # empty-file-related warning
  expect_warning(read_gtfs(ef_temp_file))

  # parsing-failure-related warning
  expect_warning(read_gtfs(pf_temp_file))
})

test_that("results in a dt_gtfs object", {

  # a dt_gtfs object is a list with "dt_gtfs" and "gtfs" classes

  dt_gtfs_class <- c("dt_gtfs", "gtfs")

  expect_s3_class(gtfs, dt_gtfs_class)
  expect_s3_class(et_gtfs, dt_gtfs_class)
  expect_s3_class(ef_gtfs, dt_gtfs_class)
  expect_s3_class(ext_gtfs, dt_gtfs_class)
  expect_s3_class(pf_gtfs, dt_gtfs_class)

  expect_type(gtfs, "list")
  expect_type(et_gtfs, "list")
  expect_type(ef_gtfs, "list")
  expect_type(ext_gtfs, "list")
  expect_type(pf_gtfs, "list")

  # all objects within the objects are data.tables, even if they originally are
  # empty tables/files

  invisible(lapply(gtfs, expect_s3_class, "data.table"))
  invisible(lapply(et_gtfs, expect_s3_class, "data.table"))
  invisible(lapply(ef_gtfs, expect_s3_class, "data.table"))
  invisible(lapply(ext_gtfs, expect_s3_class, "data.table"))
  invisible(lapply(pf_gtfs, expect_s3_class, "data.table"))

})

test_that("reads expected files and fields", {
  # this is more thoroughly checked on {gtfsio}

  files_in_zip <- sub(".txt", "", zip::zip_list(data_path)$filename)
  expect_equal(names(gtfs), files_in_zip)

  one_file_gtfs <- read_gtfs(data_path, "agency")
  expect_equal(names(one_file_gtfs), "agency")

  all_but_one_gtfs <- read_gtfs(data_path, skip = "agency")
  expect_equal(
    names(all_but_one_gtfs),
    setdiff(files_in_zip, "agency")
  )

  agency_id_gtfs <- read_gtfs(data_path, fields = list(agency = "agency_id"))
  expect_equal(names(agency_id_gtfs), files_in_zip)
  expect_equal(names(agency_id_gtfs$agency), "agency_id")
})

test_that("date fields are converted to Date objects", {
  ggl_path <- system.file("extdata/ggl_gtfs.zip", package = "gtfstools")
  ggl_gtfs <- read_gtfs(ggl_path)

  expect_s3_class(ggl_gtfs$calendar$start_date, "Date")
  expect_s3_class(ggl_gtfs$calendar$end_date, "Date")
  expect_s3_class(ggl_gtfs$calendar_dates$date, "Date")

  # and that other than that the rest remains unaltered

  ggl_gtfs$calendar[, start_date := date_to_integer(start_date)]
  ggl_gtfs$calendar[, end_date := date_to_integer(end_date)]
  ggl_gtfs$calendar_dates[, date := date_to_integer(date)]

  unconverted_gtfs <- gtfsio::import_gtfs(ggl_path)
  expect_identical(unclass(ggl_gtfs), unclass(unconverted_gtfs))
})

}