TTT_AI.hs

Dateiinhalt

{-# LANGUAGE NamedFieldPuns #-}

{- Simple Min-Max-Ai without Alpha-Beta-Pruning -}

module TTT_AI where

import Data.Function
import Control.Applicative
import Data.List
import Data.Tree
import Control.Monad

import TTT_Model

-- AI for Tic Tac Toe


computerMove :: Int -> State -> Maybe Move
computerMove strength st = do
  computer <- turn st -- whose turn is it?
  let eval st = (lastMove st, evaluate computer strength st) -- evaluate lastMove
  let moves = allmoves st         -- list of states for all possible moves
  let eval_moves = map eval moves -- evaluate all possible moves
  guard $ not $ null eval_moves   -- maximumBy expects non-empty list
  let best = maximumBy (compare `on` snd) eval_moves -- select best
  return $ fst best
  
evaluate :: Player -> Int -> State -> Double
evaluate cpl depth st =
  maximise mxscore $ prune depth $ fmap value $ unfold allmoves st
  where
    value (State {lastMove=(pl,ps), lastMScore, winsize})
      | cpl == pl 
        =        lastMScore
        -- | = if lastMScore >= sc2win then  mxscore else 0
      | otherwise 
        = negate lastMScore
        -- | = if lastMScore >= sc2win then negate mxscore else 0
    sc2win  = fromIntegral $ winsize st
    mxscore = sc2win -- | 1

unfold :: (a -> [a]) -> a -> Tree a
unfold f x = Node { rootLabel = x
                  , subForest = map (unfold f) (f x)
                  }

prune :: Int -> Tree a -> Tree a
prune 0 node = node { subForest = [] }
prune d node = node { subForest = prunedForest }
  where 
    prunedForest = map (prune $ pred d) $ subForest node

maximise :: (Num a, Ord a) => a -> Tree a -> a
maximise mx (Node x []) = x
maximise mx (Node x xs) = boundedMinimum (-mx) $ map (minimise mx) xs

minimise :: (Num a, Ord a) => a -> Tree a -> a
minimise mx (Node x []) = x
minimise mx (Node x xs) = boundedMaximum (mx) $ map (maximise mx) xs