Minimax.hs

{-# LANGUAGE BangPatterns #-}
module AI.Minimax( EvalFunc
                 , negamaxStrategy
                 , negamax
                 , negamax_ab
                 , negamaxPV
                 ) where

import AI.Utils
import Board
-- import Debug.Trace

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

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



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

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



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

negamax_ab' :: (Num a, Ord a) => Int -> a -> a -> GameTree a m -> a
negamax_ab' depth a b (GameTree  x [])       = a `max` x `min` b
negamax_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 = -negamax_ab' (1+depth) (-b) (-a) t
                                  | otherwise =  negamax_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

instance Num PV where
    (+) = undefined
    (-) = undefined
    (*) = undefined
    fromInteger = undefined
    signum = undefined
    abs = undefined
    negate (PV x ms) = PV (-x) ms

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

-- | Negamax with alpha-beta pruning
-- | extended with score and principal variation 
negamaxPV :: GameTree Int Move -> (Int, [Move])
negamaxPV bt 
    = case negamaxPV_ab 0 [] lo hi bt of
        PV v ms -> (v, reverse ms)
      where lo = PV (-maxBound) []
            hi = PV maxBound []

-- | depth parameter determines if we negate children scores
-- | negamaxPV_ab :: (Num a, Ord a) => Int -> [m] -> a -> a  -> GameTree a m -> (a, [m])
negamaxPV_ab depth ms a b (GameTree x []) = a `max` PV x ms `min` b
negamaxPV_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' = if odd depth 
                     then - negamaxPV_ab (1+depth) (m:ms) (-b) (-a) t 
                     else   negamaxPV_ab (1+depth) (m:ms) a b t