Chutes And Ladders

March 4, 2011

Our method is to simulate playing a large number of games and count the outcomes. Chutes and ladders are represented as association-lists with the from square in the car and to square in the cdr:

(define chutes '((16 . 6) (47 . 26) (49 . 11)
        (56 . 53) (62 . 19) (64 . 60) (87 . 24)
        (93 . 73) (95 . 75) (98 . 78)))

(define ladders '((1 . 38) (4 . 14) (9 . 31)
        (21 . 42) (28 . 84) (36 . 44) (51 . 67)
        (71 . 91) (80 . 100)))

A single game is the path that one token takes to reach space 100. The first cond clause ends the game, the second cond clause stays if the roll of the die is beyond the end, the third cond clause handles chutes and ladders, and the final cond clause handles all other squares. The loop accumulates the path through the board; p is the current position, and ps is the path. The lambda in the third clause takes the “true” result of an a-list lookup, which is a start/end pair, and extracts the ending position:

(define (game)
  (let loop ((ps '(0)))
    (let* ((die (randint 6 0)) (p (+ (car ps) die)))
      (cond ((= 100 (car ps)) (cdr (reverse ps)))
            ((< 100 p) (loop (cons (car ps) ps)))
            ((or (assoc p chutes) (assoc p ladders))
              => (lambda (x) (loop (cons (cdr x) ps))))
            (else (loop (cons p ps)))))))

For instance, a sample game might look like this; the player hit the 9/31 ladder and the 80/100 ladder, but no chutes, for a 16-roll game:

> (game)
(6 7 31 37 42 48 50 55 57 63 65 68 72 74 79 100)

Function games executes (game) multiple times and reports the lengths of the various games played:

(define (games n)
  (let loop ((n n) (gs '()))
    (if (zero? n) gs
      (loop (- n 1) (cons (length (game)) gs)))))

Compete reports the lengths of n games each played by k players. The expression (apply min (games k)) reports the number of turns taken by the winner:

(define (compete k n)
  (let loop ((n n) (gs '()))
    (if (zero? n) gs
      (loop (- n 1) (cons (apply min (games k)) gs)))))

Finally, stats gathers statistics:

(define (stats k n)
  (let ((gs (compete k n)))
    (values (apply min gs) (apply max gs)
      (exact->inexact (/ (apply + gs) n)))))

Here are some sample results:

> (stats 1 1000000)
7
349
39.290771
> (stats 2 100000)
7
154
26.3613
> (stats 3 100000)
7
111
21.73284
> (stats 4 100000)
7
94
19.20292
> (stats 5 100000)
7
80
17.70565

The minimum number of turns to complete the game is 7 (Wikipedia says 6; perhaps their board is somewhat different than ours). It takes on average 39.3 turns to reach space 100. Games get shorter as the number of players increases, since at least one of the players beats the average. The poor fellow who rolled 349 times before reaching space 100 was terribly unlucky; presumably, he should wait until tomorrow to buy a lottery ticket, as he certainly has no luck today.

We used randint from the Standard Prelude. You can run the program at http://programmingpraxis.codepad.org/RPq4Ocqx.

About these ads

Pages: 1 2

7 Responses to “Chutes And Ladders”

  1. [...] today’s Programming Praxis exercise, our goal is to simulate the board game Chutes and Ladders. Let’s [...]

  2. My Haskell solution (see http://bonsaicode.wordpress.com/2011/03/04/programming-praxis-chutes-and-ladders/ for a version with comments):

    import Control.Monad
    import System.Random
    
    promote :: Num a => a -> a
    promote n = maybe n id $ lookup n [(16,6), (47,26), (49,11), (56,53),
        (62,19), (64,60), (87,24), (93,73), (95,75), (98,78), (1,38), (4,14),
        (9,31), (21,42), (28,84), (36,44), (51,67), (71,91), (80,100)]
    
    game :: IO [Int]
    game = fmap (tail . turn 0 . randomRs (1,6)) newStdGen where
        turn 100 _       = [100]
        turn n   ~(d:ds) = n : turn (if n+d > 100 then n else promote $ n+d) ds
    
    stats :: Int -> Int -> IO (Int, Int, Float)
    stats k n = fmap (\rs -> (minimum rs, maximum rs, average rs)) .
        replicateM n . fmap minimum . replicateM k $ fmap length game where
            average xs = fromIntegral (sum xs) / fromIntegral n
    
    main :: IO ()
    main = do print =<< stats 1 100000
              print =<< stats 2 100000
              print =<< stats 3 100000
              print =<< stats 4 100000
              print =<< stats 5 100000
    
  3. Graham said

    Not terribly fast, though it gets the job done. To speed this up, I tried
    1. Numpy arrays (which doesn’t get much of an improvement),
    2. PyPy (which sped things up a lot), and
    3. Cython to compile the code.
    None of these three options come standard with the typical Python installation,
    unfortunately. As a further exercise for myself, I went about compiling via
    Cython, without changing the original code beyond all recognition; details
    available on codepad.

    #!/usr/bin/env python
    from random import randrange
    
    def single_game(chutes, ladders):
        pos, path = 0, []
        while pos < 100:
            pos += randrange(1, 7)
            if pos in chutes:
                pos = chutes[pos]
            elif pos in ladders:
                pos = ladders[pos]
            path.append(pos)
        if path[-1] > 100:
            path[-1] = 100
        return path
    
    
    def mult_games(n, chutes, ladders):
        return [len(single_game(chutes, ladders)) for _ in xrange(n)]
    
    
    def compete(k, n, chutes, ladders):
        return [min(mult_games(k, chutes, ladders)) for _ in xrange(n)]
    
    
    def mean(xs):
        return sum(xs) / float(len(xs))
    
    
    def stats(k, n, chutes, ladders):
        games = compete(k, n, chutes, ladders)
        return min(games), max(games), mean(games)
    
    
    if __name__ == "__main__":
        chutes = {16: 6, 47: 26, 49: 11, 56: 53, 62: 19, 64: 60, 87: 24, 93: 73,
                    95: 75, 98: 78}
        ladders = {1: 38, 4: 14, 9: 31, 21: 42, 28: 84, 36: 44, 51: 67, 71: 91,
                    80: 100}
        for k in xrange(1, 7):
            print stats(k, 100000, chutes, ladders)
    
  4. I’ve got a Haskell solution similar to Remco Niemeijer’s one, so I decided not to repeat it here once more.

    Instead, I solved the first question regarding the minimal number of rolls in a “theoretical” way, without simulating the game itself. I converted the game board into a directed graph — each node has 6 outgoing edges, corresponding to 6 possible rolls (or less, if it’s near 100) and then used breadth-first search to find out the shortest path length from start to finish. It turned out to be 7.

    import Data.Graph.Inductive hiding (nodes, edges, run)
    import Data.Graph.Inductive.Query.BFS (esp, lesp)
    
    start  = 0
    finish = 100
    step   = 6
    
    transitions = [ (1, 38), (4, 14), (9, 31), (16, 6), (21, 42), (28, 84)
                  , (36, 44), (47, 26), (49, 11), (51, 67), (56, 53), (62, 19)
                  , (64, 60), (71, 91), (80, 100), (87, 24), (93, 73), (95, 75)
                  , (98, 78) ]
    
    nodes :: [(Int, ())]
    nodes = [(n, ()) | n <- [start .. finish]]
    
    edges :: [(Int, Int, ())]
    edges = concatMap (edges' . fst) nodes
      where
        edges' x = [ edge x n (lookup n transitions) | k <- [1 .. step], let n = x + k, n <= finish ]
        edge x n (Just trans) = (x, trans, ())
        edge x n Nothing      = (x, n,     ())
    
    gameGraph :: Gr () ()
    gameGraph = mkGraph nodes edges
    
    shortestGame :: Int
    shortestGame = length (esp start finish gameGraph) - 1
    
    
  5. Mike said

    Here’s my python solution. Uses the dijkstra function from a previous exercise to find the minimum path.

    from dijkstra import *
    from random import randrange
    
    chutes = {98:78, 95:75, 93:73, 87:24, 64:60,
              62:19, 56:53, 49:11, 47:26, 16: 6 }
    
    ladders = { 1:38,  4:14,  9:31, 21:42, 28:84,
               36:44, 51:67, 71:91, 80:100 }
    
    special = dict(chutes.viewitems() | ladders.viewitems())
    
    # transision table: next_sq[current square][dice roll - 1] -> next square
    # includes effects of slides and ladders, so next_sq[0][1] is 38
    next_sq = [[special.get(r,min(r, 100))
                   for r in range(n+1,n+7)]
                      for n in range(101)]
    
    # create graph from the transition table
    graph = {n:{t:1 for t in next_sq[n]} for n in range(101)}
    
    
    mst = dijkstra(graph,0,100)
    mst[100] # returns (7, 74), min of 7 turns, previous sequare is 74
    
    def play(nplayers=1):
        sq = [0]*nplayers
        nturns = 0
        while True:
            nturns += 1
            for player in range(nplayers):
                sq[player] = next_sq[sq[player]][randrange(6)]
                if sq[player] == 100:
                    return nturns, player
    
    
    for nplayers in range (1,6):
       turns = [play(nplayers)[0] for _ in range(10000)]
       print float(sum(turns))/len(turns), min(turns)
    
    
  6. Vigor said

    These implementations which walk a tree take a long time to run – the first haskell program takes on the order of 30 seconds to print the first statistics on my system. A faster way is to create a transition matrix and repeatedly multiply with a state vector to compute the probability of any particular state after N turns. Experimentally, after 350 iterations, this accounts for 99.9999% of all games and produces an answer of avg turns = 39.2 in under a second of CPU time.

  7. Rainer said

    My Try in Rexx, Using the Dijkstra-Algorithm from http://programmingpraxis.com/2011/01/04/dijkstras-algorithm/ to find the optimal strategy

    
    MAX = 99999
    chutes = '16-6 47-26 49-11 56-53 64-60 62-19 87-24 93-73 95-75 98-78'
    ladders = '1-38 4-14 10-31 28-84 21-42 36-44 51-67 71-91 80-100'
    
    ch. = ''
    ld. = ''
    erg. = ''
    cnt = 0
    
    orte = ''
    strecken = ''
    
    call init_basic
    call zufall 100, 1
    call zufall 100, 3
    call zufall 100, 10
    call zufall 100, 100
    call ergebnis_zufall
    
    start = 1
    ziel = 100
    
    d. = MAX
    d.start = 0
    p. = ''
    
    call init_shortest_path
    call optimal_path
    
    exit
    
    zufall:
        parse arg t, p
        ct_sum = 0
        do games = 1 to t
            hundert = 0
            player_pos. = 0
            do while hundert == 0
                /* ---------------------- */
                /* p = Anzahl der Spieler */
                /* ---------------------- */
                do player = 1 to p
                    wrk = 0
                    cp = player_pos.player
                    if cp == 100 then do
                        hundert = 1
                        leave
                    end
                    select
                        /* -------------------------------- */
                        /* Akt. Pos = Beginn einer Leiter ? */
                        /* Neue Position = Ende der Leiter  */
                        /* -------------------------------- */
                        when ch.cp > 0 then wrk = ch.cp
                        /* -------------------------------- */
                        /* Akt. Pos = Oben an Rutsche ?     */
                        /* Neue Position = Unten an Rutsche */
                        /* -------------------------------- */
                        when ld.cp > 0 then wrk = ld.cp
                        otherwise do
                            /* -------------------------------- */
                            /* Wuerfeln Zufallszahl zw. 1 und 5 */
                            /* -------------------------------- */
                            wrk = cp + random(1, 6)
                            ct_sum = ct_sum + 1
                            /* --------------------------------------*/
                            /* wenn neue Pos. > 100, dann ignorieren */
                            if wrk > 100 then iterate player
                            /* --------------------------------------*/
                        end
                    end
                    player_pos.player = wrk
                end
            end
        end
        cnt = cnt + 1
        erg.cnt = p 'Personen mussten (/)',
                  'bei' t 'Versuchen durchschn.',
                  ((ct_sum % p) % t) 'mal wuerfeln.'
        return
    
    init_basic:
        do while words(chutes) > 0
            parse value chutes with first chutes
            parse value first with start'-'end
            ch.start = end
        end
        do while words(ladders) > 0
            parse value ladders with first ladders
            parse value first with start'-'end
            ld.start = end
        end
        return
    
    init_shortest_path:
        do x = 1 to 100
            orte = orte x
        end
        do x = 1 to 100
            ks = ''
            if ch.x > '' then iterate
            if ld.x > '' then ks = ks x'-'ld.x'-'0
            do y = x+1 to min(x+6,100)
                if strip(ch.y) == '' then ks = ks x'-'y'-'1
            end
            strecken = strecken ks
        end
        return
    
    ergebnis_zufall:
        say cnt
        do i = 1 to cnt
            say erg.i
        end
        return
    
    optimal_path:
        q = orte
        do while words(q) > 0
            u = n_nb(q)
            if u == '' then leave
            q = delword(q, wordpos(u,q), 1)
            call relax u,strecken
        end
        say reverse(translate(strip(ausgabe(ziel, '')),'<',' ')),
            '=' d.ziel 'Wuerfe'
        return
    
    n_nb: procedure expose d. MAX
        parse arg q
        min = MAX
        rw = ''
        do i = 1 to words(q)
        w = word(q, i)
            if d.w < min then do
                min = d.w
                rw = w
         end
        end
        return rw
    
    relax: procedure expose d. p.
        parse arg akt,kanten
        do while length(kanten) > 0
            parse value kanten with kante kanten
            parse value kante with von'-'nach'-'entf
            select
                when akt == von  then nb = nach
                otherwise iterate
            end
            neu = d.akt + entf
            if d.nb > neu then do
                d.nb = neu
                p.nb = akt
            end
        end
        return
    
    ausgabe:
        parse arg vorg, route
        if p.vorg == '' then return strip(reverse(route vorg))
        return ausgabe(p.vorg,route vorg)
    
    

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

Follow

Get every new post delivered to your Inbox.

Join 609 other followers

%d bloggers like this: