Merge pull request #57 from ITSLeeds/nighthank

Fixex from Nighthank

R/atoc.R

@@ -206,6 +206,7 @@ atoc2gtfs <- function(path_in,
   # Main Timetable Build
   timetables <- schedule2routes(
     stop_times = stop_times,
+    stops = stops,
     schedule = schedule,
     silent = silent,
     ncores = ncores

R/atoc_export.R

@@ -312,21 +312,35 @@ checkrows <- function(tmp) {
 #'
 #' @param routes routes data.frame
 #' @param stop_times stop_times data.frame
+#' @param stops stops data.frame
 #' @noRd
 #'
-longnames <- function(routes, stop_times) {
+longnames <- function(routes, stop_times, stops) {
   stop_times_sub <- dplyr::group_by(stop_times, trip_id)
   stop_times_sub <- dplyr::summarise(stop_times_sub,
     schedule = unique(schedule),
-    stop_a = stop_id[stop_sequence == 1],
+    stop_id_a = stop_id[stop_sequence == 1],
     # seq = min(stop_sequence),
-    stop_b = stop_id[stop_sequence == max(stop_sequence)]
+    stop_id_b = stop_id[stop_sequence == max(stop_sequence)]
   )
 
-  stop_times_sub$route_long_name <- paste0("Train from ",
-                                           stop_times_sub$stop_a,
+  # Add names for `stop_id_[a|b]` as `stop_name_[a|b]`
+  stop_times_sub <- dplyr::left_join(
+    stop_times_sub,
+    dplyr::rename(stops[, c("stop_id", "stop_name")], stop_name_a = stop_name),
+    by = c("stop_id_a" = "stop_id"))
+  stop_times_sub <- dplyr::left_join(
+    stop_times_sub,
+    dplyr::rename(stops[, c("stop_id", "stop_name")], stop_name_b = stop_name),
+    by = c("stop_id_b" = "stop_id"))
+
+  stop_times_sub$route_long_name <- paste0("From ",
+                                           stop_times_sub$stop_name_a,
                                            " to ",
-                                           stop_times_sub$stop_b)
+                                           stop_times_sub$stop_name_b)
+
+  stop_times_sub$route_long_name <- gsub(" Rail Station", "" , stop_times_sub$route_long_name)
+
   stop_times_sub <- stop_times_sub[!duplicated(stop_times_sub$schedule), ]
   stop_times_sub <- stop_times_sub[, c("schedule", "route_long_name")]
 

R/atoc_import.R

@@ -17,7 +17,7 @@ importALF <- function(file) {
     stringsAsFactors = FALSE
   )
 
-  # Now Fix Misaigned Values
+  # Now Fix Misaligned Values
   # Check each column for misalignments
   checkCol <- function(x, val) {
     checkCol.inner <- function(x, val) {

R/atoc_main.R

@@ -4,12 +4,13 @@
 #' Export ATOC schedule as GTFS
 #'
 #' @param stop_times stop-times
+#' @param stops stops data.frame
 #' @param schedule list of dataframes
 #' @param silent logical
 #' @param ncores number of cores to use
 #' @noRd
 #'
-schedule2routes <- function(stop_times, schedule, silent = TRUE, ncores = 1) {
+schedule2routes <- function(stop_times, stops, schedule, silent = TRUE, ncores = 1) {
 
 
   ### SECTION 1: ###############################################################################
@@ -80,7 +81,7 @@ schedule2routes <- function(stop_times, schedule, silent = TRUE, ncores = 1) {
 
 
   ### SECTION 3: ###############################################################################
-  # When splitting the calendar roWIDs are duplicated
+  # When splitting the calendar rowIDs are duplicated
   # so create new system of trip_ids and duplicate the relevant stop_times
   if (!silent) {
     message(paste0(Sys.time(), " Duplicating necessary stop times"))
@@ -90,15 +91,15 @@ schedule2routes <- function(stop_times, schedule, silent = TRUE, ncores = 1) {
   stop_times <- duplicate.stop_times_alt(calendar = calendar, stop_times = stop_times, ncores = 1)
 
   ### SECTION 5: ###############################################################################
-  # make make the trips.txt  file by matching the calnedar to the stop_times
+  # make the trips.txt file by matching the calendar to the stop_times
 
   trips <- calendar[, c("service_id", "trip_id", "rowID", "ATOC Code", "Train Status")]
-  trips <- longnames(routes = trips, stop_times = stop_times)
+  trips <- longnames(routes = trips, stop_times = stop_times, stops = stops)
 
   ### SECTION 4: ###############################################################################
-  # make make the routes.txt
+  # make the routes.txt
   # a route is all the trips with a common start and end
-  # i.e. scheduels original UID
+  # i.e. schedules original UID
   if (!silent) {
     message(paste0(Sys.time(), " Building routes.txt"))
   }
@@ -122,7 +123,9 @@ schedule2routes <- function(stop_times, schedule, silent = TRUE, ncores = 1) {
 
   routes <- routes[, c("route_id", "route_type", "ATOC Code", "route_long_name")]
   names(routes) <- c("route_id", "route_type", "agency_id", "route_long_name")
-  routes$route_short_name <- routes$route_id
+
+  # IDs are not meaningful, just leave out
+  routes$route_short_name <- "" # was: routes$route_id
 
   routes$route_type[routes$agency_id == "LT"] <- 1 # London Underground is Metro
 

R/atoc_nr.R

@@ -120,6 +120,7 @@ nr2gtfs <- function(path_in,
   # Main Timetable Build
   timetables <- schedule2routes(
     stop_times = stop_times,
+    stops = stops,
     schedule = schedule,
     silent = silent,
     ncores = ncores