tests/testthat/test-get_shapes_geometry.R

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

data_path <- system.file("extdata/spo_gtfs.zip", package = "gtfstools")
gtfs <- read_gtfs(data_path)

test_that("raises errors due to incorrect input types", {
  no_class_gtfs <- unclass(gtfs)

  expect_error(get_shapes_geometry(no_class_gtfs))
  expect_error(get_shapes_geometry(gtfs, shape_id = as.factor("17846")))
  expect_error(get_shapes_geometry(gtfs, shape_id = NA))
  expect_error(get_shapes_geometry(gtfs, crs = "4326"))
  expect_error(get_shapes_geometry(gtfs, crs = NA))

  wrong_types_gtfs <- read_gtfs(data_path)
  wrong_types_gtfs$shapes[, shape_id := as.factor(shape_id)]
  expect_error(get_shapes_geometry(wrong_types_gtfs))

  wrong_types_gtfs$shapes[
    ,
    `:=`(
      shape_id = as.character(shape_id),
      shape_pt_lon = as.character(shape_pt_lon)
    )
  ]
  expect_error(get_shapes_geometry(wrong_types_gtfs))

  wrong_types_gtfs$shapes[
    ,
    `:=`(
      shape_pt_lon = as.numeric(shape_pt_lon),
      shape_pt_lat = as.character(shape_pt_lat)
    )
  ]
  expect_error(get_shapes_geometry(wrong_types_gtfs))

  # shape_pt_sequence is always required
  wrong_types_gtfs$shapes[
    ,
    `:=`(
      shape_pt_lat = as.numeric(shape_pt_lat),
      shape_pt_sequence = as.character(shape_pt_sequence)
    )
  ]
  expect_error(get_shapes_geometry(wrong_types_gtfs))
})

test_that("convert correct shapes", {
  # if 'shape_id' is NULL (default), all shapes are converted
  shapes_sf <- get_shapes_geometry(gtfs)
  expect_true(
    all(gtfs$shapes$shape_id %chin% shapes_sf$shape_id)
  )

  # else only (valid) shapes are converted
  shape_ids <- c("17846", "ola")
  suppressWarnings(
    shapes_sf <- get_shapes_geometry(gtfs, shape_id = shape_ids)
  )
  expect_identical(shapes_sf$shape_id, "17846")
})

test_that("raises warnings/erros if invalid stop_ids are passed", {
  expect_warning(get_shapes_geometry(gtfs, shape_id = c("17846", "ola")))
  expect_warning(get_shapes_geometry(gtfs, shape_id = c("ola")))
  expect_silent(get_shapes_geometry(gtfs, character(0)))
})

test_that("returns a LINESTRING sf with correct crs", {
  # outputs a LINESTRING sf
  shapes_sf <- get_shapes_geometry(gtfs)
  expect_s3_class(shapes_sf, "sf")
  expect_s3_class(shapes_sf$geometry, "sfc_LINESTRING")

  # crs is 4326 by default
  expect_identical(sf::st_crs(shapes_sf), sf::st_crs(4326))

  # which can be changed with 'crs' argument
  shapes_sf <- get_shapes_geometry(gtfs, crs = 4674)
  expect_identical(sf::st_crs(shapes_sf), sf::st_crs(4674))

  # works even if none of the specified shapes exist/character(0) is given
  suppressWarnings(
    shapes_sf <- get_shapes_geometry(gtfs, "ola")
  )
  expect_s3_class(shapes_sf, "sf")
  expect_s3_class(shapes_sf$geometry, "sfc_LINESTRING")

  shapes_sf <- get_shapes_geometry(gtfs, character(0))
  expect_s3_class(shapes_sf, "sf")
  expect_s3_class(shapes_sf$geometry, "sfc_LINESTRING")
})

test_that("shapes are sorted by shape_pt_sequence", {
  shapes_sf <- get_shapes_geometry(gtfs, "17846")

  unordered_gtfs <- gtfs
  unordered_gtfs$shapes <- gtfs$shapes[shape_id == "17846"]
  unordered_gtfs$shapes <- unordered_gtfs$shapes[c(200:547, 1:199)]

  expect_identical(get_shapes_geometry(unordered_gtfs), shapes_sf)
})

test_that("doesn't change the given gtfs", {
  original_gtfs <- read_gtfs(data_path)
  gtfs <- read_gtfs(data_path)
  expect_identical(original_gtfs, gtfs)

  shapes_sf <- get_shapes_geometry(gtfs)
  expect_identical(original_gtfs, gtfs)
  shapes_sf <- get_shapes_geometry(gtfs, shape_id = "17846")
  expect_identical(original_gtfs, gtfs)
})