diff --git a/haskell/.gitignore b/haskell/.gitignore new file mode 100644 index 0000000..8244e6a --- /dev/null +++ b/haskell/.gitignore @@ -0,0 +1,3 @@ +main +*.hi +*.o diff --git a/haskell/Games.hs b/haskell/Games.hs new file mode 100644 index 0000000..968ff59 --- /dev/null +++ b/haskell/Games.hs @@ -0,0 +1,54 @@ +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 diff --git a/haskell/Makefile b/haskell/Makefile new file mode 100644 index 0000000..73615c0 --- /dev/null +++ b/haskell/Makefile @@ -0,0 +1,2 @@ +main: + ghc -dynamic --make main.hs diff --git a/haskell/main.hs b/haskell/main.hs new file mode 100644 index 0000000..d870561 --- /dev/null +++ b/haskell/main.hs @@ -0,0 +1,19 @@ +import Games + + +main :: IO () +main = do + print $ game 1 <> game 1 + print $ game 2 + print $ leq zero one + print $ leq zero zero + print $ leq one two + print $ leq zero two + print $ leq (nimber 1) zero + print $ leq zero (nimber 1) + print $ eq (nimber 1 <> nimber 1) zero + print $ eq (nimber 5 <> nimber 3) $ nimber 6 + print $ eq (nimber 5 <> nimber 1) $ nimber 4 + print $ eq (game 1 <> game 4) $ game 5 + print $ eq zero (add (neg (game 10)) (game 10)) + print $ eq (nimber 5) (neg $ nimber 5)