hstzaar-0.7: src/Tournament.hs

-- Competitions between diferent AIs
module Tournament where

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 b rndgen 
    = playMatch' 1 (startBoardTree b) rndgen p1 p2

playMatch' :: Int -> BoardTree -> StdGen -> AI -> AI -> IO Int
playMatch' n bt@(GameTree b branches) rnd p1 p2
  | endGame b = return (-1) -- p1 can't play, p2 wins
  | 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' = boardTree (applyTurn b t) 



-- compare two strategies on random boards
playAIs :: AI -> AI -> [Board] ->StdGen -> IO ()
playAIs p1 p2 boards rnd 
  = do rs1<-sequence [do { header i
                         ; r<-playMatch p1 p2 b rnd
                         ; footer
                         ; return r } | (i,b)<-zip [1..] boards] 
       rs2<-sequence [do { header i
                          ; r<-playMatch p2 p1 b rnd
                          ; footer
                          ; return (-r) } | (i,b)<- zip [n+1..] boards]
       let rs = rs1++rs2
       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'