Use NA for empty arrival/departure time strings

R/dates.R

@@ -0,0 +1,133 @@
+# Dates ####
+parse_gtfsio_date = function(gtfsio_date) {
+  as.Date(as.character(gtfsio_date), format = "%Y%m%d")
+}
+
+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)]
+    }
+  }
+  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 
+#' services for a date. See example. 
+#' 
+#' @param gtfs_obj gtfs feed (tidygtfs object)
+#' @return a date_service data frame
+#' 
+#' @keywords internal
+#' @importFrom stats reshape
+#' @examples 
+#' library(dplyr)
+#' local_gtfs_path <- system.file("extdata", "google_transit_nyc_subway.zip", package = "tidytransit")
+#' nyc <- read_gtfs(local_gtfs_path)
+#' nyc_services_by_date <- nyc$.$dates_services
+#' # count the number of services running on each date
+#' nyc_services_by_date %>% group_by(date) %>% count()
+set_dates_services <- function(gtfs_obj) {
+  has_calendar = feed_contains(gtfs_obj, "calendar") && nrow(gtfs_obj[["calendar"]]) > 0
+  has_calendar_dates = feed_contains(gtfs_obj, "calendar_dates") && nrow(gtfs_obj[["calendar_dates"]]) > 0
+
+  # check date validity 
+  if(!has_calendar && !has_calendar_dates) {
+    return(gtfs_obj)
+  }
+
+  feed_dates = list()
+  if(has_calendar) {
+    feed_dates$calendar <- c(gtfs_obj$calendar$start_date, gtfs_obj$calendar$end_date)
+  }
+  if(has_calendar_dates) {
+    feed_dates$calendar_dates <- gtfs_obj$calendar_dates$date[which(gtfs_obj$calendar_dates$exception_type != 2)]
+  }
+  if(length(feed_dates$calendar) == 0 && length(feed_dates$calendar_dates) == 0) {
+    warning("No valid dates defined in feed")
+    return(gtfs_obj)
+  }
+
+  # table to connect every date to corresponding services (all dates from earliest to latest)
+  if(has_calendar) {
+    weekday <- function(date) {
+      c("sunday", "monday", "tuesday", 
+        "wednesday", "thursday", "friday", 
+        "saturday")[as.POSIXlt(date)$wday + 1]
+    }
+
+    min_date = min(feed_dates$calendar, na.rm = T)
+    max_date = max(feed_dates$calendar, na.rm = T)
+    # get first and last date of a feed
+    dates <- dplyr::tibble(
+      date = seq(min_date, max_date, 1),
+      weekday = weekday(date)
+    )
+
+    # gather services by weekdays
+    .days = c("monday", "tuesday", "wednesday", "thursday", "friday", "saturday", "sunday") 
+    .cns_nondays = colnames(gtfs_obj$calendar)[which(!colnames(gtfs_obj$calendar) %in% .days)]
+    service_ids_weekdays = gtfs_obj$calendar %>% 
+      reshape(gc, direction = "long", idvar = .cns_nondays, varying = .days, 
+              v.names = "bool", timevar = "weekday_num") %>% 
+      left_join(data.frame(weekday_num = 1:7, weekday = .days), "weekday_num") %>% 
+      dplyr::filter(bool == 1) %>% dplyr::select(service_id, weekday, start_date, end_date)
+
+    # set services to dates according to weekdays and start/end date
+    date_service_df <- 
+      suppress_matches_multiple_warning(
+        dplyr::full_join(dates, service_ids_weekdays, by="weekday")
+      ) %>% 
+      dplyr::filter(date >= start_date & date <= end_date) %>% 
+      dplyr::select(-weekday, -start_date, -end_date)
+
+    # addtions and exceptions
+    if(has_calendar_dates) {
+      # add calendar_dates additions (1)
+      additions = gtfs_obj$calendar_dates %>% 
+        filter(exception_type == 1) %>% 
+        dplyr::select(-exception_type)
+      if(nrow(additions) > 0) {
+        date_service_df <- dplyr::full_join(date_service_df, 
+                                            additions, 
+                                            by=c("date", "service_id"))
+      }
+
+      # remove calendar_dates exceptions (2) 
+      exceptions = gtfs_obj$calendar_dates %>% 
+        dplyr::filter(exception_type == 2) %>% 
+        dplyr::select(-exception_type)
+      if(nrow(exceptions) > 0) {
+        date_service_df <- dplyr::anti_join(date_service_df, 
+                                            exceptions, 
+                                            by=c("date", "service_id"))
+      }
+    }
+  } else if(has_calendar_dates) { # only calendar_dates.txt
+    date_service_df = gtfs_obj$calendar_dates[gtfs_obj$calendar_dates$exception_type != 2, c("date", "service_id")]
+    date_service_df <- dplyr::as_tibble(date_service_df)
+  }
+
+  gtfs_obj$.$dates_services <- date_service_df
+
+  return(gtfs_obj)
+}

R/raptor.R

@@ -91,12 +91,11 @@ raptor = function(stop_times,
   # stop ids need to be a character vector
   # use data.table for faster manipulation
   # copy necessary as we change/rename columns by reference
-  stop_times_dt <- as.data.table(stop_times)
+  stop_times_dt <- as.data.table(replace_NA_times(stop_times))
   stop_times_dt <- setup_stop_times(stop_times_dt, reverse = arrival)
   transfers_dt <- as.data.table(transfers)
   transfers_dt <- setup_transfers(transfers_dt)
 
-
   from_stop_ids = stop_ids
   nonexistent_stop_ids = setdiff(from_stop_ids, c(stop_times_dt$to_stop_id, 
                                                   transfers_dt$trnsfrs_from_stop_id, transfers_dt$trnsfrs_to_stop_id))