Plays a "Coin Game". The game starts with a stack of coins. Each turn, a player splits a stack into two stacks that must be of two different heights. The game ends when no more stacks can be split, and the person whose turn it is is marked the loser.

coingame.hs

import Data.List (elemIndex)
import Data.Maybe (fromJust)

-- A pile of coins is just an Int describing how many coins are in the pile
type CoinPile = Int
-- A state in the coin game is just a number of piles
type CoinState = [CoinPile]
-- A player is either Me or You
data Player = Me | You deriving (Eq)

-- Given a coin state, get all the possible valid coin substates
coinSubstates :: CoinState -> [CoinState]
coinSubstates state = 
    foldl (\acc i -> acc ++ (coinSubstate state (i-1))) [] [1..length state]
-- Get the coin substates obtained by altering the coin pile at the given index
coinSubstate :: CoinState -> Int -> [CoinState]
coinSubstate state index =
    map (\a -> pre ++ [fst a,snd a] ++ (tail post)) (coinSubpiles (head post))
    where (pre,post) = splitAt index state
-- Split the pile of coins into a list of valid two-piles
coinSubpiles :: CoinPile -> [(CoinPile,CoinPile)]
coinSubpiles pile =
    map (\a -> let v=floor a in (v,pile-v)) $ takeWhile ((fromIntegral pile)/2 >) [1..]

-- Calculate the utility cost for a given coin state (with Player playing from that state)
coinUtility :: CoinState -> Player -> Int
coinUtility state player
    | null substates = if player == Me then 1 else -1
    | player == Me  = maximum (map (flip coinUtility You) substates)
    | player == You = minimum (map (flip coinUtility Me)  substates)
    where substates = coinSubstates state

-- Obtain the 'best' (most likely to yield a win) next state
nextState :: CoinState -> Maybe CoinState
nextState state =
    -- Ensure there is a valid next state
    if index == Nothing
    then Nothing
    else Just (substates !! (fromJust index))
    where
      substates = coinSubstates state
      vals = map (flip coinUtility You) substates
      index = elemIndex (maximum vals) vals

-- Get a list of all the states encountered in a perfectly-played coin game (starting with Int coins)
coinGame :: Int -> [CoinState]
coinGame start =
    takeWhile (/=[]) (iterate (applicator) [start])
    where
      applicator state = let next=(nextState state) in
                         if next==Nothing then [] else fromJust next