minimax_alpha_beta_pruning.hs

module Main where
import Test.QuickCheck
import Control.Monad

infinity :: Int
infinity = 10000

data Tree a = Leaf a | Node [Tree a] deriving (Show,Eq)

instance (Num a, Ord a, Arbitrary a) => Arbitrary (Tree a) where
  arbitrary = sized genSizedTree

-- generate a tree with depth = O(log(n)), with aprox n items (nodes + leaves)
genSizedTree :: (Num a, Ord a, Arbitrary a) => Int -> Gen (Tree a)
genSizedTree 0 = do
    a <- suchThat arbitrary (\x -> x > -10000 && x < 10000)
    return $ Leaf a

genSizedTree n = do
    nChildren <- choose(2, 5)
    let nChildrenOfChildren = n `div` nChildren
    nNodes <- choose(1, nChildren)
    let nLeaves = nChildren - nNodes
    nodes <- replicateM nNodes (genSizedTree nChildrenOfChildren)
    leaves <- replicateM nLeaves (genSizedTree 0)
    children <- shuffle (nodes ++ leaves)
    return $ Node children

maxValue :: Tree Int -> Int
maxValue (Leaf a) = a
maxValue (Node children) = auxMaxValue (-infinity) children

auxMaxValue :: Int -> [Tree Int] -> Int
auxMaxValue v (node:nodes) =
    let childV = minValue node in
      auxMaxValue (max v childV) nodes
auxMaxValue v [] = v

minValue :: Tree Int -> Int
minValue (Leaf a) = a
minValue (Node children) = auxMinValue infinity children

auxMinValue :: Int -> [Tree Int] -> Int
auxMinValue v (node:nodes) =
    let childV = maxValue node in
      auxMinValue (min v childV) nodes
auxMinValue v [] = v

abMaxValue :: Int -> Int -> Tree Int -> Int
abMaxValue _ _ (Leaf a) = a
abMaxValue alpha beta (Node children) = auxAbMaxValue (-infinity) alpha beta children

auxAbMaxValue :: Int -> Int -> Int -> [Tree Int] -> Int
auxAbMaxValue v alpha beta (node:nodes) =
    let childV = abMinValue alpha beta node in
    let newAlpha = max alpha childV in
        if newAlpha >= beta then childV
        else auxAbMaxValue (max v childV) newAlpha beta nodes
auxAbMaxValue v _ _ [] = v

abMinValue :: Int -> Int -> Tree Int -> Int
abMinValue _ _ (Leaf a) = a
abMinValue alpha beta (Node children) = auxAbMinValue infinity alpha beta children

auxAbMinValue :: Int -> Int -> Int -> [Tree Int] -> Int
auxAbMinValue v alpha beta (node:nodes) =
    let childV = abMaxValue alpha beta node in
    let newBeta = min beta childV in
        if alpha >= newBeta then childV
        else auxAbMinValue (min v childV) alpha newBeta nodes
auxAbMinValue v _ _ [] = v

-- maxValue beta (Node x) = auxMaxValue (-infinity) beta x = abMaxValue (-infinity) beta t
-- abMaxValue alpha beta (Node x) = auxAbMaxValue (-infinity) alpha beta x
-- auxMaxValue a b x == auxAbMaxValue a a b x
specA :: Tree Int -> Bool
specA tree = maxValue tree == abMaxValue (-infinity) infinity tree

-- minValue alpha (Node x) = auxMinValue infinity alpha x = abMinValue alpha infinity x
-- abMinValue alpha beta t = auxAbMinValue infinity alpha beta x
-- auxMinValue b a x = auxAbMinValue b a b x
specB :: Tree Int -> Bool
specB tree = minValue tree == abMinValue (-infinity) infinity tree

-- auxMinValue b a x = auxAbMinValue b a b x
specC :: [Tree Int] -> Bool
specC children = auxMinValue infinity children == auxAbMinValue infinity (-infinity) infinity children

-- auxMaxValue a b x == auxAbMaxValue a a b x
specD :: [Tree Int] -> Bool
specD children = auxMaxValue (-infinity) children == auxAbMaxValue (-infinity) (-infinity) infinity children

main :: IO ()
main = do
  quickCheck $ specA
  quickCheck $ specB
  quickCheck $ specC
  quickCheck $ specD