The Partially Planned Rendezous

Part I

Sisters Amie & Leslie plan to meet to have lunch at Ponce City Market. They are both impatient people who will only wait ten minutes for the other before leaving. But their planning was incomplete. Amie said, “Meet me between 7 and 8 tonight.”
What is the probability that they actually meet?

Your solution should include:
(a) A tibble with variables:
(i) Amie’s arrival times
(ii) Leslie’s arrival times
(iii) Do they meet? (0 and 1)
(iv) Trial number
(v) Cumulative Meetings
(vi) Cumulative Probabilities (b) Plots:
(i) (Trial, Cumulative Probability)
(ii) (Amie’s time, Leslie’s time), indicating if they meet
(c) Final Probability

Trials <- 10000
times <- tibble(
  Amie = 60*runif(Trials),
  Leslie = 60*runif(Trials),
  Meet = ifelse(abs(Amie - Leslie) <= 10,1,0)
)
times <- mutate(times,trial = as.numeric(row_number()))
times <- mutate(times,success = cumsum(Meet))
times <- mutate(times,prob = success/trial)
g1 <- ggplot(times, aes(trial,prob)) + geom_point(aes(color = success)) + geom_line()
g1

g2 <- ggplot(times, aes(Amie, Leslie)) + geom_point(aes(color = Meet))
g2

fprob <-times$prob[Trials]
fprob
## [1] 0.3078

Part II

Brother Brett decides to join Amie & Leslie. All three are willing to wait 10 minutes. What is the probability that they actually meet? Your solution should include:
(a) A tibble with variables:
(i) Amie’s arrival times
(ii) Leslie’s arrival times (iii) Brett’s arrival times
(iv) Do they meet? (0 and 1)
(v) Trial number
(vi) Cumulative Meetings
(vii) Cumulative Probabilities
(b) Plots:
(i) (Trial, Cumulative Probability)
(ii) (Amie’s time, Leslie’s time, Brett’s time), indicating if they meet (3-D)
(c) Final Probability

Trials <- 10000
Window <- 10
times <- tibble(
  Amie = 60*runif(Trials),
  Leslie = 60*runif(Trials),
  Brett = 60*runif(Trials),
  Meet = ifelse(abs(Amie - Leslie) <= Window & abs(Leslie - Brett) <= Window & abs(Amie - Brett) <= Window,1,0)
)
times <- mutate(times,trial = as.numeric(row_number()))
times <- mutate(times,success = cumsum(Meet))
times <- mutate(times,prob = success/trial)
#times
g1 <- ggplot(times, aes(trial,prob)) + geom_point(aes(color = success)) + geom_line()
g1

x = times$Amie
y = times$Leslie
z = times$Brett
scatter3D(x, y, z, bty = "f", colkey = FALSE, colvar = times$Meet, cex = 0.05, pch = 16, col = ramp.col(c("orange", "blue")), main = "The Partially Planned Rendezous", xlab = "Amie", ylab ="Leslie", zlab = "Brett")

fprob <-times$prob[Trials]
fprob
## [1] 0.0717

Birth Month Probability

Find the probability that, in a random sample of 25 people, there is at least one person born in each month.

trials <- 10000
t <- seq(1,trials)
x <- replicate(trials,length(unique(sample(1:12,25,replace = TRUE))))
success <- ifelse(x==12,1,0)
prob <- cumsum(success)/t
p <- tibble(t,x,success,prob)
ggplot(p,aes(t,prob))+ geom_point(color = "orange") + geom_line(color = "blue")

#fprob <-prob[trials]
#fprob
#table(x)/trials
trials <- 10                         
t <- seq(1,trials)
replicate(trials,length(unique(sample(1:12,25,replace = TRUE))))
##  [1] 10 11 11 10 10 10 12 11 11 10
trials <- 1000
t <- seq(1,trials)
x <- replicate(trials,length(unique(sample(1:365,25,replace = TRUE))))
succ <- ifelse(x==12,1,0)
prob <- cumsum(succ)/t
#table(x)/trials
p <- tibble(t,x,succ,prob)
#glimpse(p)
#ggplot(p,aes(t,prob))+ geom_point(color = "orange") + geom_line(color = "blue")
fprob <-prob[trials]
fprob
## [1] 0
table(x)/trials
## x
##    20    21    22    23    24    25 
## 0.001 0.006 0.030 0.131 0.353 0.479

Monte Carlo Simulation

If three dice are rolled, find the probability that their total is n?

probtotal <- function(d,k,nreps) {
  count <- 0
  for (rep in 1:nreps) {
    sum <- 0
    for (j in 1:d) sum <- sum + roll()
    if(sum == k) count <- count + 1
  }
  return (count/nreps)
}
roll <- function() return(sample(1:6,1))
pt <- replicate(16, 0)
trial <- replicate(16, 0)
for (k in 3:18) {
  trial[k] <- k
  pt[k] <- probtotal(3,k,10000)
}
probt <- tibble(trial,pt)
ggplot(probt, aes(trial,pt)) + geom_point()

More Loops 1

df <- tibble(
  a = rnorm(10),
  b = rnorm(10),
  c = rnorm(10),
  d = rnorm(10)
)
c(median(df$a),median(df$b),median(df$c),median(df$d))
## [1] 0.1709515 0.5379317 0.2485237 0.0198138
output <- vector("double",ncol(df))
for (i in seq_along(df)) {
  output[[i]] <- median(df[[i]])
}
output
## [1] 0.1709515 0.5379317 0.2485237 0.0198138

More Loops 2

glimpse(mtcars)
## Observations: 32
## Variables: 11
## $ mpg  <dbl> 21.0, 21.0, 22.8, 21.4, 18.7, 18.1, 14.3, 24.4, 22.8, 19.2, 17.8…
## $ cyl  <dbl> 6, 6, 4, 6, 8, 6, 8, 4, 4, 6, 6, 8, 8, 8, 8, 8, 8, 4, 4, 4, 4, 8…
## $ disp <dbl> 160.0, 160.0, 108.0, 258.0, 360.0, 225.0, 360.0, 146.7, 140.8, 1…
## $ hp   <dbl> 110, 110, 93, 110, 175, 105, 245, 62, 95, 123, 123, 180, 180, 18…
## $ drat <dbl> 3.90, 3.90, 3.85, 3.08, 3.15, 2.76, 3.21, 3.69, 3.92, 3.92, 3.92…
## $ wt   <dbl> 2.620, 2.875, 2.320, 3.215, 3.440, 3.460, 3.570, 3.190, 3.150, 3…
## $ qsec <dbl> 16.46, 17.02, 18.61, 19.44, 17.02, 20.22, 15.84, 20.00, 22.90, 1…
## $ vs   <dbl> 0, 0, 1, 1, 0, 1, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0…
## $ am   <dbl> 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0…
## $ gear <dbl> 4, 4, 4, 3, 3, 3, 3, 4, 4, 4, 4, 3, 3, 3, 3, 3, 3, 4, 4, 4, 3, 3…
## $ carb <dbl> 4, 4, 1, 1, 2, 1, 4, 2, 2, 4, 4, 3, 3, 3, 4, 4, 4, 1, 2, 1, 1, 2…
output <- vector("double",ncol(mtcars))
for (i in seq_along(mtcars)) {
  output[[i]] <- mean(mtcars[[i]])
}
output
##  [1]  20.090625   6.187500 230.721875 146.687500   3.596563   3.217250
##  [7]  17.848750   0.437500   0.406250   3.687500   2.812500

More Loops 2

glimpse(flights)
## Observations: 336,776
## Variables: 19
## $ year           <int> 2013, 2013, 2013, 2013, 2013, 2013, 2013, 2013, 2013, …
## $ month          <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …
## $ day            <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …
## $ dep_time       <int> 517, 533, 542, 544, 554, 554, 555, 557, 557, 558, 558,…
## $ sched_dep_time <int> 515, 529, 540, 545, 600, 558, 600, 600, 600, 600, 600,…
## $ dep_delay      <dbl> 2, 4, 2, -1, -6, -4, -5, -3, -3, -2, -2, -2, -2, -2, -…
## $ arr_time       <int> 830, 850, 923, 1004, 812, 740, 913, 709, 838, 753, 849…
## $ sched_arr_time <int> 819, 830, 850, 1022, 837, 728, 854, 723, 846, 745, 851…
## $ arr_delay      <dbl> 11, 20, 33, -18, -25, 12, 19, -14, -8, 8, -2, -3, 7, -…
## $ carrier        <chr> "UA", "UA", "AA", "B6", "DL", "UA", "B6", "EV", "B6", …
## $ flight         <int> 1545, 1714, 1141, 725, 461, 1696, 507, 5708, 79, 301, …
## $ tailnum        <chr> "N14228", "N24211", "N619AA", "N804JB", "N668DN", "N39…
## $ origin         <chr> "EWR", "LGA", "JFK", "JFK", "LGA", "EWR", "EWR", "LGA"…
## $ dest           <chr> "IAH", "IAH", "MIA", "BQN", "ATL", "ORD", "FLL", "IAD"…
## $ air_time       <dbl> 227, 227, 160, 183, 116, 150, 158, 53, 140, 138, 149, …
## $ distance       <dbl> 1400, 1416, 1089, 1576, 762, 719, 1065, 229, 944, 733,…
## $ hour           <dbl> 5, 5, 5, 5, 6, 5, 6, 6, 6, 6, 6, 6, 6, 6, 6, 5, 6, 6, …
## $ minute         <dbl> 15, 29, 40, 45, 0, 58, 0, 0, 0, 0, 0, 0, 0, 0, 0, 59, …
## $ time_hour      <dttm> 2013-01-01 05:00:00, 2013-01-01 05:00:00, 2013-01-01 …
output <- vector("character",ncol(flights))
for (i in seq_along(flights)) {
  output[[i]] <- typeof(flights[[i]])
}
output
##  [1] "integer"   "integer"   "integer"   "integer"   "integer"   "double"   
##  [7] "integer"   "integer"   "double"    "character" "integer"   "character"
## [13] "character" "character" "double"    "double"    "double"    "double"   
## [19] "double"
#trials <- 10000
#t <- seq(1,trials)
#x <- replicate(trials,length(unique(sample(1:365,50,replace = TRUE))))
#succ <- ifelse(x<23,1,0)
#prob <- cumsum(succ)/t
#u <- cumsum(ifelse(replicate(trials,length(unique(sample(1:365,50,replace = TRUE))))<23,1,0))/t
#p <- tibble(t,x,succ,prob,u)
#glimpse(p)
#ggplot(p,aes(t,prob))+ geom_point(color = "orange") + geom_line(color = "blue")
#fprob <-prob[trials]
#fprob
#table(x)/trials
#u