Improve package efficiency about gtfs2gps

[Joaobazzo]

I created a column speed_sequence to add the sequence of constant speed into new_stoptimes

  lim0 <- which(is.na(new_stoptimes$stop_sequence)==FALSE) # start limit
  lim1 <- c(tail(lim0,-1)-1,nrow(new_stoptimes)) # end limit
  lim_len <- lim1-lim0 +1  # length of each limit
  new_stoptimes$speed_sequence <- rep(1:length(lim0),lim_len)
  # apply function for speed estimation
  new_stoptimes <- new_stoptimes[,speed := {
    dt = data.table::last(departure_time) - data.table::first(departure_time)
    ds = data.table::last(cumdist) - data.table::first(cumdist)
    v = 3.6 * ds / dt
    list(v = v)
  },by = speed_sequence]

See the microbenchmark

library(microbenchmark)
mbm <- microbenchmark::microbenchmark(times = 20,
                                      
                                      'new' = { new(gtfs_data = "tests_joao/sao_small.zip",
                                                    filepath = "tests_joao/data/output/speed_test",
                                                    spatial_resolution = 15,
                                                    cores = NULL,
                                                    progress = TRUE,
                                                    continue = FALSE) },
                                      
                                      'old' = { old(gtfs_data = "tests_joao/sao_small.zip",
                                                    filepath = "tests_joao/data/output/speed_test",
                                                    spatial_resolution = 15,
                                                    cores = NULL,
                                                    progress = TRUE,
                                                    continue = FALSE) }
)

ggplot2::autoplot(mbm)

[rafapereirabr]

I created a column speed_sequence to add the sequence of constant speed into new_stoptimes

  lim0 <- which(is.na(new_stoptimes$stop_sequence)==FALSE) # start limit
  lim1 <- c(tail(lim0,-1)-1,nrow(new_stoptimes)) # end limit
  lim_len <- lim1-lim0 +1  # length of each limit
  new_stoptimes$speed_sequence <- rep(1:length(lim0),lim_len)
  # apply function for speed estimation
  new_stoptimes <- new_stoptimes[,speed := {
    dt = data.table::last(departure_time) - data.table::first(departure_time)
    ds = data.table::last(cumdist) - data.table::first(cumdist)
    v = 3.6 * ds / dt
    list(v = v)
  },by = speed_sequence]

See the microbenchmark

library(microbenchmark)
mbm <- microbenchmark::microbenchmark(times = 20,
                                      
                                      'new' = { new(gtfs_data = "tests_joao/sao_small.zip",
                                                    filepath = "tests_joao/data/output/speed_test",
                                                    spatial_resolution = 15,
                                                    cores = NULL,
                                                    progress = TRUE,
                                                    continue = FALSE) },
                                      
                                      'old' = { old(gtfs_data = "tests_joao/sao_small.zip",
                                                    filepath = "tests_joao/data/output/speed_test",
                                                    spatial_resolution = 15,
                                                    cores = NULL,
                                                    progress = TRUE,
                                                    continue = FALSE) }
)

ggplot2::autoplot(mbm)

This looks great. Could you please try this code? Not as elegant, but perhaps faster

 # apply function for speed estimation
new_stoptimes <- new_stoptimes[, speed := 
                                 3.6 * (data.table::last(cumdist) - data.table::first(cumdist)) / (data.table::last(departure_time) - data.table::first(departure_time)),
                               by = speed_sequence]

[Joaobazzo]

Your suggestion is the object new, while the previous is old
It changes very little on average, but I think it should simplify the code...

library(microbenchmark)
mbm <- microbenchmark::microbenchmark(times = 50,
                                      
                                      'new' = { gtfs2gps02(gtfs_data = "tests_joao/sao_small.zip",
                                                    filepath = "tests_joao/data/output/speed_test",
                                                    spatial_resolution = 15,
                                                    cores = NULL,
                                                    progress = TRUE,
                                                    continue = FALSE) },
                                      
                                      'old' = { gtfs2gps01(gtfs_data = "tests_joao/sao_small.zip",
                                                    filepath = "tests_joao/data/output/speed_test",
                                                    spatial_resolution = 15,
                                                    cores = NULL,
                                                    progress = TRUE,
                                                    continue = FALSE) }
)
mbm
# Unit: milliseconds
# expr      min       lq     mean   median       uq      max neval cld
# new 153.9255 163.1745 171.1754 169.5541 174.6480 241.4118    50   a
# old 154.2710 160.4996 173.3043 166.2644 174.8794 335.7276    50   a
ggplot2::autoplot(mbm)

[rafapereirabr]

I've made the following change to the function script gtfs2gps (line 88). It was taking too much time to convert 'segmentized' shape into points. I've used a new approach based on sfheaders which is considerably faster.

     # old (slower) version
     new_shape <- subset(shapes_sf, shape_id == shapeid) %>%
       sf::st_segmentize(spatial_resolution) %>%
       sf::st_cast("LINESTRING") %>%
       sf::st_cast("POINT", warn = FALSE)  %>% 
       sf::st_sf()

    # new faster verion using sfheaders
    new_shape <- subset(shapes_sf, shape_id == shapeid) %>%
      sf::st_segmentize(spatial_resolution) %>%
      sfheaders::sf_to_df(fill = T) %>%
      sfheaders::sf_point( x = "x", y="y", keep = T)

With this, I believe we've checked all the boxes in this issue. I'm closing this issue for now, but we'll likely other issues in the future to improve the package performance even further.