Merge pull request #214 from r-transit/dev/geojson_update_reference

Handle locations.geojson and update specs

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: tidytransit
 Type: Package
 Title: Read, Validate, Analyze, and Map GTFS Feeds
-Version: 1.6.1
+Version: 1.6.1.9000
 Authors@R: c(
     person("Flavio", "Poletti", role = c("aut", "cre"), email = "flavio.poletti@hotmail.ch"),
     person(given = "Daniel",family = "Herszenhut",role = c("aut"),email = "dhersz@gmail.com",comment = c(ORCID = "0000-0001-8066-1105")),
@@ -28,11 +28,12 @@ License: GPL
 LazyData: TRUE
 Depends: R (>= 3.6.0)
 Imports:
-    gtfsio (>= 1.1.0),
+    gtfsio (>= 1.2.0),
     dplyr (>= 1.1.1),
     data.table (>= 1.12.8),
     rlang,
     sf,
+    jsonlite,
     hms,
     digest,
     geodist

NAMESPACE

@@ -53,13 +53,16 @@ importFrom(graphics,plot)
 importFrom(gtfsio,export_gtfs)
 importFrom(gtfsio,import_gtfs)
 importFrom(gtfsio,new_gtfs)
-importFrom(hms,new_hms)
+importFrom(jsonlite,read_json)
+importFrom(jsonlite,write_json)
 importFrom(rlang,"!!")
 importFrom(rlang,.data)
 importFrom(rlang,enquo)
 importFrom(rlang,quo)
+importFrom(sf,read_sf)
 importFrom(sf,st_cast)
 importFrom(sf,st_transform)
+importFrom(sf,write_sf)
 importFrom(stats,kmeans)
 importFrom(stats,median)
 importFrom(stats,reshape)

R/convert_types.R

@@ -0,0 +1,38 @@
+#' Convert columns between gtfsio types to tidytransit types according to GTFS reference
+#' 
+#' @param gtfs_list gtfs object
+#' @param conversion_table data.frame containing a column `file` and `Field_Name`, generally 
+#'                         from internal `gtfs_reference_types` dataset
+#' @param conversion_function function to convert columns
+#'
+#' @return gtfs_list with converted (overwritten) columns in tables
+#' 
+convert_types <- function(gtfs_list, conversion_table, conversion_function) {
+  for(i in seq_len(nrow(conversion_table))) {
+    file = conversion_table$file[i]
+    field_name = conversion_table$Field_Name[i]
+    if(feed_contains(gtfs_list, file)) {
+      if(!is.null(gtfs_list[[file]][[field_name]])) {
+        stopifnot(inherits(gtfs_list[[file]], "data.table"))
+        gtfs_list[[file]][, c(field_name) := conversion_function(get(field_name))]
+      }
+    }
+  }
+  return(gtfs_list)
+}
+
+convert_char_to_date <- function(gtfs_list) {
+  convert_types(gtfs_list, gtfs_reference_types$Date, .parse_gtfsio_date)
+}
+
+convert_date_to_char <- function(gtfs_obj) {
+  convert_types(gtfs_obj, gtfs_reference_types$Date, .date_as_gtfsio_char)
+}
+
+convert_char_to_hms <- function(gtfs_list) {
+  convert_types(gtfs_list, gtfs_reference_types$Time, hhmmss_to_hms)
+}
+
+convert_hms_to_char <- function(gtfs_obj) {
+  convert_types(gtfs_obj, gtfs_reference_types$Time, hms_to_hhmmss)
+}

R/dates.R

@@ -1,37 +1,14 @@
-# Dates ####
-parse_gtfsio_date = function(gtfsio_date) {
+.parse_gtfsio_date <- function(gtfsio_date) {
   if(inherits(gtfsio_date, "Date")) {
     return(gtfsio_date)
   }
   as.Date(as.character(gtfsio_date), format = "%Y%m%d")
 }
 
-date_as_gtfsio_char = function(date) {
+.date_as_gtfsio_char <- function(date) {
   format(date, format = "%Y%m%d")
 }
 
-convert_dates <- function(gtfs_obj, parse_function = parse_gtfsio_date) {
-  if(!is.null(gtfs_obj[["calendar"]])) { # $calendar matches calendar_dates
-    stopifnot(inherits(gtfs_obj$calendar, "data.table"))
-    gtfs_obj$calendar[,start_date := parse_function(start_date)]
-    gtfs_obj$calendar[,end_date := parse_function(end_date)]
-  }
-  if(!is.null(gtfs_obj[["calendar_dates"]])) {
-    stopifnot(inherits(gtfs_obj$calendar_dates, "data.table"))
-    gtfs_obj$calendar_dates[,date := parse_function(date)]
-  }
-  if(!is.null(gtfs_obj[["feed_info"]])) {
-    stopifnot(inherits(gtfs_obj$feed_info, "data.table"))
-    if(!is.null(gtfs_obj$feed_info$feed_start_date)) {
-      gtfs_obj$feed_info[,feed_start_date := parse_function(feed_start_date)]
-    }
-    if(!is.null(gtfs_obj$feed_info$feed_end_date)) {
-      gtfs_obj$feed_info[,feed_end_date := parse_function(feed_end_date)]
-    }
-  }
-  return(gtfs_obj)
-}
-
 #' Returns all possible date/service_id combinations as a data frame
 #' 
 #' Use it to summarise service. For example, get a count of the number of 

R/geo.R

@@ -125,12 +125,12 @@ prep_dist_mtrx = function(dist_list) {
 #' @export
 stop_group_distances = function(gtfs_stops, by = "stop_name") {
   distances <- n_stop_ids <- dist_mean <- dist_median <- dist_max <- NULL
-  if(inherits(gtfs_stops, "sf")) {
-    gtfs_stops <- sf_points_to_df(gtfs_stops, c("stop_lon", "stop_lat"), TRUE)
-  }
   if(!by %in% colnames(gtfs_stops)) {
     stop("column ", by, " does not exist in ", deparse(substitute(gtfs_stops)))
   }
+  if(inherits(gtfs_stops, "sf")) {
+    gtfs_stops <- sf_points_to_df(gtfs_stops, c("stop_lon", "stop_lat"), TRUE)
+  }
   n_stops = table(gtfs_stops$stop_name)
 
   gtfs_single_stops = gtfs_stops %>% filter(stop_name %in% names(n_stops)[n_stops == 1])

R/gtfsio.R

@@ -0,0 +1,24 @@
+#' Convert a tidygtfs object to a gtfs object (for gtfsio)
+#' 
+#' @param gtfs_obj gtfs feed (tidygtfs object)
+#' @return gtfs list
+#' @keywords internal
+tidygtfs_to_gtfs = function(gtfs_obj) {
+  # convert sf tables
+  gtfs_obj <- sf_as_tbl(gtfs_obj)
+  gtfs_obj <- sf_as_json(gtfs_obj)
+
+  # convert NA to empty strings
+  gtfs_obj <- na_to_empty_strings(gtfs_obj)
+
+  # data.tables
+  gtfs_obj <- gtfs_obj[names(gtfs_obj) != "."]
+  gtfs_obj <- convert_list_tables_to_data.tables(gtfs_obj)
+  class(gtfs_obj) <- list("gtfs")
+
+  # convert dates/times to strings
+  gtfs_obj <- convert_date_to_char(gtfs_obj)
+  gtfs_obj <- convert_hms_to_char(gtfs_obj)
+
+  return(gtfs_obj)
+}

R/io.R

@@ -49,22 +49,10 @@ read_gtfs <- function(path, files = NULL, quiet = TRUE, ...) {
 #' @export
 write_gtfs <- function(gtfs_obj, zipfile, compression_level = 9, as_dir = FALSE) {
   stopifnot(inherits(gtfs_obj, "tidygtfs"))
+
+  gtfs_out = tidygtfs_to_gtfs(gtfs_obj)
 
-  # convert sf tables
-  gtfs_out = sf_as_tbl(gtfs_obj)
-
-  # convert NA to empty strings
-  gtfs_out <- na_to_empty_strings(gtfs_out)
-
-  # data.tables
-  gtfs_out <- gtfs_out[names(gtfs_out) != "."]
-  gtfs_out <- lapply(gtfs_out, as.data.table)
-  class(gtfs_out) <- list("gtfs")
-
-  # convert dates/times to strings
-  gtfs_out <- convert_dates(gtfs_out, date_as_gtfsio_char)
-  gtfs_out <- convert_hms_to_char(gtfs_out)
-
+  # export with gtfsio
   gtfsio::export_gtfs(gtfs_out, zipfile, 
                       standard_only = FALSE,
                       compression_level = compression_level, 

R/raptor.R

@@ -149,7 +149,7 @@ raptor = function(stop_times,
                              journey_departure_stop_id = from_stop_ids,
                              transfers = 0, travel_time = 0)
   initial_transfers = find_initial_transfers(initial_stops, transfers_dt, max_transfers, arrival)
-  # browser()
+
   # 3) run raptor ####
   rptr = raptor_core(initial_stops, initial_transfers, stop_times_dt, transfers_dt, max_transfers)
 

R/spatial.R

@@ -165,21 +165,23 @@ shape_as_sf_linestring <- function(df) {
   return(sf::st_linestring(m))
 }
 
-#' Transform or convert coordinates of a gtfs feed
+#' Transform coordinates of a gtfs feed
 #' 
 #' @param gtfs_obj gtfs feed (tidygtfs object)
 #' @param crs target coordinate reference system, used by sf::st_transform
 #' @return tidygtfs object with transformed stops and shapes sf dataframes
 #' 
 #' @importFrom sf st_transform
+#' @return gtfs object with transformed sf tables
 #' @export
 gtfs_transform = function(gtfs_obj, crs) {
-  if(!inherits(gtfs_obj$stops, "sf")) {
-    gtfs_obj <- gtfs_as_sf(gtfs_obj)
+  gtfs_obj <- gtfs_as_sf(gtfs_obj)
+  for(tbl in names(gtfs_obj)) {
+    if(inherits(gtfs_obj[[tbl]], "sf")) {
+      gtfs_obj[[tbl]] <- st_transform(gtfs_obj[[tbl]], crs)
+    }
   }
-  gtfs_obj$stops <- st_transform(gtfs_obj$stops, crs)
-  if(feed_contains(gtfs_obj, "shapes")) gtfs_obj$shapes <- st_transform(gtfs_obj$shapes, crs)
-  gtfs_obj
+  return(gtfs_obj)
 }
 
 #' Convert stops and shapes from sf objects to tibbles
@@ -246,4 +248,47 @@ sf_lines_to_df = function(lines_sf,
   })
   names(shps_list) <- lines_sf$shape_id
   dplyr::bind_rows(shps_list, .id = "shape_id")
-}
+}
+
+#' Convert a json (read with jsonlite) to sf object
+#'
+#' The json object is written to a temporary file and re-read with sf::read().
+#'
+#' @param json_list list as read by jsonlite::read_json (in gtfsio)
+#'
+#' @return sf object
+#' @importFrom jsonlite write_json
+#' @importFrom sf read_sf
+#' @keywords internal
+json_to_sf = function(json_list) {
+  tmpfile = tempfile(fileext = ".geojson")
+  write_json(json_list, tmpfile, digits = 8, auto_unbox = TRUE)
+  read_sf(tmpfile)
+}
+
+#' Convert an sf object to a json list
+#'
+#' The sf object is written to a temporary file and re-read with jsonlite::read_json().
+#'
+#' @param sf_obj sf table
+#'
+#' @return json list
+#' @importFrom jsonlite read_json
+#' @importFrom sf write_sf
+#' @keywords internal
+sf_to_json = function(sf_obj, layer_name) {
+  tmpfile = tempfile(fileext = ".geojson")
+  write_sf(sf_obj, tmpfile, driver = "GeoJSON", layer = layer_name)
+  read_json(tmpfile)
+}
+
+sf_as_json = function(gtfs_obj) {
+  for(geojson_file in names(gtfs_reference_filetype[gtfs_reference_filetype == "geojson"])) {
+    if(feed_contains(gtfs_obj, geojson_file) && inherits(gtfs_obj[[geojson_file]], "sf")) {
+      json = sf_to_json(gtfs_obj[[geojson_file]], geojson_file)
+      json$name <- geojson_file
+      gtfs_obj[[geojson_file]] <- json
+    }
+  }
+  return(gtfs_obj)
+}