Minimax.hs

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

import AI.Tree
import Board
-- import Debug.Trace


-- | Negamax with alpha-beta and static depth prunning 
negamaxStrategy :: Int -> Eval -> Strategy
negamaxStrategy depth eval bt rndgen 
    | isEmptyTree bt = error "negamaxStrategy: empty tree"
negamaxStrategy depth eval bt rndgen  
    = (score, m, rndgen)
    where (score, m:_) = negamaxPV $ 
                         pruneDepth depth $ -- ^ prune evaluation tree
                         mapTree eval 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 (GameTree x []) = x
negamax (GameTree _ branches) = - minimum vs
  where vs = map (negamax . snd) branches



-- | Negamax with alpha-beta prunning; 
-- computes the minimax value but not the best move
negamax_ab :: (Num a, Ord a) => a -> a -> GameTree a m -> a
negamax_ab a b (GameTree  x [])       = a `max` x `min` b
negamax_ab 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' = - negamax_ab (-b) (-a) t




-- | pair a evaluation score with something
newtype PV a = PV (Int,a) deriving (Show)

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

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

instance Show a => Num (PV a) where
    (+) = undefined
    (-) = undefined
    (*) = undefined
    fromInteger = undefined
    signum = undefined
    abs = undefined
    negate (PV (x,m)) = PV (negate x,m)


-- | Negamax with alpha-beta pruning
-- computes both minimax value and the best move (start of principal variation)
negamaxPV :: GameTree Int Move -> (Int, [Move])
negamaxPV bt
    = case negamaxPV_ab [] lo hi bt of
        PV (v,ms) -> (v,reverse ms)
      where lo = PV (-infinity, [])  -- dummy bounds
            hi = PV ( infinity, [])
            -- m = fst (head branches)

negamaxPV_ab :: [Move] -> PV [Move] -> PV [Move]  -> GameTree Int Move -> PV [Move]
negamaxPV_ab ms a b (GameTree x []) = a `max` (PV (x,ms)) `min` b
negamaxPV_ab ms a b (GameTree _ branches) = cmx a b branches
    where 
      cmx x y [] = x
      cmx x y ((m,t) : rest) 
          |  x'==y    = x'
          | otherwise = cmx x' y rest
          where x' = - negamaxPV_ab (m:ms) (-y) (-x) t