Principal variation search
Jump to navigation
Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
{-# OPTIONS -fglasgow-exts #-}
module PVS (pvs) where
import Data.Tree
import Debug.Trace
import Test.QuickCheck
import System.Random
import Control.Monad
-- 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 []