gistfile1.hs

import Data.List (sort)
import Data.Array (Array, array, (!))

deckSize = 52
eachColor = 26

-- Some convenience types:
type History = (Int, Int) -- # of red cards seen, # of black cards seen
data Choice = Stop | Continue deriving (Show, Eq)
data Decision = Decision { choice :: Choice, expectedWin :: Double } deriving (Show, Eq)
instance Ord Decision where compare a b = compare (expectedWin a) (expectedWin b)

-- Given how many of each color I've seen, what should I do?
decision :: History -> Decision
decision history = maximum [Decision Stop (pNextCardRed history), Decision Continue (expectedWinAfter history)]

-- Memoization shorthand: a simple 26x26 array indexed by history.
cachedValueArray :: (History -> Double) -> Array History Double
cachedValueArray f = array ((0, 0), (eachColor, eachColor)) [((x, y), f (x, y)) | x <- [0..eachColor], y <- [0..eachColor]]

-- The probability that the next card flipped over will be red, given a particular history.
pNextCardRed :: History -> Double
pNextCardRed = ((cachedValueArray _pNextCardRed) !) -- Memoized.
   where _pNextCardRed (redSeen, blackSeen) = (fromIntegral $ eachColor - redSeen) / (fromIntegral $ deckSize - redSeen - blackSeen)

-- The expected chance of winning if I continue, given what I've seen so far.
expectedWinAfter :: History -> Double
expectedWinAfter = ((cachedValueArray _expectedWinAfter) !) -- Memoized.
   where _expectedWinAfter (_, 26) = 1 -- If we've seen all the black cards, we're sure to win.
         _expectedWinAfter (26, _) = 0 -- If we've seen all the red cards, we can't possibly win.
         -- Otherwise, the weighted expected value of winning given the outcome of the next card flip.
         _expectedWinAfter history@(redSeen, blackSeen) =
            (pNextCardRed history) * (expectedWin $ decision (redSeen + 1, blackSeen)) +
            (1 - (pNextCardRed history)) * (expectedWin $ decision (redSeen, blackSeen + 1))
            
-- Output:
printAllDecisions :: IO ()
printAllDecisions = mapM_ (putStrLn . decisionLog) [(x, y) | x <- [0..eachColor], y <- [0..eachColor]]
   where decisionLog h = (show h) ++ ": " ++ (show . head $ decisionOrdering h) ++ " beats " ++ (show . last $ decisionOrdering h)
         decisionOrdering h = sort [Decision Stop (pNextCardRed h), Decision Continue (expectedWinAfter h)]