Merge pull request #101 from pedro-andrade-inpe/master

fixing bugs

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: gtfs2gps
 Title: Converting Transport Data from GTFS Format to GPS-Like Records
-Version: 1.0-3
+Version: 1.0-4
 Authors@R: c(person(given="Rafael H. M.", family="Pereira", email="[email protected]", role="aut", comment = c(ORCID = "0000-0003-2125-7465")),
             person(given="Pedro R.", family="Andrade", email="[email protected]", role=c("aut", "cre"), comment = c(ORCID = "0000-0001-8675-4046")),
             person(given="Joao", family="Bazzo", role="aut", comment = c(ORCID = "0000-0003-4536-5006")),

R/filter_day_period.R

@@ -4,8 +4,8 @@
 #'  agencies and services that are active within a given period of the day.
 #' 
 #' @param gtfs A GTFS data.
-#' @param period_start A string of type "hh:mm" indicating start of the period (defaults to "06:00")
-#' @param period_end A string of type "hh:mm" indicating the end of the period (defaults to "09:00")
+#' @param period_start A string of type "hh:mm" indicating start of the period (defaults to "00:00:01")
+#' @param period_end A string of type "hh:mm" indicating the end of the period (defaults to "23:59:59")
 #' @return A filtered GTFS data. 
 #' @export
 #' @examples
@@ -14,10 +14,7 @@
 #' 
 #' # filter gtfs data
 #' poa_f <- filter_day_period(poa, period_start = "10:00", period_end = "10:20")
-filter_day_period <- function(gtfs, period_start=NULL, period_end=NULL){
-  if(is.null(period_start)){ period_start <- "00:00:01"}
-  if(is.null(period_end)){ period_end <- "23:59:59"}
-
+filter_day_period <- function(gtfs, period_start = "00:00:01", period_end = "23:59:59"){
   if(is.na(data.table::as.ITime(period_start))){ stop("Error: Invalid period_start input") }
   if(is.na(data.table::as.ITime(period_end))){ stop("Error: Invalid period_end input") }
 
@@ -26,14 +23,12 @@ filter_day_period <- function(gtfs, period_start=NULL, period_end=NULL){
 
   # Update frequencies
   if(test_gtfs_freq(gtfs) == "frequency"){
-
     if((data.table::as.ITime(period_end) - data.table::as.ITime(period_start)) < data.table::as.ITime("01:00")){
       stop("Using a frequency-based GTFS. Please input time period of one hour or longer")
     } else {
       gtfs$frequencies <- gtfs$frequencies[ data.table::as.ITime(start_time) >= data.table::as.ITime(period_start) & data.table::as.ITime(end_time) <= data.table::as.ITime(period_end) ] 
     }
   }
-  # as.POSIXct(paste('2020-01-29', '10:45:00')) %>% as.numeric()
 
   # Remaining unique stops and trips
   unique_stops <- unique(gtfs$stop_times$stop_id)

R/gps_as_sf.R

@@ -19,6 +19,8 @@ gps_as_sf <- function(gps, crs = 4326){
   temp_gps <- sfheaders::sf_multipoint(gps, x = "shape_pt_lon", y = "shape_pt_lat",
                                        multipoint_id = "shape_id", keep = TRUE)
 
+  temp_gps<- temp_gps[, -duplicated(names(temp_gps))]
+
   # add projection
   sf::st_crs(temp_gps) <- crs
   return(temp_gps)

R/gtfs2gps.R

@@ -75,7 +75,7 @@ gtfs2gps <- function(gtfs_data, spatial_resolution = 15, parallel = FALSE, strat
     # each shape_id only has one stop sequence
 
     # check stop sequence
-    stops_seq <- gtfs_data$stop_times[trip_id == all_tripids[which.max(nstop)], .(stop_id, stop_sequence)]
+    stops_seq <- gtfs_data$stop_times[trip_id == all_tripids[which.max(nstop)], .(stop_id, stop_sequence, departure_time)]
     stops_seq[gtfs_data$stops, on = "stop_id", c('stop_lat', 'stop_lon') := list(i.stop_lat, i.stop_lon)] # add lat long info
 
     # convert stops to sf
@@ -125,7 +125,7 @@ gtfs2gps <- function(gtfs_data, spatial_resolution = 15, parallel = FALSE, strat
     ## Add stops to new_stoptimes  
     new_stoptimes[stops_seq$ref, "stop_id"] <- stops_seq$stop_id
     new_stoptimes[stops_seq$ref, "stop_sequence"] <- stops_seq$stop_sequence
-
+    new_stoptimes[stops_seq$ref, "departure_time"] <- stops_seq$departure_time
 
     # calculate Distance between successive points
     new_stoptimes[, dist := rcpp_distance_haversine(shape_pt_lat, shape_pt_lon, data.table::shift(shape_pt_lat, type = "lead"), data.table::shift(shape_pt_lon, type = "lead"), tolerance = 1e10)]

R/mod_updates.R

@@ -77,10 +77,7 @@ update_dt <- function(tripid, new_stoptimes, gtfs_data, all_tripids){
 
   # subset original stoptimes to get original travel_times btwn stops
   stoptimes_temp <- gtfs_data$stop_times[trip_id == tripid]
-
-  # add departure_time based on stop sequence
-  new_stoptimes[stoptimes_temp, on = 'stop_sequence', 'departure_time' := i.departure_time]
-
+
   # get a 'stop_sequence' of the stops which have proper info on 'departure_time'
   stop_id_ok <- gtfs_data$stop_times[trip_id == tripid & is.na(departure_time) == FALSE,]$stop_sequence
 

tests/testthat/test_gtfs2gps.R

@@ -13,12 +13,12 @@ test_that("gtfs2gps", {
     #write_sf(poa_gps_shape, "poa_gps_shape.shp")
 
     my_dim <- dim(poa_gps)[1]
-    expect_equal(my_dim, 386708)
+    expect_equal(my_dim, 393495)
 
     my_length <- length(poa_gps$dist[which(!poa_gps$dist < 15)])
     expect_equal(my_length, 0)
 
-    expect_equal(sum(poa_gps$dist), 4065814, 0.001)
+    expect_equal(sum(poa_gps$dist), 4138798, 0.001)
 
     expect_true(all(names(poa_gps) %in% 
       c("trip_id", "route_type", "id", "shape_pt_lon", "shape_pt_lat",
@@ -34,7 +34,7 @@ test_that("gtfs2gps", {
       filter_week_days() %>%
       gtfs2gps(spatial_resolution = 300, parallel = FALSE, progress = FALSE)
 
-    expect_equal(dim(poa_gps_300)[1], 66264)
+    expect_equal(dim(poa_gps_300)[1], 67377)
     expect(dim(poa_gps_300)[1] < dim(poa_gps)[1], "more spatial_resolution is not decreasing the number of points")
 
     # save into file