-- | Utilities for AI players.
module AI.Utils
  ( winOrPreventLoss
  , pruneDepth, pruneBreadth
  , highFirst, lowFirst
  , withPieces, withBoard
  , dontPass, singleCaptures, nubDoubleCaptures
  ) where


import Board
import Data.List (nubBy, sortBy, minimumBy)
import qualified Data.IntMap as IntMap
import System.Random



-- order subtrees with ascending or descending order
highFirst, lowFirst  :: GameTree Int m -> GameTree Int m
highFirst (GameTree x branches) 
    = GameTree x branches'
    where branches' = [(m,lowFirst t) | (m,t)<-sortBy cmp branches] 
          cmp (_,x) (_,y) = compare (value y) (value x)
          value (GameTree n _)  = n

lowFirst (GameTree x branches) 
    = GameTree x branches'
    where branches' = [(m,highFirst t) | (m,t)<-sortBy cmp branches]
          cmp (_,x) (_, y) = compare (value x) (value y)
          value (GameTree n _)  = n



-- prune to a fixed depth
pruneDepth :: Int -> GameTree a m -> GameTree a m
pruneDepth 0     (GameTree x branches)  = GameTree x []
pruneDepth (n+1) (GameTree x branches) 
    = GameTree x [(m,pruneDepth n t) | (m,t)<-branches]

-- prune to a fixed breadth
pruneBreadth :: Int -> GameTree a m -> GameTree a m
pruneBreadth k (GameTree node branches) 
    = GameTree node [(m,pruneBreadth k t) | (m,t)<-take k branches]


  
-- conditional strategies
withBoard :: (Board -> Strategy) -> Strategy
withBoard f t@(GameTree b _) g = f b t g

withPieces :: (Int -> Strategy) -> Strategy
withPieces f = withBoard $ \b -> f (IntMap.size (active b) + IntMap.size (inactive b))



-- | Searches BoardTree to a depth of 1 looking for a 
-- | guaranteed win or a preventable loss.
winOrPreventLoss :: Strategy -> Strategy
winOrPreventLoss s (GameTree a branches) = s $ GameTree a branches2
  where
  winning = [ (t, b) | (t, b@(GameTree _ [])) <- branches ]
{-
  losing  = [ t | (t, (GameTree _ branches')) <- branches, 
                           (_, (GameTree _ [])) <- branches' ]
-}
  branches1 = (if not (null winning) 
               then [head winning]
               else if length branches<cutoff 
                    then [ (t,b) | (t,b)<-branches, not_losing b] 
                    else branches)
  branches2 = if null branches1 then [head branches] else branches1
  not_losing (GameTree _ branches) 
      = null [t | (t, GameTree _ []) <- branches]
  cutoff = 100 -- braching upper bound for searching losing moves



-- narrow the search space: don't consider double-capture or pass moves
singleCaptures ::  Strategy -> Strategy   
singleCaptures s g@(GameTree _ branches) rndgen 
    | null branches' = s g rndgen
    | otherwise      = s g' rndgen
    where
      g'@(GameTree _ branches') = narrow g
      narrow :: BoardTree -> BoardTree
      narrow (GameTree board branches)
          = GameTree board [ (t, narrow g) 
                            | (t@(_,Just(_,dest)),g)<-branches, 
                            dest`IntMap.member`(active board)]

-- don't consider passing moves 
dontPass :: Strategy -> Strategy
dontPass s g rndgen = s (narrow g) rndgen
    where
      narrow :: BoardTree -> BoardTree
      narrow (GameTree node branches) 
        | null branches' = GameTree node branches
        | otherwise =  GameTree node branches'
        where branches' = [(t, narrow g) | (t@(m1,Just m2),g)<-branches]


-- eliminate double-captures that lead to identical boards
nubDoubleCaptures :: Strategy -> Strategy
nubDoubleCaptures s g rndgen = s (narrow g) rndgen
    where narrow (GameTree node branches) 
              = GameTree node $ nubBy equiv [(t, narrow g) | (t,g)<-branches]
          equiv ((m1,Just m2),_) ((m2', Just m1'),_)
              = fst m1/=fst m2 && m1==m1' && m2==m2'
          equiv _ _ = False