Draft

Simulating Chutes and Ladders

Animations
Github
Side Projects
Simulations
Author

Joey Stanley

Published

April 24, 2019

Modified

October 6, 2023

library(tidyverse)
── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.2.1     ✔ readr     2.2.0
✔ forcats   1.0.1     ✔ stringr   1.6.0
✔ ggplot2   4.0.3     ✔ tibble    3.3.1
✔ lubridate 1.9.5     ✔ tidyr     1.3.2
✔ purrr     1.2.2     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(readxl)
board <- read_excel("board.xlsx") |> 
  print()
# A tibble: 54 × 8
    tile color  text                   amount condition event movement next_tile
   <dbl> <chr>  <chr>                   <dbl> <chr>     <chr> <chr>    <chr>    
 1     1 white  START here.                NA <NA>      <NA>  <NA>     2        
 2     2 yellow Slow start! Spin agai…      0 <NA>      <NA>  spin ag… 3        
 3     3 yellow Capture escaped lion!       4 <NA>      <NA>  <NA>     4 or 11  
 4     4 yellow Correpondence course.      -1 <NA>      <NA>  <NA>     5        
 5     5 red    Business salary.           12 <NA>      <NA>  <NA>     6        
 6     6 yellow Context winner!            12 <NA>      <NA>  <NA>     7        
 7    10 yellow Rent apartment.            -1 <NA>      <NA>  <NA>     <NA>     
 8    11 yellow Car repairs.               -2 <NA>      <NA>  <NA>     <NA>     
 9    12 red    Collect for scholarsh…      3 <NA>      <NA>  <NA>     <NA>     
10    13 red    Pay for tuition.           -5 <NA>      <NA>  <NA>     <NA>     
# ℹ 44 more rows
spin <- function() { sample(x = 1:10, size = 1) }
initiate_game <- function(.n_players = 1) {
  game <- crossing(player = as.factor(1:.n_players),
                    turn = 1:200) |> 
    rowwise() |> 
    mutate(spin = spin(),
           start_tile = NaN,
           end_tile = NaN,
           start_cash = NaN,
           end_cash = NaN,
           cash_diff = NaN) |> 
    ungroup()
  
  # First turn
  # game[game$turn == 1,]$start_tile <- 27
  # game[game$turn == 1,]$start_cash <- 10000
  
  return(game)
}
game <- initiate_game() |> 
  print()
# A tibble: 200 × 8
   player  turn  spin start_tile end_tile start_cash end_cash cash_diff
   <fct>  <int> <int>      <dbl>    <dbl>      <dbl>    <dbl>     <dbl>
 1 1          1     4        NaN      NaN        NaN      NaN       NaN
 2 1          2     5        NaN      NaN        NaN      NaN       NaN
 3 1          3     2        NaN      NaN        NaN      NaN       NaN
 4 1          4     4        NaN      NaN        NaN      NaN       NaN
 5 1          5    10        NaN      NaN        NaN      NaN       NaN
 6 1          6     9        NaN      NaN        NaN      NaN       NaN
 7 1          7     1        NaN      NaN        NaN      NaN       NaN
 8 1          8     9        NaN      NaN        NaN      NaN       NaN
 9 1          9     2        NaN      NaN        NaN      NaN       NaN
10 1         10     8        NaN      NaN        NaN      NaN       NaN
# ℹ 190 more rows

Simulate one turn by one player.

take_turn <- function(.game, .player, .turn) {
  
  # Get temporary shortcut object to modify during this turn
  game_row_num <- which(.game$turn == .turn & .game$player == .player)
  this_turn <- slice(.game, game_row_num)
  
  # Use prev turn to get start tile and cash.
  if (.turn == 1) {
    this_turn$start_tile <- 27
    this_turn$start_cash <- 10000
  } else {
    prev_turn <- slice(.game, which(.game$turn == .turn-1 & .game$player == .player))
    this_turn$start_tile <- prev_turn$end_tile
    this_turn$start_cash <- prev_turn$end_cash
  }
  
  # Now advance by the spin amount.
  this_turn$end_tile <- this_turn$start_tile + this_turn$spin
  
  
  
  
  # Now overwrite the row in the original df with this temporary object.
  .game[.game$player == .player & .game$turn == .turn,] <- this_turn
  
  return(.game)
}

take_turn(game, "1", 1)
# A tibble: 200 × 8
   player  turn  spin start_tile end_tile start_cash end_cash cash_diff
   <fct>  <int> <int>      <dbl>    <dbl>      <dbl>    <dbl>     <dbl>
 1 1          1     4         27       31      10000      NaN       NaN
 2 1          2     5        NaN      NaN        NaN      NaN       NaN
 3 1          3     2        NaN      NaN        NaN      NaN       NaN
 4 1          4     4        NaN      NaN        NaN      NaN       NaN
 5 1          5    10        NaN      NaN        NaN      NaN       NaN
 6 1          6     9        NaN      NaN        NaN      NaN       NaN
 7 1          7     1        NaN      NaN        NaN      NaN       NaN
 8 1          8     9        NaN      NaN        NaN      NaN       NaN
 9 1          9     2        NaN      NaN        NaN      NaN       NaN
10 1         10     8        NaN      NaN        NaN      NaN       NaN
# ℹ 190 more rows

Now do a whole game.

simulate_game <- function() {
  this_game <- initiate_game()
  
  for (i in 1:nrow(this_game)) {
    this_game <- take_turn(this_game, this_game$player[[i]], this_game$turn[[i]])
  }
  
  return(this_game)
}
simulate_game()
# A tibble: 200 × 8
   player  turn  spin start_tile end_tile start_cash end_cash cash_diff
   <fct>  <int> <int>      <dbl>    <dbl>      <dbl>    <dbl>     <dbl>
 1 1          1     2         27       29      10000      NaN       NaN
 2 1          2    10         29       39        NaN      NaN       NaN
 3 1          3     3         39       42        NaN      NaN       NaN
 4 1          4    10         42       52        NaN      NaN       NaN
 5 1          5     5         52       57        NaN      NaN       NaN
 6 1          6     2         57       59        NaN      NaN       NaN
 7 1          7     7         59       66        NaN      NaN       NaN
 8 1          8    10         66       76        NaN      NaN       NaN
 9 1          9     4         76       80        NaN      NaN       NaN
10 1         10     9         80       89        NaN      NaN       NaN
# ℹ 190 more rows