module BishBosh.Search.AlphaBeta(
extractSelectedTurns,
negaMax,
) where
import BishBosh.Model.Game((=~))
import Control.Arrow((&&&))
import qualified BishBosh.Component.Move as Component.Move
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.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 Control.Exception
import qualified Control.Monad.Reader
import qualified Data.Maybe
import qualified Data.Tree
data Result x y positionHash criterionValue weightedMean = MkResult {
Result x y positionHash criterionValue weightedMean
-> DynamicMoveData x y positionHash
getDynamicMoveData :: Search.DynamicMoveData.DynamicMoveData x y positionHash,
Result x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
getQuantifiedGame :: Evaluation.QuantifiedGame.QuantifiedGame x y criterionValue weightedMean,
Result x y positionHash criterionValue weightedMean -> NMoves
getNMovesEvaluated :: Component.Move.NMoves
}
extractSelectedTurns
:: Component.Move.NPlies
-> Result x y positionHash criterionValue weightedMean
-> (Search.DynamicMoveData.DynamicMoveData x y positionHash, [Component.Turn.Turn x y], Component.Move.NMoves)
NMoves
nPlies MkResult {
getDynamicMoveData :: forall x y positionHash criterionValue weightedMean.
Result x y positionHash criterionValue weightedMean
-> DynamicMoveData x y positionHash
getDynamicMoveData = DynamicMoveData x y positionHash
dynamicMoveData,
getQuantifiedGame :: forall x y positionHash criterionValue weightedMean.
Result x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
getQuantifiedGame = QuantifiedGame x y criterionValue weightedMean
quantifiedGame,
getNMovesEvaluated :: forall x y positionHash criterionValue weightedMean.
Result x y positionHash criterionValue weightedMean -> NMoves
getNMovesEvaluated = NMoves
nMovesEvaluated
} = (
DynamicMoveData x y positionHash
dynamicMoveData,
NMoves
-> QuantifiedGame x y criterionValue weightedMean -> [Turn x y]
forall x y criterionValue weightedMean.
NMoves
-> QuantifiedGame x y criterionValue weightedMean -> [Turn x y]
Evaluation.QuantifiedGame.getLatestTurns NMoves
nPlies QuantifiedGame x y criterionValue weightedMean
quantifiedGame,
NMoves
nMovesEvaluated
)
updateKillerMoves
:: (Ord x, Ord 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
. NMoves -> KillerMoveKey x y -> Transformation (KillerMoveKey x y)
forall killerMove.
Ord killerMove =>
NMoves -> killerMove -> Transformation killerMove
Search.KillerMoves.insert (
TurnsByLogicalColour (Turn x y) -> NMoves
forall turn. TurnsByLogicalColour turn -> NMoves
State.TurnsByLogicalColour.getNPlies (TurnsByLogicalColour (Turn x y) -> NMoves)
-> TurnsByLogicalColour (Turn x y) -> NMoves
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)
-> Exception -> Transformation x y positionHash
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkNullDatum String
"BishBosh.Search.AlphaBeta.updateKillerMoves:\tzero turns have been made."
findTranspositionTerminalQuantifiedGame :: (
Eq x,
Eq y,
Num weightedMean
)
=> Evaluation.PositionHashQuantifiedGameTree.PositionHashQuantifiedGameTree x y positionHash criterionValue weightedMean
-> Search.TranspositionValue.Value (Component.Move.Move x y)
-> Evaluation.QuantifiedGame.QuantifiedGame x y criterionValue weightedMean
findTranspositionTerminalQuantifiedGame :: PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> Value (Move x y)
-> QuantifiedGame x y criterionValue weightedMean
findTranspositionTerminalQuantifiedGame PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
positionHashQuantifiedGameTree Value (Move x y)
transpositionValue = QuantifiedGame x y criterionValue weightedMean
-> ([NodeLabel x y positionHash criterionValue weightedMean]
-> QuantifiedGame x y criterionValue weightedMean)
-> Maybe [NodeLabel x y positionHash criterionValue weightedMean]
-> QuantifiedGame x y criterionValue weightedMean
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
Exception -> QuantifiedGame x y criterionValue weightedMean
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> QuantifiedGame x y criterionValue weightedMean)
-> Exception -> QuantifiedGame x y criterionValue weightedMean
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkSearchFailure String
"BishBosh.Search.AlphaBeta.findTranspositionTerminalQuantifiedGame:\tEvaluation.PositionHashQuantifiedGameTree.traceMatchingMoves failed."
) (
(
if NMoves -> Bool
forall a. Integral a => a -> Bool
even (NMoves -> Bool) -> NMoves -> Bool
forall a b. (a -> b) -> a -> b
$ Value (Move x y) -> NMoves
forall move. Value move -> NMoves
Search.TranspositionValue.inferSearchDepth Value (Move x y)
transpositionValue
then QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
forall weightedMean x y criterionValue.
Num weightedMean =>
QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
Evaluation.QuantifiedGame.negateFitness
else QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
forall a. a -> a
id
) (QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean)
-> ([NodeLabel x y positionHash criterionValue weightedMean]
-> QuantifiedGame x y criterionValue weightedMean)
-> [NodeLabel x y positionHash criterionValue weightedMean]
-> QuantifiedGame x y criterionValue weightedMean
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeLabel x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
forall x y positionHash criterionValue weightedMean.
NodeLabel x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
Evaluation.PositionHashQuantifiedGameTree.getQuantifiedGame (NodeLabel x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean)
-> ([NodeLabel x y positionHash criterionValue weightedMean]
-> NodeLabel x y positionHash criterionValue weightedMean)
-> [NodeLabel x y positionHash criterionValue weightedMean]
-> QuantifiedGame x y criterionValue weightedMean
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NodeLabel x y positionHash criterionValue weightedMean]
-> NodeLabel x y positionHash criterionValue weightedMean
forall a. [a] -> a
last
) (Maybe [NodeLabel x y positionHash criterionValue weightedMean]
-> QuantifiedGame x y criterionValue weightedMean)
-> ([Move x y]
-> Maybe [NodeLabel x y positionHash criterionValue weightedMean])
-> [Move x y]
-> QuantifiedGame x y criterionValue weightedMean
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> [Move x y]
-> Maybe [NodeLabel x y positionHash criterionValue weightedMean]
forall x y positionHash criterionValue weightedMean.
(Eq x, Eq y) =>
PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> [Move x y]
-> Maybe [NodeLabel x y positionHash criterionValue weightedMean]
Evaluation.PositionHashQuantifiedGameTree.traceMatchingMoves PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
positionHashQuantifiedGameTree ([Move x y] -> QuantifiedGame x y criterionValue weightedMean)
-> [Move x y] -> QuantifiedGame x y criterionValue weightedMean
forall a b. (a -> b) -> a -> b
$ Value (Move x y) -> [Move x y]
forall move. Value move -> [move]
Search.TranspositionValue.getMoves Value (Move x y)
transpositionValue
updateTranspositions :: (
Eq x,
Eq y,
Num weightedMean,
Ord positionHash,
Ord weightedMean
)
=> Search.TranspositionValue.IsOptimal
-> Component.Move.NPlies
-> positionHash
-> [Component.Turn.Turn x y]
-> Evaluation.PositionHashQuantifiedGameTree.PositionHashQuantifiedGameTree x y positionHash criterionValue weightedMean
-> Search.DynamicMoveData.Transformation x y positionHash
updateTranspositions :: Bool
-> NMoves
-> positionHash
-> [Turn x y]
-> PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> Transformation x y positionHash
updateTranspositions Bool
isOptimal NMoves
nPlies positionHash
positionHash [Turn x y]
turns PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
positionHashQuantifiedGameTree = Transformation (Move x y) positionHash
-> Transformation x y positionHash
forall x y positionHash.
Transformation (Move x y) positionHash
-> Transformation x y positionHash
Search.DynamicMoveData.updateTranspositions (Transformation (Move x y) positionHash
-> Transformation x y positionHash)
-> Transformation (Move x y) positionHash
-> Transformation x y positionHash
forall a b. (a -> b) -> a -> b
$ FindFitness (Move x y) weightedMean
-> positionHash
-> Value (Move x y)
-> Transformation (Move x y) positionHash
forall positionHash weightedMean move.
(Ord positionHash, Ord weightedMean) =>
FindFitness move weightedMean
-> positionHash -> Value move -> Transformation move positionHash
Search.Transpositions.insert (
QuantifiedGame x y criterionValue weightedMean -> weightedMean
forall x y criterionValue weightedMean.
QuantifiedGame x y criterionValue weightedMean -> weightedMean
Evaluation.QuantifiedGame.getFitness (QuantifiedGame x y criterionValue weightedMean -> weightedMean)
-> (Value (Move x y)
-> QuantifiedGame x y criterionValue weightedMean)
-> FindFitness (Move x y) weightedMean
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> Value (Move x y)
-> QuantifiedGame x y criterionValue weightedMean
forall x y weightedMean positionHash criterionValue.
(Eq x, Eq y, Num weightedMean) =>
PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> Value (Move x y)
-> QuantifiedGame x y criterionValue weightedMean
findTranspositionTerminalQuantifiedGame PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
positionHashQuantifiedGameTree
) positionHash
positionHash (Value (Move x y) -> Transformation (Move x y) positionHash)
-> ([Move x y] -> Value (Move x y))
-> [Move x y]
-> Transformation (Move x y) positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> NMoves -> [Move x y] -> Value (Move x y)
forall move. Bool -> NMoves -> [move] -> Value move
Search.TranspositionValue.mkValue Bool
isOptimal NMoves
nPlies ([Move x y] -> Transformation (Move x y) positionHash)
-> [Move x y] -> Transformation (Move x y) positionHash
forall a b. (a -> b) -> a -> b
$ (Turn x y -> Move x y) -> [Turn x y] -> [Move x y]
forall a b. (a -> b) -> [a] -> [b]
map (
QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Move x y)
-> (Turn x y -> QualifiedMove x y) -> Turn x y -> Move x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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,
Eq criterionValue,
Num weightedMean,
Ord weightedMean,
Ord positionHash,
Ord x,
Ord y
)
=> Input.SearchOptions.SearchDepth
-> Search.SearchState.SearchState x y positionHash criterionValue weightedMean
-> Input.SearchOptions.Reader (Result x y positionHash criterionValue weightedMean)
negaMax :: NMoves
-> SearchState x y positionHash criterionValue weightedMean
-> Reader (Result x y positionHash criterionValue weightedMean)
negaMax NMoves
initialSearchDepth SearchState x y positionHash criterionValue weightedMean
initialSearchState = do
Maybe NMoves
maybeMinimumTranspositionSearchDepth <- (SearchOptions -> Maybe NMoves)
-> ReaderT SearchOptions Identity (Maybe NMoves)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Control.Monad.Reader.asks SearchOptions -> Maybe NMoves
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
descend :: (Maybe (QuantifiedGame x y criterionValue weightedMean),
Maybe (QuantifiedGame x y criterionValue weightedMean))
-> NMoves
-> SearchState x y positionHash criterionValue weightedMean
-> Result x y positionHash criterionValue weightedMean
descend (Maybe (QuantifiedGame x y criterionValue weightedMean)
maybeAlphaQuantifiedGame, Maybe (QuantifiedGame x y criterionValue weightedMean)
maybeBetaQuantifiedGame) NMoves
searchDepth SearchState x y positionHash criterionValue weightedMean
searchState
| NMoves
searchDepth NMoves -> NMoves -> Bool
forall a. Eq a => a -> a -> Bool
== NMoves
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 criterionValue weightedMean.
DynamicMoveData x y positionHash
-> QuantifiedGame x y criterionValue weightedMean
-> NMoves
-> Result x y positionHash criterionValue weightedMean
MkResult {
getDynamicMoveData :: DynamicMoveData x y positionHash
getDynamicMoveData = DynamicMoveData x y positionHash
dynamicMoveData,
getQuantifiedGame :: QuantifiedGame x y criterionValue weightedMean
getQuantifiedGame = QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
forall weightedMean x y criterionValue.
Num weightedMean =>
QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
Evaluation.QuantifiedGame.negateFitness QuantifiedGame x y criterionValue weightedMean
quantifiedGame,
getNMovesEvaluated :: NMoves
getNMovesEvaluated = NMoves
1
}
| Bool
useTranspositions
, Just Value (Move x y)
transpositionValue <- positionHash
-> Transpositions (Move x y) positionHash
-> Maybe (Value (Move x y))
forall positionHash move.
Ord positionHash =>
positionHash
-> Transpositions move positionHash -> Maybe (Value move)
Search.Transpositions.find positionHash
positionHash (Transpositions (Move x y) positionHash
-> Maybe (Value (Move x y)))
-> Transpositions (Move x y) positionHash
-> Maybe (Value (Move x y))
forall a b. (a -> b) -> a -> b
$ DynamicMoveData x y positionHash
-> Transpositions (Move x y) positionHash
forall x y positionHash.
DynamicMoveData x y positionHash
-> Transpositions (Move x y) positionHash
Search.DynamicMoveData.getTranspositions DynamicMoveData x y positionHash
dynamicMoveData
, let
selectMax'' :: Result x y positionHash criterionValue weightedMean
selectMax'' = (Forest x y positionHash criterionValue weightedMean
-> Forest x y positionHash criterionValue weightedMean)
-> Result x y positionHash criterionValue weightedMean
selectMax' ((Forest x y positionHash criterionValue weightedMean
-> Forest x y positionHash criterionValue weightedMean)
-> Result x y positionHash criterionValue weightedMean)
-> (Forest x y positionHash criterionValue weightedMean
-> Forest x y positionHash criterionValue weightedMean)
-> Result x y positionHash criterionValue weightedMean
forall a b. (a -> b) -> a -> b
$ Forest x y positionHash criterionValue weightedMean
-> Maybe (Forest x y positionHash criterionValue weightedMean)
-> Forest x y positionHash criterionValue weightedMean
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (
Exception -> Forest x y positionHash criterionValue weightedMean
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Forest x y positionHash criterionValue weightedMean)
-> Exception -> Forest x y positionHash criterionValue weightedMean
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkSearchFailure String
"BishBosh.Search.AlphaBeta.negaMax.descend:\tEvaluation.PositionHashQuantifiedGameTree.promoteMatchingMoves failed."
) (Maybe (Forest x y positionHash criterionValue weightedMean)
-> Forest x y positionHash criterionValue weightedMean)
-> (Forest x y positionHash criterionValue weightedMean
-> Maybe (Forest x y positionHash criterionValue weightedMean))
-> Forest x y positionHash criterionValue weightedMean
-> Forest x y positionHash criterionValue weightedMean
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Move x y]
-> Forest x y positionHash criterionValue weightedMean
-> Maybe (Forest x y positionHash criterionValue weightedMean)
forall x y positionHash criterionValue weightedMean.
(Eq x, Eq y) =>
[Move x y]
-> Forest x y positionHash criterionValue weightedMean
-> Maybe (Forest x y positionHash criterionValue weightedMean)
Evaluation.PositionHashQuantifiedGameTree.promoteMatchingMoves (Value (Move x y) -> [Move x y]
forall move. Value move -> [move]
Search.TranspositionValue.getMoves Value (Move x y)
transpositionValue)
= if Value (Move x y) -> NMoves
forall move. Value move -> NMoves
Search.TranspositionValue.inferSearchDepth Value (Move x y)
transpositionValue NMoves -> NMoves -> Bool
forall a. Ord a => a -> a -> Bool
< NMoves
searchDepth
then Result x y positionHash criterionValue weightedMean
selectMax''
else let
transposedQuantifiedGame :: QuantifiedGame x y criterionValue weightedMean
transposedQuantifiedGame = PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> Value (Move x y)
-> QuantifiedGame x y criterionValue weightedMean
forall x y weightedMean positionHash criterionValue.
(Eq x, Eq y, Num weightedMean) =>
PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> Value (Move x y)
-> QuantifiedGame x y criterionValue weightedMean
findTranspositionTerminalQuantifiedGame PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
positionHashQuantifiedGameTree Value (Move x y)
transpositionValue
in if Value (Move x y) -> Bool
forall move. Value move -> Bool
Search.TranspositionValue.getIsOptimal Value (Move x y)
transpositionValue
then MkResult :: forall x y positionHash criterionValue weightedMean.
DynamicMoveData x y positionHash
-> QuantifiedGame x y criterionValue weightedMean
-> NMoves
-> Result x y positionHash criterionValue weightedMean
MkResult {
getDynamicMoveData :: DynamicMoveData x y positionHash
getDynamicMoveData = DynamicMoveData x y positionHash
dynamicMoveData,
getQuantifiedGame :: QuantifiedGame x y criterionValue weightedMean
getQuantifiedGame = Bool
-> QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (QuantifiedGame x y criterionValue weightedMean
transposedQuantifiedGame QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean -> Bool
forall a. Eq a => a -> a -> Bool
== Result x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
forall x y positionHash criterionValue weightedMean.
Result x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
getQuantifiedGame Result x y positionHash criterionValue weightedMean
selectMax'') QuantifiedGame x y criterionValue weightedMean
transposedQuantifiedGame,
getNMovesEvaluated :: NMoves
getNMovesEvaluated = NMoves
0
}
else Result x y positionHash criterionValue weightedMean
-> (QuantifiedGame x y criterionValue weightedMean
-> Result x y positionHash criterionValue weightedMean)
-> Maybe (QuantifiedGame x y criterionValue weightedMean)
-> Result x y positionHash criterionValue weightedMean
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Result x y positionHash criterionValue weightedMean
selectMax'' (
\QuantifiedGame x y criterionValue weightedMean
betaQuantifiedGame -> if QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean -> Ordering
forall weightedMean x y criterionValue.
Ord weightedMean =>
QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean -> Ordering
Evaluation.QuantifiedGame.compareFitness QuantifiedGame x y criterionValue weightedMean
transposedQuantifiedGame QuantifiedGame x y criterionValue weightedMean
betaQuantifiedGame Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT
then MkResult :: forall x y positionHash criterionValue weightedMean.
DynamicMoveData x y positionHash
-> QuantifiedGame x y criterionValue weightedMean
-> NMoves
-> Result x y positionHash criterionValue weightedMean
MkResult {
getDynamicMoveData :: DynamicMoveData x y positionHash
getDynamicMoveData = DynamicMoveData x y positionHash
dynamicMoveData,
getQuantifiedGame :: QuantifiedGame x y criterionValue weightedMean
getQuantifiedGame = Bool
-> QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (QuantifiedGame x y criterionValue weightedMean
betaQuantifiedGame QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean -> Bool
forall a. Eq a => a -> a -> Bool
== Result x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
forall x y positionHash criterionValue weightedMean.
Result x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
getQuantifiedGame Result x y positionHash criterionValue weightedMean
selectMax'') QuantifiedGame x y criterionValue weightedMean
betaQuantifiedGame,
getNMovesEvaluated :: NMoves
getNMovesEvaluated = NMoves
0
}
else Result x y positionHash criterionValue weightedMean
selectMax''
) Maybe (QuantifiedGame x y criterionValue weightedMean)
maybeBetaQuantifiedGame
| Bool
otherwise = (Forest x y positionHash criterionValue weightedMean
-> Forest x y positionHash criterionValue weightedMean)
-> Result x y positionHash criterionValue weightedMean
selectMax' Forest x y positionHash criterionValue weightedMean
-> Forest x y positionHash criterionValue weightedMean
forall a. a -> a
id
where
(PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
positionHashQuantifiedGameTree, DynamicMoveData x y positionHash
dynamicMoveData) = SearchState x y positionHash criterionValue weightedMean
-> PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
forall x y positionHash criterionValue weightedMean.
SearchState x y positionHash criterionValue weightedMean
-> PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
Search.SearchState.getPositionHashQuantifiedGameTree (SearchState x y positionHash criterionValue weightedMean
-> PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean)
-> (SearchState x y positionHash criterionValue weightedMean
-> DynamicMoveData x y positionHash)
-> SearchState x y positionHash criterionValue weightedMean
-> (PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean,
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 criterionValue weightedMean
-> DynamicMoveData x y positionHash
forall x y positionHash criterionValue weightedMean.
SearchState x y positionHash criterionValue weightedMean
-> DynamicMoveData x y positionHash
Search.SearchState.getDynamicMoveData (SearchState x y positionHash criterionValue weightedMean
-> (PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean,
DynamicMoveData x y positionHash))
-> SearchState x y positionHash criterionValue weightedMean
-> (PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean,
DynamicMoveData x y positionHash)
forall a b. (a -> b) -> a -> b
$ SearchState x y positionHash criterionValue weightedMean
searchState
useTranspositions :: Bool
useTranspositions = Bool -> (NMoves -> Bool) -> Maybe NMoves -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False (NMoves
searchDepth NMoves -> NMoves -> Bool
forall a. Ord a => a -> a -> Bool
>=) Maybe NMoves
maybeMinimumTranspositionSearchDepth
(positionHash
positionHash, QuantifiedGame x y criterionValue weightedMean
quantifiedGame) = PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> positionHash
forall x y positionHash criterionValue weightedMean.
PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> positionHash
Evaluation.PositionHashQuantifiedGameTree.getRootPositionHash (PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> positionHash)
-> (PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean)
-> PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> (positionHash, QuantifiedGame x y criterionValue weightedMean)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
forall x y positionHash criterionValue weightedMean.
PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
Evaluation.PositionHashQuantifiedGameTree.getRootQuantifiedGame (PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> (positionHash, QuantifiedGame x y criterionValue weightedMean))
-> PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> (positionHash, QuantifiedGame x y criterionValue weightedMean)
forall a b. (a -> b) -> a -> b
$ PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
positionHashQuantifiedGameTree
game :: Game x y
game = QuantifiedGame x y criterionValue weightedMean -> Game x y
forall x y criterionValue weightedMean.
QuantifiedGame x y criterionValue weightedMean -> Game x y
Evaluation.QuantifiedGame.getGame QuantifiedGame x y criterionValue weightedMean
quantifiedGame
(NMoves
nPlies, NMoves
nDistinctPositions) = TurnsByLogicalColour (Turn x y) -> NMoves
forall turn. TurnsByLogicalColour turn -> NMoves
State.TurnsByLogicalColour.getNPlies (TurnsByLogicalColour (Turn x y) -> NMoves)
-> (Game x y -> TurnsByLogicalColour (Turn x y))
-> Game x y
-> NMoves
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 (Game x y -> NMoves)
-> (Game x y -> NMoves) -> Game x y -> (NMoves, NMoves)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& InstancesByPosition (Position x y) -> NMoves
forall position. InstancesByPosition position -> NMoves
State.InstancesByPosition.getNDistinctPositions (InstancesByPosition (Position x y) -> NMoves)
-> (Game x y -> InstancesByPosition (Position x y))
-> Game x y
-> NMoves
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 -> (NMoves, NMoves)) -> Game x y -> (NMoves, NMoves)
forall a b. (a -> b) -> a -> b
$ Game x y
game
selectMax' :: (Forest x y positionHash criterionValue weightedMean
-> Forest x y positionHash criterionValue weightedMean)
-> Result x y positionHash criterionValue weightedMean
selectMax' Forest x y positionHash criterionValue weightedMean
-> Forest x y positionHash criterionValue weightedMean
forestSorter = DynamicMoveData x y positionHash
-> Maybe (QuantifiedGame x y criterionValue weightedMean)
-> Forest x y positionHash criterionValue weightedMean
-> Result x y positionHash criterionValue weightedMean
selectMax DynamicMoveData x y positionHash
dynamicMoveData Maybe (QuantifiedGame x y criterionValue weightedMean)
maybeAlphaQuantifiedGame (Forest x y positionHash criterionValue weightedMean
-> Result x y positionHash criterionValue weightedMean)
-> (Tree (NodeLabel x y positionHash criterionValue weightedMean)
-> Forest x y positionHash criterionValue weightedMean)
-> Tree (NodeLabel x y positionHash criterionValue weightedMean)
-> Result x y positionHash criterionValue weightedMean
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Forest x y positionHash criterionValue weightedMean
-> Forest x y positionHash criterionValue weightedMean
forestSorter (Forest x y positionHash criterionValue weightedMean
-> Forest x y positionHash criterionValue weightedMean)
-> (Tree (NodeLabel x y positionHash criterionValue weightedMean)
-> Forest x y positionHash criterionValue weightedMean)
-> Tree (NodeLabel x y positionHash criterionValue weightedMean)
-> Forest x y positionHash criterionValue weightedMean
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
if Bool
recordKillerMoves
then (Forest x y positionHash criterionValue weightedMean
-> Forest x y positionHash criterionValue weightedMean)
-> Forest x y positionHash criterionValue weightedMean
-> Forest x y positionHash criterionValue weightedMean
forall x y positionHash criterionValue weightedMean.
(Forest x y positionHash criterionValue weightedMean
-> Forest x y positionHash criterionValue weightedMean)
-> Forest x y positionHash criterionValue weightedMean
-> Forest x y positionHash criterionValue weightedMean
Evaluation.PositionHashQuantifiedGameTree.sortNonCaptureMoves (
LogicalColour
-> (Tree (NodeLabel x y positionHash criterionValue weightedMean)
-> KillerMoveKey x y)
-> KillerMoves (KillerMoveKey x y)
-> Forest x y positionHash criterionValue weightedMean
-> Forest x y positionHash criterionValue weightedMean
forall killerMove a.
Ord killerMove =>
LogicalColour
-> (a -> killerMove) -> KillerMoves killerMove -> [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 criterionValue weightedMean)
-> Turn x y)
-> Tree (NodeLabel x y positionHash criterionValue weightedMean)
-> KillerMoveKey x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame x y criterionValue weightedMean -> Turn x y
forall x y criterionValue weightedMean.
QuantifiedGame x y criterionValue weightedMean -> Turn x y
Evaluation.QuantifiedGame.getLastTurn (QuantifiedGame x y criterionValue weightedMean -> Turn x y)
-> (Tree (NodeLabel x y positionHash criterionValue weightedMean)
-> QuantifiedGame x y criterionValue weightedMean)
-> Tree (NodeLabel x y positionHash criterionValue weightedMean)
-> Turn x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (NodeLabel x y positionHash criterionValue weightedMean)
-> QuantifiedGame x y criterionValue weightedMean
forall x y positionHash criterionValue weightedMean.
BarePositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
Evaluation.PositionHashQuantifiedGameTree.getRootQuantifiedGame'
) (KillerMoves (KillerMoveKey x y)
-> Forest x y positionHash criterionValue weightedMean
-> Forest x y positionHash criterionValue weightedMean)
-> KillerMoves (KillerMoveKey x y)
-> Forest x y positionHash criterionValue weightedMean
-> Forest x y positionHash criterionValue weightedMean
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 criterionValue weightedMean
-> Forest x y positionHash criterionValue weightedMean
forall a. a -> a
id
) (Forest x y positionHash criterionValue weightedMean
-> Forest x y positionHash criterionValue weightedMean)
-> (Tree (NodeLabel x y positionHash criterionValue weightedMean)
-> Forest x y positionHash criterionValue weightedMean)
-> Tree (NodeLabel x y positionHash criterionValue weightedMean)
-> Forest x y positionHash criterionValue weightedMean
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (NodeLabel x y positionHash criterionValue weightedMean)
-> Forest x y positionHash criterionValue weightedMean
forall a. Tree a -> Forest a
Data.Tree.subForest (Tree (NodeLabel x y positionHash criterionValue weightedMean)
-> Result x y positionHash criterionValue weightedMean)
-> Tree (NodeLabel x y positionHash criterionValue weightedMean)
-> Result x y positionHash criterionValue weightedMean
forall a b. (a -> b) -> a -> b
$ PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> Tree (NodeLabel x y positionHash criterionValue weightedMean)
forall x y positionHash criterionValue weightedMean.
PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> BarePositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
Evaluation.PositionHashQuantifiedGameTree.deconstruct PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
positionHashQuantifiedGameTree
selectMax :: DynamicMoveData x y positionHash
-> Maybe (QuantifiedGame x y criterionValue weightedMean)
-> Forest x y positionHash criterionValue weightedMean
-> Result x y positionHash criterionValue weightedMean
selectMax DynamicMoveData x y positionHash
dynamicMoveData' Maybe (QuantifiedGame x y criterionValue weightedMean)
maybeAlphaQuantifiedGame' (Tree (NodeLabel x y positionHash criterionValue weightedMean)
node : Forest x y positionHash criterionValue weightedMean
remainingNodes)
| Bool
trapRepeatedPositions
, NMoves
nDistinctPositions NMoves -> NMoves -> Bool
forall a. Ord a => a -> a -> Bool
>= NMoves
State.InstancesByPosition.leastCyclicPlies
, InstancesByPosition (Position x y) -> NMoves
forall position. InstancesByPosition position -> NMoves
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 criterionValue weightedMean -> Game x y)
-> QuantifiedGame x y criterionValue weightedMean
-> InstancesByPosition (Position x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame x y criterionValue weightedMean -> Game x y
forall x y criterionValue weightedMean.
QuantifiedGame x y criterionValue weightedMean -> Game x y
Evaluation.QuantifiedGame.getGame (QuantifiedGame x y criterionValue weightedMean
-> InstancesByPosition (Position x y))
-> QuantifiedGame x y criterionValue weightedMean
-> InstancesByPosition (Position x y)
forall a b. (a -> b) -> a -> b
$ Tree (NodeLabel x y positionHash criterionValue weightedMean)
-> QuantifiedGame x y criterionValue weightedMean
forall x y positionHash criterionValue weightedMean.
BarePositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
Evaluation.PositionHashQuantifiedGameTree.getRootQuantifiedGame' Tree (NodeLabel x y positionHash criterionValue weightedMean)
node
) NMoves -> NMoves -> Bool
forall a. Eq a => a -> a -> Bool
== NMoves
nDistinctPositions = DynamicMoveData x y positionHash
-> Maybe (QuantifiedGame x y criterionValue weightedMean)
-> Forest x y positionHash criterionValue weightedMean
-> Result x y positionHash criterionValue weightedMean
selectMax DynamicMoveData x y positionHash
dynamicMoveData' Maybe (QuantifiedGame x y criterionValue weightedMean)
maybeAlphaQuantifiedGame' Forest x y positionHash criterionValue weightedMean
remainingNodes
| Just betaQuantifiedGame <- Maybe (QuantifiedGame x y criterionValue weightedMean)
maybeBetaQuantifiedGame
, let fitnessComparedWithBeta :: Ordering
fitnessComparedWithBeta = QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean -> Ordering
forall weightedMean x y criterionValue.
Ord weightedMean =>
QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean -> Ordering
Evaluation.QuantifiedGame.compareFitness QuantifiedGame x y criterionValue weightedMean
quantifiedGame'' QuantifiedGame x y criterionValue weightedMean
betaQuantifiedGame
, Ordering
fitnessComparedWithBeta Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT = Result x y positionHash criterionValue weightedMean
result'' {
getDynamicMoveData :: DynamicMoveData x y positionHash
getDynamicMoveData = let
game'' :: Game x y
game'' = QuantifiedGame x y criterionValue weightedMean -> Game x y
forall x y criterionValue weightedMean.
QuantifiedGame x y criterionValue weightedMean -> Game x y
Evaluation.QuantifiedGame.getGame QuantifiedGame x y criterionValue weightedMean
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 criterionValue weightedMean -> Game x y
forall x y criterionValue weightedMean.
QuantifiedGame x y criterionValue weightedMean -> Game x y
Evaluation.QuantifiedGame.getGame QuantifiedGame x y criterionValue weightedMean
betaQuantifiedGame
)
then Game x y -> Transformation x y positionHash
forall x y positionHash.
(Ord x, Ord 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 criterionValue weightedMean
getQuantifiedGame = QuantifiedGame x y criterionValue weightedMean
betaQuantifiedGame
}
| Bool
otherwise = NMoves
-> Transformation x y positionHash criterionValue weightedMean
forall x y positionHash criterionValue weightedMean.
NMoves
-> Transformation x y positionHash criterionValue weightedMean
addNMovesToResult (
Result x y positionHash criterionValue weightedMean -> NMoves
forall x y positionHash criterionValue weightedMean.
Result x y positionHash criterionValue weightedMean -> NMoves
getNMovesEvaluated Result x y positionHash criterionValue weightedMean
result''
) Transformation x y positionHash criterionValue weightedMean
-> Transformation x y positionHash criterionValue weightedMean
forall a b. (a -> b) -> a -> b
$ let
isFitter :: Bool
isFitter = Bool
-> (QuantifiedGame x y criterionValue weightedMean -> Bool)
-> Maybe (QuantifiedGame x y criterionValue weightedMean)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
True (
(Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT) (Ordering -> Bool)
-> (QuantifiedGame x y criterionValue weightedMean -> Ordering)
-> QuantifiedGame x y criterionValue weightedMean
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean -> Ordering
forall weightedMean x y criterionValue.
Ord weightedMean =>
QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean -> Ordering
Evaluation.QuantifiedGame.compareFitness QuantifiedGame x y criterionValue weightedMean
quantifiedGame''
) Maybe (QuantifiedGame x y criterionValue weightedMean)
maybeAlphaQuantifiedGame'
in DynamicMoveData x y positionHash
-> Maybe (QuantifiedGame x y criterionValue weightedMean)
-> Forest x y positionHash criterionValue weightedMean
-> Result x y positionHash criterionValue weightedMean
selectMax (
(
if Bool
useTranspositions Bool -> Bool -> Bool
&& Bool
isFitter
then Bool
-> NMoves
-> positionHash
-> [Turn x y]
-> PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> Transformation x y positionHash
forall x y weightedMean positionHash criterionValue.
(Eq x, Eq y, Num weightedMean, Ord positionHash,
Ord weightedMean) =>
Bool
-> NMoves
-> positionHash
-> [Turn x y]
-> PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> Transformation x y positionHash
updateTranspositions Bool
False NMoves
nPlies positionHash
positionHash (
NMoves
-> QuantifiedGame x y criterionValue weightedMean -> [Turn x y]
forall x y criterionValue weightedMean.
NMoves
-> QuantifiedGame x y criterionValue weightedMean -> [Turn x y]
Evaluation.QuantifiedGame.getLatestTurns NMoves
nPlies QuantifiedGame x y criterionValue weightedMean
quantifiedGame''
) PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
positionHashQuantifiedGameTree
else Transformation x y positionHash
forall a. a -> a
id
) DynamicMoveData x y positionHash
dynamicMoveData''
) (
if Bool
isFitter
then QuantifiedGame x y criterionValue weightedMean
-> Maybe (QuantifiedGame x y criterionValue weightedMean)
forall a. a -> Maybe a
Just QuantifiedGame x y criterionValue weightedMean
quantifiedGame''
else Maybe (QuantifiedGame x y criterionValue weightedMean)
maybeAlphaQuantifiedGame'
) Forest x y positionHash criterionValue weightedMean
remainingNodes
where
result'' :: Result x y positionHash criterionValue weightedMean
result''@MkResult {
getDynamicMoveData :: forall x y positionHash criterionValue weightedMean.
Result x y positionHash criterionValue weightedMean
-> DynamicMoveData x y positionHash
getDynamicMoveData = DynamicMoveData x y positionHash
dynamicMoveData'',
getQuantifiedGame :: forall x y positionHash criterionValue weightedMean.
Result x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
getQuantifiedGame = QuantifiedGame x y criterionValue weightedMean
quantifiedGame''
} = Transformation x y positionHash criterionValue weightedMean
forall weightedMean x y positionHash criterionValue.
Num weightedMean =>
Transformation x y positionHash criterionValue weightedMean
negateFitnessOfResult Transformation x y positionHash criterionValue weightedMean
-> (SearchState x y positionHash criterionValue weightedMean
-> Result x y positionHash criterionValue weightedMean)
-> SearchState x y positionHash criterionValue weightedMean
-> Result x y positionHash criterionValue weightedMean
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (QuantifiedGame x y criterionValue weightedMean),
Maybe (QuantifiedGame x y criterionValue weightedMean))
-> NMoves
-> SearchState x y positionHash criterionValue weightedMean
-> Result x y positionHash criterionValue weightedMean
descend (
((Maybe (QuantifiedGame x y criterionValue weightedMean),
Maybe (QuantifiedGame x y criterionValue weightedMean))
-> (Maybe (QuantifiedGame x y criterionValue weightedMean),
Maybe (QuantifiedGame x y criterionValue weightedMean)))
-> Maybe (QuantifiedGame x y criterionValue weightedMean)
-> Maybe (QuantifiedGame x y criterionValue weightedMean)
-> (Maybe (QuantifiedGame x y criterionValue weightedMean),
Maybe (QuantifiedGame x y criterionValue weightedMean))
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Maybe (QuantifiedGame x y criterionValue weightedMean),
Maybe (QuantifiedGame x y criterionValue weightedMean))
-> (Maybe (QuantifiedGame x y criterionValue weightedMean),
Maybe (QuantifiedGame x y criterionValue weightedMean))
forall weightedMean x y criterionValue.
Num weightedMean =>
OpenInterval x y criterionValue weightedMean
-> OpenInterval x y criterionValue weightedMean
Evaluation.QuantifiedGame.negateInterval Maybe (QuantifiedGame x y criterionValue weightedMean)
maybeAlphaQuantifiedGame' Maybe (QuantifiedGame x y criterionValue weightedMean)
maybeBetaQuantifiedGame
) (
NMoves -> NMoves
forall a. Enum a => a -> a
pred NMoves
searchDepth
) (SearchState x y positionHash criterionValue weightedMean
-> Result x y positionHash criterionValue weightedMean)
-> SearchState x y positionHash criterionValue weightedMean
-> Result x y positionHash criterionValue weightedMean
forall a b. (a -> b) -> a -> b
$ PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> DynamicMoveData x y positionHash
-> SearchState x y positionHash criterionValue weightedMean
forall x y positionHash criterionValue weightedMean.
PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> DynamicMoveData x y positionHash
-> SearchState x y positionHash criterionValue weightedMean
Search.SearchState.mkSearchState (
Tree (NodeLabel x y positionHash criterionValue weightedMean)
-> PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
forall x y positionHash criterionValue weightedMean.
BarePositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
Evaluation.PositionHashQuantifiedGameTree.fromBarePositionHashQuantifiedGameTree Tree (NodeLabel x y positionHash criterionValue weightedMean)
node
) DynamicMoveData x y positionHash
dynamicMoveData'
selectMax DynamicMoveData x y positionHash
dynamicMoveData' Maybe (QuantifiedGame x y criterionValue weightedMean)
maybeAlphaQuantifiedGame' Forest x y positionHash criterionValue weightedMean
_ = MkResult :: forall x y positionHash criterionValue weightedMean.
DynamicMoveData x y positionHash
-> QuantifiedGame x y criterionValue weightedMean
-> NMoves
-> Result x y positionHash criterionValue weightedMean
MkResult {
getDynamicMoveData :: DynamicMoveData x y positionHash
getDynamicMoveData = DynamicMoveData x y positionHash
dynamicMoveData',
getQuantifiedGame :: QuantifiedGame x y criterionValue weightedMean
getQuantifiedGame = QuantifiedGame x y criterionValue weightedMean
-> Maybe (QuantifiedGame x y criterionValue weightedMean)
-> QuantifiedGame x y criterionValue weightedMean
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (
QuantifiedGame x y criterionValue weightedMean
-> Maybe (QuantifiedGame x y criterionValue weightedMean)
-> QuantifiedGame x y criterionValue weightedMean
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (
Exception -> QuantifiedGame x y criterionValue weightedMean
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> QuantifiedGame x y criterionValue weightedMean)
-> Exception -> QuantifiedGame x y criterionValue weightedMean
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkResultUndefined String
"BishBosh.Search.AlphaBeta.negaMax.selectMax:\tneither alpha nor beta is defined."
) Maybe (QuantifiedGame x y criterionValue weightedMean)
maybeBetaQuantifiedGame
) Maybe (QuantifiedGame x y criterionValue weightedMean)
maybeAlphaQuantifiedGame',
getNMovesEvaluated :: NMoves
getNMovesEvaluated = NMoves
0
}
Result x y positionHash criterionValue weightedMean
-> Reader (Result x y positionHash criterionValue weightedMean)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result x y positionHash criterionValue weightedMean
-> Reader (Result x y positionHash criterionValue weightedMean))
-> (Result x y positionHash criterionValue weightedMean
-> Result x y positionHash criterionValue weightedMean)
-> Result x y positionHash criterionValue weightedMean
-> Reader (Result x y positionHash criterionValue weightedMean)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
\result :: Result x y positionHash criterionValue weightedMean
result@MkResult {
getDynamicMoveData :: forall x y positionHash criterionValue weightedMean.
Result x y positionHash criterionValue weightedMean
-> DynamicMoveData x y positionHash
getDynamicMoveData = DynamicMoveData x y positionHash
dynamicMoveData,
getQuantifiedGame :: forall x y positionHash criterionValue weightedMean.
Result x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
getQuantifiedGame = QuantifiedGame x y criterionValue weightedMean
quantifiedGame
} -> let
positionHashQuantifiedGameTree :: PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
positionHashQuantifiedGameTree = SearchState x y positionHash criterionValue weightedMean
-> PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
forall x y positionHash criterionValue weightedMean.
SearchState x y positionHash criterionValue weightedMean
-> PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
Search.SearchState.getPositionHashQuantifiedGameTree SearchState x y positionHash criterionValue weightedMean
initialSearchState
nPlies :: NMoves
nPlies = TurnsByLogicalColour (Turn x y) -> NMoves
forall turn. TurnsByLogicalColour turn -> NMoves
State.TurnsByLogicalColour.getNPlies (TurnsByLogicalColour (Turn x y) -> NMoves)
-> (QuantifiedGame x y criterionValue weightedMean
-> TurnsByLogicalColour (Turn x y))
-> QuantifiedGame x y criterionValue weightedMean
-> NMoves
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 (Game x y -> TurnsByLogicalColour (Turn x y))
-> (QuantifiedGame x y criterionValue weightedMean -> Game x y)
-> QuantifiedGame x y criterionValue weightedMean
-> TurnsByLogicalColour (Turn x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame x y criterionValue weightedMean -> Game x y
forall x y criterionValue weightedMean.
QuantifiedGame x y criterionValue weightedMean -> Game x y
Evaluation.QuantifiedGame.getGame (QuantifiedGame x y criterionValue weightedMean -> NMoves)
-> QuantifiedGame x y criterionValue weightedMean -> NMoves
forall a b. (a -> b) -> a -> b
$ PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
forall x y positionHash criterionValue weightedMean.
PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
Evaluation.PositionHashQuantifiedGameTree.getRootQuantifiedGame PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
positionHashQuantifiedGameTree
in Result x y positionHash criterionValue weightedMean
result {
getDynamicMoveData :: DynamicMoveData x y positionHash
getDynamicMoveData = Bool
-> NMoves
-> positionHash
-> [Turn x y]
-> PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> Transformation x y positionHash
forall x y weightedMean positionHash criterionValue.
(Eq x, Eq y, Num weightedMean, Ord positionHash,
Ord weightedMean) =>
Bool
-> NMoves
-> positionHash
-> [Turn x y]
-> PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> Transformation x y positionHash
updateTranspositions Bool
True NMoves
nPlies (
PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> positionHash
forall x y positionHash criterionValue weightedMean.
PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
-> positionHash
Evaluation.PositionHashQuantifiedGameTree.getRootPositionHash PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
positionHashQuantifiedGameTree
) (
NMoves
-> QuantifiedGame x y criterionValue weightedMean -> [Turn x y]
forall x y criterionValue weightedMean.
NMoves
-> QuantifiedGame x y criterionValue weightedMean -> [Turn x y]
Evaluation.QuantifiedGame.getLatestTurns NMoves
nPlies QuantifiedGame x y criterionValue weightedMean
quantifiedGame
) PositionHashQuantifiedGameTree
x y positionHash criterionValue weightedMean
positionHashQuantifiedGameTree DynamicMoveData x y positionHash
dynamicMoveData
}
) (Result x y positionHash criterionValue weightedMean
-> Reader (Result x y positionHash criterionValue weightedMean))
-> Result x y positionHash criterionValue weightedMean
-> Reader (Result x y positionHash criterionValue weightedMean)
forall a b. (a -> b) -> a -> b
$ (Maybe (QuantifiedGame x y criterionValue weightedMean),
Maybe (QuantifiedGame x y criterionValue weightedMean))
-> NMoves
-> SearchState x y positionHash criterionValue weightedMean
-> Result x y positionHash criterionValue weightedMean
forall weightedMean x y positionHash criterionValue.
(Eq criterionValue, Enum x, Enum y, Ord positionHash,
Ord weightedMean, Ord x, Ord y, Num weightedMean) =>
(Maybe (QuantifiedGame x y criterionValue weightedMean),
Maybe (QuantifiedGame x y criterionValue weightedMean))
-> NMoves
-> SearchState x y positionHash criterionValue weightedMean
-> Result x y positionHash criterionValue weightedMean
descend (Maybe (QuantifiedGame x y criterionValue weightedMean),
Maybe (QuantifiedGame x y criterionValue weightedMean))
forall x y criterionValue weightedMean.
OpenInterval x y criterionValue weightedMean
Evaluation.QuantifiedGame.unboundedInterval NMoves
initialSearchDepth SearchState x y positionHash criterionValue weightedMean
initialSearchState
type Transformation x y positionHash criterionValue weightedMean = Result x y positionHash criterionValue weightedMean -> Result x y positionHash criterionValue weightedMean
negateFitnessOfResult :: Num weightedMean => Transformation x y positionHash criterionValue weightedMean
negateFitnessOfResult :: Transformation x y positionHash criterionValue weightedMean
negateFitnessOfResult result :: Result x y positionHash criterionValue weightedMean
result@MkResult { getQuantifiedGame :: forall x y positionHash criterionValue weightedMean.
Result x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
getQuantifiedGame = QuantifiedGame x y criterionValue weightedMean
quantifiedGame } = Result x y positionHash criterionValue weightedMean
result {
getQuantifiedGame :: QuantifiedGame x y criterionValue weightedMean
getQuantifiedGame = QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
forall weightedMean x y criterionValue.
Num weightedMean =>
QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
Evaluation.QuantifiedGame.negateFitness QuantifiedGame x y criterionValue weightedMean
quantifiedGame
}
addNMovesToResult :: Component.Move.NMoves -> Transformation x y positionHash criterionValue weightedMean
addNMovesToResult :: NMoves
-> Transformation x y positionHash criterionValue weightedMean
addNMovesToResult NMoves
nMoves result :: Result x y positionHash criterionValue weightedMean
result@MkResult { getNMovesEvaluated :: forall x y positionHash criterionValue weightedMean.
Result x y positionHash criterionValue weightedMean -> NMoves
getNMovesEvaluated = NMoves
nMovesEvaluated } = Bool -> Transformation x y positionHash criterionValue weightedMean
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (NMoves
nMoves NMoves -> NMoves -> Bool
forall a. Ord a => a -> a -> Bool
> NMoves
0) Result x y positionHash criterionValue weightedMean
result {
getNMovesEvaluated :: NMoves
getNMovesEvaluated = NMoves
nMoves NMoves -> NMoves -> NMoves
forall a. Num a => a -> a -> a
+ NMoves
nMovesEvaluated
}