## The 16 Game

### October 29, 2013

This is a trick question. There is no need to write a program; the solution is easy to work out just by reasoning. The numbers 4 through 16 don’t contribute to the solution, and can be ignored. There are 3! = 6 permutations of the numbers 1 through 3; two of them, (1 2 3) and (2 1 3), are winners, and the other four are losers. Thus, the average winning percentage is one-third. But if you really want to write a program, here it is:

`(define (play xs)`

(let loop ((xs xs) (one #f) (two #f))

(cond ((= (car xs) 1) (if two #t (loop (cdr xs) #t #f)))

((= (car xs) 2) (if one #t (loop (cdr xs) #f #t)))

((= (car xs) 3) #f)

(else (loop (cdr xs) one two))))))

`(define (plays n)`

(let loop ((n n) (wins 0))

(if (zero? n) wins

(if (play (shuffle (range 1 17)))

(loop (- n 1) (+ wins 1))

(loop (- n 1) wins)))))

`Play`

plays a single card; `plays`

plays *n* cards. The return value of `(plays n)`

ought to be about one-third of *n*:

`> (plays 3000)`

1010

> (plays 3000)

978

> (plays 3000)

989

It looks like our random number generator is properly uniform. We used `range`

, `randint`

and `shuffle`

from the Standard Prelude. You can run the program at http://programmingpraxis.codepad.org/OQTymiiW.

The only thing that matters is the relative order of 1, 2, and 3 in a permutation. Since 1/3 of the permutations have 1 and 2 before 3, the classical probability of winning is 1/3 and the expected percentage of winning cards in a pack is a little above 33. I didn’t write a program.

Solution in Racket.

Oops! The winning-% function had a bug in the second for*/sum clause.

Trying Nimrod:

A slightly different approach, which recursively calculate the probability. It is “generalized” to take any N >= 3, but that doesn’t matter :-)

module TheSixteenGame(

solve

) where

solve :: Int -> Double

solve n

| n <= 2 = error "Input integer should be >= 3"

| otherwise = twoLeft n

twoLeft :: Int -> Double

twoLeft n

| n == 2 = 1.0

| otherwise = pickOne * oneLeft (n – 1) + pickNone * twoLeft (n – 1)

where

pickOne = 2.0 / fromIntegral n

pickNone = fromIntegral (n – 3) / fromIntegral n

oneLeft :: Int -> Double

oneLeft n

| n == 1 = 1.0

| otherwise = pickOne + pickNone * oneLeft (n – 1)

where

pickOne = 1.0 / fromIntegral n

pickNone = fromIntegral (n – 2) / fromIntegral n