hstzaar-0.4: src/Tournament.hs

-- Competitions between diferent AIs
module Tournament where

import AI.Minimax
import AI.Lame
import Board
import System.Random
import Control.Monad

-- compare two strategies on a starting board 
-- plays 2 games with (either strategy first) and sums the results
-- result is 1 , 0 or -1 according to the relative comparision
playMatch ::  AI -> AI -> Board -> StdGen -> IO Int
playMatch p1 p2 startboard rndgen 
    = playMatch' 1 (boardTree startboard) rndgen p1 p2

playMatch' :: Int -> BoardTree -> StdGen -> AI -> AI -> IO Int
playMatch' n bt@(GameTree _ branches) rnd p1 p2
    | null branches  -- first player can't play: second player wins
        = return (-1)
    | otherwise 
        = do putStrLn (show n ++ ". " ++ name p1 ++ ":\t" ++ showTurn t)
             liftM negate $ playMatch' (n+1) bt' rnd' p2 p1
    where (t, rnd') = strategy p1 bt rnd
          bt' = swapBoardTree $ head [bt' | (t',bt')<-branches, t'==t]
          --k = length branches



-- compare two strategies on random boards
playAIs :: AI -> AI -> [Board] ->StdGen -> IO ()
playAIs p1 p2 boards rnd 
    = do rs<-sequence  ([do header i
                            r<-playMatch p1 p2 b rnd 
                            footer
                            return r
                         | (i,b)<-zip [1..] boards] ++
                        [do header i
                            r<-playMatch p2 p1 b rnd
                            footer
                            return (-r)
                         | (i,b)<- zip [n+1..] boards
                        ])
         let won = length [r | r<-rs, r>0]
         let lost= length [r | r<-rs, r<0]
         let score = sum rs
         putStrLn (name p1 ++ " vs " ++ name p2 ++ ": " 
                   ++ show score ++ " (" 
                   ++ show won ++ " matches won and " 
                   ++ show lost ++ " lost)")
    where n = length boards
          header i = putStrLn ("Match " ++ show i ++ "/" ++ show (2*n))
          footer = putStrLn (replicate 80 '-')


-- create random boards 
randomBoards :: Int -> StdGen -> ([Board], StdGen)
randomBoards 0 rndgen = ([], rndgen)
randomBoards (n+1) rndgen = (b:bs, rndgen'')
    where (b, rndgen') = randomBoard rndgen
          (bs, rndgen'') = randomBoards n rndgen'