{-
	Copyright (C) 2018 Dr. Alistair Ward

	This file is part of BishBosh.

	BishBosh is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	BishBosh is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]

	* Performs an <https://www.chessprogramming.org/Alpha-Beta> search, implemented using <https://www.chessprogramming.org/Negamax>.

	* Moves are dynamically re-ordering using the killer-heuristic.

	* <https://www.chessprogramming.org/Repetitions> & <https://www.chessprogramming.org/Transposition>s are detected.
-}

module BishBosh.Search.AlphaBeta(
-- * Types
-- ** Type-synonyms
--	Transformation,
-- ** Data-types
--	Result(),
-- * Functions
	extractSelectedTurns,
--	updateKillerMoves,
--	findTranspositionTerminalQuantifiedGame,
--	updateTranspositions,
	negaMax,
--	negateFitnessOfResult,
--	addNPositionsToResult
 ) 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	Control.Exception
import qualified	Control.Monad.Reader
import qualified	Data.Default
import qualified	Data.Maybe
import qualified	Data.Tree

-- | The type returned by 'negaMax'.
data Result positionHash	= MkResult {
	Result positionHash -> DynamicMoveData positionHash
getDynamicMoveData	:: Search.DynamicMoveData.DynamicMoveData positionHash,	-- ^ Killer moves & transpositions.
	Result positionHash -> QuantifiedGame
getQuantifiedGame	:: Evaluation.QuantifiedGame.QuantifiedGame,
	Result positionHash -> NPositions
getNPositionsEvaluated	:: Type.Count.NPositions				-- ^ The total number of nodes analysed, before making the selection.
}

{- |
	* Drop the specified number of plies; typically those made before starting the search.

	* CAVEAT: abandons the fitness component of the quantified game.
-}
extractSelectedTurns
	:: Type.Count.NPlies
	-> Result positionHash
	-> (Search.DynamicMoveData.DynamicMoveData positionHash, [Component.Turn.Turn], Type.Count.NPositions)
extractSelectedTurns :: NPositions
-> Result positionHash
-> (DynamicMoveData positionHash, [Turn], NPositions)
extractSelectedTurns NPositions
nPlies MkResult {
	getDynamicMoveData :: forall positionHash.
Result positionHash -> DynamicMoveData positionHash
getDynamicMoveData	= DynamicMoveData positionHash
dynamicMoveData,
	getQuantifiedGame :: forall positionHash. Result positionHash -> QuantifiedGame
getQuantifiedGame	= QuantifiedGame
quantifiedGame,
	getNPositionsEvaluated :: forall positionHash. Result positionHash -> NPositions
getNPositionsEvaluated	= NPositions
nPositionsEvaluated
} = (
	DynamicMoveData positionHash
dynamicMoveData,
	NPositions -> QuantifiedGame -> [Turn]
Evaluation.QuantifiedGame.getLatestTurns NPositions
nPlies QuantifiedGame
quantifiedGame,
	NPositions
nPositionsEvaluated
 )

-- | Record the last move as a killer, unless it's a capture move.
updateKillerMoves :: Model.Game.Game -> Search.DynamicMoveData.Transformation positionHash
updateKillerMoves :: Game -> Transformation positionHash
updateKillerMoves Game
game
	| Just Turn
lastTurn <- Game -> Maybe Turn
Model.Game.maybeLastTurn Game
game	= if Turn -> Bool
Component.Turn.isCapture Turn
lastTurn
		then Transformation positionHash
forall a. a -> a
id	-- This move was (assuming appropriate Search-options) statically sorted.
		else Transformation KillerMoveKey -> Transformation positionHash
forall positionHash.
Transformation KillerMoveKey -> Transformation positionHash
Search.DynamicMoveData.updateKillerMoves (Transformation KillerMoveKey -> Transformation positionHash)
-> (KillerMoveKey -> Transformation KillerMoveKey)
-> KillerMoveKey
-> Transformation positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPositions -> KillerMoveKey -> Transformation KillerMoveKey
forall killerMoveKey.
Ord killerMoveKey =>
NPositions -> killerMoveKey -> Transformation killerMoveKey
Search.KillerMoves.insert (
			TurnsByLogicalColour Turn -> NPositions
forall turn. TurnsByLogicalColour turn -> NPositions
State.TurnsByLogicalColour.getNPlies (TurnsByLogicalColour Turn -> NPositions)
-> TurnsByLogicalColour Turn -> NPositions
forall a b. (a -> b) -> a -> b
$ Game -> TurnsByLogicalColour Turn
Model.Game.getTurnsByLogicalColour Game
game
		) (KillerMoveKey -> Transformation positionHash)
-> KillerMoveKey -> Transformation positionHash
forall a b. (a -> b) -> a -> b
$ Turn -> KillerMoveKey
Search.DynamicMoveData.mkKillerMoveKeyFromTurn Turn
lastTurn
	| Bool
otherwise						= Exception -> Transformation positionHash
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Transformation positionHash)
-> (String -> Exception) -> String -> Transformation 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 positionHash)
-> String -> Transformation positionHash
forall a b. (a -> b) -> a -> b
$ Game -> String -> String
forall a. Show a => a -> String -> String
shows Game
game String
"."

{- |
	* Track the specified move-sequence down the /positionHashQuantifiedGameTree/ & retrieve the fitness from the terminal quantified game.

	* CAVEAT: the return-value, is quantified from the perspective of the player who is about to move.
-}
findTranspositionTerminalQuantifiedGame
	:: Evaluation.PositionHashQuantifiedGameTree.PositionHashQuantifiedGameTree positionHash
	-> Search.TranspositionValue.TranspositionValue Component.QualifiedMove.QualifiedMove
	-> Evaluation.QuantifiedGame.QuantifiedGame
findTranspositionTerminalQuantifiedGame :: PositionHashQuantifiedGameTree positionHash
-> TranspositionValue QualifiedMove -> QuantifiedGame
findTranspositionTerminalQuantifiedGame PositionHashQuantifiedGameTree positionHash
positionHashQuantifiedGameTree TranspositionValue QualifiedMove
transpositionValue	= QuantifiedGame
-> ([NodeLabel positionHash] -> QuantifiedGame)
-> Maybe [NodeLabel positionHash]
-> QuantifiedGame
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
	Exception -> QuantifiedGame
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> QuantifiedGame)
-> (String -> Exception) -> String -> QuantifiedGame
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 -> String -> String
forall a. Show a => a -> String -> String
shows TranspositionValue QualifiedMove
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) -> String -> QuantifiedGame
forall a b. (a -> b) -> a -> b
$ (
		MoveNotation
-> NPositions
-> PositionHashQuantifiedGameTree positionHash
-> String
-> String
forall a.
ShowNotationFloat a =>
MoveNotation -> NPositions -> a -> String -> String
Notation.MoveNotation.showsNotationFloatToNDecimals MoveNotation
forall a. Default a => a
Data.Default.def {-move-notation-} NPositions
3 {-decimal digits-} (PositionHashQuantifiedGameTree positionHash -> String -> String)
-> PositionHashQuantifiedGameTree positionHash -> String -> String
forall a b. (a -> b) -> a -> b
$ NPositions
-> PositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree 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 positionHash
positionHashQuantifiedGameTree
	 ) String
""
 ) (
	(
		if NPositions -> Bool
forall a. Integral a => a -> Bool
even NPositions
inferredSearchDepth
			then QuantifiedGame -> QuantifiedGame
Evaluation.QuantifiedGame.negateFitness	-- The opponent made the last move in the list, & therefore defined the fitness.
			else QuantifiedGame -> QuantifiedGame
forall a. a -> a
id
	) (QuantifiedGame -> QuantifiedGame)
-> ([NodeLabel positionHash] -> QuantifiedGame)
-> [NodeLabel positionHash]
-> QuantifiedGame
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeLabel positionHash -> QuantifiedGame
forall positionHash. NodeLabel positionHash -> QuantifiedGame
Evaluation.PositionHashQuantifiedGameTree.getQuantifiedGame (NodeLabel positionHash -> QuantifiedGame)
-> ([NodeLabel positionHash] -> NodeLabel positionHash)
-> [NodeLabel positionHash]
-> QuantifiedGame
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NodeLabel positionHash] -> NodeLabel positionHash
forall a. [a] -> a
last
 ) (Maybe [NodeLabel positionHash] -> QuantifiedGame)
-> ([QualifiedMove] -> Maybe [NodeLabel positionHash])
-> [QualifiedMove]
-> QuantifiedGame
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionHashQuantifiedGameTree positionHash
-> [QualifiedMove] -> Maybe [NodeLabel positionHash]
forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> [QualifiedMove] -> Maybe [NodeLabel positionHash]
Evaluation.PositionHashQuantifiedGameTree.traceMatchingMoves PositionHashQuantifiedGameTree positionHash
positionHashQuantifiedGameTree ([QualifiedMove] -> QuantifiedGame)
-> [QualifiedMove] -> QuantifiedGame
forall a b. (a -> b) -> a -> b
$ TranspositionValue QualifiedMove -> [QualifiedMove]
forall qualifiedMove.
TranspositionValue qualifiedMove -> [qualifiedMove]
Search.TranspositionValue.getQualifiedMoves TranspositionValue QualifiedMove
transpositionValue	where
	inferredSearchDepth :: NPositions
inferredSearchDepth	= TranspositionValue QualifiedMove -> NPositions
forall qualifiedMove.
TranspositionValue qualifiedMove -> NPositions
Search.TranspositionValue.inferSearchDepth TranspositionValue QualifiedMove
transpositionValue

-- | Record a qualifiedMove-sequence in the transposition-table.
updateTranspositions
	:: Ord positionHash
	=> Search.TranspositionValue.IsOptimal
	-> Type.Count.NPlies
	-> positionHash
	-> [Component.Turn.Turn]
	-> Evaluation.PositionHashQuantifiedGameTree.PositionHashQuantifiedGameTree positionHash
	-> Search.DynamicMoveData.Transformation positionHash
updateTranspositions :: Bool
-> NPositions
-> positionHash
-> [Turn]
-> PositionHashQuantifiedGameTree positionHash
-> Transformation positionHash
updateTranspositions Bool
isOptimal NPositions
nPlies positionHash
positionHash [Turn]
turns PositionHashQuantifiedGameTree positionHash
positionHashQuantifiedGameTree	= Transformation QualifiedMove positionHash
-> Transformation positionHash
forall positionHash.
Transformation QualifiedMove positionHash
-> Transformation positionHash
Search.DynamicMoveData.updateTranspositions (Transformation QualifiedMove positionHash
 -> Transformation positionHash)
-> ([QualifiedMove] -> Transformation QualifiedMove positionHash)
-> [QualifiedMove]
-> Transformation positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FindFitness QualifiedMove
-> positionHash
-> TranspositionValue QualifiedMove
-> Transformation QualifiedMove positionHash
forall positionHash qualifiedMove.
Ord positionHash =>
FindFitness qualifiedMove
-> positionHash
-> TranspositionValue qualifiedMove
-> Transformation qualifiedMove positionHash
Search.Transpositions.insert (
	QuantifiedGame -> WeightedMean
Evaluation.QuantifiedGame.getFitness (QuantifiedGame -> WeightedMean)
-> (TranspositionValue QualifiedMove -> QuantifiedGame)
-> FindFitness QualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionHashQuantifiedGameTree positionHash
-> TranspositionValue QualifiedMove -> QuantifiedGame
forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> TranspositionValue QualifiedMove -> QuantifiedGame
findTranspositionTerminalQuantifiedGame PositionHashQuantifiedGameTree positionHash
positionHashQuantifiedGameTree
 ) positionHash
positionHash {-the hash of the game before the first move in the sequence-} (TranspositionValue QualifiedMove
 -> Transformation QualifiedMove positionHash)
-> ([QualifiedMove] -> TranspositionValue QualifiedMove)
-> [QualifiedMove]
-> Transformation QualifiedMove positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> NPositions
-> [QualifiedMove]
-> TranspositionValue QualifiedMove
forall qualifiedMove.
Bool
-> NPositions
-> [qualifiedMove]
-> TranspositionValue qualifiedMove
Search.TranspositionValue.mkTranspositionValue Bool
isOptimal NPositions
nPlies ([QualifiedMove] -> Transformation positionHash)
-> [QualifiedMove] -> Transformation positionHash
forall a b. (a -> b) -> a -> b
$ (Turn -> QualifiedMove) -> [Turn] -> [QualifiedMove]
forall a b. (a -> b) -> [a] -> [b]
map Turn -> QualifiedMove
Component.Turn.getQualifiedMove [Turn]
turns

{- |
	* Implements a depth-first search (implemented as nega-max), with alpha-beta pruning.

	* /alpha/ is the minimum fitness of which the maximising player is assured.

	* /beta/ is the maximum fitness of which the minimising player is assured.
-}
negaMax
	:: Ord positionHash
	=> Type.Count.NPlies	-- ^ The depth to which the tree should be searched; i.e. the number of plies to look-ahead.
	-> Search.SearchState.SearchState positionHash
	-> Input.SearchOptions.Reader (Result positionHash)
{-# SPECIALISE negaMax :: Type.Count.NPlies -> Search.SearchState.SearchState Type.Crypto.PositionHash -> Input.SearchOptions.Reader (Result Type.Crypto.PositionHash) #-}
negaMax :: NPositions
-> SearchState positionHash -> Reader (Result positionHash)
negaMax NPositions
initialSearchDepth SearchState 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 -> NPositions
getNPlies	= TurnsByLogicalColour Turn -> NPositions
forall turn. TurnsByLogicalColour turn -> NPositions
State.TurnsByLogicalColour.getNPlies (TurnsByLogicalColour Turn -> NPositions)
-> (Game -> TurnsByLogicalColour Turn) -> Game -> NPositions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game -> TurnsByLogicalColour Turn
Model.Game.getTurnsByLogicalColour	-- Abbreviate.
{-
		descend
			:: Evaluation.QuantifiedGame.OpenInterval
			-> Type.Count.NPlies
			-> Search.SearchState.SearchState positionHash
			-> Result positionHash
-}
		descend :: (Maybe QuantifiedGame, Maybe QuantifiedGame)
-> NPositions -> SearchState positionHash -> Result positionHash
descend (Maybe QuantifiedGame
maybeAlphaQuantifiedGame, Maybe QuantifiedGame
maybeBetaQuantifiedGame) NPositions
searchDepth SearchState positionHash
searchState
			| NPositions
searchDepth NPositions -> NPositions -> Bool
forall a. Eq a => a -> a -> Bool
== NPositions
0 Bool -> Bool -> Bool
|| Game -> Bool
Model.Game.isTerminated Game
game	= MkResult :: forall positionHash.
DynamicMoveData positionHash
-> QuantifiedGame -> NPositions -> Result positionHash
MkResult {
				getDynamicMoveData :: DynamicMoveData positionHash
getDynamicMoveData	= DynamicMoveData positionHash
dynamicMoveData,
				getQuantifiedGame :: QuantifiedGame
getQuantifiedGame	= QuantifiedGame -> QuantifiedGame
Evaluation.QuantifiedGame.negateFitness QuantifiedGame
quantifiedGame,	-- CAVEAT: zero new moves have been applied, so the last move was the opponent's.
				getNPositionsEvaluated :: NPositions
getNPositionsEvaluated	= NPositions
1								-- Fitness-negation requires evaluation.
			} -- Terminate the recursion.
			| Bool
useTranspositions
			, Just TranspositionValue QualifiedMove
transpositionValue	<- positionHash
-> Transpositions QualifiedMove positionHash
-> Maybe (TranspositionValue QualifiedMove)
forall positionHash qualifiedMove.
Ord positionHash =>
positionHash
-> Transpositions qualifiedMove positionHash
-> Maybe (TranspositionValue qualifiedMove)
Search.Transpositions.find positionHash
positionHash (Transpositions QualifiedMove positionHash
 -> Maybe (TranspositionValue QualifiedMove))
-> Transpositions QualifiedMove positionHash
-> Maybe (TranspositionValue QualifiedMove)
forall a b. (a -> b) -> a -> b
$ DynamicMoveData positionHash
-> Transpositions QualifiedMove positionHash
forall positionHash.
DynamicMoveData positionHash
-> Transpositions QualifiedMove positionHash
Search.DynamicMoveData.getTranspositions DynamicMoveData positionHash
dynamicMoveData	-- Look for a previously encountered position with a matching positionHash.
			, let
				selectMaxUsingTranspositions :: Result positionHash
selectMaxUsingTranspositions	= (Forest positionHash -> Forest positionHash) -> Result positionHash
selectMaxWithSorter ((Forest positionHash -> Forest positionHash)
 -> Result positionHash)
-> (Forest positionHash -> Forest positionHash)
-> Result positionHash
forall a b. (a -> b) -> a -> b
$ Forest positionHash
-> Maybe (Forest positionHash) -> Forest positionHash
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (
					Exception -> Forest positionHash
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Forest positionHash)
-> (String -> Exception) -> String -> Forest 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 positionHash) -> String -> Forest positionHash
forall a b. (a -> b) -> a -> b
$ TranspositionValue QualifiedMove -> String -> String
forall a. Show a => a -> String -> String
shows TranspositionValue QualifiedMove
transpositionValue String
"."	-- N.B.: perhaps because of hash-collision.
				 ) (Maybe (Forest positionHash) -> Forest positionHash)
-> (Forest positionHash -> Maybe (Forest positionHash))
-> Forest positionHash
-> Forest positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [QualifiedMove]
-> Forest positionHash -> Maybe (Forest positionHash)
forall positionHash.
[QualifiedMove]
-> Forest positionHash -> Maybe (Forest positionHash)
Evaluation.PositionHashQuantifiedGameTree.promoteMatchingMoves (
					TranspositionValue QualifiedMove -> [QualifiedMove]
forall qualifiedMove.
TranspositionValue qualifiedMove -> [qualifiedMove]
Search.TranspositionValue.getQualifiedMoves TranspositionValue QualifiedMove
transpositionValue
				 ) -- For efficiency, promote moves in the positionHashQuantifiedGameTree, using the knowledge in the transposition.
			= if TranspositionValue QualifiedMove -> NPositions
forall qualifiedMove.
TranspositionValue qualifiedMove -> NPositions
Search.TranspositionValue.inferSearchDepth TranspositionValue QualifiedMove
transpositionValue NPositions -> NPositions -> Bool
forall a. Ord a => a -> a -> Bool
< NPositions
searchDepth
				then Result positionHash
selectMaxUsingTranspositions	-- This transposition resulted from a search-depth which is insufficient to compose a valid response to this search.
				else let
					transposedQuantifiedGame :: QuantifiedGame
transposedQuantifiedGame	= PositionHashQuantifiedGameTree positionHash
-> TranspositionValue QualifiedMove -> QuantifiedGame
forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> TranspositionValue QualifiedMove -> QuantifiedGame
findTranspositionTerminalQuantifiedGame PositionHashQuantifiedGameTree positionHash
positionHashQuantifiedGameTree TranspositionValue QualifiedMove
transpositionValue
				in if TranspositionValue QualifiedMove -> Bool
forall qualifiedMove. TranspositionValue qualifiedMove -> Bool
Search.TranspositionValue.getIsOptimal TranspositionValue QualifiedMove
transpositionValue
					then MkResult :: forall positionHash.
DynamicMoveData positionHash
-> QuantifiedGame -> NPositions -> Result positionHash
MkResult {
						getDynamicMoveData :: DynamicMoveData positionHash
getDynamicMoveData	= DynamicMoveData positionHash
dynamicMoveData,
						getQuantifiedGame :: QuantifiedGame
getQuantifiedGame	= Bool -> QuantifiedGame -> QuantifiedGame
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (QuantifiedGame
transposedQuantifiedGame QuantifiedGame -> QuantifiedGame -> Bool
forall a. Eq a => a -> a -> Bool
== Result positionHash -> QuantifiedGame
forall positionHash. Result positionHash -> QuantifiedGame
getQuantifiedGame Result positionHash
selectMaxUsingTranspositions) QuantifiedGame
transposedQuantifiedGame,
						getNPositionsEvaluated :: NPositions
getNPositionsEvaluated	= NPositions
0
					}
					else Result positionHash
-> (QuantifiedGame -> Result positionHash)
-> Maybe QuantifiedGame
-> Result positionHash
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Result positionHash
selectMaxUsingTranspositions (
						\QuantifiedGame
betaQuantifiedGame -> if QuantifiedGame -> QuantifiedGame -> Ordering
Evaluation.QuantifiedGame.compareFitness QuantifiedGame
transposedQuantifiedGame QuantifiedGame
betaQuantifiedGame Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT
							then Result positionHash
selectMaxUsingTranspositions
							else MkResult :: forall positionHash.
DynamicMoveData positionHash
-> QuantifiedGame -> NPositions -> Result positionHash
MkResult {
								getDynamicMoveData :: DynamicMoveData positionHash
getDynamicMoveData	= DynamicMoveData positionHash
dynamicMoveData,
								getQuantifiedGame :: QuantifiedGame
getQuantifiedGame	= Bool -> QuantifiedGame -> QuantifiedGame
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (QuantifiedGame
betaQuantifiedGame QuantifiedGame -> QuantifiedGame -> Bool
forall a. Eq a => a -> a -> Bool
== Result positionHash -> QuantifiedGame
forall positionHash. Result positionHash -> QuantifiedGame
getQuantifiedGame Result positionHash
selectMaxUsingTranspositions) QuantifiedGame
betaQuantifiedGame,
								getNPositionsEvaluated :: NPositions
getNPositionsEvaluated	= NPositions
0
							}
					) Maybe QuantifiedGame
maybeBetaQuantifiedGame
			| Bool
otherwise	= (Forest positionHash -> Forest positionHash) -> Result positionHash
selectMaxWithSorter Forest positionHash -> Forest positionHash
forall a. a -> a
id
			where
				(PositionHashQuantifiedGameTree positionHash
positionHashQuantifiedGameTree, DynamicMoveData positionHash
dynamicMoveData)	= SearchState positionHash
-> PositionHashQuantifiedGameTree positionHash
forall positionHash.
SearchState positionHash
-> PositionHashQuantifiedGameTree positionHash
Search.SearchState.getPositionHashQuantifiedGameTree (SearchState positionHash
 -> PositionHashQuantifiedGameTree positionHash)
-> (SearchState positionHash -> DynamicMoveData positionHash)
-> SearchState positionHash
-> (PositionHashQuantifiedGameTree positionHash,
    DynamicMoveData positionHash)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& SearchState positionHash -> DynamicMoveData positionHash
forall positionHash.
SearchState positionHash -> DynamicMoveData positionHash
Search.SearchState.getDynamicMoveData (SearchState positionHash
 -> (PositionHashQuantifiedGameTree positionHash,
     DynamicMoveData positionHash))
-> SearchState positionHash
-> (PositionHashQuantifiedGameTree positionHash,
    DynamicMoveData positionHash)
forall a b. (a -> b) -> a -> b
$ SearchState 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
quantifiedGame)	= PositionHashQuantifiedGameTree positionHash -> positionHash
forall positionHash.
PositionHashQuantifiedGameTree positionHash -> positionHash
Evaluation.PositionHashQuantifiedGameTree.getRootPositionHash (PositionHashQuantifiedGameTree positionHash -> positionHash)
-> (PositionHashQuantifiedGameTree positionHash -> QuantifiedGame)
-> PositionHashQuantifiedGameTree positionHash
-> (positionHash, QuantifiedGame)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& PositionHashQuantifiedGameTree positionHash -> QuantifiedGame
forall positionHash.
PositionHashQuantifiedGameTree positionHash -> QuantifiedGame
Evaluation.PositionHashQuantifiedGameTree.getRootQuantifiedGame (PositionHashQuantifiedGameTree positionHash
 -> (positionHash, QuantifiedGame))
-> PositionHashQuantifiedGameTree positionHash
-> (positionHash, QuantifiedGame)
forall a b. (a -> b) -> a -> b
$ PositionHashQuantifiedGameTree positionHash
positionHashQuantifiedGameTree
				game :: Game
game				= QuantifiedGame -> Game
Evaluation.QuantifiedGame.getGame QuantifiedGame
quantifiedGame	-- Prior to application of any move from the forest.
				(NPositions
nPlies, NPositions
nDistinctPositions)	= Game -> NPositions
getNPlies (Game -> NPositions)
-> (Game -> NPositions) -> Game -> (NPositions, NPositions)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& InstancesByPosition Position -> NPositions
forall position. InstancesByPosition position -> NPositions
State.InstancesByPosition.getNDistinctPositions (InstancesByPosition Position -> NPositions)
-> (Game -> InstancesByPosition Position) -> Game -> NPositions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game -> InstancesByPosition Position
Model.Game.getInstancesByPosition (Game -> (NPositions, NPositions))
-> Game -> (NPositions, NPositions)
forall a b. (a -> b) -> a -> b
$ Game
game	-- Count the distinct positions since the last irreversible move.

				selectMaxWithSorter :: (Forest positionHash -> Forest positionHash) -> Result positionHash
selectMaxWithSorter Forest positionHash -> Forest positionHash
forestSorter	= DynamicMoveData positionHash
-> Maybe QuantifiedGame
-> Forest positionHash
-> Result positionHash
selectMax DynamicMoveData positionHash
dynamicMoveData Maybe QuantifiedGame
maybeAlphaQuantifiedGame (Forest positionHash -> Result positionHash)
-> (Tree (NodeLabel positionHash) -> Forest positionHash)
-> Tree (NodeLabel positionHash)
-> Result positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Forest positionHash -> Forest positionHash
forestSorter (Forest positionHash -> Forest positionHash)
-> (Tree (NodeLabel positionHash) -> Forest positionHash)
-> Tree (NodeLabel positionHash)
-> Forest positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
					if Bool
recordKillerMoves
						then (Forest positionHash -> Forest positionHash)
-> Forest positionHash -> Forest positionHash
forall positionHash.
(Forest positionHash -> Forest positionHash)
-> Forest positionHash -> Forest positionHash
Evaluation.PositionHashQuantifiedGameTree.sortNonCaptureMoves (
							LogicalColour
-> (Tree (NodeLabel positionHash) -> KillerMoveKey)
-> KillerMoves KillerMoveKey
-> Forest positionHash
-> Forest positionHash
forall killerMoveKey a.
Ord killerMoveKey =>
LogicalColour
-> (a -> killerMoveKey) -> KillerMoves killerMoveKey -> [a] -> [a]
Search.KillerMoves.sortByHistoryHeuristic (
								Game -> LogicalColour
Model.Game.getNextLogicalColour Game
game
							) (
								Turn -> KillerMoveKey
Search.DynamicMoveData.mkKillerMoveKeyFromTurn (Turn -> KillerMoveKey)
-> (Tree (NodeLabel positionHash) -> Turn)
-> Tree (NodeLabel positionHash)
-> KillerMoveKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame -> Turn
Evaluation.QuantifiedGame.getLastTurn (QuantifiedGame -> Turn)
-> (Tree (NodeLabel positionHash) -> QuantifiedGame)
-> Tree (NodeLabel positionHash)
-> Turn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (NodeLabel positionHash) -> QuantifiedGame
forall positionHash.
BarePositionHashQuantifiedGameTree positionHash -> QuantifiedGame
Evaluation.PositionHashQuantifiedGameTree.getRootQuantifiedGame'
							) (KillerMoves KillerMoveKey
 -> Forest positionHash -> Forest positionHash)
-> KillerMoves KillerMoveKey
-> Forest positionHash
-> Forest positionHash
forall a b. (a -> b) -> a -> b
$ DynamicMoveData positionHash -> KillerMoves KillerMoveKey
forall positionHash.
DynamicMoveData positionHash -> KillerMoves KillerMoveKey
Search.DynamicMoveData.getKillerMoves DynamicMoveData positionHash
dynamicMoveData
						) -- Dynamically advance the evaluation of killer-moves, to just after the statically sorted capture-moves.
						else Forest positionHash -> Forest positionHash
forall a. a -> a
id
				 ) (Forest positionHash -> Forest positionHash)
-> (Tree (NodeLabel positionHash) -> Forest positionHash)
-> Tree (NodeLabel positionHash)
-> Forest positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (NodeLabel positionHash) -> Forest positionHash
forall a. Tree a -> Forest a
Data.Tree.subForest (Tree (NodeLabel positionHash) -> Result positionHash)
-> Tree (NodeLabel positionHash) -> Result positionHash
forall a b. (a -> b) -> a -> b
$ PositionHashQuantifiedGameTree positionHash
-> Tree (NodeLabel positionHash)
forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> BarePositionHashQuantifiedGameTree positionHash
Evaluation.PositionHashQuantifiedGameTree.deconstruct PositionHashQuantifiedGameTree positionHash
positionHashQuantifiedGameTree
{-
				selectMax
					:: Search.DynamicMoveData.DynamicMoveData positionHash
					-> Maybe Evaluation.QuantifiedGame.QuantifiedGame
					-> [Evaluation.PositionHashQuantifiedGameTree.BarePositionHashQuantifiedGameTree positionHash]
					-> Result positionHash
-}
				selectMax :: DynamicMoveData positionHash
-> Maybe QuantifiedGame
-> Forest positionHash
-> Result positionHash
selectMax DynamicMoveData positionHash
dynamicMoveData' Maybe QuantifiedGame
maybeAlphaQuantifiedGame' (Tree (NodeLabel positionHash)
node : Forest 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	-- CAVEAT: accounting for the typically (except when its the initial position) unrepeatable first distinct position.
					, InstancesByPosition Position -> NPositions
forall position. InstancesByPosition position -> NPositions
State.InstancesByPosition.getNDistinctPositions (
						Game -> InstancesByPosition Position
Model.Game.getInstancesByPosition (Game -> InstancesByPosition Position)
-> (QuantifiedGame -> Game)
-> QuantifiedGame
-> InstancesByPosition Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame -> Game
Evaluation.QuantifiedGame.getGame (QuantifiedGame -> InstancesByPosition Position)
-> QuantifiedGame -> InstancesByPosition Position
forall a b. (a -> b) -> a -> b
$ Tree (NodeLabel positionHash) -> QuantifiedGame
forall positionHash.
BarePositionHashQuantifiedGameTree positionHash -> QuantifiedGame
Evaluation.PositionHashQuantifiedGameTree.getRootQuantifiedGame' Tree (NodeLabel positionHash)
node	-- If the size hasn't increased, then the recently added position must have already been a member; (size == 1) during successive unrepeatable moves also, but that exception is caught above.
					) NPositions -> NPositions -> Bool
forall a. Eq a => a -> a -> Bool
== NPositions
nDistinctPositions	= DynamicMoveData positionHash
-> Maybe QuantifiedGame
-> Forest positionHash
-> Result positionHash
selectMax DynamicMoveData positionHash
dynamicMoveData' (
						Maybe QuantifiedGame
maybeAlphaQuantifiedGame' Maybe QuantifiedGame
-> Maybe QuantifiedGame -> Maybe QuantifiedGame
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> QuantifiedGame -> Maybe QuantifiedGame
forall a. a -> Maybe a
Just QuantifiedGame
quantifiedGame''	-- CAVEAT: guard against exhausting all nodes without defining alpha.
					) Forest positionHash
remainingNodes						-- Skip this node & recurse through the remaining moves at this depth.
					| Just betaQuantifiedGame	<- Maybe QuantifiedGame
maybeBetaQuantifiedGame	-- Beta-cutoff can't occur until beta has been defined.
					, let fitnessComparedWithBeta :: Ordering
fitnessComparedWithBeta	= QuantifiedGame -> QuantifiedGame -> Ordering
Evaluation.QuantifiedGame.compareFitness QuantifiedGame
quantifiedGame'' QuantifiedGame
betaQuantifiedGame
					, Ordering
fitnessComparedWithBeta Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT	= Result positionHash
result'' {
						getDynamicMoveData :: DynamicMoveData positionHash
getDynamicMoveData	= let
							game'' :: Game
game''	= QuantifiedGame -> Game
Evaluation.QuantifiedGame.getGame QuantifiedGame
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
game'' Game -> Game -> Bool
=~ QuantifiedGame -> Game
Evaluation.QuantifiedGame.getGame QuantifiedGame
betaQuantifiedGame	-- CAVEAT: betaQuantifiedGame was copied in selectMaxWithSorters terminal case, from one of the open-interval's boundaries.
							) -- Confirm that betaQuantifiedGame is beneath the current node.
								then Game -> Transformation positionHash
forall positionHash. Game -> Transformation positionHash
updateKillerMoves Game
game''
								else Transformation positionHash
forall a. a -> a
id
						) DynamicMoveData positionHash
dynamicMoveData'',
						getQuantifiedGame :: QuantifiedGame
getQuantifiedGame	= QuantifiedGame
betaQuantifiedGame
					} -- Beta-cutoff; the solution-space is either zero or negative.
					| Bool
otherwise	= NPositions -> Transformation positionHash
forall positionHash. NPositions -> Transformation positionHash
addNPositionsToResult (
						Result positionHash -> NPositions
forall positionHash. Result positionHash -> NPositions
getNPositionsEvaluated Result positionHash
result''
					) Transformation positionHash -> Transformation positionHash
forall a b. (a -> b) -> a -> b
$ let
						isFitter :: Bool
isFitter	= Bool -> (QuantifiedGame -> Bool) -> Maybe QuantifiedGame -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
True {-alpha is undefined => anything qualifies-} (
							\QuantifiedGame
alphaQuantifiedGame -> case QuantifiedGame
quantifiedGame'' QuantifiedGame -> QuantifiedGame -> Ordering
`Evaluation.QuantifiedGame.compareFitness` QuantifiedGame
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 -> NPositions) -> (NPositions, NPositions))
-> (QuantifiedGame -> NPositions)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
									((QuantifiedGame -> NPositions) -> QuantifiedGame -> NPositions
forall a b. (a -> b) -> a -> b
$ QuantifiedGame
quantifiedGame'') ((QuantifiedGame -> NPositions) -> NPositions)
-> ((QuantifiedGame -> NPositions) -> NPositions)
-> (QuantifiedGame -> NPositions)
-> (NPositions, NPositions)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((QuantifiedGame -> NPositions) -> QuantifiedGame -> NPositions
forall a b. (a -> b) -> a -> b
$ QuantifiedGame
alphaQuantifiedGame)
								 ) ((QuantifiedGame -> NPositions) -> Bool)
-> (QuantifiedGame -> NPositions) -> Bool
forall a b. (a -> b) -> a -> b
$ Game -> NPositions
getNPlies (Game -> NPositions)
-> (QuantifiedGame -> Game) -> QuantifiedGame -> NPositions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame -> Game
Evaluation.QuantifiedGame.getGame	-- Prefer a shorter move-sequence.
						 ) Maybe QuantifiedGame
maybeAlphaQuantifiedGame'
					in DynamicMoveData positionHash
-> Maybe QuantifiedGame
-> Forest positionHash
-> Result positionHash
selectMax (
						(
							if Bool
useTranspositions Bool -> Bool -> Bool
&& Bool
isFitter
								then Bool
-> NPositions
-> positionHash
-> [Turn]
-> PositionHashQuantifiedGameTree positionHash
-> Transformation positionHash
forall positionHash.
Ord positionHash =>
Bool
-> NPositions
-> positionHash
-> [Turn]
-> PositionHashQuantifiedGameTree positionHash
-> Transformation positionHash
updateTranspositions Bool
False {-isOptimal-} NPositions
nPlies positionHash
positionHash {-the hash of the game before the first move in the sequence-} (
									NPositions -> QuantifiedGame -> [Turn]
Evaluation.QuantifiedGame.getLatestTurns NPositions
nPlies QuantifiedGame
quantifiedGame''	-- Discard turns previously applied to the game to which the positionHash refers.
								) PositionHashQuantifiedGameTree positionHash
positionHashQuantifiedGameTree
								else Transformation positionHash
forall a. a -> a
id
						) DynamicMoveData positionHash
dynamicMoveData''
					) (
						if Bool
isFitter
							then QuantifiedGame -> Maybe QuantifiedGame
forall a. a -> Maybe a
Just QuantifiedGame
quantifiedGame''	-- Replace the alpha solution (i.e. the lower acceptable solution-bound).
							else Maybe QuantifiedGame
maybeAlphaQuantifiedGame'
					) Forest positionHash
remainingNodes	-- Recurse through the remaining moves at this depth.
					where
						result'' :: Result positionHash
result''@MkResult {
							getDynamicMoveData :: forall positionHash.
Result positionHash -> DynamicMoveData positionHash
getDynamicMoveData	= DynamicMoveData positionHash
dynamicMoveData'',
							getQuantifiedGame :: forall positionHash. Result positionHash -> QuantifiedGame
getQuantifiedGame	= QuantifiedGame
quantifiedGame''
						} = Transformation positionHash
forall positionHash. Transformation positionHash
negateFitnessOfResult Transformation positionHash
-> (SearchState positionHash -> Result positionHash)
-> SearchState positionHash
-> Result positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe QuantifiedGame, Maybe QuantifiedGame)
-> NPositions -> SearchState positionHash -> Result positionHash
descend (
							((Maybe QuantifiedGame, Maybe QuantifiedGame)
 -> (Maybe QuantifiedGame, Maybe QuantifiedGame))
-> Maybe QuantifiedGame
-> Maybe QuantifiedGame
-> (Maybe QuantifiedGame, Maybe QuantifiedGame)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Maybe QuantifiedGame, Maybe QuantifiedGame)
-> (Maybe QuantifiedGame, Maybe QuantifiedGame)
Evaluation.QuantifiedGame.negateInterval Maybe QuantifiedGame
maybeAlphaQuantifiedGame' Maybe QuantifiedGame
maybeBetaQuantifiedGame
						 ) (
							NPositions -> NPositions
forall a. Enum a => a -> a
pred NPositions
searchDepth
						 ) (SearchState positionHash -> Result positionHash)
-> SearchState positionHash -> Result positionHash
forall a b. (a -> b) -> a -> b
$ PositionHashQuantifiedGameTree positionHash
-> DynamicMoveData positionHash -> SearchState positionHash
forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> DynamicMoveData positionHash -> SearchState positionHash
Search.SearchState.mkSearchState (
							Tree (NodeLabel positionHash)
-> PositionHashQuantifiedGameTree positionHash
forall positionHash.
BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
Evaluation.PositionHashQuantifiedGameTree.fromBarePositionHashQuantifiedGameTree Tree (NodeLabel positionHash)
node
						 ) DynamicMoveData positionHash
dynamicMoveData'	-- Recurse.
				selectMax DynamicMoveData positionHash
dynamicMoveData' Maybe QuantifiedGame
maybeAlphaQuantifiedGame' []	= MkResult :: forall positionHash.
DynamicMoveData positionHash
-> QuantifiedGame -> NPositions -> Result positionHash
MkResult {
					getDynamicMoveData :: DynamicMoveData positionHash
getDynamicMoveData	= DynamicMoveData positionHash
dynamicMoveData',
					getQuantifiedGame :: QuantifiedGame
getQuantifiedGame	= QuantifiedGame -> Maybe QuantifiedGame -> QuantifiedGame
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (
						QuantifiedGame -> Maybe QuantifiedGame -> QuantifiedGame
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (
							Exception -> QuantifiedGame
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> QuantifiedGame)
-> (String -> Exception) -> String -> QuantifiedGame
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) -> String -> QuantifiedGame
forall a b. (a -> b) -> a -> b
$ Game -> String -> String
forall a. Show a => a -> String -> String
shows Game
game String
"."
						) Maybe QuantifiedGame
maybeBetaQuantifiedGame	-- Return the only viable position known.
					) Maybe QuantifiedGame
maybeAlphaQuantifiedGame',	-- Return the fittest viable position found.
					getNPositionsEvaluated :: NPositions
getNPositionsEvaluated	= NPositions
0
				} -- Zero moves remain => terminate the recursion.
	Result positionHash -> Reader (Result positionHash)
forall (m :: * -> *) a. Monad m => a -> m a
return {-to Reader-monad-} (Result positionHash -> Reader (Result positionHash))
-> (Result positionHash -> Result positionHash)
-> Result positionHash
-> Reader (Result positionHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
		\result :: Result positionHash
result@MkResult {
			getDynamicMoveData :: forall positionHash.
Result positionHash -> DynamicMoveData positionHash
getDynamicMoveData	= DynamicMoveData positionHash
dynamicMoveData,
			getQuantifiedGame :: forall positionHash. Result positionHash -> QuantifiedGame
getQuantifiedGame	= QuantifiedGame
quantifiedGame
		} -> let
			positionHashQuantifiedGameTree :: PositionHashQuantifiedGameTree positionHash
positionHashQuantifiedGameTree	= SearchState positionHash
-> PositionHashQuantifiedGameTree positionHash
forall positionHash.
SearchState positionHash
-> PositionHashQuantifiedGameTree positionHash
Search.SearchState.getPositionHashQuantifiedGameTree SearchState positionHash
initialSearchState
			nPlies :: NPositions
nPlies				= Game -> NPositions
getNPlies (Game -> NPositions)
-> (QuantifiedGame -> Game) -> QuantifiedGame -> NPositions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame -> Game
Evaluation.QuantifiedGame.getGame (QuantifiedGame -> NPositions) -> QuantifiedGame -> NPositions
forall a b. (a -> b) -> a -> b
$ PositionHashQuantifiedGameTree positionHash -> QuantifiedGame
forall positionHash.
PositionHashQuantifiedGameTree positionHash -> QuantifiedGame
Evaluation.PositionHashQuantifiedGameTree.getRootQuantifiedGame PositionHashQuantifiedGameTree positionHash
positionHashQuantifiedGameTree
		in Result positionHash
result {
			getDynamicMoveData :: DynamicMoveData positionHash
getDynamicMoveData	= Bool
-> NPositions
-> positionHash
-> [Turn]
-> PositionHashQuantifiedGameTree positionHash
-> Transformation positionHash
forall positionHash.
Ord positionHash =>
Bool
-> NPositions
-> positionHash
-> [Turn]
-> PositionHashQuantifiedGameTree positionHash
-> Transformation positionHash
updateTranspositions Bool
True {-Optimal-} NPositions
nPlies (
				PositionHashQuantifiedGameTree positionHash -> positionHash
forall positionHash.
PositionHashQuantifiedGameTree positionHash -> positionHash
Evaluation.PositionHashQuantifiedGameTree.getRootPositionHash PositionHashQuantifiedGameTree positionHash
positionHashQuantifiedGameTree
			) (
				NPositions -> QuantifiedGame -> [Turn]
Evaluation.QuantifiedGame.getLatestTurns NPositions
nPlies QuantifiedGame
quantifiedGame
			) PositionHashQuantifiedGameTree positionHash
positionHashQuantifiedGameTree DynamicMoveData positionHash
dynamicMoveData
		}
	 ) (Result positionHash -> Reader (Result positionHash))
-> Result positionHash -> Reader (Result positionHash)
forall a b. (a -> b) -> a -> b
$ (Maybe QuantifiedGame, Maybe QuantifiedGame)
-> NPositions -> SearchState positionHash -> Result positionHash
forall positionHash.
Ord positionHash =>
(Maybe QuantifiedGame, Maybe QuantifiedGame)
-> NPositions -> SearchState positionHash -> Result positionHash
descend (Maybe QuantifiedGame, Maybe QuantifiedGame)
Evaluation.QuantifiedGame.unboundedInterval NPositions
initialSearchDepth SearchState positionHash
initialSearchState

-- | The type of a function which transforms the result.
type Transformation positionHash	= Result positionHash -> Result positionHash

-- | Mutator.
negateFitnessOfResult :: Transformation positionHash
negateFitnessOfResult :: Transformation positionHash
negateFitnessOfResult result :: Result positionHash
result@MkResult { getQuantifiedGame :: forall positionHash. Result positionHash -> QuantifiedGame
getQuantifiedGame = QuantifiedGame
quantifiedGame }	= Result positionHash
result {
	getQuantifiedGame :: QuantifiedGame
getQuantifiedGame	= QuantifiedGame -> QuantifiedGame
Evaluation.QuantifiedGame.negateFitness QuantifiedGame
quantifiedGame
}

-- | Mutator.
addNPositionsToResult :: Type.Count.NPositions -> Transformation positionHash
addNPositionsToResult :: NPositions -> Transformation positionHash
addNPositionsToResult NPositions
nPositions result :: Result positionHash
result@MkResult { getNPositionsEvaluated :: forall positionHash. Result positionHash -> NPositions
getNPositionsEvaluated = NPositions
nPositionsEvaluated }	= Bool -> Transformation 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 positionHash
result {
	getNPositionsEvaluated :: NPositions
getNPositionsEvaluated	= NPositions
nPositions NPositions -> NPositions -> NPositions
forall a. Num a => a -> a -> a
+ NPositions
nPositionsEvaluated
}