module SetGames where
import Data.Maybe
import Iso
import Games
import BasicGames
import List
getRight (Right x) = x
getLeft (Left x) = x
nonemptyIso = Iso (\(x:xs) -> (x,xs)) (\(x,xs) -> x:xs)
diff minus [] = []
diff minus (x:xs) = x : diff' x xs
where diff' base [] = []
diff' base (x:xs) = minus x base : diff' x xs
undiff plus [] = []
undiff plus (x:xs) = x : undiff' x xs
where undiff' base [] = []
undiff' base (x:xs) = base' : undiff' base' xs
where base' = plus base x
natMultisetGame :: Game Nat -> Game [Nat]
natMultisetGame g =
listGame g +> Iso (diff () . sort) (undiff (+))
natSetGame :: Game Nat -> Game [Nat]
natSetGame g =
listGame g +> Iso (diff (\ x y -> xy1) . sort)
(undiff (\ x y -> x+y+1))
compareByGame :: Game a -> (a -> a -> Ordering)
compareByGame (Single _) x y = EQ
compareByGame (Split (Iso ask bld) g1 g2) x y =
case (ask x, ask y) of
(Left x1 , Left y1) -> compareByGame g1 x1 y1
(Right x2, Right y2) -> compareByGame g2 x2 y2
(Left x1, Right y2) -> LT
(Right x2, Left y1) -> GT
sortByGame :: Game a -> [a] -> [a]
sortByGame g = sortBy (compareByGame g)
removeEQ :: Game a -> a -> Maybe (Game a)
removeEQ (Single _) x = Nothing
removeEQ (Split (Iso ask bld) g1 g2) x =
case ask x of
Left x1 ->
Just $ case removeEQ g1 x1 of
Nothing -> g2 +> rightI
Just g1' -> Split (Iso ask bld) g1' g2
Right x2 ->
Just $ case removeEQ g2 x2 of
Nothing -> g1 +> leftI
Just g2' -> Split (Iso ask bld) g1 g2'
where rightI = Iso (getRight . ask)
(bld . Right)
leftI = Iso (getLeft . ask)
(bld . Left)
removeLE :: Game a -> a -> Maybe (Game a)
removeLE (Single _) x = Nothing
removeLE (Split (Iso ask bld) g1 g2) x =
case ask x of
Left x1 ->
Just $ case removeLE g1 x1 of
Nothing -> g2 +> rightI
Just g1' -> Split (Iso ask bld) g1' g2
Right x2 -> case removeLE g2 x2 of
Nothing -> Nothing
Just g2' -> Just (g2' +> rightI)
where rightI = Iso (getRight . ask)
(bld . Right)
removeLT :: Game a -> a -> Game a
removeLT (Single iso) x = Single iso
removeLT (Split (Iso ask bld) g1 g2) x =
case ask x of
Left x1 -> Split (Iso ask bld) (removeLT g1 x1) g2
Right x2 -> g2 +> Iso (getRight . ask) (bld . Right)
setGame :: Game a -> Game [a]
setGame g = setGame' g +> Iso (sortByGame g) id
where setGame' g = Split listIso unitGame $
depGame g $ \x ->
case removeLE g x of
Just g' -> setGame' g'
Nothing -> constGame []
multisetGame :: Game a -> Game [a]
multisetGame g = multisetGame' g +> Iso (sortByGame g) id
where multisetGame' g = Split listIso unitGame
(depGame g (\x -> multisetGame' (removeLT g x)))