Minimax.hs

module Minimax where

import Data.Maybe
import Safe


type Move  = (Int, Int)

type Field = (Int, Int, Player)

data Player = PC
            | None
            | Human
  deriving (Ord, Eq, Show)

data Playfield = Playfield {
    getField :: [Field]
} deriving (Eq, Show)

type Winner = Player


initPlayfield :: Playfield
initPlayfield = Playfield
  [(0, 0, None), (0, 1, None), (0, 2, None)
  , (1, 0, None), (1, 1, None), (1, 2, None)
  , (2, 0, None), (2, 1, None), (2, 2, None)]


move :: Player           -- ^ the player to move
     -> Move             -- ^ where to move the player
     -> Playfield        -- ^ the old playfield
     -> Maybe Playfield  -- ^ new playfield if move is valid
move pl (a, b) pf = case getField pf `atMay` index of
  Just (_, _, None) ->
    Just $ Playfield (fmap (\(x', y', pl') -> if (x', y') == (a, b)
                                                then (a, b, pl)
                                                else (x', y', pl'))
                     (getField pf))
  _ -> Nothing
  where
    index = a * 3 + 1 * b


getAllPossibleMoves :: Playfield -> [Move]
getAllPossibleMoves pf =
  foldl (\x (a, b, p) -> x ++ [(a, b) | p == None])
    [] (getField pf)


checkGameEnded :: Playfield -> Int
checkGameEnded pf
  | horizontal Human ||
      vertical Human ||
      cross    Human    = negate 1
  | horizontal PC ||
      vertical PC ||
      cross    PC       = 1
  | null . getAllPossibleMoves $ pf = 0
  | otherwise = negate 2
  where
    horizontal pl =
      (not . null)
        . filter (\x -> length x == 3)
        . fmap (\i -> filter (\(a, _, p) -> a == i && p == pl)
          (getField pf))
        $ [0..2]
    vertical pl =
      (not . null)
        . filter (\x -> length x == 3)
        . fmap (\i -> filter (\(_, b, p) -> b == i && p == pl)
          (getField pf))
        $ [0..2]
    cross pl =
      (not . null)
        . filter (\x -> length x == 3)
        . fmap (filter (\(_, _, p) -> p == pl))
        $ [[head (getField pf), getField pf !! 4, getField pf !! 8],
           [getField pf !! 2, getField pf !! 4, getField pf !! 6]]


minimax :: Playfield   -- ^ state
        -> Move        -- ^ action
minimax pf = go (val, action) (getAllPossibleMoves pf)
  where
    go (_, a) []     = a
    go (v, a) (x:xs)
      | v < mimi x   = go (mimi x, x) xs
      | otherwise    = go (v, a) xs
    mimi x        = minValP (fromJust $ move PC x pf) (negate 1000) 1000
    (val, action) = (negate 1000, (0, 0))



testfield :: Playfield
testfield = Playfield
  [(0, 0, Human), (0, 1, None), (0, 2, PC)
  , (1, 0, None), (1, 1, Human), (1, 2, None)
  , (2, 0, PC), (2, 1, None), (2, 2, None)]


minValP :: Playfield  -- ^ state
        -> Int     -- ^ alpha
        -> Int     -- ^ beta
        -> Int     -- ^ min value
minValP pf alpha' beta'
  | checkGameEnded pf /= negate 2 = checkGameEnded pf
  | otherwise = go alpha' beta' (getAllPossibleMoves pf)
  where
    go :: Int -> Int -> [Move] -> Int
    go _     beta []       = beta
    go alpha beta (x:xs)
      | newbeta x <= alpha = alpha
      | otherwise          = go alpha (newbeta x) xs
      where
        newbeta :: Move -> Int
        newbeta s = min beta
                      . maxValP (fromJust . move Human s $ pf) alpha
                      $ beta


maxValP :: Playfield      -- ^ state
        -> Int -- ^ alpha
        -> Int -- ^ beta
        -> Int -- ^ max value
maxValP pf alpha' beta'
  | checkGameEnded pf /= negate 2 = checkGameEnded pf
  | otherwise = go alpha' beta' (getAllPossibleMoves pf)
  where
    go :: Int -> Int -> [Move] -> Int
    go alpha _    []        = alpha
    go alpha beta (x:xs)
      | newalpha x >= beta  = beta
      | otherwise           = go (newalpha x) beta xs
      where
        newalpha :: Move -> Int
        newalpha s = max alpha
                       . minValP (fromJust . move PC s $ pf) alpha
                       $ beta


minVal :: Playfield  -- ^ state
       -> Int        -- ^ max value
minVal pf
  | checkGameEnded pf /= negate 2 = checkGameEnded pf
  | otherwise = foldl (\v x -> min v . maxVal . fromJust . move Human x $ pf)
                      1000
                      (getAllPossibleMoves pf)


maxVal :: Playfield  -- ^ state
       -> Int        -- ^ max value
maxVal pf
  | checkGameEnded pf /= negate 2 = checkGameEnded pf
  | otherwise = foldl (\v x -> max v . minVal . fromJust . move PC x $ pf)
                      (negate 1000)
                      (getAllPossibleMoves pf)