Bus Shelter Occupancy

[MW19]

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
  )

[HanOostdijk]

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)}

[MW19]

@HanOostdijk

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 #> #> 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

Thats great - Thank you!