Minimax.hs

module AI.Minimax( EvalFunc
                 , minimaxStrategy
                 , minimax
                 , minimax_ab
                 , minimaxPV
                 ) where

import AI.Utils
import Board

-- | type of static evaluation functions
type EvalFunc = Board -> Int  

-- | Minimax with alpha-beta and static depth prunning 
minimaxStrategy :: Int -> EvalFunc -> Strategy
minimaxStrategy n eval bt rndgen 
    | isEmptyTree bt = error "minimaxStrategy: empty tree"
minimaxStrategy n eval bt rndgen = ((m1,m2), rndgen)
    where (bestscore, m1:m2:_) = minimaxPV bt'
          bt' = pruneDepth n $        -- ^ prune to depth `n'
                mapTree eval bt       -- ^ apply static evaluation function



-- | Naive minimax algorithm (not used)
-- | nodes values are static evaluation scores
minimax ::  (Num a, Ord a) => GameTree a m -> a 
minimax = minimax' 0

minimax' :: (Num a, Ord a) => Int -> GameTree a m -> a 
minimax' depth (GameTree x []) = x
minimax' depth (GameTree _ branches) 
    | odd depth = - minimum vs
    | otherwise = maximum vs
    where vs = map (minimax' (1+depth) . snd) branches



-- | Minimax with alpha-beta prunning
minimax_ab ::  (Num a, Ord a) => a -> a -> GameTree a m -> a
minimax_ab = minimax_ab' 0

minimax_ab' :: (Num a, Ord a) => Int -> a -> a -> GameTree a m -> a
minimax_ab' depth a b (GameTree  x [])       = a `max` x `min` b
minimax_ab' depth a b (GameTree _ branches) = cmx a b (map snd branches)
    where cmx a b []  = a
          cmx a b (t:ts) | a'==b     = a'
                         | otherwise = cmx a' b ts
                         where a' | odd depth = -minimax_ab' (1+depth) (-b) (-a) t
                                  | otherwise =  minimax_ab' (1+depth) a b t

-- | Principal Variantions
data PV = PV !Int [Move] deriving (Show)

instance Eq PV where
    (PV x _) == (PV y _) = x==y

instance Ord PV where
    compare (PV x _) (PV y _) = compare x y

negatePV :: PV -> PV
negatePV (PV x ms) = PV (-x) ms


-- | Minimax with alpha-beta pruning
-- | extended with score and principal variation 
minimaxPV :: GameTree Int Move -> (Int, [Move])
minimaxPV bt 
    = case minimaxPV_ab' 0 [] (PV (-infinity-1) []) (PV (infinity+1) []) bt of
        PV v ms -> (v,ms)

-- | first parameter determines if we negate children scores
-- | minimaxPV_ab' :: (Num a, Ord a) => Int -> [m] -> a -> a  -> GameTree a m -> (a, [m])
minimaxPV_ab' depth ms a b (GameTree x []) = a `max` PV x (reverse ms) `min` b
minimaxPV_ab' depth ms a b (GameTree _ branches) = cmx a b branches
    where cmx a b [] = a
          cmx a b ((m,t) : branches) 
              | a'==b = a'
              | otherwise = cmx a' b branches
              where a'| odd depth = negatePV $ minimaxPV_ab' (1+depth) (m:ms) (negatePV b) (negatePV a) t
                      | otherwise = minimaxPV_ab' (1+depth) (m:ms) a b t