# Principal variation search

(Difference between revisions)

```{-# OPTIONS -fglasgow-exts #-}

module Zertz.NegaMax (pvs) where

import Data.Tree
import Debug.Trace

import Test.QuickCheck
import System.Random

-- Top node reflects the current position
b x = Node x []
testt = Node ("p1_1",1)
[Node ("p2_2_1",2)
[b \$ ("p1_3_1",-7), b \$ ("p1_3_2",-2)],
Node ("p2_2_1",3)
[b \$ ("p1_3_1",-4), b \$ ("p1_3_2",-6)],
Node ("p2_2_2",4)
[b \$ ("p1_3_3",-2), b \$ ("p1_3_4",-5)] ]

showTree x = putStr \$ drawTree \$ fmap show x

test2 = fmap show testt
test3 = putStr \$ drawTree test2

-- straightforward minimax (not even with alpha beta)
negamax node = case node of
Node (move,v) [] -> ([move],v)
Node (move,_) (n:nn) -> (move:pvm, pvv)
where (pvm, pvv) = negaLevel (neg (negamax n)) nn
where negaLevel prev_best@(_,old_v) (n:nn)
= negaLevel best4 nn
where best4 = case neg \$ negamax n of
value@(_,v) | v > old_v -> value
| otherwise -> prev_best
negaLevel best _ = best
neg (m,v) = (m,-v)

-- Normal alpha beta
alpha_beta alpha beta node = case node of
Node (move,v) [] -> ([move],v)
Node (move,_) nn -> (move:pvm, pvv)
where (pvm, pvv) = negaLevel ([1010101],-1000) alpha beta nn
where negaLevel prev_best@(_,v1) prev_alpha beta (n:nn) | v1 < beta
= negaLevel best4 alpha beta nn
where best4 = case neg \$ alpha_beta (-beta) (-alpha) n of
value@(_,v2) | (v2 > v1) -> value
| otherwise -> prev_best
alpha = if v1 > prev_alpha then v1 else prev_alpha
negaLevel best alpha beta _     = best
neg (m,v) = (m,-v)
-- Principle variation search
-- the search continues as long as alpha < pvs < beta
-- as soon pvs hits one these bounds the search stops and returns best
pvs :: (Num a1, Ord a1) => a1 -> a1 -> [Tree (a, a1)] -> ([a], a1)
pvs alpha beta (n:nn) = case negpvs (-beta) (-alpha) n of
best -> negaLevel best alpha beta nn
where negaLevel prev_best@(_,v1) prev_alpha beta (n:nn) | v1 < beta
= negaLevel best4 alpha beta nn
where best4 = case negpvs (-alpha - 1) (-alpha) n of
value@(_,v2) | (alpha < v2) && (v2 < beta)
-> negpvs (-beta) (-v2) n
| (v2 > v1) -> value
| otherwise -> prev_best
alpha = if v1 > prev_alpha then v1 else prev_alpha
negaLevel best alpha beta _     = best
negpvs alpha beta node = case node of
Node (move,v) [] -> ([move], -v)
Node (move,_) nn -> (move:pvm, -pvv)
where (pvm, pvv) = pvs alpha beta nn
pvs _ _ _ = error "PV Search called with empty list"

pvs_topnode (Node (move,v) []) = ([move],v)
pvs_topnode (Node (move,_) nn) = case pvs (-10000) 10000 nn of
(pvm, pvv) -> (move:pvm, pvv)

test5 = pvs_topnode testt
test6 = negamax testt

rtest n = generate 1000 (mkStdGen n)
test7 = rtest 4 \$ choose (1, 10)
test8 = rtest 4 \$ (vector 5 :: Gen [Int])
-- Twenty numbers from 1 to 10.
test9 = rtest 4 \$ sequence [ choose (1,10) | i <- [1..20] ]

instance (Arbitrary x) => Arbitrary (Tree x) where
arbitrary = sized tree'
where tree' 0 = liftM leaf arbitrary
tree' n | n>0 =
oneof [liftM leaf arbitrary,
liftM2 Node arbitrary leaves]
where subtree = tree' (n `div` 2)
leaves  = do n <- choose (1,5)
sequence [ subtree | i <- [1..n] ]
leaf = flip Node []
coarbitrary (Node v nodes) =
variant 0 . coarbitrary v .coarbitrary nodes

test10 :: Tree (Int, Int)
test10 = rtest 14 \$ arbitrary
test11 = showTree test10
test12 = pvs_topnode test10
test13 = negamax test10

prop_SameResult :: Tree (Int,Int) -> Bool
prop_SameResult node = case pvs' == negamax' of
True -> True
False -> trace (show (pvs', negamax')) False
where pvs' = pvs_topnode node
negamax' = negamax node

test14 = quickCheck prop_SameResult
test15 = verboseCheck prop_SameResult
test16 = test prop_SameResult
-- beta sets the maximum best score.
-- test17 returns -6 because there is a lower node that returns -6, which is good enough
-- we don't need to search further.
-- i.e. test17 <= beta if there is such a score.
test17 = pvs (-1000) (-6) nodes
where Node _ nodes = testt
-- alpha sets the minimum best score.
-- presumably alpha <= test17 <= beta if there is a valid path for this
test18 = pvs (-1000) 1000 nodes
where Node _ nodes = testt
test19 = pvs (-4) 1000 nodes
where Node _ nodes = testt
test20 = pvs (-100001) (-100000) nodes
where Node _ nodes = testt
test21 = pvs 100000 100001 nodes
where Node _ nodes = testt
testt1 = Node ("p1_1",1)
[Node ("p2_2_1",2)
[b \$ ("p1_3_1",-7)],
Node ("p2_2_2",4)
[b \$ ("p1_3_3",-2), b \$ ("p1_3_4",-5)] ]
test22 = pvs (-1000) 1000 nodes
where Node _ nodes = testt1
testt2 = Node ("p1_1",1)
[Node ("p2_2_2",4)
[b \$ ("p1_3_3",-2)] ]
test23 = pvs (-1000) 1000 nodes
where Node _ nodes = testt2
--the only failing test, and it makes sense that this fails.
--test24 = pvs (-1000) 1000 []```