Bus Shelter Occupancy

General
#1

Hi,

I would like to see at any given minute of the day how many bus shelters are being used at any given point to help with social distancing of COVID.

I would like to see the data in this format:

Time BusID Shelter
03/06/2020 05:20 AA1 239
03/06/2020 05:21 AA1 239
03/06/2020 05:22 AA1 239
03/06/2020 05:23 AA1 239
03/06/2020 05:24 AA1 239
03/06/2020 06:18 AA2 220
03/06/2020 06:19 AA2 220
03/06/2020 06:20 AA2 220
03/06/2020 06:21 AA2 220

The code I have at present, expands the times but I cant seem to add in BusID or Shelter.

df <- data.frame(StandOccupancy = seq(from = min(ArrivalTime), to = max(DepartureTime), by = 60)) # 60 seconds = 1 minutes

Any help would be appreciated.

tibble::tribble(
  ~IncomingBusID,       ~ArrivalTime, ~OutGoingBusID,     ~DepartureTime, ~BusShelter,
           "AA1", "03/06/2020 05:20",          "AA1", "03/06/2020 05:24",         239,
           "AA2", "03/06/2020 06:18",          "AA2", "03/06/2020 06:21",         220
  )
#2

You could do something like this (using the packages purrr and lubridate)

t1 <-tibble::tribble(
  ~IncomingBusID,       ~ArrivalTime, ~OutGoingBusID,     ~DepartureTime, ~BusShelter,
  "AA1", "03/06/2020 05:20",          "AA1", "03/06/2020 05:24",         239,
  "AA2", "03/06/2020 06:18",          "AA2", "03/06/2020 06:21",         220
)
print(t1)
#> # A tibble: 2 x 5
#>   IncomingBusID ArrivalTime      OutGoingBusID DepartureTime    BusShelter
#>   <chr>         <chr>            <chr>         <chr>                 <dbl>
#> 1 AA1           03/06/2020 05:20 AA1           03/06/2020 05:24        239
#> 2 AA2           03/06/2020 06:18 AA2           03/06/2020 06:21        220

purrr::pmap_dfr(t1,
    function(IncomingBusID, ArrivalTime, OutGoingBusID, DepartureTime, BusShelter) {
      dt_format = "%d/%m/%Y %H:%M"
      df <- data.frame(
        Time = seq(from = lubridate::as_datetime(ArrivalTime,format=dt_format), 
                   to = lubridate::as_datetime(DepartureTime,format=dt_format), by = 60)
        )
      n  <- nrow(df)
      df <- cbind(df , BusID= rep(IncomingBusID,n), Shelter= rep(BusShelter,n))
    })
#>                  Time BusID Shelter
#> 1 2020-06-03 05:20:00   AA1     239
#> 2 2020-06-03 05:21:00   AA1     239
#> 3 2020-06-03 05:22:00   AA1     239
#> 4 2020-06-03 05:23:00   AA1     239
#> 5 2020-06-03 05:24:00   AA1     239
#> 6 2020-06-03 06:18:00   AA2     220
#> 7 2020-06-03 06:19:00   AA2     220
#> 8 2020-06-03 06:20:00   AA2     220
#> 9 2020-06-03 06:21:00   AA2     220

Created on 2020-06-04 by the reprex package (v0.3.0)

1 Like
#4

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

#3

Thats great - Thank you!