From 1b6e515405d9485842bc789eaeff9edd4962dd53 Mon Sep 17 00:00:00 2001
From: oweno-tfwm <owen.oneill@tfwm.org.uk>
Date: Wed, 20 Sep 2023 20:30:29 +0100
Subject: [PATCH] alter detection of ships so it actually works- real world
 data doesn't completely follow the schema. Also add 'metro' to long name for
 underground & Tyne&Wear metro services

---
 R/atoc_export.R | 18 ++++++++++++------
 R/atoc_main.R   |  9 +++++----
 2 files changed, 17 insertions(+), 10 deletions(-)

diff --git a/R/atoc_export.R b/R/atoc_export.R
index 5701967..8a70d91 100644
--- a/R/atoc_export.R
+++ b/R/atoc_export.R
@@ -179,12 +179,18 @@ longnames <- function(routes, stop_times, stops) {
   routes <- dplyr::left_join(routes, stop_times_sub,
                              by = c("rowID" = "schedule"))
 
-
-  routes[`Train Category` == "SS", route_long_name := paste("Ship",route_long_name)]
-  routes[`Train Category` %in% c("BS", "BR"), route_long_name := paste("Bus",route_long_name)]
-  routes[!(`Train Category` %in% c("SS", "BS", "BR")), route_long_name := paste("Train",route_long_name)]
-  #TODO reflect the London Transport services being set to metro/underground in this naming code
-
+  #you'd expect to only have to look at category to tell if it's a ship, but in practice the category for
+  #ships is NA, so we have to look at 'Train Status' too.
+  routes["SS" ==`Train Category` | "S"==`Train Status` | "4"==`Train Status`,
+                            route_long_name := paste("Ship",route_long_name)]
+  routes[`Train Category` %in% c("BS", "BR"),
+                            route_long_name := paste("Bus",route_long_name)]
+
+  #Tyne & Wear metro is "OL" in data OL="London Underground/Metro Service"
+  routes[`Train Category` %in% c("EL", "OL"),
+                            route_long_name := paste("Metro",route_long_name)]
+  routes[!(`Train Category` %in% c("SS", "BS", "BR", "EL", "OL") | "S"==`Train Status` | "4"==`Train Status`),
+                            route_long_name := paste("Train",route_long_name)]
   return(routes)
 }
 
diff --git a/R/atoc_main.R b/R/atoc_main.R
index 2aace00..518222f 100644
--- a/R/atoc_main.R
+++ b/R/atoc_main.R
@@ -127,12 +127,17 @@ schedule2routes <- function(stop_times, stops, schedule, silent = TRUE, ncores =
   trips <- dplyr::left_join(trips, train_status, by = c("Train Status" = "train_status"))
   rm(train_status)
 
+  trips$route_type[trips$`Train Category` %in% c("EL", "OL") & trips$route_type == 2 ] <- 1
+  # London Underground is Metro (unless already identified as a bus/ship etc)
+  # "OL" is also used for Tyne & Wear metro
+
   routes <- trips
 
   routes <- dplyr::group_by(routes, `ATOC Code`, route_long_name, `Train Category`, route_type )
   routes <- dplyr::summarise(routes)
   routes$route_id <- 1:nrow(routes)
 
+  #join route_id back into trip table
   trips <- dplyr::left_join(trips, routes, by = c("ATOC Code", "route_long_name", "Train Category", "route_type"))
 
   routes <- routes[, c("route_id", "route_type", "ATOC Code", "route_long_name", "Train Category" )]
@@ -141,10 +146,6 @@ schedule2routes <- function(stop_times, stops, schedule, silent = TRUE, ncores =
   # IDs are not meaningful, just leave out
   routes$route_short_name <- "" # was: routes$route_id
 
-  routes$route_type[routes$agency_id == "LT" & routes$route_type == 2 ] <- 1
-      # London Underground is Metro (unless already identified as a bus/ship etc)
-      #TODO look at what this causes LizPurpCrossRailElizabethLine to be categorised as.
-      #TODO move to longnames()
 
   ### Section 6: #######################################################
   # Final Checks