Minimax.hs

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

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

-- greedy AI player
greedy :: AI
greedy = AI { name = "greedy"
            , description = "Maximize the static evaluation function"
            , strategy = (withPieces $ \n -> 
                          if n==60 then singleCaptures greedyStrategy
                          else winOrPreventLoss $ 
                               -- nubDoubleCaptures $ 
                               dontPass greedyStrategy
                         )
            }

-- greedy strategy
-- lookup one move ahed and choose the highest static evaluation score
greedyStrategy :: Strategy
greedyStrategy (GameTree _ branches) rndgen 
    | null branches = error "greedyStrategy: empty branches"
    | otherwise     = (bestmove, rndgen)
    where 
      choices = [(m, score t) | (m,t)<-branches]
      (bestmove,bestscore) = minimumBy cmp choices
      cmp (_,x) (_,y) = compare x y 
      score (GameTree b _)  = static_eval b   -- valued the opponent



-- minimaxing AI player with alpha-beta prunning and fixed depth and breadth
plyN :: Int -> Int -> AI
plyN depth breadth 
  = AI { name = "ply_" ++ show depth ++ "_" ++ show breadth
       , description = "Minimaxing with depth " ++ show depth ++ 
                       " and breadth " ++ show breadth
       , strategy = (withPieces $ \n -> 
                      if n==60 then singleCaptures greedyStrategy
                      else winOrPreventLoss $ 
                           --nubDoubleCaptures $
                           dontPass $
                           minimaxStrategy depth breadth
                    )
       }
         

{-
-- 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 with alpha-beta and static prunning 
-- n is the ply depth, m is the tree breadth 
minimaxStrategy :: Int -> Int -> Strategy
minimaxStrategy n m (GameTree _ []) rndgen 
    = error "minimaxStrategy: empty tree"
minimaxStrategy n m bt rndgen 
    = (bestmove, rndgen)
    where (bestmove,bestscore) = minimaxMove_ab (-infinity) infinity bt'
          bt' = pruneDepth n $        -- ^ prune to depth `n'
                pruneBreadth m $      -- ^ cut to breadth `m'
                lowFirst $            -- ^ order moves acording to static valuation
                mapTree static_eval bt  -- ^ apply static 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