module Data.Tree.Game_tree.Negascout (
negamax,
alpha_beta_search,
principal_variation_search,
negascout
) where
import Data.Tree.Game_tree.Game_tree
negascout :: Game_tree a => a
-> Int
-> ([a], Int)
negascout node depth = negascout' ((minBound :: Int) + 1) (maxBound :: Int) node depth
principal_variation_search :: Game_tree a => a
-> Int
-> ([a], Int)
principal_variation_search node depth
| is_terminal node || depth == 0 = ([node], node_value node)
| otherwise = case pvs ((minBound :: Int) + 1) (maxBound :: Int) (children node) depth of
(pvm, pvv) -> (node:pvm, pvv)
alpha_beta_search :: Game_tree a => a
-> Int
-> ([a], Int)
alpha_beta_search node depth =
alpha_beta ((minBound :: Int) + 1) (maxBound :: Int) node depth
negamax :: Game_tree a => a
-> Int
-> ([a], Int)
negamax node depth
| is_terminal node || depth == 0 = ([node], node_value node)
| otherwise = case children node of
(c:cs) -> (node:pvm, pvv)
where (pvm, pvv) = negaLevel (neg (negamax c (depth 1))) cs
where negaLevel prev_best@(_, old_v) (n:nn) =
negaLevel best4 nn
where best4 = case neg $ negamax n (depth 1) of
value@(_, v) | v > old_v -> value
| otherwise -> prev_best
negaLevel best _ = best
neg (m, v) = (m, v)
negascout' :: Game_tree a => Int
-> Int
-> a
-> Int
-> ([a], Int)
negascout' alpha beta node depth
| is_terminal node || depth == 0 = ([node], node_value node)
| otherwise = let (pvm, pvv) = negascout'' [] alpha beta $ children node
in (node:pvm, pvv)
where
d = depth 1
negascout'' npv nalpha _ [] = (npv, nalpha)
negascout'' npv nalpha b (c:cs) = result
where (n', alpha') = let (new_n', new_alpha') = negascout' (b) (nalpha) c d
in if (new_alpha') > nalpha
then (new_n', new_alpha')
else (npv, nalpha)
result
| alpha' >= beta = ((c:n'), alpha')
| alpha' >= b = result'
| otherwise = negascout'' n' alpha' (alpha' + 1) cs
where
result'
| alpha'' >= beta = ((c:n''), alpha'')
| otherwise = negascout'' n'' alpha'' (alpha'' + 1) cs
where
alpha'' = alpha'''
(n'', alpha''') = negascout' (beta) (alpha') c d
pvs :: Game_tree a => Int -> Int -> [a] -> Int -> ([a], Int)
pvs alpha beta (c:cs) depth = case negpvs (beta) (alpha) c d of
best -> negaLevel best alpha beta cs
where d = depth 1
negaLevel prev_best@(_, old_v) prev_alpha beta' (n:nn) | old_v < beta'
= negaLevel best4 alpha' beta' nn
where best4 = case negpvs (alpha' 1) (alpha') n d of
value@(_, v) | (alpha' < v) && (v < beta')
-> negpvs (beta') (v) n d
| (v > old_v) -> value
| otherwise -> prev_best
alpha' = if old_v > prev_alpha then old_v else prev_alpha
negaLevel best aa bb _ = best
negpvs alpha'' beta'' node d'
| is_terminal node || d' == 0 = ([node], (node_value node))
| otherwise = case children node of
nn' -> (node:pvm, pvv)
where (pvm, pvv) = pvs alpha'' beta'' nn' d'
alpha_beta :: Game_tree a => Int
-> Int
-> a
-> Int
-> ([a], Int)
alpha_beta alpha beta node depth
| is_terminal node || depth == 0 = ([node], node_value node)
| otherwise = case children node of
(c:cs) -> (node:pvm, pvv)
where (pvm, pvv) = negaLevel ([], (minBound :: Int) + 2) alpha beta (c:cs)
where negaLevel prev_best@(_, old_v) prev_alpha beta' (n:nn) | old_v < beta'
= negaLevel best4 alpha' beta' nn
where best4 = case neg $ alpha_beta (beta') (alpha') n (depth 1) of
value@(_, v) | (v > old_v) -> value
| otherwise -> prev_best
alpha' = if old_v > prev_alpha then old_v else prev_alpha
negaLevel best _ _ _ = best
neg (m, v) = (m, v)