55 lines
1.2 KiB
Haskell
55 lines
1.2 KiB
Haskell
module Games where
|
|
|
|
import qualified Data.Set as S
|
|
import Data.Foldable.WithIndex
|
|
import Data.Group
|
|
|
|
|
|
data Game = Game (S.Set Game) (S.Set Game)
|
|
deriving (Eq, Show, Ord)
|
|
|
|
zero, one, two :: Game
|
|
zero = game 0
|
|
one = game 1
|
|
two = game 2
|
|
|
|
-- | Construct the game representing the natural number n
|
|
game :: (Num t, Ord t) => t -> Game
|
|
game n
|
|
| n == 0 = Game S.empty S.empty
|
|
| n > 0 = Game (S.singleton $ game (n-1)) S.empty
|
|
|
|
-- | Construct the n-th nimber
|
|
nimber n
|
|
| n == 0 = zero
|
|
| n > 0 = Game (S.fromList $ map nimber [0..(n-1)]) (S.fromList $ map nimber [0..(n-1)])
|
|
|
|
-- | Add games
|
|
add :: Game -> Game -> Game
|
|
add g1@(Game l1 r1) g2@(Game l2 r2) =
|
|
Game (S.union (S.map (add g2) l1 ) (S.map (add g1) l2))
|
|
(S.union (S.map (add g2) r1) (S.map (add g1) r2))
|
|
|
|
-- | Negative of a game
|
|
neg :: Game -> Game
|
|
neg (Game l r) = Game (S.map neg r) (S.map neg l)
|
|
|
|
-- | Compare games with <=
|
|
leq :: Game -> Game -> Bool
|
|
leq g1@(Game l1 r1) g2@(Game l2 r2) = none (\r -> leq r g1) r2 && none (\l -> leq g2 l) l1
|
|
|
|
-- | Equality of games
|
|
eq :: Game -> Game -> Bool
|
|
eq g h = leq g h && leq h g
|
|
|
|
|
|
-- | Make games a semigroup
|
|
instance Semigroup Game where
|
|
(<>) = add
|
|
|
|
instance Monoid Game where
|
|
mempty = zero
|
|
|
|
instance Group Game where
|
|
invert = neg
|