Gametree.hs

{-# 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
-}