hstzaar-0.6: src/AI/Minimax.hs
module AI.Minimax( minimaxStrategy
, minimax
, minimax_ab
, minimaxPV
) where
--import Data.List (sort, sortBy, maximumBy, minimumBy)
import AI.Utils
import AI.Eval
import Board
{-
-- | Minimaxing AI player with fixed depth
fixed_ply :: Int -> AI
fixed_ply depth
= AI { name = "ply_" ++ show depth
, description = "Minimaxing with limit depth " ++ show depth
, strategy = minimaxStrategy depth
}
-- dynamic strategy
-- increase minimax depth as the game progress
dynamic_ply :: Int -> Int -> AI
dynamic_ply d1 d2 = AI { name = "dyn" ++ show d1 ++ "_" ++ show d2
, description = "Minimax with dynamic depth " ++ show d1 ++ "," ++ show d2
, strategy = (withNPieces $ \numpieces ->
if numpieces>30 then
minimaxStrategy d1
else
minimaxStrategy d2
)
}
-}
-- Minimaxing strategy with alpha-beta and static prunning
minimaxStrategy :: Int -> Strategy
minimaxStrategy n bt rndgen
| endGameTree bt = error "minimaxStrategy: end of game"
minimaxStrategy n 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
-- Minimax with alpha-beta pruning
-- extended to obtain both score and principal variation
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
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