{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} -- -- Traversing game trees -- auxiliary definitions for labeling with static valuations -- module AI.Gametree where import Data.Function (on) import Data.List(minimumBy) -- | a type class for labelled transition systems -- i.e. game positions and moves class Transitions s l | s -> l where actions :: s -> [l] -- next labels from a state transition :: l -> s -> s -- transition from a state -- | check if a state is terminal -- i.e. has no actions isTerminal :: Transitions s l => s -> Bool isTerminal = null . actions -- | immediate state successors successors :: Transitions s l => s -> [s] successors s = [transition l s | l <- actions s] -- | immediate successors labelled by actions transitions :: Transitions s l => s -> [(l,s)] transitions s = [(l, transition l s) | l <- actions s] {- -- | a pair of something with a strict integer valuation -- supporting equality, ordering and limited arithmetic on valuation data Valued a = Valued { value :: !Int, unvalued :: a } deriving Show instance Functor Valued where fmap f (Valued v x) = Valued v (f x) -- | apply a valuation valued :: Valuation a -> a -> Valued a valued f x = Valued (f x) x -- | modify the valuation revalue :: (Int -> Int) -> Valued a -> Valued a revalue f (Valued v x) = Valued (f v) x instance Eq (Valued a) where x == y = value x==value y instance Ord (Valued a) where compare x y = compare (value x) (value y) -- some instances of numeric type class (only negate and fromInteger) instance Num (Valued a) where (+) = undefined (-) = undefined (*) = undefined negate = revalue negate fromInteger n = valued (const (fromIntegral n)) undefined abs = undefined signum = undefined -- | add a constant to a value infix 6 $+ ($+) :: Int -> Valued a -> Valued a k $+ x = revalue (+k) x -}