Minimax.hs

module AI.Minimax( greedy
                 , plyN
                 , dynamic
                 , minimax
                 , minimax_ab
                 , minimaxMove
                 , minimaxMove_ab
                 , prunedepth
                 , prunebreadth_asc
                 ) where

import Data.List (sort, sortBy, maximumBy, minimumBy, nub, nubBy)
import AI.Utils
import AI.Eval
import Board
import Debug.Trace


-- A greedy strategy
-- chooses the move with highest static evaluation score
greedy :: AI
greedy = AI { name = "greedy"
            , description = "Maximize the static evaluation function"
            , strategy = (ifPieces (==60)
                          greedyStrategy
                          (winOrPreventLoss (singleCaptures greedyStrategy))
                         )
            }



greedyStrategy :: Strategy
greedyStrategy (GameTree _ branches) rndgen 
    = trace ("[greedy score: " ++ show bestscore ++ "]") (bestmove, rndgen)
    where 
      choices = [(m, score t) | (m,t)<-branches]
      (bestmove,bestscore) = maximumBy cmp choices
      cmp (_,x) (_,y) = compare x y 
      score (GameTree _ []) = inf     -- opponent loses
      score (GameTree b _)  = -eval b   -- valued by the opponent



-- straight minimaxing strategies with fixed depth
plyN :: Int -> AI
plyN n = AI { name = "ply" ++ show n
            , description = "Minimax with depth " ++ show n
            , strategy = (ifPieces (==60)
                          greedyStrategy
                          (winOrPreventLoss
                           (singleCaptures 
                            (minimaxStrategy n 5))))
            }
         

-- dynamic strategy
-- use greedy algorithm for opening then switching to maximaxing 
dynamic :: Int -> AI
dynamic n = AI { name = "dyn" ++ show n 
               , description = "Minimax with dynamic depth " ++ show n
               , strategy = (ifPieces (==60) 
                             greedyStrategy
                             (winOrPreventLoss                       
                              (singleCaptures
                               (ifPieces (>40)
                                greedyStrategy
                                (minimaxStrategy n 5)
                               )
                              )
                             )
                            )
               }


-- Minimaxing strategy to ply depth `n' and breadth `m'
-- FIXME: for some reason alpha-beta prunning gives 
-- worst results than plain minimaxing against the greedy strategy 
minimaxStrategy :: Int -> Int -> Strategy
minimaxStrategy n m (GameTree _ []) rndgen = error "minimaxStrategy: empty tree"
minimaxStrategy n m g rndgen 
    = trace ("[minimax score: "++ show bestscore ++"]") (bestmove, rndgen)
    where (bestmove,bestscore) = minimaxMove g' -- minimaxMove_ab (-inf) inf g'
          g'  = prunebreadth_asc m $  -- ^ cut to breadth `m'
                prunedepth n $    -- ^ prune to depth `n'
                mapTree eval g   -- ^ apply evaluation function


-- Naive minimax algorithm (not used)
-- nodes should contain the static evaluation scores
minimax :: (Num a, Ord a) => GameTree a m -> a 
minimax (GameTree x []) = x
minimax (GameTree _ branches) = - minimum (map (minimax.snd) branches)

-- auxiliary function that returns the best first move
minimaxMove :: (Num a, Ord a) => GameTree a m -> (m,a)
minimaxMove (GameTree _ branches) = (m,x)
    where (m,x) = maximumBy cmp [(m, -minimax t) | (m,t)<-branches]
          cmp (_, x) (_, y) = compare x y



-- Minimax with alpha-beta prunning
minimax_ab :: (Num a, Ord a) => a -> a -> GameTree a m -> a
minimax_ab a b (GameTree x []) = a `max` x `min` b
minimax_ab a b (GameTree _ branches) = cmx a b (map snd branches)
    where cmx a b []  = a
          cmx a b (t:ts) | a'>=b = b
                         | otherwise = cmx a' b ts
                         where a' = - minimax_ab (-b) (-a) t


-- This variant also returns the best initial move
minimaxMove_ab :: (Num a, Ord a) => a -> a -> GameTree a m -> (m,a)
minimaxMove_ab a b (GameTree _ []) = error "minimaxMove_ab: empty tree"
minimaxMove_ab a b (GameTree _ branches@((m,_):_)) = cmx m a b branches
    where cmx m a b []  = (m,a)
          cmx m a b ((m',t):branches) 
              | a'>=b = (m',b)
              | otherwise = cmx m' a' b branches
              where a' = - minimax_ab (-b) (-a) t






{-
-- | eliminate double-captures that lead to the same board
nubCaptures :: BoardTree -> BoardTree
nubCaptures (GameTree node branches) 
    = GameTree node $ nubBy equiv [(t, nubCaptures g) | (t,g)<-branches]
    where
      equiv :: (Turn,BoardTree) -> (Turn,BoardTree) -> Bool
      equiv ((m1,Just m2),_) ((m2', Just m1'),_)
          = fst m1/=fst m2 && m1==m1' && m2==m2'
      equiv _ _ = False
                            
-}