module BishBosh.Search.AlphaBeta(
extractSelectedTurns,
negaMax,
) where
import BishBosh.Model.Game((=~))
import Control.Applicative((<|>))
import Control.Arrow((&&&))
import qualified BishBosh.Component.QualifiedMove as Component.QualifiedMove
import qualified BishBosh.Component.Turn as Component.Turn
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Evaluation.PositionHashQuantifiedGameTree as Evaluation.PositionHashQuantifiedGameTree
import qualified BishBosh.Evaluation.QuantifiedGame as Evaluation.QuantifiedGame
import qualified BishBosh.Input.SearchOptions as Input.SearchOptions
import qualified BishBosh.Model.Game as Model.Game
import qualified BishBosh.Notation.MoveNotation as Notation.MoveNotation
import qualified BishBosh.Property.Arboreal as Property.Arboreal
import qualified BishBosh.Search.DynamicMoveData as Search.DynamicMoveData
import qualified BishBosh.Search.KillerMoves as Search.KillerMoves
import qualified BishBosh.Search.SearchState as Search.SearchState
import qualified BishBosh.Search.Transpositions as Search.Transpositions
import qualified BishBosh.Search.TranspositionValue as Search.TranspositionValue
import qualified BishBosh.State.InstancesByPosition as State.InstancesByPosition
import qualified BishBosh.State.TurnsByLogicalColour as State.TurnsByLogicalColour
import qualified BishBosh.Type.Count as Type.Count
import qualified BishBosh.Type.Crypto as Type.Crypto
import qualified BishBosh.Type.Length as Type.Length
import qualified Control.Exception
import qualified Control.Monad.Reader
import qualified Data.Default
import qualified Data.Maybe
import qualified Data.Tree
data Result x y positionHash = MkResult {
Result x y positionHash -> DynamicMoveData x y positionHash
getDynamicMoveData :: Search.DynamicMoveData.DynamicMoveData x y positionHash,
Result x y positionHash -> QuantifiedGame x y
getQuantifiedGame :: Evaluation.QuantifiedGame.QuantifiedGame x y,
Result x y positionHash -> NPositions
getNPositionsEvaluated :: Type.Count.NPositions
}
extractSelectedTurns
:: Type.Count.NPlies
-> Result x y positionHash
-> (Search.DynamicMoveData.DynamicMoveData x y positionHash, [Component.Turn.Turn x y], Type.Count.NPositions)
NPositions
nPlies MkResult {
getDynamicMoveData :: forall x y positionHash.
Result x y positionHash -> DynamicMoveData x y positionHash
getDynamicMoveData = DynamicMoveData x y positionHash
dynamicMoveData,
getQuantifiedGame :: forall x y positionHash.
Result x y positionHash -> QuantifiedGame x y
getQuantifiedGame = QuantifiedGame x y
quantifiedGame,
getNPositionsEvaluated :: forall x y positionHash. Result x y positionHash -> NPositions
getNPositionsEvaluated = NPositions
nPositionsEvaluated
} = (
DynamicMoveData x y positionHash
dynamicMoveData,
NPositions -> QuantifiedGame x y -> [Turn x y]
forall x y. NPositions -> QuantifiedGame x y -> [Turn x y]
Evaluation.QuantifiedGame.getLatestTurns NPositions
nPlies QuantifiedGame x y
quantifiedGame,
NPositions
nPositionsEvaluated
)
updateKillerMoves :: (
Ord x,
Ord y,
Enum x,
Enum y,
Show x,
Show y
)
=> Model.Game.Game x y
-> Search.DynamicMoveData.Transformation x y positionHash
updateKillerMoves :: Game x y -> Transformation x y positionHash
updateKillerMoves Game x y
game
| Just Turn x y
lastTurn <- Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
Model.Game.maybeLastTurn Game x y
game = if Turn x y -> Bool
forall x y. Turn x y -> Bool
Component.Turn.isCapture Turn x y
lastTurn
then Transformation x y positionHash
forall a. a -> a
id
else Transformation (KillerMoveKey x y)
-> Transformation x y positionHash
forall x y positionHash.
Transformation (KillerMoveKey x y)
-> Transformation x y positionHash
Search.DynamicMoveData.updateKillerMoves (Transformation (KillerMoveKey x y)
-> Transformation x y positionHash)
-> (KillerMoveKey x y -> Transformation (KillerMoveKey x y))
-> KillerMoveKey x y
-> Transformation x y positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPositions
-> KillerMoveKey x y -> Transformation (KillerMoveKey x y)
forall killerMoveKey.
Ord killerMoveKey =>
NPositions -> killerMoveKey -> Transformation killerMoveKey
Search.KillerMoves.insert (
TurnsByLogicalColour (Turn x y) -> NPositions
forall turn. TurnsByLogicalColour turn -> NPositions
State.TurnsByLogicalColour.getNPlies (TurnsByLogicalColour (Turn x y) -> NPositions)
-> TurnsByLogicalColour (Turn x y) -> NPositions
forall a b. (a -> b) -> a -> b
$ Game x y -> TurnsByLogicalColour (Turn x y)
forall x y. Game x y -> TurnsByLogicalColour x y
Model.Game.getTurnsByLogicalColour Game x y
game
) (KillerMoveKey x y -> Transformation x y positionHash)
-> KillerMoveKey x y -> Transformation x y positionHash
forall a b. (a -> b) -> a -> b
$ Turn x y -> KillerMoveKey x y
forall x y. Turn x y -> KillerMoveKey x y
Search.DynamicMoveData.mkKillerMoveKeyFromTurn Turn x y
lastTurn
| Bool
otherwise = Exception -> Transformation x y positionHash
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Transformation x y positionHash)
-> (String -> Exception)
-> String
-> Transformation x y positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkNullDatum (String -> Exception) -> (String -> String) -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
"BishBosh.Search.AlphaBeta.updateKillerMoves:\tzero turns have been made; " (String -> Transformation x y positionHash)
-> String -> Transformation x y positionHash
forall a b. (a -> b) -> a -> b
$ Game x y -> String -> String
forall a. Show a => a -> String -> String
shows Game x y
game String
"."
findTranspositionTerminalQuantifiedGame :: (
Eq x,
Eq y,
Enum x,
Enum y,
Show x,
Show y
)
=> Evaluation.PositionHashQuantifiedGameTree.PositionHashQuantifiedGameTree x y positionHash
-> Search.TranspositionValue.TranspositionValue (Component.QualifiedMove.QualifiedMove x y)
-> Evaluation.QuantifiedGame.QuantifiedGame x y
findTranspositionTerminalQuantifiedGame :: PositionHashQuantifiedGameTree x y positionHash
-> TranspositionValue (QualifiedMove x y) -> QuantifiedGame x y
findTranspositionTerminalQuantifiedGame PositionHashQuantifiedGameTree x y positionHash
positionHashQuantifiedGameTree TranspositionValue (QualifiedMove x y)
transpositionValue = QuantifiedGame x y
-> ([NodeLabel x y positionHash] -> QuantifiedGame x y)
-> Maybe [NodeLabel x y positionHash]
-> QuantifiedGame x y
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
Exception -> QuantifiedGame x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> QuantifiedGame x y)
-> (String -> Exception) -> String -> QuantifiedGame x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkSearchFailure (String -> Exception) -> (String -> String) -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
"BishBosh.Search.AlphaBeta.findTranspositionTerminalQuantifiedGame:\tEvaluation.PositionHashQuantifiedGameTree.traceMatchingMoves failed; " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TranspositionValue (QualifiedMove x y) -> String -> String
forall a. Show a => a -> String -> String
shows TranspositionValue (QualifiedMove x y)
transpositionValue (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
":\n" (String -> QuantifiedGame x y) -> String -> QuantifiedGame x y
forall a b. (a -> b) -> a -> b
$ (
MoveNotation
-> NPositions
-> PositionHashQuantifiedGameTree x y positionHash
-> String
-> String
forall a.
ShowNotationFloat a =>
MoveNotation -> NPositions -> a -> String -> String
Notation.MoveNotation.showsNotationFloatToNDecimals MoveNotation
forall a. Default a => a
Data.Default.def NPositions
3 (PositionHashQuantifiedGameTree x y positionHash
-> String -> String)
-> PositionHashQuantifiedGameTree x y positionHash
-> String
-> String
forall a b. (a -> b) -> a -> b
$ NPositions
-> PositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
forall tree. Prunable tree => NPositions -> tree -> tree
Property.Arboreal.prune (NPositions -> NPositions
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPositions
inferredSearchDepth) PositionHashQuantifiedGameTree x y positionHash
positionHashQuantifiedGameTree
) String
""
) (
(
if NPositions -> Bool
forall a. Integral a => a -> Bool
even NPositions
inferredSearchDepth
then QuantifiedGame x y -> QuantifiedGame x y
forall x y. QuantifiedGame x y -> QuantifiedGame x y
Evaluation.QuantifiedGame.negateFitness
else QuantifiedGame x y -> QuantifiedGame x y
forall a. a -> a
id
) (QuantifiedGame x y -> QuantifiedGame x y)
-> ([NodeLabel x y positionHash] -> QuantifiedGame x y)
-> [NodeLabel x y positionHash]
-> QuantifiedGame x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeLabel x y positionHash -> QuantifiedGame x y
forall x y positionHash.
NodeLabel x y positionHash -> QuantifiedGame x y
Evaluation.PositionHashQuantifiedGameTree.getQuantifiedGame (NodeLabel x y positionHash -> QuantifiedGame x y)
-> ([NodeLabel x y positionHash] -> NodeLabel x y positionHash)
-> [NodeLabel x y positionHash]
-> QuantifiedGame x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NodeLabel x y positionHash] -> NodeLabel x y positionHash
forall a. [a] -> a
last
) (Maybe [NodeLabel x y positionHash] -> QuantifiedGame x y)
-> ([QualifiedMove x y] -> Maybe [NodeLabel x y positionHash])
-> [QualifiedMove x y]
-> QuantifiedGame x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionHashQuantifiedGameTree x y positionHash
-> [QualifiedMove x y] -> Maybe [NodeLabel x y positionHash]
forall x y positionHash.
(Eq x, Eq y) =>
PositionHashQuantifiedGameTree x y positionHash
-> [QualifiedMove x y] -> Maybe [NodeLabel x y positionHash]
Evaluation.PositionHashQuantifiedGameTree.traceMatchingMoves PositionHashQuantifiedGameTree x y positionHash
positionHashQuantifiedGameTree ([QualifiedMove x y] -> QuantifiedGame x y)
-> [QualifiedMove x y] -> QuantifiedGame x y
forall a b. (a -> b) -> a -> b
$ TranspositionValue (QualifiedMove x y) -> [QualifiedMove x y]
forall qualifiedMove.
TranspositionValue qualifiedMove -> [qualifiedMove]
Search.TranspositionValue.getQualifiedMoves TranspositionValue (QualifiedMove x y)
transpositionValue where
inferredSearchDepth :: NPositions
inferredSearchDepth = TranspositionValue (QualifiedMove x y) -> NPositions
forall qualifiedMove.
TranspositionValue qualifiedMove -> NPositions
Search.TranspositionValue.inferSearchDepth TranspositionValue (QualifiedMove x y)
transpositionValue
updateTranspositions :: (
Eq x,
Eq y,
Enum x,
Enum y,
Ord positionHash,
Show x,
Show y
)
=> Search.TranspositionValue.IsOptimal
-> Type.Count.NPlies
-> positionHash
-> [Component.Turn.Turn x y]
-> Evaluation.PositionHashQuantifiedGameTree.PositionHashQuantifiedGameTree x y positionHash
-> Search.DynamicMoveData.Transformation x y positionHash
updateTranspositions :: Bool
-> NPositions
-> positionHash
-> [Turn x y]
-> PositionHashQuantifiedGameTree x y positionHash
-> Transformation x y positionHash
updateTranspositions Bool
isOptimal NPositions
nPlies positionHash
positionHash [Turn x y]
turns PositionHashQuantifiedGameTree x y positionHash
positionHashQuantifiedGameTree = Transformation (QualifiedMove x y) positionHash
-> Transformation x y positionHash
forall x y positionHash.
Transformation (QualifiedMove x y) positionHash
-> Transformation x y positionHash
Search.DynamicMoveData.updateTranspositions (Transformation (QualifiedMove x y) positionHash
-> Transformation x y positionHash)
-> ([QualifiedMove x y]
-> Transformation (QualifiedMove x y) positionHash)
-> [QualifiedMove x y]
-> Transformation x y positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FindFitness (QualifiedMove x y)
-> positionHash
-> TranspositionValue (QualifiedMove x y)
-> Transformation (QualifiedMove x y) positionHash
forall positionHash qualifiedMove.
Ord positionHash =>
FindFitness qualifiedMove
-> positionHash
-> TranspositionValue qualifiedMove
-> Transformation qualifiedMove positionHash
Search.Transpositions.insert (
QuantifiedGame x y -> WeightedMean
forall x y. QuantifiedGame x y -> WeightedMean
Evaluation.QuantifiedGame.getFitness (QuantifiedGame x y -> WeightedMean)
-> (TranspositionValue (QualifiedMove x y) -> QuantifiedGame x y)
-> FindFitness (QualifiedMove x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionHashQuantifiedGameTree x y positionHash
-> TranspositionValue (QualifiedMove x y) -> QuantifiedGame x y
forall x y positionHash.
(Eq x, Eq y, Enum x, Enum y, Show x, Show y) =>
PositionHashQuantifiedGameTree x y positionHash
-> TranspositionValue (QualifiedMove x y) -> QuantifiedGame x y
findTranspositionTerminalQuantifiedGame PositionHashQuantifiedGameTree x y positionHash
positionHashQuantifiedGameTree
) positionHash
positionHash (TranspositionValue (QualifiedMove x y)
-> Transformation (QualifiedMove x y) positionHash)
-> ([QualifiedMove x y] -> TranspositionValue (QualifiedMove x y))
-> [QualifiedMove x y]
-> Transformation (QualifiedMove x y) positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> NPositions
-> [QualifiedMove x y]
-> TranspositionValue (QualifiedMove x y)
forall qualifiedMove.
Bool
-> NPositions
-> [qualifiedMove]
-> TranspositionValue qualifiedMove
Search.TranspositionValue.mkTranspositionValue Bool
isOptimal NPositions
nPlies ([QualifiedMove x y] -> Transformation x y positionHash)
-> [QualifiedMove x y] -> Transformation x y positionHash
forall a b. (a -> b) -> a -> b
$ (Turn x y -> QualifiedMove x y)
-> [Turn x y] -> [QualifiedMove x y]
forall a b. (a -> b) -> [a] -> [b]
map Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove [Turn x y]
turns
negaMax :: (
Enum x,
Enum y,
Ord positionHash,
Ord x,
Ord y,
Show x,
Show y
)
=> Type.Count.NPlies
-> Search.SearchState.SearchState x y positionHash
-> Input.SearchOptions.Reader (Result x y positionHash)
{-# SPECIALISE negaMax :: Type.Count.NPlies -> Search.SearchState.SearchState Type.Length.X Type.Length.Y Type.Crypto.PositionHash -> Input.SearchOptions.Reader (Result Type.Length.X Type.Length.Y Type.Crypto.PositionHash) #-}
negaMax :: NPositions
-> SearchState x y positionHash -> Reader (Result x y positionHash)
negaMax NPositions
initialSearchDepth SearchState x y positionHash
initialSearchState = do
Maybe NPositions
maybeMinimumTranspositionSearchDepth <- (SearchOptions -> Maybe NPositions)
-> ReaderT SearchOptions Identity (Maybe NPositions)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Control.Monad.Reader.asks SearchOptions -> Maybe NPositions
Input.SearchOptions.maybeMinimumTranspositionSearchDepth
Bool
recordKillerMoves <- (SearchOptions -> Bool) -> ReaderT SearchOptions Identity Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Control.Monad.Reader.asks SearchOptions -> Bool
Input.SearchOptions.recordKillerMoves
Bool
trapRepeatedPositions <- (SearchOptions -> Bool) -> ReaderT SearchOptions Identity Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Control.Monad.Reader.asks SearchOptions -> Bool
Input.SearchOptions.getTrapRepeatedPositions
let
getNPlies :: Game x y -> NPositions
getNPlies = TurnsByLogicalColour (Turn x y) -> NPositions
forall turn. TurnsByLogicalColour turn -> NPositions
State.TurnsByLogicalColour.getNPlies (TurnsByLogicalColour (Turn x y) -> NPositions)
-> (Game x y -> TurnsByLogicalColour (Turn x y))
-> Game x y
-> NPositions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game x y -> TurnsByLogicalColour (Turn x y)
forall x y. Game x y -> TurnsByLogicalColour x y
Model.Game.getTurnsByLogicalColour
descend :: (Maybe (QuantifiedGame x y), Maybe (QuantifiedGame x y))
-> NPositions
-> SearchState x y positionHash
-> Result x y positionHash
descend (Maybe (QuantifiedGame x y)
maybeAlphaQuantifiedGame, Maybe (QuantifiedGame x y)
maybeBetaQuantifiedGame) NPositions
searchDepth SearchState x y positionHash
searchState
| NPositions
searchDepth NPositions -> NPositions -> Bool
forall a. Eq a => a -> a -> Bool
== NPositions
0 Bool -> Bool -> Bool
|| Game x y -> Bool
forall x y. Game x y -> Bool
Model.Game.isTerminated Game x y
game = MkResult :: forall x y positionHash.
DynamicMoveData x y positionHash
-> QuantifiedGame x y -> NPositions -> Result x y positionHash
MkResult {
getDynamicMoveData :: DynamicMoveData x y positionHash
getDynamicMoveData = DynamicMoveData x y positionHash
dynamicMoveData,
getQuantifiedGame :: QuantifiedGame x y
getQuantifiedGame = QuantifiedGame x y -> QuantifiedGame x y
forall x y. QuantifiedGame x y -> QuantifiedGame x y
Evaluation.QuantifiedGame.negateFitness QuantifiedGame x y
quantifiedGame,
getNPositionsEvaluated :: NPositions
getNPositionsEvaluated = NPositions
1
}
| Bool
useTranspositions
, Just TranspositionValue (QualifiedMove x y)
transpositionValue <- positionHash
-> Transpositions (QualifiedMove x y) positionHash
-> Maybe (TranspositionValue (QualifiedMove x y))
forall positionHash qualifiedMove.
Ord positionHash =>
positionHash
-> Transpositions qualifiedMove positionHash
-> Maybe (TranspositionValue qualifiedMove)
Search.Transpositions.find positionHash
positionHash (Transpositions (QualifiedMove x y) positionHash
-> Maybe (TranspositionValue (QualifiedMove x y)))
-> Transpositions (QualifiedMove x y) positionHash
-> Maybe (TranspositionValue (QualifiedMove x y))
forall a b. (a -> b) -> a -> b
$ DynamicMoveData x y positionHash
-> Transpositions (QualifiedMove x y) positionHash
forall x y positionHash.
DynamicMoveData x y positionHash
-> Transpositions (QualifiedMove x y) positionHash
Search.DynamicMoveData.getTranspositions DynamicMoveData x y positionHash
dynamicMoveData
, let
selectMaxUsingTranspositions :: Result x y positionHash
selectMaxUsingTranspositions = (Forest x y positionHash -> Forest x y positionHash)
-> Result x y positionHash
selectMaxWithSorter ((Forest x y positionHash -> Forest x y positionHash)
-> Result x y positionHash)
-> (Forest x y positionHash -> Forest x y positionHash)
-> Result x y positionHash
forall a b. (a -> b) -> a -> b
$ Forest x y positionHash
-> Maybe (Forest x y positionHash) -> Forest x y positionHash
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (
Exception -> Forest x y positionHash
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Forest x y positionHash)
-> (String -> Exception) -> String -> Forest x y positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkSearchFailure (String -> Exception) -> (String -> String) -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
"BishBosh.Search.AlphaBeta.negaMax.descend:\tEvaluation.PositionHashQuantifiedGameTree.promoteMatchingMoves failed; " (String -> Forest x y positionHash)
-> String -> Forest x y positionHash
forall a b. (a -> b) -> a -> b
$ TranspositionValue (QualifiedMove x y) -> String -> String
forall a. Show a => a -> String -> String
shows TranspositionValue (QualifiedMove x y)
transpositionValue String
"."
) (Maybe (Forest x y positionHash) -> Forest x y positionHash)
-> (Forest x y positionHash -> Maybe (Forest x y positionHash))
-> Forest x y positionHash
-> Forest x y positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [QualifiedMove x y]
-> Forest x y positionHash -> Maybe (Forest x y positionHash)
forall x y positionHash.
(Eq x, Eq y) =>
[QualifiedMove x y]
-> Forest x y positionHash -> Maybe (Forest x y positionHash)
Evaluation.PositionHashQuantifiedGameTree.promoteMatchingMoves (
TranspositionValue (QualifiedMove x y) -> [QualifiedMove x y]
forall qualifiedMove.
TranspositionValue qualifiedMove -> [qualifiedMove]
Search.TranspositionValue.getQualifiedMoves TranspositionValue (QualifiedMove x y)
transpositionValue
)
= if TranspositionValue (QualifiedMove x y) -> NPositions
forall qualifiedMove.
TranspositionValue qualifiedMove -> NPositions
Search.TranspositionValue.inferSearchDepth TranspositionValue (QualifiedMove x y)
transpositionValue NPositions -> NPositions -> Bool
forall a. Ord a => a -> a -> Bool
< NPositions
searchDepth
then Result x y positionHash
selectMaxUsingTranspositions
else let
transposedQuantifiedGame :: QuantifiedGame x y
transposedQuantifiedGame = PositionHashQuantifiedGameTree x y positionHash
-> TranspositionValue (QualifiedMove x y) -> QuantifiedGame x y
forall x y positionHash.
(Eq x, Eq y, Enum x, Enum y, Show x, Show y) =>
PositionHashQuantifiedGameTree x y positionHash
-> TranspositionValue (QualifiedMove x y) -> QuantifiedGame x y
findTranspositionTerminalQuantifiedGame PositionHashQuantifiedGameTree x y positionHash
positionHashQuantifiedGameTree TranspositionValue (QualifiedMove x y)
transpositionValue
in if TranspositionValue (QualifiedMove x y) -> Bool
forall qualifiedMove. TranspositionValue qualifiedMove -> Bool
Search.TranspositionValue.getIsOptimal TranspositionValue (QualifiedMove x y)
transpositionValue
then MkResult :: forall x y positionHash.
DynamicMoveData x y positionHash
-> QuantifiedGame x y -> NPositions -> Result x y positionHash
MkResult {
getDynamicMoveData :: DynamicMoveData x y positionHash
getDynamicMoveData = DynamicMoveData x y positionHash
dynamicMoveData,
getQuantifiedGame :: QuantifiedGame x y
getQuantifiedGame = Bool -> QuantifiedGame x y -> QuantifiedGame x y
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (QuantifiedGame x y
transposedQuantifiedGame QuantifiedGame x y -> QuantifiedGame x y -> Bool
forall a. Eq a => a -> a -> Bool
== Result x y positionHash -> QuantifiedGame x y
forall x y positionHash.
Result x y positionHash -> QuantifiedGame x y
getQuantifiedGame Result x y positionHash
selectMaxUsingTranspositions) QuantifiedGame x y
transposedQuantifiedGame,
getNPositionsEvaluated :: NPositions
getNPositionsEvaluated = NPositions
0
}
else Result x y positionHash
-> (QuantifiedGame x y -> Result x y positionHash)
-> Maybe (QuantifiedGame x y)
-> Result x y positionHash
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Result x y positionHash
selectMaxUsingTranspositions (
\QuantifiedGame x y
betaQuantifiedGame -> if QuantifiedGame x y -> QuantifiedGame x y -> Ordering
forall x y. QuantifiedGame x y -> QuantifiedGame x y -> Ordering
Evaluation.QuantifiedGame.compareFitness QuantifiedGame x y
transposedQuantifiedGame QuantifiedGame x y
betaQuantifiedGame Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT
then Result x y positionHash
selectMaxUsingTranspositions
else MkResult :: forall x y positionHash.
DynamicMoveData x y positionHash
-> QuantifiedGame x y -> NPositions -> Result x y positionHash
MkResult {
getDynamicMoveData :: DynamicMoveData x y positionHash
getDynamicMoveData = DynamicMoveData x y positionHash
dynamicMoveData,
getQuantifiedGame :: QuantifiedGame x y
getQuantifiedGame = Bool -> QuantifiedGame x y -> QuantifiedGame x y
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (QuantifiedGame x y
betaQuantifiedGame QuantifiedGame x y -> QuantifiedGame x y -> Bool
forall a. Eq a => a -> a -> Bool
== Result x y positionHash -> QuantifiedGame x y
forall x y positionHash.
Result x y positionHash -> QuantifiedGame x y
getQuantifiedGame Result x y positionHash
selectMaxUsingTranspositions) QuantifiedGame x y
betaQuantifiedGame,
getNPositionsEvaluated :: NPositions
getNPositionsEvaluated = NPositions
0
}
) Maybe (QuantifiedGame x y)
maybeBetaQuantifiedGame
| Bool
otherwise = (Forest x y positionHash -> Forest x y positionHash)
-> Result x y positionHash
selectMaxWithSorter Forest x y positionHash -> Forest x y positionHash
forall a. a -> a
id
where
(PositionHashQuantifiedGameTree x y positionHash
positionHashQuantifiedGameTree, DynamicMoveData x y positionHash
dynamicMoveData) = SearchState x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
forall x y positionHash.
SearchState x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
Search.SearchState.getPositionHashQuantifiedGameTree (SearchState x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash)
-> (SearchState x y positionHash
-> DynamicMoveData x y positionHash)
-> SearchState x y positionHash
-> (PositionHashQuantifiedGameTree x y positionHash,
DynamicMoveData x y positionHash)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& SearchState x y positionHash -> DynamicMoveData x y positionHash
forall x y positionHash.
SearchState x y positionHash -> DynamicMoveData x y positionHash
Search.SearchState.getDynamicMoveData (SearchState x y positionHash
-> (PositionHashQuantifiedGameTree x y positionHash,
DynamicMoveData x y positionHash))
-> SearchState x y positionHash
-> (PositionHashQuantifiedGameTree x y positionHash,
DynamicMoveData x y positionHash)
forall a b. (a -> b) -> a -> b
$ SearchState x y positionHash
searchState
useTranspositions :: Bool
useTranspositions = Bool -> (NPositions -> Bool) -> Maybe NPositions -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False (NPositions
searchDepth NPositions -> NPositions -> Bool
forall a. Ord a => a -> a -> Bool
>=) Maybe NPositions
maybeMinimumTranspositionSearchDepth
(positionHash
positionHash, QuantifiedGame x y
quantifiedGame) = PositionHashQuantifiedGameTree x y positionHash -> positionHash
forall x y positionHash.
PositionHashQuantifiedGameTree x y positionHash -> positionHash
Evaluation.PositionHashQuantifiedGameTree.getRootPositionHash (PositionHashQuantifiedGameTree x y positionHash -> positionHash)
-> (PositionHashQuantifiedGameTree x y positionHash
-> QuantifiedGame x y)
-> PositionHashQuantifiedGameTree x y positionHash
-> (positionHash, QuantifiedGame x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& PositionHashQuantifiedGameTree x y positionHash
-> QuantifiedGame x y
forall x y positionHash.
PositionHashQuantifiedGameTree x y positionHash
-> QuantifiedGame x y
Evaluation.PositionHashQuantifiedGameTree.getRootQuantifiedGame (PositionHashQuantifiedGameTree x y positionHash
-> (positionHash, QuantifiedGame x y))
-> PositionHashQuantifiedGameTree x y positionHash
-> (positionHash, QuantifiedGame x y)
forall a b. (a -> b) -> a -> b
$ PositionHashQuantifiedGameTree x y positionHash
positionHashQuantifiedGameTree
game :: Game x y
game = QuantifiedGame x y -> Game x y
forall x y. QuantifiedGame x y -> Game x y
Evaluation.QuantifiedGame.getGame QuantifiedGame x y
quantifiedGame
(NPositions
nPlies, NPositions
nDistinctPositions) = Game x y -> NPositions
forall x y. Game x y -> NPositions
getNPlies (Game x y -> NPositions)
-> (Game x y -> NPositions) -> Game x y -> (NPositions, NPositions)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& InstancesByPosition (Position x y) -> NPositions
forall position. InstancesByPosition position -> NPositions
State.InstancesByPosition.getNDistinctPositions (InstancesByPosition (Position x y) -> NPositions)
-> (Game x y -> InstancesByPosition (Position x y))
-> Game x y
-> NPositions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game x y -> InstancesByPosition (Position x y)
forall x y. Game x y -> InstancesByPosition x y
Model.Game.getInstancesByPosition (Game x y -> (NPositions, NPositions))
-> Game x y -> (NPositions, NPositions)
forall a b. (a -> b) -> a -> b
$ Game x y
game
selectMaxWithSorter :: (Forest x y positionHash -> Forest x y positionHash)
-> Result x y positionHash
selectMaxWithSorter Forest x y positionHash -> Forest x y positionHash
forestSorter = DynamicMoveData x y positionHash
-> Maybe (QuantifiedGame x y)
-> Forest x y positionHash
-> Result x y positionHash
selectMax DynamicMoveData x y positionHash
dynamicMoveData Maybe (QuantifiedGame x y)
maybeAlphaQuantifiedGame (Forest x y positionHash -> Result x y positionHash)
-> (Tree (NodeLabel x y positionHash) -> Forest x y positionHash)
-> Tree (NodeLabel x y positionHash)
-> Result x y positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Forest x y positionHash -> Forest x y positionHash
forestSorter (Forest x y positionHash -> Forest x y positionHash)
-> (Tree (NodeLabel x y positionHash) -> Forest x y positionHash)
-> Tree (NodeLabel x y positionHash)
-> Forest x y positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
if Bool
recordKillerMoves
then (Forest x y positionHash -> Forest x y positionHash)
-> Forest x y positionHash -> Forest x y positionHash
forall x y positionHash.
(Forest x y positionHash -> Forest x y positionHash)
-> Forest x y positionHash -> Forest x y positionHash
Evaluation.PositionHashQuantifiedGameTree.sortNonCaptureMoves (
LogicalColour
-> (Tree (NodeLabel x y positionHash) -> KillerMoveKey x y)
-> KillerMoves (KillerMoveKey x y)
-> Forest x y positionHash
-> Forest x y positionHash
forall killerMoveKey a.
Ord killerMoveKey =>
LogicalColour
-> (a -> killerMoveKey) -> KillerMoves killerMoveKey -> [a] -> [a]
Search.KillerMoves.sortByHistoryHeuristic (
Game x y -> LogicalColour
forall x y. Game x y -> LogicalColour
Model.Game.getNextLogicalColour Game x y
game
) (
Turn x y -> KillerMoveKey x y
forall x y. Turn x y -> KillerMoveKey x y
Search.DynamicMoveData.mkKillerMoveKeyFromTurn (Turn x y -> KillerMoveKey x y)
-> (Tree (NodeLabel x y positionHash) -> Turn x y)
-> Tree (NodeLabel x y positionHash)
-> KillerMoveKey x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame x y -> Turn x y
forall x y. QuantifiedGame x y -> Turn x y
Evaluation.QuantifiedGame.getLastTurn (QuantifiedGame x y -> Turn x y)
-> (Tree (NodeLabel x y positionHash) -> QuantifiedGame x y)
-> Tree (NodeLabel x y positionHash)
-> Turn x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (NodeLabel x y positionHash) -> QuantifiedGame x y
forall x y positionHash.
BarePositionHashQuantifiedGameTree x y positionHash
-> QuantifiedGame x y
Evaluation.PositionHashQuantifiedGameTree.getRootQuantifiedGame'
) (KillerMoves (KillerMoveKey x y)
-> Forest x y positionHash -> Forest x y positionHash)
-> KillerMoves (KillerMoveKey x y)
-> Forest x y positionHash
-> Forest x y positionHash
forall a b. (a -> b) -> a -> b
$ DynamicMoveData x y positionHash -> KillerMoves (KillerMoveKey x y)
forall x y positionHash.
DynamicMoveData x y positionHash -> KillerMoves (KillerMoveKey x y)
Search.DynamicMoveData.getKillerMoves DynamicMoveData x y positionHash
dynamicMoveData
)
else Forest x y positionHash -> Forest x y positionHash
forall a. a -> a
id
) (Forest x y positionHash -> Forest x y positionHash)
-> (Tree (NodeLabel x y positionHash) -> Forest x y positionHash)
-> Tree (NodeLabel x y positionHash)
-> Forest x y positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (NodeLabel x y positionHash) -> Forest x y positionHash
forall a. Tree a -> Forest a
Data.Tree.subForest (Tree (NodeLabel x y positionHash) -> Result x y positionHash)
-> Tree (NodeLabel x y positionHash) -> Result x y positionHash
forall a b. (a -> b) -> a -> b
$ PositionHashQuantifiedGameTree x y positionHash
-> Tree (NodeLabel x y positionHash)
forall x y positionHash.
PositionHashQuantifiedGameTree x y positionHash
-> BarePositionHashQuantifiedGameTree x y positionHash
Evaluation.PositionHashQuantifiedGameTree.deconstruct PositionHashQuantifiedGameTree x y positionHash
positionHashQuantifiedGameTree
selectMax :: DynamicMoveData x y positionHash
-> Maybe (QuantifiedGame x y)
-> Forest x y positionHash
-> Result x y positionHash
selectMax DynamicMoveData x y positionHash
dynamicMoveData' Maybe (QuantifiedGame x y)
maybeAlphaQuantifiedGame' (Tree (NodeLabel x y positionHash)
node : Forest x y positionHash
remainingNodes)
| Bool
trapRepeatedPositions
, NPositions
nDistinctPositions NPositions -> NPositions -> Bool
forall a. Ord a => a -> a -> Bool
>= NPositions -> NPositions
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPositions
State.InstancesByPosition.leastCyclicPlies
, InstancesByPosition (Position x y) -> NPositions
forall position. InstancesByPosition position -> NPositions
State.InstancesByPosition.getNDistinctPositions (
Game x y -> InstancesByPosition (Position x y)
forall x y. Game x y -> InstancesByPosition x y
Model.Game.getInstancesByPosition (Game x y -> InstancesByPosition (Position x y))
-> (QuantifiedGame x y -> Game x y)
-> QuantifiedGame x y
-> InstancesByPosition (Position x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame x y -> Game x y
forall x y. QuantifiedGame x y -> Game x y
Evaluation.QuantifiedGame.getGame (QuantifiedGame x y -> InstancesByPosition (Position x y))
-> QuantifiedGame x y -> InstancesByPosition (Position x y)
forall a b. (a -> b) -> a -> b
$ Tree (NodeLabel x y positionHash) -> QuantifiedGame x y
forall x y positionHash.
BarePositionHashQuantifiedGameTree x y positionHash
-> QuantifiedGame x y
Evaluation.PositionHashQuantifiedGameTree.getRootQuantifiedGame' Tree (NodeLabel x y positionHash)
node
) NPositions -> NPositions -> Bool
forall a. Eq a => a -> a -> Bool
== NPositions
nDistinctPositions = DynamicMoveData x y positionHash
-> Maybe (QuantifiedGame x y)
-> Forest x y positionHash
-> Result x y positionHash
selectMax DynamicMoveData x y positionHash
dynamicMoveData' (
Maybe (QuantifiedGame x y)
maybeAlphaQuantifiedGame' Maybe (QuantifiedGame x y)
-> Maybe (QuantifiedGame x y) -> Maybe (QuantifiedGame x y)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> QuantifiedGame x y -> Maybe (QuantifiedGame x y)
forall a. a -> Maybe a
Just QuantifiedGame x y
quantifiedGame''
) Forest x y positionHash
remainingNodes
| Just betaQuantifiedGame <- Maybe (QuantifiedGame x y)
maybeBetaQuantifiedGame
, let fitnessComparedWithBeta :: Ordering
fitnessComparedWithBeta = QuantifiedGame x y -> QuantifiedGame x y -> Ordering
forall x y. QuantifiedGame x y -> QuantifiedGame x y -> Ordering
Evaluation.QuantifiedGame.compareFitness QuantifiedGame x y
quantifiedGame'' QuantifiedGame x y
betaQuantifiedGame
, Ordering
fitnessComparedWithBeta Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT = Result x y positionHash
result'' {
getDynamicMoveData :: DynamicMoveData x y positionHash
getDynamicMoveData = let
game'' :: Game x y
game'' = QuantifiedGame x y -> Game x y
forall x y. QuantifiedGame x y -> Game x y
Evaluation.QuantifiedGame.getGame QuantifiedGame x y
quantifiedGame''
in (
if Bool
recordKillerMoves Bool -> Bool -> Bool
&& Bool -> Bool
not (
Ordering
fitnessComparedWithBeta Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ Bool -> Bool -> Bool
&& Game x y
game'' Game x y -> Game x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Game x y -> Game x y -> Bool
=~ QuantifiedGame x y -> Game x y
forall x y. QuantifiedGame x y -> Game x y
Evaluation.QuantifiedGame.getGame QuantifiedGame x y
betaQuantifiedGame
)
then Game x y -> Transformation x y positionHash
forall x y positionHash.
(Ord x, Ord y, Enum x, Enum y, Show x, Show y) =>
Game x y -> Transformation x y positionHash
updateKillerMoves Game x y
game''
else Transformation x y positionHash
forall a. a -> a
id
) DynamicMoveData x y positionHash
dynamicMoveData'',
getQuantifiedGame :: QuantifiedGame x y
getQuantifiedGame = QuantifiedGame x y
betaQuantifiedGame
}
| Bool
otherwise = NPositions -> Transformation x y positionHash
forall x y positionHash.
NPositions -> Transformation x y positionHash
addNPositionsToResult (
Result x y positionHash -> NPositions
forall x y positionHash. Result x y positionHash -> NPositions
getNPositionsEvaluated Result x y positionHash
result''
) Transformation x y positionHash -> Transformation x y positionHash
forall a b. (a -> b) -> a -> b
$ let
isFitter :: Bool
isFitter = Bool
-> (QuantifiedGame x y -> Bool)
-> Maybe (QuantifiedGame x y)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
True (
\QuantifiedGame x y
alphaQuantifiedGame -> case QuantifiedGame x y
quantifiedGame'' QuantifiedGame x y -> QuantifiedGame x y -> Ordering
forall x y. QuantifiedGame x y -> QuantifiedGame x y -> Ordering
`Evaluation.QuantifiedGame.compareFitness` QuantifiedGame x y
alphaQuantifiedGame of
Ordering
LT -> Bool
False
Ordering
GT -> Bool
True
Ordering
EQ -> (NPositions -> NPositions -> Bool)
-> (NPositions, NPositions) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry NPositions -> NPositions -> Bool
forall a. Ord a => a -> a -> Bool
(<) ((NPositions, NPositions) -> Bool)
-> ((QuantifiedGame x y -> NPositions) -> (NPositions, NPositions))
-> (QuantifiedGame x y -> NPositions)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
((QuantifiedGame x y -> NPositions)
-> QuantifiedGame x y -> NPositions
forall a b. (a -> b) -> a -> b
$ QuantifiedGame x y
quantifiedGame'') ((QuantifiedGame x y -> NPositions) -> NPositions)
-> ((QuantifiedGame x y -> NPositions) -> NPositions)
-> (QuantifiedGame x y -> NPositions)
-> (NPositions, NPositions)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((QuantifiedGame x y -> NPositions)
-> QuantifiedGame x y -> NPositions
forall a b. (a -> b) -> a -> b
$ QuantifiedGame x y
alphaQuantifiedGame)
) ((QuantifiedGame x y -> NPositions) -> Bool)
-> (QuantifiedGame x y -> NPositions) -> Bool
forall a b. (a -> b) -> a -> b
$ Game x y -> NPositions
forall x y. Game x y -> NPositions
getNPlies (Game x y -> NPositions)
-> (QuantifiedGame x y -> Game x y)
-> QuantifiedGame x y
-> NPositions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame x y -> Game x y
forall x y. QuantifiedGame x y -> Game x y
Evaluation.QuantifiedGame.getGame
) Maybe (QuantifiedGame x y)
maybeAlphaQuantifiedGame'
in DynamicMoveData x y positionHash
-> Maybe (QuantifiedGame x y)
-> Forest x y positionHash
-> Result x y positionHash
selectMax (
(
if Bool
useTranspositions Bool -> Bool -> Bool
&& Bool
isFitter
then Bool
-> NPositions
-> positionHash
-> [Turn x y]
-> PositionHashQuantifiedGameTree x y positionHash
-> Transformation x y positionHash
forall x y positionHash.
(Eq x, Eq y, Enum x, Enum y, Ord positionHash, Show x, Show y) =>
Bool
-> NPositions
-> positionHash
-> [Turn x y]
-> PositionHashQuantifiedGameTree x y positionHash
-> Transformation x y positionHash
updateTranspositions Bool
False NPositions
nPlies positionHash
positionHash (
NPositions -> QuantifiedGame x y -> [Turn x y]
forall x y. NPositions -> QuantifiedGame x y -> [Turn x y]
Evaluation.QuantifiedGame.getLatestTurns NPositions
nPlies QuantifiedGame x y
quantifiedGame''
) PositionHashQuantifiedGameTree x y positionHash
positionHashQuantifiedGameTree
else Transformation x y positionHash
forall a. a -> a
id
) DynamicMoveData x y positionHash
dynamicMoveData''
) (
if Bool
isFitter
then QuantifiedGame x y -> Maybe (QuantifiedGame x y)
forall a. a -> Maybe a
Just QuantifiedGame x y
quantifiedGame''
else Maybe (QuantifiedGame x y)
maybeAlphaQuantifiedGame'
) Forest x y positionHash
remainingNodes
where
result'' :: Result x y positionHash
result''@MkResult {
getDynamicMoveData :: forall x y positionHash.
Result x y positionHash -> DynamicMoveData x y positionHash
getDynamicMoveData = DynamicMoveData x y positionHash
dynamicMoveData'',
getQuantifiedGame :: forall x y positionHash.
Result x y positionHash -> QuantifiedGame x y
getQuantifiedGame = QuantifiedGame x y
quantifiedGame''
} = Transformation x y positionHash
forall x y positionHash. Transformation x y positionHash
negateFitnessOfResult Transformation x y positionHash
-> (SearchState x y positionHash -> Result x y positionHash)
-> SearchState x y positionHash
-> Result x y positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (QuantifiedGame x y), Maybe (QuantifiedGame x y))
-> NPositions
-> SearchState x y positionHash
-> Result x y positionHash
descend (
((Maybe (QuantifiedGame x y), Maybe (QuantifiedGame x y))
-> (Maybe (QuantifiedGame x y), Maybe (QuantifiedGame x y)))
-> Maybe (QuantifiedGame x y)
-> Maybe (QuantifiedGame x y)
-> (Maybe (QuantifiedGame x y), Maybe (QuantifiedGame x y))
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Maybe (QuantifiedGame x y), Maybe (QuantifiedGame x y))
-> (Maybe (QuantifiedGame x y), Maybe (QuantifiedGame x y))
forall x y. OpenInterval x y -> OpenInterval x y
Evaluation.QuantifiedGame.negateInterval Maybe (QuantifiedGame x y)
maybeAlphaQuantifiedGame' Maybe (QuantifiedGame x y)
maybeBetaQuantifiedGame
) (
NPositions -> NPositions
forall a. Enum a => a -> a
pred NPositions
searchDepth
) (SearchState x y positionHash -> Result x y positionHash)
-> SearchState x y positionHash -> Result x y positionHash
forall a b. (a -> b) -> a -> b
$ PositionHashQuantifiedGameTree x y positionHash
-> DynamicMoveData x y positionHash -> SearchState x y positionHash
forall x y positionHash.
PositionHashQuantifiedGameTree x y positionHash
-> DynamicMoveData x y positionHash -> SearchState x y positionHash
Search.SearchState.mkSearchState (
Tree (NodeLabel x y positionHash)
-> PositionHashQuantifiedGameTree x y positionHash
forall x y positionHash.
BarePositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
Evaluation.PositionHashQuantifiedGameTree.fromBarePositionHashQuantifiedGameTree Tree (NodeLabel x y positionHash)
node
) DynamicMoveData x y positionHash
dynamicMoveData'
selectMax DynamicMoveData x y positionHash
dynamicMoveData' Maybe (QuantifiedGame x y)
maybeAlphaQuantifiedGame' [] = MkResult :: forall x y positionHash.
DynamicMoveData x y positionHash
-> QuantifiedGame x y -> NPositions -> Result x y positionHash
MkResult {
getDynamicMoveData :: DynamicMoveData x y positionHash
getDynamicMoveData = DynamicMoveData x y positionHash
dynamicMoveData',
getQuantifiedGame :: QuantifiedGame x y
getQuantifiedGame = QuantifiedGame x y
-> Maybe (QuantifiedGame x y) -> QuantifiedGame x y
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (
QuantifiedGame x y
-> Maybe (QuantifiedGame x y) -> QuantifiedGame x y
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (
Exception -> QuantifiedGame x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> QuantifiedGame x y)
-> (String -> Exception) -> String -> QuantifiedGame x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkResultUndefined (String -> Exception) -> (String -> String) -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
"BishBosh.Search.AlphaBeta.negaMax.descend.selectMax:\tthere are zero nodes to process, but neither alpha nor beta is defined; " (String -> QuantifiedGame x y) -> String -> QuantifiedGame x y
forall a b. (a -> b) -> a -> b
$ Game x y -> String -> String
forall a. Show a => a -> String -> String
shows Game x y
game String
"."
) Maybe (QuantifiedGame x y)
maybeBetaQuantifiedGame
) Maybe (QuantifiedGame x y)
maybeAlphaQuantifiedGame',
getNPositionsEvaluated :: NPositions
getNPositionsEvaluated = NPositions
0
}
Result x y positionHash -> Reader (Result x y positionHash)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result x y positionHash -> Reader (Result x y positionHash))
-> (Result x y positionHash -> Result x y positionHash)
-> Result x y positionHash
-> Reader (Result x y positionHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
\result :: Result x y positionHash
result@MkResult {
getDynamicMoveData :: forall x y positionHash.
Result x y positionHash -> DynamicMoveData x y positionHash
getDynamicMoveData = DynamicMoveData x y positionHash
dynamicMoveData,
getQuantifiedGame :: forall x y positionHash.
Result x y positionHash -> QuantifiedGame x y
getQuantifiedGame = QuantifiedGame x y
quantifiedGame
} -> let
positionHashQuantifiedGameTree :: PositionHashQuantifiedGameTree x y positionHash
positionHashQuantifiedGameTree = SearchState x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
forall x y positionHash.
SearchState x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
Search.SearchState.getPositionHashQuantifiedGameTree SearchState x y positionHash
initialSearchState
nPlies :: NPositions
nPlies = Game x y -> NPositions
forall x y. Game x y -> NPositions
getNPlies (Game x y -> NPositions)
-> (QuantifiedGame x y -> Game x y)
-> QuantifiedGame x y
-> NPositions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame x y -> Game x y
forall x y. QuantifiedGame x y -> Game x y
Evaluation.QuantifiedGame.getGame (QuantifiedGame x y -> NPositions)
-> QuantifiedGame x y -> NPositions
forall a b. (a -> b) -> a -> b
$ PositionHashQuantifiedGameTree x y positionHash
-> QuantifiedGame x y
forall x y positionHash.
PositionHashQuantifiedGameTree x y positionHash
-> QuantifiedGame x y
Evaluation.PositionHashQuantifiedGameTree.getRootQuantifiedGame PositionHashQuantifiedGameTree x y positionHash
positionHashQuantifiedGameTree
in Result x y positionHash
result {
getDynamicMoveData :: DynamicMoveData x y positionHash
getDynamicMoveData = Bool
-> NPositions
-> positionHash
-> [Turn x y]
-> PositionHashQuantifiedGameTree x y positionHash
-> Transformation x y positionHash
forall x y positionHash.
(Eq x, Eq y, Enum x, Enum y, Ord positionHash, Show x, Show y) =>
Bool
-> NPositions
-> positionHash
-> [Turn x y]
-> PositionHashQuantifiedGameTree x y positionHash
-> Transformation x y positionHash
updateTranspositions Bool
True NPositions
nPlies (
PositionHashQuantifiedGameTree x y positionHash -> positionHash
forall x y positionHash.
PositionHashQuantifiedGameTree x y positionHash -> positionHash
Evaluation.PositionHashQuantifiedGameTree.getRootPositionHash PositionHashQuantifiedGameTree x y positionHash
positionHashQuantifiedGameTree
) (
NPositions -> QuantifiedGame x y -> [Turn x y]
forall x y. NPositions -> QuantifiedGame x y -> [Turn x y]
Evaluation.QuantifiedGame.getLatestTurns NPositions
nPlies QuantifiedGame x y
quantifiedGame
) PositionHashQuantifiedGameTree x y positionHash
positionHashQuantifiedGameTree DynamicMoveData x y positionHash
dynamicMoveData
}
) (Result x y positionHash -> Reader (Result x y positionHash))
-> Result x y positionHash -> Reader (Result x y positionHash)
forall a b. (a -> b) -> a -> b
$ (Maybe (QuantifiedGame x y), Maybe (QuantifiedGame x y))
-> NPositions
-> SearchState x y positionHash
-> Result x y positionHash
forall x y positionHash.
(Ord positionHash, Ord x, Ord y, Enum x, Enum y, Show x, Show y) =>
(Maybe (QuantifiedGame x y), Maybe (QuantifiedGame x y))
-> NPositions
-> SearchState x y positionHash
-> Result x y positionHash
descend (Maybe (QuantifiedGame x y), Maybe (QuantifiedGame x y))
forall x y. OpenInterval x y
Evaluation.QuantifiedGame.unboundedInterval NPositions
initialSearchDepth SearchState x y positionHash
initialSearchState
type Transformation x y positionHash = Result x y positionHash -> Result x y positionHash
negateFitnessOfResult :: Transformation x y positionHash
negateFitnessOfResult :: Transformation x y positionHash
negateFitnessOfResult result :: Result x y positionHash
result@MkResult { getQuantifiedGame :: forall x y positionHash.
Result x y positionHash -> QuantifiedGame x y
getQuantifiedGame = QuantifiedGame x y
quantifiedGame } = Result x y positionHash
result {
getQuantifiedGame :: QuantifiedGame x y
getQuantifiedGame = QuantifiedGame x y -> QuantifiedGame x y
forall x y. QuantifiedGame x y -> QuantifiedGame x y
Evaluation.QuantifiedGame.negateFitness QuantifiedGame x y
quantifiedGame
}
addNPositionsToResult :: Type.Count.NPositions -> Transformation x y positionHash
addNPositionsToResult :: NPositions -> Transformation x y positionHash
addNPositionsToResult NPositions
nPositions result :: Result x y positionHash
result@MkResult { getNPositionsEvaluated :: forall x y positionHash. Result x y positionHash -> NPositions
getNPositionsEvaluated = NPositions
nPositionsEvaluated } = Bool -> Transformation x y positionHash
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (NPositions
nPositions NPositions -> NPositions -> Bool
forall a. Ord a => a -> a -> Bool
> NPositions
0) Result x y positionHash
result {
getNPositionsEvaluated :: NPositions
getNPositionsEvaluated = NPositions
nPositions NPositions -> NPositions -> NPositions
forall a. Num a => a -> a -> a
+ NPositions
nPositionsEvaluated
}