{- |
Simulation of a game with the following rules:

Players A and B alternatingly take numbers from a set of 2*n numbers.
Player A can choose freely from the remaining numbers,
whereas player B always chooses the maximum remaining number.
How many possibly outcomes of the games exist?
The order in which the numbers are taken is not respected.

E-Mail by Daniel Beer from 2011-10-24.
-}
module Combinatorics.MaxNim (numberOfPossibilities) where

import qualified Data.Set as Set


{- |
We only track the number taken by player A
because player B will automatically have the complement set.
-}
gameRound :: (Set.Set Int, Set.Set Int) -> [(Set.Set Int, Set.Set Int)]
gameRound :: (Set Int, Set Int) -> [(Set Int, Set Int)]
gameRound (Set Int
takenByA, Set Int
remaining) = do
   Int
a <- forall a. Set a -> [a]
Set.toList Set Int
remaining
   forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Ord a => a -> Set a -> Set a
Set.insert Int
a Set Int
takenByA, forall a. Set a -> Set a
Set.deleteMax forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Set a
Set.delete Int
a Set Int
remaining)

possibilities :: Int -> Set.Set (Set.Set Int)
possibilities :: Int -> Set (Set Int)
possibilities Int
n =
   forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$
   forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) [(forall a. Set a
Set.empty, forall a. Ord a => [a] -> Set a
Set.fromList [Int
1 .. Int
2forall a. Num a => a -> a -> a
*Int
n])] forall a b. (a -> b) -> a -> b
$
   forall a. Int -> a -> [a]
replicate Int
n (Set Int, Set Int) -> [(Set Int, Set Int)]
gameRound

{-
This turns out to be the sequence of Catalan numbers.
-}
numberOfPossibilities :: [Int]
numberOfPossibilities :: [Int]
numberOfPossibilities =
   forall a b. (a -> b) -> [a] -> [b]
map (forall a. Set a -> Int
Set.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Set (Set Int)
possibilities) [Int
0..]