Kombinatorische-Spieltheorie/haskell/Games.hs

55 lines
1.2 KiB
Haskell
Raw Normal View History

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