Merge pull request #37 from r-transit/locations.geojson

read/write locations.geojson and rework spec implementation

DESCRIPTION

@@ -41,7 +41,8 @@ BugReports: https://github.com/r-transit/gtfsio/issues
 Imports: 
     data.table,
     utils,
-    zip
+    zip,
+    jsonlite
 Suggests: 
     knitr,
     rmarkdown,
@@ -50,16 +51,20 @@ VignetteBuilder:
     knitr
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Collate: 
     'gtfsio_error.R'
     'assert_gtfs.R'
     'assert_inputs.R'
     'checks.R'
+    'data.R'
     'export_gtfs.R'
     'get_gtfs_standards.R'
     'gtfs_methods.R'
     'gtfs_subset.R'
     'gtfsio.R'
     'import_gtfs.R'
     'new_gtfs.R'
+LazyData: true
+Depends: 
+    R (>= 3.1.0)

NAMESPACE

@@ -16,3 +16,4 @@ export(import_gtfs)
 export(new_gtfs)
 importFrom(data.table,"%chin%")
 importFrom(data.table,":=")
+importFrom(jsonlite,read_json)

R/data.R

@@ -0,0 +1,52 @@
+#' GTFS reference
+#'
+#' The data from the official GTFS specification document parsed to a list. Revision date:
+#' ``r attributes(gtfs_reference)$revision_date``.
+#'
+#' @format
+#' A list with data for every GTFS file. Each named list element (also a list) has
+#' specifications for one GTFS file in the following structure:
+#' \itemize{
+#'   \item{`File_Name`: file name including file extension (txt or geojson)}
+#'   \item{`File_Presence`: Presence condition applied to the file}
+#'   \item{`file`: file name without file extension}
+#'   \item{`file_ext`: file extension}
+#'   \item{`fields`: data.frame with parsed field specification (columns:
+#'         `Field_Name`, `Type`, `Presence`, `Description`, `gtfsio_type`)}
+#'   \item{`primary_key`: primary key as vector}
+#'   \item{`field_types`: named vector on how GTFS types (values) should be read in gtfsio
+#'                        (names). Values are the same as in `fields`.}
+#' }
+#'
+#' @details
+#' GTFS Types are converted to R types in gtfsio according to the following list:
+#' `r .doc_field_types()`
+#'
+#' @source [https://github.com/google/transit/blob/master/gtfs/spec/en/reference.md](https://github.com/google/transit/blob/master/gtfs/spec/en/reference.md)
+#' @keywords data
+"gtfs_reference"
+
+.doc_field_types = function() { # nocov start
+  fields <- lapply(gtfsio::gtfs_reference, `[[`, "fields")
+  fields <- do.call("rbind", fields)
+
+  type_assignment <- unique(fields[,c("Type", "gtfsio_type")])
+  type_assignment <- type_assignment[!startsWith(type_assignment$Type, "Foreign ID"),]
+  type_assignment <- type_assignment[order(type_assignment$gtfsio_type),]
+
+  type_assignment <-  lapply(split(type_assignment, type_assignment$Type), function(ta) {
+    if(nrow(ta) > 1) {
+      ta$gtfsio_type <- paste0(ta$gtfsio_type, collapse = ", ")
+      ta <- ta[1,]
+    }
+    ta
+  })
+  type_assignment <- do.call("rbind", type_assignment)
+
+  doc <- c("\\itemize{",
+           paste0("\\item{", type_assignment$Type, " = \`",
+                  type_assignment$gtfsio_type, "\`}"),
+           "}\n")
+
+  return(paste(doc, collapse = "\n"))
+} # nocov end

R/export_gtfs.R

@@ -2,7 +2,7 @@
 #'
 #' Writes GTFS objects to disk as GTFS transit feeds. The object must be
 #' formatted according to the standards for reading and writing GTFS transit
-#' feeds, as specified in \code{\link{get_gtfs_standards}} (i.e. data types are
+#' feeds, as specified in \code{\link{gtfs_reference}} (i.e. data types are
 #' not checked). If present, does not write auxiliary tables held in a sub-list
 #' named \code{"."}.
 #'
@@ -25,7 +25,7 @@
 #'
 #' @return Invisibly returns the same GTFS object passed to \code{gtfs}.
 #'
-#' @seealso \code{\link{get_gtfs_standards}}
+#' @seealso \code{\link{gtfs_reference}}
 #'
 #' @family io functions
 #'
@@ -52,8 +52,6 @@ export_gtfs <- function(gtfs,
                         overwrite = TRUE,
                         quiet = TRUE) {
 
-  gtfs_standards <- get_gtfs_standards()
-
   # basic input checking
 
   assert_class(gtfs, "gtfs")
@@ -73,7 +71,7 @@ export_gtfs <- function(gtfs,
   if (!as_dir & !grepl("\\.zip$", path)) error_ext_must_be_zip()
   if (as_dir & grepl("\\.zip$", path)) error_path_must_be_dir()
 
-  extra_files <- setdiff(files, names(gtfs_standards))
+  extra_files <- setdiff(files, names(gtfsio::gtfs_reference))
   if (standard_only & !is.null(files) & !identical(extra_files, character(0))) {
     error_non_standard_files(extra_files)
   }
@@ -91,7 +89,7 @@ export_gtfs <- function(gtfs,
   # 'extra_files' is re-evaluated because 'files' might have changed in the
   # lines above
 
-  extra_files <- setdiff(files, names(gtfs_standards))
+  extra_files <- setdiff(files, names(gtfsio::gtfs_reference))
 
   if (standard_only) files <- setdiff(files, extra_files)
 
@@ -119,35 +117,43 @@ export_gtfs <- function(gtfs,
 
   if (!quiet) message("Writing text files to ", tmpd)
 
-  for (file in files) {
+  filenames <- append_file_ext(files)
+  filepaths <- file.path(tmpd, filenames)
+
+  for (i in seq_along(files)) {
 
-    filename <- paste0(file, ".txt")
-    filepath <- file.path(tmpd, filename)
+    filename <- filenames[i]
+    file <- files[i]
+    filepath <- filepaths[i]
 
     if (!quiet) message("  - Writing ", filename)
 
     dt <- gtfs[[file]]
 
-    # if 'standard_only' is set to TRUE, remove non-standard fields from 'dt'
-    # before writing it to disk
+    if(endsWith(filename, ".geojson")) {
+      jsonlite::write_json(dt, filepath, pretty = FALSE, auto_unbox = TRUE, digits = 8)
+    } else {
 
-    if (standard_only) {
+      # if 'standard_only' is set to TRUE, remove non-standard fields from 'dt'
+      # before writing it to disk
 
-      file_cols  <- names(dt)
-      extra_cols <- setdiff(file_cols, names(gtfs_standards[[file]]))
+      if (standard_only) {
 
-      if (!identical(extra_cols, character(0))) dt <- dt[, !..extra_cols]
+        file_cols  <- names(dt)
+        extra_cols <- setdiff(file_cols, names(gtfsio::gtfs_reference[[file]][["field_types"]]))
 
-    }
+        if (!identical(extra_cols, character(0))) dt <- dt[, !..extra_cols]
 
-    # print warning message if warning is raised and 'quiet' is FALSE
-    withCallingHandlers(
-      data.table::fwrite(dt, filepath, scipen = 999),
-      warning = function(cnd) {
-        if (!quiet) message("    - ", conditionMessage(cnd))
       }
-    )
 
+      # print warning message if warning is raised and 'quiet' is FALSE
+      withCallingHandlers(
+        data.table::fwrite(dt, filepath, scipen = 999),
+        warning = function(cnd) {
+          if (!quiet) message("    - ", conditionMessage(cnd))
+        }
+      )
+    }
   }
 
   # zip the contents of 'tmpd' to 'path', if as_dir = FALSE
@@ -161,8 +167,6 @@ export_gtfs <- function(gtfs,
 
     unlink(path, recursive = TRUE)
 
-    filepaths <- file.path(tmpd, paste0(files, ".txt"))
-
     zip::zip(
       path,
       filepaths,

R/get_gtfs_standards.R

@@ -1,6 +1,10 @@
+# nocov start
+
 #' Generate GTFS standards
 #'
 #' @description
+#' *This function is deprecated and no longer used in [import_gtfs()] or [export_gtfs()].*
+#'
 #' Generates a list specifying the standards to be used when reading and writing
 #' GTFS feeds with R. Each list element (also a list) represents a distinct GTFS
 #' table, and describes:
@@ -40,11 +44,12 @@
 #' - Timezone = `character`
 #' - URL = `character`
 #'
-#' @examples
-#' gtfs_standards <- get_gtfs_standards()
-#'
+#' @examples \dontrun{
+#'   gtfs_standards <- get_gtfs_standards()
+#' }
 #' @export
 get_gtfs_standards <- function() {
+  .Deprecated("gtfs_reference")
   agency <- list(
     file_spec       = "req",
     agency_id       = list("id",            "cond"),
@@ -404,3 +409,5 @@ translate_types <- function(text_file, r_equivalents) {
     }
   )
 }
+
+# nocov end