From 4dab13b235f27ca0f1fe5cccb6361f0825dc469e Mon Sep 17 00:00:00 2001 From: pedro-andrade-inpe Date: Wed, 4 Mar 2020 16:05:34 -0300 Subject: [PATCH 1/5] Close #99. Getting departure_time earlier to avoid future problems with data filtered by day period. More outputs were produced because some NA values that used to be removed no longer exist. --- R/gtfs2gps.R | 4 ++-- R/mod_updates.R | 5 +---- tests/testthat/test_gtfs2gps.R | 6 +++--- 3 files changed, 6 insertions(+), 9 deletions(-) diff --git a/R/gtfs2gps.R b/R/gtfs2gps.R index e94fb63b..b6cf561d 100644 --- a/R/gtfs2gps.R +++ b/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)] diff --git a/R/mod_updates.R b/R/mod_updates.R index ed10e14f..ddbc7281 100644 --- a/R/mod_updates.R +++ b/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 diff --git a/tests/testthat/test_gtfs2gps.R b/tests/testthat/test_gtfs2gps.R index 84590b5d..877a624e 100644 --- a/tests/testthat/test_gtfs2gps.R +++ b/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 From f2916af3cc34ff5546870d92e67ae165c3acaf74 Mon Sep 17 00:00:00 2001 From: pedro-andrade-inpe Date: Wed, 4 Mar 2020 16:06:15 -0300 Subject: [PATCH 2/5] Close #100. Removing duplicated columns in gps_as_sf(). --- R/gps_as_sf.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/gps_as_sf.R b/R/gps_as_sf.R index bb5975f4..8f540d2f 100644 --- a/R/gps_as_sf.R +++ b/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) From df18a375f2d64f612c4006af24ed1fbfd467272c Mon Sep 17 00:00:00 2001 From: pedro-andrade-inpe Date: Wed, 4 Mar 2020 16:12:02 -0300 Subject: [PATCH 3/5] Updating version. --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4c776e24..dd73b187 100644 --- a/DESCRIPTION +++ b/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="rafa.pereira.br@gmail.com", role="aut", comment = c(ORCID = "0000-0003-2125-7465")), person(given="Pedro R.", family="Andrade", email="pedro.andrade@inpe.br", 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")), From c9dc9b6bc0e1137e1ec104cb000f6067530164f0 Mon Sep 17 00:00:00 2001 From: pedro-andrade-inpe Date: Wed, 4 Mar 2020 16:47:04 -0300 Subject: [PATCH 4/5] Small updates in the documentation. --- R/filter_day_period.R | 10 +++------- man/filter_day_period.Rd | 6 +++--- 2 files changed, 6 insertions(+), 10 deletions(-) diff --git a/R/filter_day_period.R b/R/filter_day_period.R index aff3ca18..34c2594b 100644 --- a/R/filter_day_period.R +++ b/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,7 +23,6 @@ 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 { diff --git a/man/filter_day_period.Rd b/man/filter_day_period.Rd index e409f0b6..f9df2f4b 100644 --- a/man/filter_day_period.Rd +++ b/man/filter_day_period.Rd @@ -4,14 +4,14 @@ \alias{filter_day_period} \title{Filter GTFS data within a period of the day} \usage{ -filter_day_period(gtfs, period_start = NULL, period_end = NULL) +filter_day_period(gtfs, period_start = "00:00:01", period_end = "23:59:59") } \arguments{ \item{gtfs}{A GTFS data.} -\item{period_start}{A string of type "hh:mm" indicating start of the period (defaults to "06:00")} +\item{period_start}{A string of type "hh:mm" indicating start of the period (defaults to "00:00:01")} -\item{period_end}{A string of type "hh:mm" indicating the end of the period (defaults to "09:00")} +\item{period_end}{A string of type "hh:mm" indicating the end of the period (defaults to "23:59:59")} } \value{ A filtered GTFS data. From 6ba7e1f0b4cd1f77e95c8b3bcde00c0a77b8913d Mon Sep 17 00:00:00 2001 From: pedro-andrade-inpe Date: Wed, 4 Mar 2020 17:36:21 -0300 Subject: [PATCH 5/5] Removing unnecessary line. --- R/filter_day_period.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/filter_day_period.R b/R/filter_day_period.R index 34c2594b..b7aeed01 100644 --- a/R/filter_day_period.R +++ b/R/filter_day_period.R @@ -29,7 +29,6 @@ filter_day_period <- function(gtfs, period_start = "00:00:01", period_end = "23: 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)