<p><div><div><div><div data-show-faces="false" data-height="21" data-width="100" data-layout="button_count" data-send="true" data-href="https://www.r-bloggers.com/uber-assignment-with-lpsolve/"></div></div><div></div></div><div></div></div>
<div>
(This article was first published on <strong><a href="https://insightr.wordpress.com/2017/10/13/uber-assignment-with-lpsolve/"> R – insightR</a></strong>, and kindly contributed to <a rel="nofollow" href="https://www.r-bloggers.com/">R-bloggers)</a> </div>
<p><strong>By Yuri Fonseca</strong></p>
<p>In this post we are going to make an Uber assignment simulation and calculate some metrics of waiting time through simulation.</p>
<p><span></span></p>
<h2>Setting</h2>
<p>Suppose we live in a 100×100 block city where each block takes 1 minute to cross by car. Drivers can pick up passengers only on corners, and passengers must call Uber on corners. Inferior-left corner is (1,1) and superior-right corner is (100,100).</p>
<h2>Functions</h2>
<p>In order to calculate the average waiting time of a passenger, we need a couple of functions. The first function calculates the distance of a specific passenger and a specific driver, the second function creates the passengers, the third creates the cars and finally, the last function builds the distance matrix between cars and passengers in order to assign them in a optimal way.</p>
<p>Since our city is a perfect square, the distance between a passenger and a car is simple the distance in the x-axis plus the distance in the y-axis. Moreover, signs don’t matter. In this simple example we just need to know the initial position of the driver, initial position of the car and final destination. Each of these positions is a 2×1 vector representation in the city map.</p>
<h4>Observation: distance matrix</h4>
<p>We are going to use an linear programming solver in order to allocate optimally cars to passangers. This allocation problem just work with square matrix. So, if we have more cars than passengers, we need to create fictionary passengers (zero distances) in order to the solver converge. Note that we are going to do just a single round of allocation, so the number of cars needs to be bigger or equal than the number of passengers asking for a UBER driver.</p>
<pre>create_passenger = function(id){

  initial.position = sample(50, 2, replace = TRUE)
  final.destination = sample(50, 2, replace = TRUE)

  return(list('number' = id, 'initial' = initial.position,
              'final' = final.destination))
}

create_car = function(id){

  initial.position = sample(50, 2, replace = TRUE)

  return(list('number' = id, 'position' = initial.position))
}

distance = function(x,y){
  sum(abs(x-y))
}

distance.matrix = function(cars, passengers){

  d.matrix = matrix(0, nrow = length(cars), ncol = length(cars))

  for (i in 1:length(cars)){
    for (j in 1:length(passengers)){
      d.matrix[i,j] = distance(cars[[i]]$position, passengers[[j]]$initial)
    }
  }
  return(d.matrix)
}
</pre>
<h4>Example MAP</h4>
<p>Let’s check an example of 10 passengers and 10 cars:</p>
<pre>library(lpSolve)
library(ggplot2)

set.seed(20)

passengers = lapply(seq(1:10), create_passenger)
cars = lapply(seq(1:10), create_car)

d.matrix = distance.matrix(cars, passengers)
opt.allocation = lp.assign(d.matrix)

passengers.points = sapply(passengers, function(x) x$initial)
cars.points = sapply(cars, function(x) x$position)

points = t(cbind(passengers.points, cars.points))
assignments = apply(opt.allocation$solution, 1, which.max) #checking the assignment for each car

df1 = data.frame('x.axis' = points[,1],
                 'y.axis' = points[,2],
                 'id' = c(rep('Passenger',10), rep('Car',10)))

# df.assign = data.frame('x' = cars.points[1,],
#                        'y' = cars.points[2,],
#                        'xend' = passengers.points[1,assignments],
#                        'yend' = passengers.points[2,assignments])

df.assign1 = data.frame('x' = cars.points[1,],
                       'y' = cars.points[2,],
                       'xend' = passengers.points[1,assignments],
                       'yend' = cars.points[2,])

df.assign2 = data.frame('x' = passengers.points[1,assignments],
                       'y' = cars.points[2,],
                       'xend' = passengers.points[1,assignments],
                       'yend' = passengers.points[2,assignments])

ggplot(df1, aes(x.axis,y.axis)) + geom_point(aes(color = id, group = id), size = 3) + # car and passengers
  geom_segment(aes(x = x, y = y, xend = xend, yend = yend), data = df.assign1) +
  geom_segment(aes(x = x, y = y, xend = xend, yend = yend), data = df.assign2,
             arrow = arrow(length = unit(0.02, &quot;npc&quot;), type = 'closed')) +
  scale_x_continuous(minor_breaks = seq(1, 50, 1)) +
  scale_y_continuous(minor_breaks = seq(1, 50, 1)) +
  ggtitle('Optimal Allocation')
</pre>
<p><img alt="plot of chunk example_city" src="https://i1.wp.com/i.imgur.com/JmMGiTk.png?w=456&ssl=1" data-recalc-dims="1"></p>
<h2>Monte Carlo simulation</h2>
<p>Now the waiting time… Suppose that we have 10 passengers asking for cars in the city, we are going to see how the waiting time changes with the numbers of cars. As example, we are going to change the numbers of cars from 10 up to 30 cars, with 500 hundred Monte Carlo simulation.</p>
<pre>simulations = function(N, MC) {

  ncars = N
  times = matrix(0, nrow = MC, ncol = N)

  for (i in 1:MC){
    passengers = lapply(seq(1:10), create_passenger)
    cars = lapply(seq(1:ncars), create_car)

    d.matrix = distance.matrix(cars, passengers)
    opt.allocation = lp.assign(d.matrix)
    times[i,] = colSums(opt.allocation$solution*opt.allocation$costs) # waiting time for each passenger
  }
  return(times)
}

results = lapply(seq(10,30,2), simulations, MC = 500) # MC = 500 just to save some time
</pre>
<p>Now it is possible to check how the numbers of cars affect the mean waiting time and the 10% and 90% confidence level for the waiting time.</p>
<pre>df2 = data.frame('WaitingTime' = sapply(results, mean),
                 'LB' = sapply(results, quantile, probs = 0.10),
                'UB' = sapply(results, quantile, probs = 0.90),
                'Cars' = seq(10,30,2))

ggplot(df2, aes(x = Cars)) + geom_line(aes(y = WaitingTime), lwd = 1.2) +
  geom_ribbon(aes(ymin = LB, ymax = UB), fill = 'blue', alpha = .3)
</pre>
<p><img alt="plot of chunk WaitingTime" src="https://i1.wp.com/i.imgur.com/VDujeYK.png?w=456&ssl=1" data-recalc-dims="1"></p>
<p> <a rel="nofollow" href="http://feeds.wordpress.com/1.0/gocomments/insightr.wordpress.com/718/" target="_blank"><img border="0" alt="" src="http://feeds.wordpress.com/1.0/comments/insightr.wordpress.com/718/"></a> <img border="0" alt="" src="https://i1.wp.com/pixel.wp.com/b.gif?resize=1%2C1&ssl=1" data-recalc-dims="1"></p>
	<p>
<div>
<div>To <strong>leave a comment</strong> for the author, please follow the link and comment on their blog: <strong><a href="https://insightr.wordpress.com/2017/10/13/uber-assignment-with-lpsolve/"> R – insightR</a></strong>.</div>
<hr>
<a rel="nofollow" href="https://www.r-bloggers.com/">R-bloggers.com</a> offers <strong><a rel="nofollow" href="https://feedburner.google.com/fb/a/mailverify?uri=RBloggers">daily e-mail updates</a></strong> about <a rel="nofollow" href="https://www.r-project.org/" title="The R Project for Statistical Computing">R</a> news and <a rel="nofollow" href="https://www.r-bloggers.com/search/tutorial" title="R tutorials">tutorials</a> on topics such as: <a rel="nofollow" href="https://www.r-bloggers.com/search/data%20science" title="Data science">Data science</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/Big%20Data" title="Big Data">Big Data, <a rel="nofollow" href="https://www.r-users.com/" title="R jobs">R jobs</a>, visualization (<a rel="nofollow" href="https://www.r-bloggers.com/search/ggplot2" title="ggplot and ggplot2 tutorials">ggplot2</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/boxplot" title="Boxplots using lattice and ggplot2 tutorials">Boxplots</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/map" title="Maps and gis">maps</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/animation" title="Animation in R">animation</a>), programming (<a rel="nofollow" href="https://www.r-bloggers.com/search/RStudio" title="RStudio IDE for R">RStudio</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/sweave" title="Sweave and literate programming">Sweave</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/LaTeX" title="LaTeX in R">LaTeX</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/SQL" title="SQL and databases">SQL</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/eclipse" title="Eclipse IDE for R">Eclipse</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/git" title="git and github, Version Control System">git</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/hadoop" title="Large data in R using Hadoop">hadoop</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/Web+Scraping" title="Web Scraping of google, facebook, yahoo, twitter and more using R">Web Scraping</a>) statistics (<a rel="nofollow" href="https://www.r-bloggers.com/search/regression" title="Regressions and ANOVA analysis tutorials">regression</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/PCA" title="principal component analysis tutorial">PCA</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/time+series" title="Time series">time series</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/trading" title="finance trading">trading</a>) and more...
<img width="1" alt="" src="http://feeds.feedburner.com/~r/RBloggers/~4/_vozQBp0JPk" height="1"></a></div>