Optimization of treatment in a loop for

Question

I want to finalize and why not optimize a taxi management program in real time. The program manages the taxi ride of the nearest town. Also the availability of taxis. Knowing that a taxi is unavailable for an hour after which it becomes available again, and can be sent for a new ride. A taxi in progress cannot be used, so we must assign the 2nd taxi closest to the city, if not available then the 3rd and so on..

The "taxi_manage" table will be used to manage taxi availability. There is only one taxi per city. Cities are represented by a numeric code (zip code)

State before traitement

taxi_manage

taxi_number   city    time_end   available
00001         1                        0
00002         11                       0
00003         12                       0
00004         13                       0
00005         14                       0
00006         2                        0

Table of the distance between each city We will go through this table to retrieve the nearest city taxi number

city_distance
city  city_2  distance
1       1        0
1       11       3
1       12       8
2       2        0
2       13       4
2       14       7

Main table containing the taxi requests, which will be completed by the taxi number that will carry out the race.

taxi_request
id      time    city    selected_taxi
1      8:30       
2      8:40       
3      9:45       
4      8:32       
5      8:39       
6      8:40

Expected result:

After traitement

taxi_manage
taxi_number   city    time_end   available
00001         1          9:30          0
00002         11         9:40          0
00003         12         10:45         0
00004         13         9:39          0
00005         14         9:40          0
00006         2          9:32          0


taxi_request
id      time    city    selected_taxi
1      8:30      1       00001
2      8:40      1       00002
3      9:45      1       00001
4      8:32      2       00006
5      8:39      2       00004
6      8:40      2       00005

In id 3 the taxi number 00001 finished its run at 9:30 (see taxi_manage table), 
so it is selected because at 9:45 it is available again.

data:

taxi_manage <- data.table(
  taxi_number = c(00001,00002,00003,00004,00005,00006),
  city = c(1,11,12,13,14,2),
  time_end = c(NA, NA,NA,NA,NA,NA),
  available = c(0, 0,0,0,0,0)
)

city_distance <- data.table(
  city = c(1,1,1,2,2,2),
  city_2 = c(1,11,12,2,13,14),
  distance = c(0, 3,8,0,4,7)
)

taxi_request<- data.table(
  id = c(1,2,3,4,5,6),
  time = c("8:30","8:40","9:45","8:32","8:39","8:40"),
  city = c(1,1,1,2,2,2)
)

repeat_data <- function(d, n) {
  return(d[rep(seq_len(nrow(d)), n)])
}

taxi_request <- repeat_data(taxi_request, 10400)

Here is the program that I cannot optimize and whose processing is very long on more than several million lines. The program works with real data but not with this simplified example.

for (i in 1:nrow(taxi_request)){

  # update available
  request<- taxi_request %>%
    filter(id == i)

  taxi_manage <- taxi_manage %>%
    mutate(available = ifelse(hour(request$time)>=time_end,
                            0,1))

  # Check if taxi is available
  tmp <- city_distance %>%
    filter(city == request$city) %>%
    left_join(taxi_manage %>%
                select(taxi_number, time_end, available),
              by="city")

  # Choice taxi
  selected_taxi <- tmp %>%
    filter(available==0) %>%
    head(n=1) %>%
    pull(taxi_number)

  if (not_empty(selected_taxi)){
    # update taxi to be available
    taxi_manage <- taxi_manage %>%
      mutate(available=ifelse(taxi_number==selected_taxi, 1, available),
             heure_fin=ifelse(taxi_number==selected_taxi, hour(heure_dem) + 2, available),
             minute_fin=ifelse(taxi_number==selected_taxi, minute(heure_dem), available))

    # Add taxi number to taxi_request table
    taxi_request <- taxi_request %>%
      mutate(selected_taxi = ifelse(id==i, selected_taxi, selected_taxi))
  }
  else{
    taxi_request <- taxi_request %>%
      mutate(choix = ifelse(id==i, "no taxi found", selected_taxi))
  }

}

user_3817004 · Answer

If I understand correctly, the OP wants to assign to each taxi request a car which is

available and
located in the nearest city

As the question is tagged data.table, here is a solution which uses data.table syntax utilizing non-equi join, assigment by reference, and keyed subsetting.

Note that the input data has been modified to include an additional use case (no taxi available), to comply with syntax rules, and to avoid costly type conversions.

library(data.table)
options(datatable.print.class = TRUE)

on_duty_duration <- 1L * 60L *60L # 1 hour in seconds
setkey(taxi_manage, taxi_number)
setkey(taxi_request, id)

for (req_id in taxi_request$id) {
  available_taxi <- taxi_manage[taxi_request[req_id], on = .(time_end < time)]
  nearest_available_taxi <- 
    city_distance[available_taxi, on = .(city = i.city, city_2 = city), 
                  nomatch = NULL][
                    , taxi_number[which.min(distance)]]
  if(length(nearest_available_taxi) > 0) {
    taxi_request[req_id, assigned_taxi := nearest_available_taxi]
    taxi_manage[nearest_available_taxi, 
                time_end := taxi_request[req_id, time + on_duty_duration]]
    taxi_manage[nearest_available_taxi, ride_count := ride_count + 1L]
  }
}

The final result is

taxi_request

       id     time   city assigned_taxi
              
1:      1 08:30:00      1         00001
2:      2 08:40:00      1         00002
3:      3 09:45:00      1         00001
4:      4 08:32:00      2         00006
5:      5 08:39:00      2         00004
6:      6 08:40:00      2         00005
7:      7 08:42:00      2

Note that request #7 has no taxi assigned as no taxi was available at the time of the request.

The last status of the managed taxis was

taxi_manage

   taxi_number   city time_end ride_count
                 
1:       00001      1 10:45:00          2
2:       00002     11 09:40:00          1
3:       00003     12 00:00:00          0
4:       00004     13 09:39:00          1
5:       00005     14 09:40:00          1
6:       00006      2 09:32:00          1

Explanation

Please, see also the comments in the Data section for additional explanations.
Keys are set for both taxi_manage and taxi_request. This simplifies codying because we can subset with, e.g., taxi_manage["00001"] instead of taxi_manage[taxi_number == "00001"]. In addition, binary search is used for subsetting.
The code processes one taxi request after the other in order of occurrence in taxi_request. It is assumed that the requests are already ordered by the time of request (at least for each city).
Within the loop, all available taxi (regardless of location) are found using a non-equi join with the condition time_end < time.
With a second join, the distances to the locations of the available taxi are being appended and the nearest available taxi is picked. In case no taxi is available, a vector of length 0 is returned.
Finally, taxi_request and taxi_manage are updated by reference, i.e., without copying the whole object.

Code variant

For the sake of completeness, I would like to mention that data.table syntax allows for an equivalent code using grouping by = id instead of the for loop. Note that references to taxi_request[req_id] are replaced by .SD.

on_duty_duration <- 1L * 60L *60L # 1 hour in seconds
setkey(taxi_manage, taxi_number)

taxi_request[, assigned_taxi := {
  available_taxi <- taxi_manage[.SD, on = .(time_end < time)]
  nearest_available_taxi <- 
    city_distance[available_taxi, on = .(city = i.city, city_2 = city), 
                  nomatch = NULL][
                    , taxi_number[which.min(distance)]]
  request_time <- .SD$time
  taxi_manage[nearest_available_taxi, 
              time_end := request_time + on_duty_duration]
  taxi_manage[nearest_available_taxi, ride_count := ride_count + 1L]
  if (length(nearest_available_taxi) > 0) nearest_available_taxi else NA
},
by = id]

Unfortunately, I cannot assess the impact on performance as the sample dataset is far too small.

Performance considerations

The code above involves two joins per taxi request. One join can be pulled out of the loop by creating a taxi_distances table which contains the related cities, distances and taxi

taxi_distances <- city_distance[taxi_manage, on = .(city_2=city), nomatch = NULL]
setkey(taxi_distances, taxi_number)

     city city_2 distance taxi_number time_end ride_count
                      
1:      1      1        0       00001 00:00:00          0
2:      1     11        3       00002 00:00:00          0
3:      1     12        8       00003 00:00:00          0
4:      2     13        4       00004 00:00:00          0
5:      2     14        7       00005 00:00:00          0
6:      2      2        0       00006 00:00:00          0

Note that taxi appear only once just by chance; in case one taxi serves more than one city there might by multiple entries for the same taxi.

Now, bookkeeping is done in taxi_distances instead of taxi_manage. The modified code becomes:

on_duty_duration <- 1L * 60L *60L # 1 hour in seconds
taxi_request[, assigned_taxi := {
  nearest_available_taxi <-
    .SD[taxi_distances, on = .(city, time > time_end), 
        nomatch = NULL, taxi_number[which.min(distance)]]
  request_time <- .SD$time
  taxi_distances[nearest_available_taxi, 
                 time_end := request_time + on_duty_duration]
  taxi_distances[nearest_available_taxi, ride_count := ride_count + 1L]
  if (length(nearest_available_taxi) > 0) nearest_available_taxi else NA
},
by = id]

Data

library(data.table)
options(datatable.print.class = TRUE)

taxi_manage <- data.table(
  taxi_number = c("00001","00002","00003","00004","00005","00006"),
  city = c("1","11","12","13","14","2"),
  time_end = as.ITime(rep("00:00", 6L)),
  ride_count = rep(0L, 6L)
)

city_distance <- data.table(
  city = c("1","1","1","2","2","2"),
  city_2 = c("1","11","12","2","13","14"),
  distance = c(0, 3,8,0,4,7)
)

taxi_request<- data.table(
  id = c("1","2","3","4","5","6", "7"),
  time = as.ITime(c("8:30","8:40","9:45","8:32","8:39","8:40","8:42")),
  city = c("1","1","1","2","2","2","2"),
  assigned_taxi = rep(NA_character_, 7L)
)

Please note

all id columns have been coerced to type character (which is more realistic)
columns time_end, ride_count, and assigned_taxi have been initialized with sensible values
columns time and time_end are of class ITime which is a time-of-day class stored as the integer number of seconds in the day (see ?data.table::ITime)

user_3817004 · Answer

This is posted as a new answer, because it is a completely different approach to my previous answer and includes a benchmark comparison with makeshift and scalable datasets.

First, a table taxi_distances of available taxi for each city is created by joining city_distance and taxi_manage. It is ordered by city and distance using setkey(). This is computed once and avoids repeated joins within the main loop.

Then, taxi_request is ordered by city and time using setkey(). It loops over cities and requests and considers the most recent requests within one 1 hour before of the actual request using a non-equi self join of taxi_request. Each subset of requests shows the taxi which are already assigned. From the sublist of available taxi for the actual city the nearest available taxi is picked using an anti-join (kind of setdiff()) and is assigned to the actual request using update by reference (with special treatment in case there is no nearest available taxi). The update by reference is important here because it conveys the information of which taxi are assigned into the next iteration.

The non-equi self join returns an empty table but taxi_request has been updated as a side-effect.

library(data.table)
options(datatable.print.class = TRUE)

taxi_distances <- city_distance[taxi_manage, on = .(city_2=city), nomatch = NULL]
setkey(taxi_distances, city, distance)

setkey(taxi_request, city, time)
on_duty_duration <- 1L * 60L *60L # 1 hour in seconds
taxi_request[, time_before := time - on_duty_duration]

taxi_request[
  taxi_request, on = .(city, time <= time, time >= time_before), by = .EACHI, 
  {
    print(.SD) # for demonstration 
    nearest_available_taxi <-
      taxi_distances[x.city][!.SD, on = .(taxi_number = assigned_taxi), 
                             first(taxi_number)]
    print(nearest_available_taxi)  # for demonstration 
    if (length(nearest_available_taxi) > 0) 
      taxi_request[i.id, assigned_taxi := nearest_available_taxi]
    NULL
  }
]

      id assigned_taxi time_before
                
1:     1             -00:35:00
[1] "T001000"
      id assigned_taxi time_before
                
1:     1       T001000   -00:35:00
2:     2             -00:10:00
character(0)
      id assigned_taxi time_before
                
1:     1       T001000   -00:35:00
2:     2             -00:10:00
3:     3              00:15:00
character(0)
      id assigned_taxi time_before
                
1:     2             -00:10:00
2:     3              00:15:00
3:     4              00:40:00
[1] "T001000"
      id assigned_taxi time_before
                
1:     3              00:15:00
2:     4       T001000    00:40:00
3:     5              01:05:00
character(0)
      id assigned_taxi time_before
                
1:     6             -00:35:00
[1] "T002000"
      id assigned_taxi time_before
                
1:     6       T002000   -00:35:00
2:     7             -00:10:00
[1] "T002001"
      id assigned_taxi time_before
                
1:     6       T002000   -00:35:00
2:     7       T002001   -00:10:00
3:     8              00:15:00
character(0)
      id assigned_taxi time_before
                
1:     7       T002001   -00:10:00
2:     8              00:15:00
3:     9              00:40:00
[1] "T002000"
      id assigned_taxi time_before
                
1:     8              00:15:00
2:     9       T002000    00:40:00
3:    10              01:05:00
[1] "T002001"
      id assigned_taxi time_before
                
1:    11             -00:35:00
[1] "T003000"
      id assigned_taxi time_before
                
1:    11       T003000   -00:35:00
2:    12             -00:10:00
[1] "T003001"
      id assigned_taxi time_before
                
1:    11       T003000   -00:35:00
2:    12       T003001   -00:10:00
3:    13              00:15:00
[1] "T003002"
      id assigned_taxi time_before
                
1:    12       T003001   -00:10:00
2:    13       T003002    00:15:00
3:    14              00:40:00
[1] "T003000"
      id assigned_taxi time_before
                
1:    13       T003002    00:15:00
2:    14       T003000    00:40:00
3:    15              01:05:00
[1] "T003001"
Empty data.table (0 rows and 5 cols): city,time,time,assigned_taxi,time_before

taxi_request

       id    city     time assigned_taxi time_before
                     
 1:     1 C001000 00:25:00       T001000   -00:35:00
 2:     2 C001000 00:50:00             -00:10:00
 3:     3 C001000 01:15:00              00:15:00
 4:     4 C001000 01:40:00       T001000    00:40:00
 5:     5 C001000 02:05:00              01:05:00
 6:     6 C002000 00:25:00       T002000   -00:35:00
 7:     7 C002000 00:50:00       T002001   -00:10:00
 8:     8 C002000 01:15:00              00:15:00
 9:     9 C002000 01:40:00       T002000    00:40:00
10:    10 C002000 02:05:00       T002001    01:05:00
11:    11 C003000 00:25:00       T003000   -00:35:00
12:    12 C003000 00:50:00       T003001   -00:10:00
13:    13 C003000 01:15:00       T003002    00:15:00
14:    14 C003000 01:40:00       T003000    00:40:00
15:    15 C003000 02:05:00       T003001    01:05:00

Data

As I do not have a access to OP's production data, I have created a dummy dataset consisting of 3 cities, 6 taxi, 15 requests, and a constant request interval of 25 minutes (2.4 requests per hour). In order to cover several uses cases, the 1st city has one taxi, the 2nd city 2 taxi, etc. So, there will be a fews requests for which no taxi is available.

req_interval <- 25L * 60L # seconds 
n_city <- 3L
n_taxi <- seq(n_city)
n_req_per_city <- 5L
stopifnot(n_req_per_city * req_interval <= as.ITime("23:59:59"))
n_req <- n_req_per_city * n_city

tmp <- unlist(Vectorize(rep.int)(n_taxi, n_taxi))

fmt <- "C%03i%03i"
city_distance <- data.table(
  city = sprintf(fmt, tmp, 0L),
  city_2 = sprintf(fmt, tmp, rowid(tmp) - 1L),
  distance = rowid(tmp) - 1L
)

fmt <- "T%03i%03i"
taxi_manage <- data.table(
  taxi_number = sprintf(fmt, tmp, rowid(tmp) - 1L),
  city = city_distance$city_2,
  time_end = as.ITime(rep("00:00", length(tmp))),
  ride_count = rep(0L, length(tmp))
)

taxi_request <- data.table(
  id = seq(n_req),
  city = rep(unique(city_distance$city), each = n_req_per_city), 
  time = as.ITime(req_interval * rep((seq(n_req_per_city)), n_city)), 
  assigned_taxi = rep(NA_character_, n_req)
)


city_distance

      city  city_2 distance
          
1: C001000 C001000        0
2: C002000 C002000        0
3: C002000 C002001        1
4: C003000 C003000        0
5: C003000 C003001        1
6: C003000 C003002        2

taxi_manage

   taxi_number    city time_end ride_count
                  
1:     T001000 C001000 00:00:00          0
2:     T002000 C002000 00:00:00          0
3:     T002001 C002001 00:00:00          0
4:     T003000 C003000 00:00:00          0
5:     T003001 C003001 00:00:00          0
6:     T003002 C003002 00:00:00          0

taxi_request

       id    city     time assigned_taxi
                
 1:     1 C001000 00:25:00          
 2:     2 C001000 00:50:00          
 3:     3 C001000 01:15:00          
 4:     4 C001000 01:40:00          
 5:     5 C001000 02:05:00          
 6:     6 C002000 00:25:00          
 7:     7 C002000 00:50:00          
 8:     8 C002000 01:15:00          
 9:     9 C002000 01:40:00          
10:    10 C002000 02:05:00          
11:    11 C003000 00:25:00          
12:    12 C003000 00:50:00          
13:    13 C003000 01:15:00          
14:    14 C003000 01:40:00          
15:    15 C003000 02:05:00

Benchmark

The benchmark compares 5 variants

The for loop approach from my previous answer
The code variant using grouping by = id from my previous answer
The performance improvement which pulls one join out of the loop from my previous answer
The self-join approach from this answer (with an edit to avoid a large cartesian join)
The self-join approach from this answer but using setdiff() instead of the anti-join

The runs were performed for three different use cases, all with 10000 requests:

n_city: 1, n_taxi: 1, n_request: 10000, req_interval: 8
n_city: 10, n_taxi: 55, n_request: 10000, req_interval: 86
n_city: 100, n_taxi: 5050, n_request: 10000, req_interval: 863

As can bee seen from the chart below, variant 5 is 3 to 5 times faster than variant 1:

In addition, variant 5 allocates less memory than any other variant. Variant 1 allocates more than 5 times more memory than variant 5 as can be seen from the printed benchmark results:

   expression n_req n_city    min median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result memory time 
                          
 1 v1         10000      1 30.41s 31.19s    0.0318    1.97GB    1.42      3   134      1.57m


Benchmark code
library(data.table)
library(bench)

bm2 <- press(
  n_req =  c(10000L),
  n_city = c(1L, 10L, 100L),
  {
    n_taxi <- seq(n_city)
    n_req_per_city <- n_req / n_city
    req_interval <- 
      as.integer(as.ITime("23:59:59") / n_req_per_city)
    stopifnot(n_req_per_city * req_interval <= as.ITime("23:59:59"))
    
    tmp <- unlist(Vectorize(rep.int)(n_taxi, n_taxi))

    fmt <- "C%04i%04i"
    city_distance <- data.table(
      city = sprintf(fmt, tmp, 0L),
      city_2 = sprintf(fmt, tmp, rowid(tmp) - 1L),
      distance = rowid(tmp) - 1L
    )
    # city_distance
    
    fmt <- "T%04i%04i"
    taxi_manage0 <- data.table(
      taxi_number = sprintf(fmt, tmp, rowid(tmp) - 1L),
      city = city_distance$city_2,
      time_end = as.ITime(rep("00:00", length(tmp))),
      ride_count = rep(0L, length(tmp))
    )
    # taxi_manage
    
    taxi_request0 <- data.table(
      id = seq(n_req),
      city = rep(unique(city_distance$city), each = n_req_per_city), 
      time = as.ITime(req_interval * rep((seq(n_req_per_city)), n_city)), 
      assigned_taxi = rep(NA_character_, n_req)
    )
    # taxi_request0
    
    cat(sprintf("
n_city: %i, n_taxi: %i, n_request: %i, req_interval: %i
",
                uniqueN(city_distance$city), 
                uniqueN(taxi_manage0$taxi_number), 
                nrow(taxi_request0), 
                req_interval))
    
    mark(
      v1 = {
        taxi_manage <- copy(taxi_manage0)
        taxi_request <- copy(taxi_request0)
        on_duty_duration <- 1L * 60L *60L # 1 hour in seconds
        setkey(taxi_manage, taxi_number)
        setkey(taxi_request, id)
        
        for (req_id in taxi_request$id) {
          available_taxi <- taxi_manage[taxi_request[req_id], on = .(time_end < time)]
          nearest_available_taxi <- 
            city_distance[available_taxi, on = .(city = i.city, city_2 = city), 
                          nomatch = NULL][
                            , taxi_number[which.min(distance)]]
          if(length(nearest_available_taxi) > 0) {
            taxi_request[req_id, assigned_taxi := nearest_available_taxi]
            taxi_manage[nearest_available_taxi, 
                        time_end := taxi_request[req_id, time + on_duty_duration]]
          }
        }
        taxi_request
      },
      v2 = {
        taxi_manage <- copy(taxi_manage0)
        taxi_request <- copy(taxi_request0)
        on_duty_duration <- 1L * 60L *60L # 1 hour in seconds
        setkey(taxi_manage, taxi_number)
        
        taxi_request[, assigned_taxi := {
          available_taxi <- taxi_manage[.SD, on = .(time_end < time)]
          nearest_available_taxi <- 
            city_distance[available_taxi, on = .(city = i.city, city_2 = city), 
                          nomatch = NULL][
                            , taxi_number[which.min(distance)]]
          request_time <- .SD$time
          taxi_manage[nearest_available_taxi, 
                      time_end := request_time + on_duty_duration]
          if (length(nearest_available_taxi) > 0) nearest_available_taxi else NA
        },
        by = id]
        taxi_request
      },
      v3 = {
        taxi_manage <- copy(taxi_manage0)
        taxi_request <- copy(taxi_request0)
        taxi_distances <- city_distance[taxi_manage, on = .(city_2=city), nomatch = NULL]
        setkey(taxi_distances, taxi_number)
        
        on_duty_duration <- 1L * 60L *60L # 1 hour in seconds
        
        taxi_request[, assigned_taxi := {
          nearest_available_taxi <-
            .SD[taxi_distances, on = .(city, time > time_end), 
                nomatch = NULL, taxi_number[which.min(distance)]]
          request_time <- .SD$time
          taxi_distances[nearest_available_taxi, 
                         time_end := request_time + on_duty_duration]
          if (length(nearest_available_taxi) > 0) nearest_available_taxi else NA
        },
        by = id]
        taxi_request[]
      },
      v4 = {
        taxi_manage <- copy(taxi_manage0)
        taxi_request <- copy(taxi_request0)
        
        taxi_distances <- city_distance[taxi_manage, on = .(city_2=city), nomatch = NULL]
        setkey(taxi_distances, city, distance)
        
        setkey(taxi_request, city, time)
        on_duty_duration <- 1L * 60L *60L # 1 hour in seconds
        taxi_request[, time_before := time - on_duty_duration]
        
        taxi_request[
          taxi_request, on = .(city, time <= time, time >= time_before), by = .EACHI, 
          {
            nearest_available_taxi <-
              taxi_distances[first(x.city)][!.SD, on = .(taxi_number = assigned_taxi), 
                                            first(taxi_number)]
            if (length(nearest_available_taxi) > 0) 
              taxi_request[i.id, assigned_taxi := nearest_available_taxi]
            NULL
          }
          ]
        taxi_request[, time_before := NULL][]
      },
      v5 = {
        taxi_manage <- copy(taxi_manage0)
        taxi_request <- copy(taxi_request0)
        
        taxi_distances <- city_distance[taxi_manage, on = .(city_2=city), nomatch = NULL]
        setkey(taxi_distances, city, distance)
        
        setkey(taxi_request, city, time)
        on_duty_duration <- 1L * 60L *60L # 1 hour in seconds
        taxi_request[, time_before := time - on_duty_duration]
        
        taxi_request[
          taxi_request, on = .(city, time <= time, time >= time_before), by = .EACHI, 
          {
            nearest_available_taxi <- first(setdiff(
              taxi_distances[first(x.city), taxi_number], 
              .SD[, assigned_taxi]))
            if (length(nearest_available_taxi) > 0) 
              taxi_request[i.id, assigned_taxi := nearest_available_taxi]
            NULL
          }
          ]
        taxi_request[, time_before := NULL][]
      },
      check = function(x, y) all.equal(x, y, check.attributes = FALSE),
      min_time = 10, 
      min_iterations = 3L
    ) # mark
  }  
) # press

bm2
ggplot2::autoplot(bm2)

Parallelisation (an experiment)
As the OP has mentioned that the cities are grouped by region with disjoint cities and reportedly has tried to speed up computation using foreach() and %dopar% I have started to experiment with paralleisation as well.
The first experiment uses the multithreading capabilities of data.table, setDTthreads(2L). Unfortunately, the benchmark shows no speed-up for v6 (2 threads) vs v5 (1 thread) which might be due to hardware limitations.  v4 was included to confirm that v5 is the faster version.


   expression n_req n_city    min median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result memory time 
                          
 1 v4         20000    200  48.5s  48.5s    0.0206    3.44GB    0.639     1    31      48.5s 


Anyhow, v5 took about 30 seconds to process 20000 requests and less than 15 seconds to process 10000 requests. The number of cities (and the number of taxi) in the makeshift datasets seem to have little effect on run time.
For OP's production dataset with 900000 requests, processing may take about 30 minutes (assuming linear behaviour). So, the question if it is worthwhile to investigate parallelisation further.
Additional benchmarks
To verify my assumption that the v5 code is fast enough to handle OP's production dataset I have conducted additional benchmarks with 10k, 20k, 40k, and 80k requests.

  expression n_req n_city     min median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result memory time 
                         
1 v5         80000    100   1.98m  1.98m   0.00841   10.13GB    0.471     1    56      1.98m 


Plotting the run times vs number of requests on double logarithmic (log-log) scale
library(ggplot2)
ggplot(bm4) +
  aes(n_req, median, label = as.character(median)) +
  scale_x_log10(breaks = bm4$n_req) + scale_y_log10() +
  geom_point() + 
  geom_smooth(method = "lm", se = TRUE) +
  ggrepel::geom_text_repel()

indicates that run times scales linearily with problem size and that run times of 25 to 30 minutes for 900k requests might be achievable (on the system used for benchmarking; your mileage may vary):

However, memory allocation might be a greater challenge than runtimes
ggplot(bm4) +
  aes(n_req, mem_alloc, label = as.character(mem_alloc)) +
  scale_x_log10(breaks = bm4$n_req) + scale_y_log10() +
  geom_point() + 
  geom_smooth(method = "lm", se = TRUE) +
  ggrepel::geom_text_repel()


Note the log-log scale. Again, memory allocation varies linearily with problem size. However, for the 80k case about 10 GBytes of memory were allocated. Extrapolating this to 900k, more than 110 Gbytes of memory would be required.
The conclusion is that splitting up the problem in smaller chunks by regions might be necessary to comply with the available memory.

Optimization of treatment in a loop for

2 Answers

Explanation

Code variant

Performance considerations

Data

Data

Benchmark

Benchmark code

Parallelisation (an experiment)

Additional benchmarks