Game.hs

-- Time-stamp: <2011-02-12 21:11:31 simonmar>
-----------------------------------------------------------------------------

module Game where

import Board
import Tree

import Control.Parallel
import Control.Parallel.Strategies hiding (parMap)
import Debug.Trace

import Control.Monad.Par

type Player = Evaluation -> Evaluation -> Evaluation
type Move = (Board,Evaluation)

alternate :: Int -> Piece -> Player -> Player -> Board -> [Move]
alternate _ _ _ _ b | fullBoard b = []
alternate _ _ _ _ b | static b == XWin = []
alternate _ _ _ _ b | static b == OWin = []
alternate depth player f g board = move : alternate depth opponent g f board'
	where
	move@(board',eval) = best f possibles scores
        scores = runPar $ parMapM (bestMove depth opponent g f) possibles
	possibles = newPositions player board
        opponent = opposite player

opposite :: Piece -> Piece
opposite X = O
opposite O = X


best :: Player -> [Board] -> [Evaluation] -> Move
best f (b:bs) (s:ss) = best' b s bs ss
	where
	best' b s [] [] = (b,s)
	best' b s (b':bs) (s':ss) | s==(f s s') = best' b s bs ss
				  | otherwise 	= best' b' s' bs ss

showMove :: Move -> String
showMove (b,e) = show e ++ "\n" ++ showBoard b

bestMove :: Int -> Piece -> Player -> Player -> Board -> Par Evaluation
bestMove depth p f g board
  = do
    let tree = cropTree $ mapTree static $ prune depth $ searchTree p $ board
    parMise 2 f g tree

cropTree :: (Tree Evaluation) -> (Tree Evaluation)
cropTree (Branch a []) = (Branch a [])
cropTree (Branch (Score x) l) = Branch (Score x) (map cropTree l)
cropTree (Branch x l) = Branch x []

searchTree :: Piece -> Board -> (Tree Board)
searchTree p board = repTree (newPositions p) (newPositions (opposite p)) board

mise :: Player -> Player -> (Tree Evaluation) -> Evaluation
mise f g (Branch a []) = a
mise f g (Branch _ l) = foldr f (g OWin XWin) (map (mise g f) l)

parMise :: Int -> Player -> Player -> (Tree Evaluation) -> Par Evaluation
parMise 0 f g t = return (mise f g t)
parMise n f g (Branch a []) = return a
parMise n f g (Branch _ l) = do
  es <- parMapM (parMise (n-1) g f) l
  return (foldr f (g OWin XWin) es)