fate_simulation.R

rm(list = ls())
library(tidyverse)

fate <-
  function(stopping_rule) {
    # the order you meet people
    the_shuffle = sample(1:100)
    # everybody you've met
    the_exes <- the_shuffle[1:stopping_rule]
    # how good was the best so far
    the_bar = max(the_exes)
    # everbody who's left to meet
    the_potentials <- the_shuffle[stopping_rule:100]
    # the first one who's good enough
    partner = the_potentials[the_potentials >= the_bar][1]
    # sometimes no one's good enough
    if(is.na(partner)) {partner <- -99}

    return(data.frame(partner = partner))
  }

run_fate <- function(stopping_rule, sims = 1000) {
  map_df(1:sims, ~ fate(stopping_rule))
}

simulations <- map_df(1:100, ~run_fate(.), .id = "stopping_rule")

gg_df <- 
  simulations %>%
  mutate(stopping_rule = as.numeric(stopping_rule)) %>%
  group_by(stopping_rule) %>%
  summarize(probability_alone = mean(partner == -99),
            how_good_if_not_alone = mean(partner[partner != -99])) %>%
  gather(key, value, -stopping_rule)

ggplot(gg_df, aes(stopping_rule, value)) +
  geom_point() +
  geom_line() +
  geom_vline(xintercept = 37, color = "red") +
  theme_bw() +
  theme(strip.background = element_blank(), axis.title.y = element_blank()) +
  facet_wrap(~key, scales = "free")

inspired by: https://www.thecut.com/2018/10/how-to-know-when-to-stop-dating-using-math-its-at-37.html?utm_medium=s1&utm_source=tw&utm_campaign=sou