Minimax.hs

{-# LANGUAGE BangPatterns #-}
module AI.Minimax ( negamax
                  , negamax_alpha_beta
                  , negascout
                  , jamboree
                  ) where

import Board
import AI.Gametree
import Control.Parallel.Strategies 


-- | Naive negamax algorithm (no prunning)
-- wrapper
negamax :: Gametree p => Valuation p -> Int -> p -> Valued p
negamax node_value depth p = negamax' depth p
  where
    -- worker
    negamax' d p
      | d==0 || is_terminal p = valued node_value p
      | otherwise = negate $ minimum [negamax' d  p' | p'<-children p]
        where d' = d-1

-- | Negamax with alpha-beta prunning 
-- wrapper
negamax_alpha_beta :: Gametree p => Valuation p -> Int -> p -> Valued p
negamax_alpha_beta node_value depth p
  = let a = fromIntegral (minBound+1 :: Int) 
        b = fromIntegral (maxBound :: Int) 
    in alpha_beta' depth a b p
  where
    -- worker
    alpha_beta' d alfa beta p
        | d==0 || is_terminal p = valued node_value p 
        | otherwise = cmx alfa (children p)
          where 
            d' = d-1
            cmx alfa [] = alfa
            cmx alfa (p:ps) 
              | a'>=beta = a'
              | otherwise = cmx (max a' alfa) ps
                where a' = negate $ alpha_beta' d' (negate beta) (negate alfa) p



-- | Negascout search
-- wrapper
negascout :: Gametree p => Valuation p -> Int -> p -> Valued p
negascout node_value depth p
  = let a = fromIntegral (minBound+1 :: Int) 
        b = fromIntegral (maxBound :: Int) 
    in negascout' node_value depth a b p

-- worker      
negascout' node_value d alfa beta p
  | d==0 || is_terminal p = valued node_value p 
  | d==1  = valued (negate . node_value) p0       -- short-circuit for depth 1
  | b >= beta = b
  | otherwise = scout (max alfa b) b ps
    where
      d' = d-1
      ps = children p
      p0 = unvalued $ minimum $ map (valued node_value) ps
      -- p0 = estimate_best node_value ps  -- child with best static score
      b = negate $ negascout' node_value d' (negate beta) (negate alfa) p0 -- full search estimate
    
      scout !alfa !b [] = b
      scout !alfa !b (p:ps)
        | s>=beta = s
        | otherwise = scout alfa' b' ps
          where s = negate $ negascout' node_value d' (negate (1$+alfa)) (negate alfa) p
                s' | s>alfa = negate $ 
                              negascout' node_value d' (negate beta) (negate alfa) p
                   | otherwise = s
                alfa' = max alfa s'
                b' = max b s'
      

-- | Parallel negascout, aka "Jamboree"
-- | result of each scout test
data Result a b = Cutoff a   -- beta cutoff found
                | Search b   -- do a full search
                | OK          -- test suceeded
                      
                      
jamboree :: Gametree p => Valuation p -> Int -> p -> Valued p
jamboree node_value depth p 
  = let a = fromIntegral (minBound+1 :: Int) 
        b = fromIntegral (maxBound :: Int) 
    in jamboree' node_value depth a b p 

-- worker
jamboree' node_value d alfa beta p
  | d<=1  = negascout' node_value d alfa beta p
            -- use sequencial version for low depth
  | is_terminal p = valued node_value p   -- terminal node?
  | b >= beta = b   -- 1st child failed high
  | otherwise = cutoff [] (map scout ps `using` parList rseq)
    where    
      d' = d-1
      ps = children p            
      p0 = unvalued $ minimum $ map (valued node_value) ps -- best child
    
      b = negate $ jamboree' node_value d' (negate beta) (negate alfa) p0 -- full search estimate
      alfa' = max alfa b

      scout p 
        | s >= beta = Cutoff s  
        | s > alfa' = Search p
        | otherwise = OK
          where s = negate $ jamboree' node_value d' (negate (1$+alfa')) (negate alfa') p
                    -- null window search

      -- join results of parallel scouts
      cutoff _  (Cutoff s : rs) = s
      cutoff ps (Search p : rs) = cutoff (p:ps) rs
      cutoff ps (OK : rs)       = cutoff ps rs
      cutoff ps []              = search alfa' b ps

      -- sequential full search for scout failures
      search !alfa !b [] = b
      search !alfa !b (p : ps) 
        | s >= beta = s
        | otherwise = search (max s alfa) (max s b) ps
          where s = negate $ jamboree' node_value d' (negate beta) (negate alfa) p



-- | estimate best move using static evaluation
-- estimate_best :: Valuation p -> [p] -> p            
-- estimate_best node_value = minimumBy cmp 
--  where cmp p p' = compare (node_value p) (node_value p')