Coin Tricks

Derren Brown recently claimed he would predict the UK lottery numbers, live on television, and then explain how he did it. It’s doubtful that he did either — the alternative explanation that he’d actually committed a massive and improbably daring fraud is vastly more likely than the bullshit he spun out, as it’s actually possible…

I’m certain (or at the very least hopeful) that the actual “reveal” will come later on in the series… but in the mean time, he did show one very cute mathematical trick for winning a coin game.

This is the game:

  • Player 1 chooses a 3-coin combination, say Tails,Tails,Heads
  • Player 2 chooses another, for example Heads,Tails,Tails
  • We now throw a series of coins until one of the players’ combination is thrown in order.

You might think, given that any 3-coin combination is as likely as another (will be thrown with a 1/8 probability) that there’s nothing to choose between them. But notice that I didn’t say you threw 3 coins at a time! For example, if we throw.

  1. Tails
  2. Heads
  3. Tails … at this point we’ve thrown 3 coins, and matched no combination
  4. Tails … and now player 2 has won: coins 2-4 read Heads,Tails,Tails

If you look at these 2 combinations, you’ll see that Player 1 will win if the sequence goes: Tails,Tails,(any number of Tails), Head. Player 2 will win in any other situation, i.e. 75% of the time.
The combination the hapless participant chose (Heads,Heads,Heads) is even worse, losing 87.5% of the time!

It’s about time for me to try modelling a problem in Haskell, so let’s try this one!
I find the docs for System.Random rather confusing, but found some inspiration from a
haskell-cafe post about random coin throws and encouragement on #haskell from Luke30, Twey, and others.

I won’t go through the code in detail this time, but here are some key things to note:

  • the randoms function returns an infinite stream of random things. In this case I’m using it as a stream of Bools, like [False, True, True, False, True, ...] and then converting them into [Tail,Head, ...].

    lilac pointed out that I could create an instance of Random for Coins, I’ll have a look at that soon.

  • I’m using tails (nicely overloaded vocabulary ;-) to iterate the infinite sequence of coin flips, stopping when one of the players’ sequences matches.

And here’s the code:

import System.Random
import Control.Monad
import System.IO
import Data.Maybe
import Data.List

data Coin = Head | Tail
    deriving (Eq, Ord, Show)

-- Derren Brown's coin game.
-- The second winner has chosen a combination that will win
-- significantly more often

main = do
    g1 <- guess
    let g2 = counter g1
    putStrLn $ "Player 1 chooses " ++ (show g1)
    putStrLn $ "Player 2 chooses " ++ (show g2)
    coins <- coinFlips
    let winner = take 1 .  catMaybes .
                 map (win g1 g2) $
                    tails coins
    putStrLn $ "Player " ++ (show winner) ++ " wins!"

guess = do f <- coinFlips
           return $ take 3 f

counter [a,b,_] = [rev b, a, b]
    where rev Head = Tail
          rev Tail = Head

win g1 g2 l | g1 `isPrefixOf` l = Just 1
            | g2 `isPrefixOf` l = Just 2
            | otherwise         = Nothing

-- modified from
coinFlips :: IO [Coin]
coinFlips = do g <- newStdGen
               let bools = randoms g
               let coins = map bool2coin bools
               return coins
      where bool2coin True  = Head
            bool2coin False = Tail