packages feed

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