gameTrees.hs

 import Data.Maybe (fromMaybe)
import Debug.Trace (traceShow, trace)

data GameTree a = Leaf a | Nodes (Maybe a) [GameTree a]  deriving (Show, Eq)

type IsMaximizingPlayer = Bool

example :: GameTree Int
example =
  Nodes Nothing
        [Nodes Nothing
               [Nodes Nothing
                      [Nodes Nothing [Leaf 5, Leaf 6],
                       Nodes Nothing [Leaf 7, Leaf 4, Leaf 5]],
                Nodes Nothing
                      [Nodes Nothing [Leaf 3]]],
         Nodes Nothing
                [Nodes Nothing
                      [Nodes Nothing [Leaf 6],
                       Nodes Nothing [Leaf 6, Leaf 9]],
                 Nodes Nothing
                      [Nodes Nothing [Leaf 7]]],
          Nodes Nothing
                [Nodes Nothing [Nodes Nothing [Leaf 5]],
                 Nodes Nothing [Nodes Nothing [Leaf 9, Leaf 7],
                                Nodes Nothing [Leaf 6]]]]


score :: GameTree a -> Maybe a
score (Leaf a) = Just a
score (Nodes x _) = x


-- vanilla scoring
-- TODO: refactor
scoring :: (Num a, Ord a) => GameTree a -> IsMaximizingPlayer -> GameTree a
scoring leaf@(Leaf a) _ = leaf
scoring node@(Nodes (Just x) _) _ = node
scoring (Nodes Nothing x) isMax =
  Nodes ((foldl1 f) <$> m) scoredNodes
  where m = sequence. map score $ scoredNodes
        scoredNodes = map ((flip scoring)  (not isMax)) x
        f = if isMax then max else min



rescore :: (Num a, Ord a, Bounded a) => a -> GameTree a -> GameTree a
rescore t (Nodes Nothing nodes) = Nodes (Just t) nodes
rescore _ a = a

c f b isM =  (\(v,current,alpha) x ->
             let c = fromMaybe minBound . score $ (pruningAlgorithm x (not isM) (alpha,b))
                 v_ = f v c
                 newA =  f alpha v_
             in (v_,c, newA))

--annotate1 :: GameTree a -> (GameTree a -> a) -> AnnotatedGameTree a
--annotate1 (Leaf a) _ = Leaf a
--annotate1 (Nodes x y) = (Nodes )  
--	
--
--
pruningAlgorithm :: (Num a, Ord a, Bounded a, Show a) => GameTree a -> IsMaximizingPlayer -> (a,a) -> GameTree a
pruningAlgorithm leaf@(Leaf a) _ _= leaf -- traceShow leaf leaf
pruningAlgorithm node@(Nodes (Just x) _) _ _ = node -- traceShow node node
pruningAlgorithm (Nodes Nothing nodes) isM (a,b) =
  let f = if isM then max else min
      (a_,b_) =  if isM then (a,b) else (b,a)
      passon = if isM then (,b) else (a,)
      acc = if isM then (minBound, minBound, a_) else (maxBound, maxBound, a_)
      fm = if isM then (<) else (>)
      ff = (\(v,current,alpha) x ->
             let c = (fromMaybe minBound) . score $ (pruningAlgorithm x (not isM) (passon alpha))
                 v_ = f v c
                 newA =  f alpha v_
             in (v_,c, newA))
      e1 = scanl ff acc $ nodes
      e = takeWhile (\(_,v,_) -> fm v b_) e1
      y = drop (length e) nodes
      (nodeValue, _,_) = last e
      j = zipWith rescore (map (\(_,c,_) -> c) e) (take (length e) nodes)
  in  traceShow (show b_ ++ show e1 ++ "\n") (Nodes (Just nodeValue) (j ++ y))


main = putStrLn . show $ pruningAlgorithm example True (minBound, maxBound)