Sharing a bicycle (part 4)

The function tfinal that I developed for part 3 returns the time for the two friends to complete a journey as a function of six variables: the total distance (s), the distance ahead of the other friend that the rider leaves the bicycle (h), and the walking and riding speeds of each friend (wA,rA,wB, and rB respectively). The graph of completion time vs. distance ahead is so strange-looking that I decided I wanted to see what the whole process looked like for given values of wA, rA, wB, rB, s, and h. That meant writing a function to return a data frame containing the elapsed time and the position of each friend and the bicycle at the end of each event.

The main difficulty I encountered was in bookkeeping: there are a lot of stages, exceptions, variables and velocities to keep track of! I also learned something new: the <<- operator. Note the functions modify in lines 8-13 and adjoin in lines 16-21. Within the body of the bikeShare function, I am continually updating the time and the positions of A, B, and the bicycle (designated as C). I then append the updated values to vectors. When both friends finally reach the other house, these four vectors are joined together to form the data frame. To avoid rewriting the same code over and over again — and to make the code more readable — I wanted to turn the update and append processes into functions (really, I think of them more as procedures or subroutines).

The problem is that an R function generally cannot change the value of a variable declared outside the function. At first I was using the conventional assignment operator <-, and it wasn’t working. A quick search through The Art of R Programming (a book I cannot recommend highly enough) led me to the <<- operator, and with that everything fell into place.

So here is the code. The function bikeShare is the workhorse that keeps track of all the times and positions, and returns the required data frame (actually a tibble, since I’m using the tidyverse):

library(tidyverse)

bikeShare <- function(wA,rA,wB,rB,s,h) {

  t <- 0; xA <- 0; xB <- 0; xC <- 0
  ttime <- t; x_A <- xA; x_B <- xB; x_C <- xC

  modify <- function(tx,a,b,c) {
    t <<- tx
    xA <<- a
    xB <<- b
    xC <<- c
  }

  adjoin <- function(tx,a,b,c) {
    ttime <<- append(ttime,tx)
    x_A <<- append(x_A,a)
    x_B <<- append(x_B,b)
    x_C <<- append(x_C,c)
  }

  repeat {
    # Step 1: A riding, B walking.
    dtA <- (s - xA)/rA
    dtB <- (s - xB)/wB
    if(rA <= wB) {
      modify(t + dtB,xA + rA*dtB,s,xA)
      adjoin(t,xA,xB,xC)
      modify(t + (s - xA)/rA,s,s,s)
      adjoin(t,xA,xB,xC)
      posrec <- tibble(ttime,x_A,x_B,x_C)
      return(posrec)
    }
    dt <- (h + xB - xA)/(rA - wB)
    if((xA + rA*dt >= s)||(xB + wB*dt >= s))
      if(dtA < dtB) {
        modify(t + dtA,s,xB + wB*dtA,s)
        adjoin(t,xA,xB,xC)
        modify(t + (s - xB)/wB,s,s,s)
        adjoin(t,xA,xB,xC)
        posrec <- tibble(ttime,x_A,x_B,x_C)
        return(posrec)
      } else {
        modify(t + dtB,xA + rA*dtB,s,xA)
        adjoin(t,xA,xB,xC)
        modify(t + (s - xA)/rA,s,s,s)
        adjoin(t,xA,xB,xC)
        posrec <- tibble(ttime,x_A,x_B,x_C)
        return(posrec)
      }
    modify(t+dt,xA + rA*dt,xB + wB*dt,xA)
    adjoin(t,xA,xB,xC)

    # Step 2: Both walking.
    dt <- h/wB
    if(xA + wA*dt >= s) {
      dtA <- (s - xA)/wA
      modify(t + dtA,s,xB + wB*dtA,xC)
      adjoin(t,xA,xB,xC)
      modify(t + (xC - xB)/wB,s,xC,xC)
      adjoin(t,xA,xB,xC)
      modify(t + (s - xB)/rB,s,s,s)
      adjoin(t,xA,xB,xC)
      posrec <- tibble(ttime,x_A,x_B,x_C)
      return(posrec)
    }
    modify(t + dt,xA + wA*dt,xB <- xB + h,xC)
    adjoin(t,xA,xB,xC)

    # Step 3: A walking, B riding
    dtA <- (s - xA)/wA
    dtB <- (s - xB)/rB
    if(rB <= wA) {
      modify(t + dtA,s,xB + rB*dtA,xB)
      adjoin(t,xA,xB,xC)
      modify(t + (s - xB)/rB,s,s,s)
      adjoin(t,xA,xB,xC)
      posrec <- tibble(ttime,x_A,x_B,x_C)
      return(posrec)
    }
    dt <- (h + xA - xB)/(rB - wA)
    if((xB + rB*dt >= s)||(xA + wA*dt >= s))
      if(dtB < dtA) {
        modify(t + dtB,xA + wA*dtB,s,s)
        adjoin(t,xA,xB,xC)
        modify(t + (s - xA)/wA,s,s,s)
        adjoin(t,xA,xB,xC)
        posrec <- tibble(ttime,x_A,x_B,x_C)
        return(posrec)
      } else {
        modify(t + dtA,s,xB + rB*dtA,xB)
        adjoin(t,xA,xB,xC)
        modify(t + (s - xB)/rB,s,s,s)
        adjoin(t,xA,xB,xC)
        posrec <- tibble(ttime,x_A,x_B,x_C)
        return(posrec)
      }
    modify(t + dt,xA + wA*dt,xB + rB*dt,xB)
    adjoin(t,xA,xB,xC)

    # Step 4: Both walking
    dt <- h/wA
    if(xB + wB*dt >=s) {
      dtB <- (s - xB)/wB
      modify(t + dtB,xA + wA*dtB,s,xC)
      adjoin(t,xA,xB,xC)
      modify(t + (xC - xA)/wA,xC,s,xC)
      adjoin(t,xA,xB,xC)
      modify(t + (s - xA)/rA,s,s,s)
      adjoin(t,xA,xB,xC)
      posrec <- tibble(ttime,x_A,x_B,x_C)
      return(posrec)
    }
    modify(t + dt,xA + h,xB + wB*dt,xC)
    adjoin(t,xA,xB,xC)
  }
}

wA <- 2.9333
rA <- 8.8
wB <- 4
rB <- 12
s <-  5280
h <- 520

dtbl <- bikeShare(wA,rA,wB,rB,s,h)

xtbl <- dtbl %>%
  gather(object,distance,-ttime) %>%
  mutate(object=as.factor(object))

p <- ggplot(xtbl,aes(ttime,distance,group=object,color=object)) +
  geom_line(size=2) +
  xlab("Time (sec)") + ylab("Position (ft)")
print(p)

The code produces the figure below:

I’m not sure that’s the best way to display the information. The red line corresponds to friend A, the green line to friend B, and the blue line to the bicycle. The problem is that for most of the time, the bicycle is coincident with the rider, so the blue line covers up the line corresponding to whichever friend happens to be riding it at the moment.

Nevertheless, the figure does record the progress of the journey. At the beginning, B is walking and A is riding the bike (we can tell this because the bike rider corresponds to the color that does not appear — red in this case). Then at about time 108, A is 520 feet ahead of B so A gets off the bike and begins walking. Meanwhile B gets to the bike at about time = 240. The journey proceeds this way, and you can see every time the bike changes hands.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s