hstzaar-0.9.2: src/Tournament.hs

-- Competitions between diferent AIs
module Tournament where

import Board
import AI
import AI.Gametree
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 or -1 according to the winner
playMatch :: Board -> StdGen -> AI -> AI -> IO Int
playMatch b rnd p1 p2
  | is_terminal b = return (-1) -- p1 can't play, p2 wins
  | otherwise = do putStrLn line
                   liftM negate $ playMatch b' rnd' p2 p1
    where (score, m, rnd') = playing p1 b rnd
          line = show (move b) ++ ". " ++  show (active b) ++  
                  " ("++name p1 ++ "):\t" ++ " " ++
                 showMove m ++ "\tscore: " ++ show score
          b' = applyMove m b



-- 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 b rnd p1 p2
                        ; hline
                        ; r'<-playMatch b rnd p2 p1
                        ; hline
                        ; return (r-r') 
                        } 
                    | (i,b)<-zip [1..] boards] 
       let won = sum [r | r<-rs, r>0]
       let lost= - sum [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 n)
          hline = putStrLn (replicate 70 '-')


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