{-
	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	BishBosh.Type.Length					as Type.Length
import qualified	Control.Exception
import qualified	Control.Monad.Reader
import qualified	Data.Default
import qualified	Data.Maybe
import qualified	Data.Tree

-- | The type returned by 'negaMax'.
data Result x y positionHash	= MkResult {
	Result x y positionHash -> DynamicMoveData x y positionHash
getDynamicMoveData	:: Search.DynamicMoveData.DynamicMoveData x y positionHash,	-- ^ Killer moves & transpositions.
	Result x y positionHash -> QuantifiedGame x y
getQuantifiedGame	:: Evaluation.QuantifiedGame.QuantifiedGame x y,
	Result x y 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 x y positionHash
	-> (Search.DynamicMoveData.DynamicMoveData x y positionHash, [Component.Turn.Turn x y], Type.Count.NPositions)
extractSelectedTurns :: NPositions
-> Result x y positionHash
-> (DynamicMoveData x y positionHash, [Turn x y], NPositions)
extractSelectedTurns NPositions
nPlies MkResult {
	getDynamicMoveData :: forall x y positionHash.
Result x y positionHash -> DynamicMoveData x y positionHash
getDynamicMoveData	= DynamicMoveData x y positionHash
dynamicMoveData,
	getQuantifiedGame :: forall x y positionHash.
Result x y positionHash -> QuantifiedGame x y
getQuantifiedGame	= QuantifiedGame x y
quantifiedGame,
	getNPositionsEvaluated :: forall x y positionHash. Result x y positionHash -> NPositions
getNPositionsEvaluated	= NPositions
nPositionsEvaluated
} = (
	DynamicMoveData x y positionHash
dynamicMoveData,
	NPositions -> QuantifiedGame x y -> [Turn x y]
forall x y. NPositions -> QuantifiedGame x y -> [Turn x y]
Evaluation.QuantifiedGame.getLatestTurns NPositions
nPlies QuantifiedGame x y
quantifiedGame,
	NPositions
nPositionsEvaluated
 )

-- | Record the last move as a killer, unless it's a capture move.
updateKillerMoves :: (
	Ord	x,
	Ord	y,
	Enum	x,
	Enum	y,
	Show	x,
	Show	y
 )
	=> Model.Game.Game x y
	-> Search.DynamicMoveData.Transformation x y positionHash
updateKillerMoves :: Game x y -> Transformation x y positionHash
updateKillerMoves Game x y
game
	| Just Turn x y
lastTurn <- Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
Model.Game.maybeLastTurn Game x y
game	= if Turn x y -> Bool
forall x y. Turn x y -> Bool
Component.Turn.isCapture Turn x y
lastTurn
		then Transformation x y positionHash
forall a. a -> a
id	-- This move was (assuming appropriate Search-options) statically sorted.
		else Transformation (KillerMoveKey x y)
-> Transformation x y positionHash
forall x y positionHash.
Transformation (KillerMoveKey x y)
-> Transformation x y positionHash
Search.DynamicMoveData.updateKillerMoves (Transformation (KillerMoveKey x y)
 -> Transformation x y positionHash)
-> (KillerMoveKey x y -> Transformation (KillerMoveKey x y))
-> KillerMoveKey x y
-> Transformation x y positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPositions
-> KillerMoveKey x y -> Transformation (KillerMoveKey x y)
forall killerMoveKey.
Ord killerMoveKey =>
NPositions -> killerMoveKey -> Transformation killerMoveKey
Search.KillerMoves.insert (
			TurnsByLogicalColour (Turn x y) -> NPositions
forall turn. TurnsByLogicalColour turn -> NPositions
State.TurnsByLogicalColour.getNPlies (TurnsByLogicalColour (Turn x y) -> NPositions)
-> TurnsByLogicalColour (Turn x y) -> NPositions
forall a b. (a -> b) -> a -> b
$ Game x y -> TurnsByLogicalColour (Turn x y)
forall x y. Game x y -> TurnsByLogicalColour x y
Model.Game.getTurnsByLogicalColour Game x y
game
		) (KillerMoveKey x y -> Transformation x y positionHash)
-> KillerMoveKey x y -> Transformation x y positionHash
forall a b. (a -> b) -> a -> b
$ Turn x y -> KillerMoveKey x y
forall x y. Turn x y -> KillerMoveKey x y
Search.DynamicMoveData.mkKillerMoveKeyFromTurn Turn x y
lastTurn
	| Bool
otherwise						= Exception -> Transformation x y positionHash
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Transformation x y positionHash)
-> (String -> Exception)
-> String
-> Transformation x y positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkNullDatum (String -> Exception) -> (String -> String) -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
"BishBosh.Search.AlphaBeta.updateKillerMoves:\tzero turns have been made; " (String -> Transformation x y positionHash)
-> String -> Transformation x y positionHash
forall a b. (a -> b) -> a -> b
$ Game x y -> String -> String
forall a. Show a => a -> String -> String
shows Game x y
game String
"."

{- |
	* 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 :: (
	Eq	x,
	Eq	y,
	Enum	x,
	Enum	y,
	Show	x,
	Show	y
 )
	=> Evaluation.PositionHashQuantifiedGameTree.PositionHashQuantifiedGameTree x y positionHash
	-> Search.TranspositionValue.TranspositionValue (Component.QualifiedMove.QualifiedMove x y)
	-> Evaluation.QuantifiedGame.QuantifiedGame x y
findTranspositionTerminalQuantifiedGame :: PositionHashQuantifiedGameTree x y positionHash
-> TranspositionValue (QualifiedMove x y) -> QuantifiedGame x y
findTranspositionTerminalQuantifiedGame PositionHashQuantifiedGameTree x y positionHash
positionHashQuantifiedGameTree TranspositionValue (QualifiedMove x y)
transpositionValue	= QuantifiedGame x y
-> ([NodeLabel x y positionHash] -> QuantifiedGame x y)
-> Maybe [NodeLabel x y positionHash]
-> QuantifiedGame x y
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
	Exception -> QuantifiedGame x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> QuantifiedGame x y)
-> (String -> Exception) -> String -> QuantifiedGame x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkSearchFailure (String -> Exception) -> (String -> String) -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
"BishBosh.Search.AlphaBeta.findTranspositionTerminalQuantifiedGame:\tEvaluation.PositionHashQuantifiedGameTree.traceMatchingMoves failed; " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TranspositionValue (QualifiedMove x y) -> String -> String
forall a. Show a => a -> String -> String
shows TranspositionValue (QualifiedMove x y)
transpositionValue (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
":\n" (String -> QuantifiedGame x y) -> String -> QuantifiedGame x y
forall a b. (a -> b) -> a -> b
$ (
		MoveNotation
-> NPositions
-> PositionHashQuantifiedGameTree x y positionHash
-> String
-> String
forall a.
ShowNotationFloat a =>
MoveNotation -> NPositions -> a -> String -> String
Notation.MoveNotation.showsNotationFloatToNDecimals MoveNotation
forall a. Default a => a
Data.Default.def {-move-notation-} NPositions
3 {-decimal digits-} (PositionHashQuantifiedGameTree x y positionHash
 -> String -> String)
-> PositionHashQuantifiedGameTree x y positionHash
-> String
-> String
forall a b. (a -> b) -> a -> b
$ NPositions
-> PositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
forall tree. Prunable tree => NPositions -> tree -> tree
Property.Arboreal.prune (NPositions -> NPositions
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPositions
inferredSearchDepth) PositionHashQuantifiedGameTree x y positionHash
positionHashQuantifiedGameTree
	 ) String
""
 ) (
	(
		if NPositions -> Bool
forall a. Integral a => a -> Bool
even NPositions
inferredSearchDepth
			then QuantifiedGame x y -> QuantifiedGame x y
forall x y. QuantifiedGame x y -> QuantifiedGame x y
Evaluation.QuantifiedGame.negateFitness	-- The opponent made the last move in the list, & therefore defined the fitness.
			else QuantifiedGame x y -> QuantifiedGame x y
forall a. a -> a
id
	) (QuantifiedGame x y -> QuantifiedGame x y)
-> ([NodeLabel x y positionHash] -> QuantifiedGame x y)
-> [NodeLabel x y positionHash]
-> QuantifiedGame x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeLabel x y positionHash -> QuantifiedGame x y
forall x y positionHash.
NodeLabel x y positionHash -> QuantifiedGame x y
Evaluation.PositionHashQuantifiedGameTree.getQuantifiedGame (NodeLabel x y positionHash -> QuantifiedGame x y)
-> ([NodeLabel x y positionHash] -> NodeLabel x y positionHash)
-> [NodeLabel x y positionHash]
-> QuantifiedGame x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NodeLabel x y positionHash] -> NodeLabel x y positionHash
forall a. [a] -> a
last
 ) (Maybe [NodeLabel x y positionHash] -> QuantifiedGame x y)
-> ([QualifiedMove x y] -> Maybe [NodeLabel x y positionHash])
-> [QualifiedMove x y]
-> QuantifiedGame x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionHashQuantifiedGameTree x y positionHash
-> [QualifiedMove x y] -> Maybe [NodeLabel x y positionHash]
forall x y positionHash.
(Eq x, Eq y) =>
PositionHashQuantifiedGameTree x y positionHash
-> [QualifiedMove x y] -> Maybe [NodeLabel x y positionHash]
Evaluation.PositionHashQuantifiedGameTree.traceMatchingMoves PositionHashQuantifiedGameTree x y positionHash
positionHashQuantifiedGameTree ([QualifiedMove x y] -> QuantifiedGame x y)
-> [QualifiedMove x y] -> QuantifiedGame x y
forall a b. (a -> b) -> a -> b
$ TranspositionValue (QualifiedMove x y) -> [QualifiedMove x y]
forall qualifiedMove.
TranspositionValue qualifiedMove -> [qualifiedMove]
Search.TranspositionValue.getQualifiedMoves TranspositionValue (QualifiedMove x y)
transpositionValue	where
	inferredSearchDepth :: NPositions
inferredSearchDepth	= TranspositionValue (QualifiedMove x y) -> NPositions
forall qualifiedMove.
TranspositionValue qualifiedMove -> NPositions
Search.TranspositionValue.inferSearchDepth TranspositionValue (QualifiedMove x y)
transpositionValue

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

{- |
	* 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 :: (
	Enum	x,
	Enum	y,
	Ord	positionHash,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 )
	=> Type.Count.NPlies	-- ^ The depth to which the tree should be searched; i.e. the number of plies to look-ahead.
	-> Search.SearchState.SearchState x y positionHash
	-> Input.SearchOptions.Reader (Result x y positionHash)
{-# SPECIALISE negaMax :: Type.Count.NPlies -> Search.SearchState.SearchState Type.Length.X Type.Length.Y Type.Crypto.PositionHash -> Input.SearchOptions.Reader (Result Type.Length.X Type.Length.Y Type.Crypto.PositionHash) #-}
negaMax :: NPositions
-> SearchState x y positionHash -> Reader (Result x y positionHash)
negaMax NPositions
initialSearchDepth SearchState x y positionHash
initialSearchState	= do
	Maybe NPositions
maybeMinimumTranspositionSearchDepth	<- (SearchOptions -> Maybe NPositions)
-> ReaderT SearchOptions Identity (Maybe NPositions)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Control.Monad.Reader.asks SearchOptions -> Maybe NPositions
Input.SearchOptions.maybeMinimumTranspositionSearchDepth
	Bool
recordKillerMoves			<- (SearchOptions -> Bool) -> ReaderT SearchOptions Identity Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Control.Monad.Reader.asks SearchOptions -> Bool
Input.SearchOptions.recordKillerMoves
	Bool
trapRepeatedPositions			<- (SearchOptions -> Bool) -> ReaderT SearchOptions Identity Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Control.Monad.Reader.asks SearchOptions -> Bool
Input.SearchOptions.getTrapRepeatedPositions

	let
		getNPlies :: Game x y -> NPositions
getNPlies	= TurnsByLogicalColour (Turn x y) -> NPositions
forall turn. TurnsByLogicalColour turn -> NPositions
State.TurnsByLogicalColour.getNPlies (TurnsByLogicalColour (Turn x y) -> NPositions)
-> (Game x y -> TurnsByLogicalColour (Turn x y))
-> Game x y
-> NPositions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game x y -> TurnsByLogicalColour (Turn x y)
forall x y. Game x y -> TurnsByLogicalColour x y
Model.Game.getTurnsByLogicalColour	-- Abbreviate.
{-
		descend
			:: Evaluation.QuantifiedGame.OpenInterval x y
			-> Type.Count.NPlies
			-> Search.SearchState.SearchState x y positionHash
			-> Result x y positionHash
-}
		descend :: (Maybe (QuantifiedGame x y), Maybe (QuantifiedGame x y))
-> NPositions
-> SearchState x y positionHash
-> Result x y positionHash
descend (Maybe (QuantifiedGame x y)
maybeAlphaQuantifiedGame, Maybe (QuantifiedGame x y)
maybeBetaQuantifiedGame) NPositions
searchDepth SearchState x y positionHash
searchState
			| NPositions
searchDepth NPositions -> NPositions -> Bool
forall a. Eq a => a -> a -> Bool
== NPositions
0 Bool -> Bool -> Bool
|| Game x y -> Bool
forall x y. Game x y -> Bool
Model.Game.isTerminated Game x y
game	= MkResult :: forall x y positionHash.
DynamicMoveData x y positionHash
-> QuantifiedGame x y -> NPositions -> Result x y positionHash
MkResult {
				getDynamicMoveData :: DynamicMoveData x y positionHash
getDynamicMoveData	= DynamicMoveData x y positionHash
dynamicMoveData,
				getQuantifiedGame :: QuantifiedGame x y
getQuantifiedGame	= QuantifiedGame x y -> QuantifiedGame x y
forall x y. QuantifiedGame x y -> QuantifiedGame x y
Evaluation.QuantifiedGame.negateFitness QuantifiedGame x y
quantifiedGame,	-- 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 x y)
transpositionValue	<- positionHash
-> Transpositions (QualifiedMove x y) positionHash
-> Maybe (TranspositionValue (QualifiedMove x y))
forall positionHash qualifiedMove.
Ord positionHash =>
positionHash
-> Transpositions qualifiedMove positionHash
-> Maybe (TranspositionValue qualifiedMove)
Search.Transpositions.find positionHash
positionHash (Transpositions (QualifiedMove x y) positionHash
 -> Maybe (TranspositionValue (QualifiedMove x y)))
-> Transpositions (QualifiedMove x y) positionHash
-> Maybe (TranspositionValue (QualifiedMove x y))
forall a b. (a -> b) -> a -> b
$ DynamicMoveData x y positionHash
-> Transpositions (QualifiedMove x y) positionHash
forall x y positionHash.
DynamicMoveData x y positionHash
-> Transpositions (QualifiedMove x y) positionHash
Search.DynamicMoveData.getTranspositions DynamicMoveData x y positionHash
dynamicMoveData	-- Look for a previously encountered position with a matching positionHash.
			, let
				selectMaxUsingTranspositions :: Result x y positionHash
selectMaxUsingTranspositions	= (Forest x y positionHash -> Forest x y positionHash)
-> Result x y positionHash
selectMaxWithSorter ((Forest x y positionHash -> Forest x y positionHash)
 -> Result x y positionHash)
-> (Forest x y positionHash -> Forest x y positionHash)
-> Result x y positionHash
forall a b. (a -> b) -> a -> b
$ Forest x y positionHash
-> Maybe (Forest x y positionHash) -> Forest x y positionHash
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (
					Exception -> Forest x y positionHash
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Forest x y positionHash)
-> (String -> Exception) -> String -> Forest x y positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkSearchFailure (String -> Exception) -> (String -> String) -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
"BishBosh.Search.AlphaBeta.negaMax.descend:\tEvaluation.PositionHashQuantifiedGameTree.promoteMatchingMoves failed; " (String -> Forest x y positionHash)
-> String -> Forest x y positionHash
forall a b. (a -> b) -> a -> b
$ TranspositionValue (QualifiedMove x y) -> String -> String
forall a. Show a => a -> String -> String
shows TranspositionValue (QualifiedMove x y)
transpositionValue String
"."	-- N.B.: perhaps because of hash-collision.
				 ) (Maybe (Forest x y positionHash) -> Forest x y positionHash)
-> (Forest x y positionHash -> Maybe (Forest x y positionHash))
-> Forest x y positionHash
-> Forest x y positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [QualifiedMove x y]
-> Forest x y positionHash -> Maybe (Forest x y positionHash)
forall x y positionHash.
(Eq x, Eq y) =>
[QualifiedMove x y]
-> Forest x y positionHash -> Maybe (Forest x y positionHash)
Evaluation.PositionHashQuantifiedGameTree.promoteMatchingMoves (
					TranspositionValue (QualifiedMove x y) -> [QualifiedMove x y]
forall qualifiedMove.
TranspositionValue qualifiedMove -> [qualifiedMove]
Search.TranspositionValue.getQualifiedMoves TranspositionValue (QualifiedMove x y)
transpositionValue
				 ) -- For efficiency, promote moves in the positionHashQuantifiedGameTree, using the knowledge in the transposition.
			= if TranspositionValue (QualifiedMove x y) -> NPositions
forall qualifiedMove.
TranspositionValue qualifiedMove -> NPositions
Search.TranspositionValue.inferSearchDepth TranspositionValue (QualifiedMove x y)
transpositionValue NPositions -> NPositions -> Bool
forall a. Ord a => a -> a -> Bool
< NPositions
searchDepth
				then Result x y positionHash
selectMaxUsingTranspositions	-- This transposition resulted from a search-depth which is insufficient to compose a valid response to this search.
				else let
					transposedQuantifiedGame :: QuantifiedGame x y
transposedQuantifiedGame	= PositionHashQuantifiedGameTree x y positionHash
-> TranspositionValue (QualifiedMove x y) -> QuantifiedGame x y
forall x y positionHash.
(Eq x, Eq y, Enum x, Enum y, Show x, Show y) =>
PositionHashQuantifiedGameTree x y positionHash
-> TranspositionValue (QualifiedMove x y) -> QuantifiedGame x y
findTranspositionTerminalQuantifiedGame PositionHashQuantifiedGameTree x y positionHash
positionHashQuantifiedGameTree TranspositionValue (QualifiedMove x y)
transpositionValue
				in if TranspositionValue (QualifiedMove x y) -> Bool
forall qualifiedMove. TranspositionValue qualifiedMove -> Bool
Search.TranspositionValue.getIsOptimal TranspositionValue (QualifiedMove x y)
transpositionValue
					then MkResult :: forall x y positionHash.
DynamicMoveData x y positionHash
-> QuantifiedGame x y -> NPositions -> Result x y positionHash
MkResult {
						getDynamicMoveData :: DynamicMoveData x y positionHash
getDynamicMoveData	= DynamicMoveData x y positionHash
dynamicMoveData,
						getQuantifiedGame :: QuantifiedGame x y
getQuantifiedGame	= Bool -> QuantifiedGame x y -> QuantifiedGame x y
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (QuantifiedGame x y
transposedQuantifiedGame QuantifiedGame x y -> QuantifiedGame x y -> Bool
forall a. Eq a => a -> a -> Bool
== Result x y positionHash -> QuantifiedGame x y
forall x y positionHash.
Result x y positionHash -> QuantifiedGame x y
getQuantifiedGame Result x y positionHash
selectMaxUsingTranspositions) QuantifiedGame x y
transposedQuantifiedGame,
						getNPositionsEvaluated :: NPositions
getNPositionsEvaluated	= NPositions
0
					}
					else Result x y positionHash
-> (QuantifiedGame x y -> Result x y positionHash)
-> Maybe (QuantifiedGame x y)
-> Result x y positionHash
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Result x y positionHash
selectMaxUsingTranspositions (
						\QuantifiedGame x y
betaQuantifiedGame -> if QuantifiedGame x y -> QuantifiedGame x y -> Ordering
forall x y. QuantifiedGame x y -> QuantifiedGame x y -> Ordering
Evaluation.QuantifiedGame.compareFitness QuantifiedGame x y
transposedQuantifiedGame QuantifiedGame x y
betaQuantifiedGame Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT
							then Result x y positionHash
selectMaxUsingTranspositions
							else MkResult :: forall x y positionHash.
DynamicMoveData x y positionHash
-> QuantifiedGame x y -> NPositions -> Result x y positionHash
MkResult {
								getDynamicMoveData :: DynamicMoveData x y positionHash
getDynamicMoveData	= DynamicMoveData x y positionHash
dynamicMoveData,
								getQuantifiedGame :: QuantifiedGame x y
getQuantifiedGame	= Bool -> QuantifiedGame x y -> QuantifiedGame x y
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (QuantifiedGame x y
betaQuantifiedGame QuantifiedGame x y -> QuantifiedGame x y -> Bool
forall a. Eq a => a -> a -> Bool
== Result x y positionHash -> QuantifiedGame x y
forall x y positionHash.
Result x y positionHash -> QuantifiedGame x y
getQuantifiedGame Result x y positionHash
selectMaxUsingTranspositions) QuantifiedGame x y
betaQuantifiedGame,
								getNPositionsEvaluated :: NPositions
getNPositionsEvaluated	= NPositions
0
							}
					) Maybe (QuantifiedGame x y)
maybeBetaQuantifiedGame
			| Bool
otherwise	= (Forest x y positionHash -> Forest x y positionHash)
-> Result x y positionHash
selectMaxWithSorter Forest x y positionHash -> Forest x y positionHash
forall a. a -> a
id
			where
				(PositionHashQuantifiedGameTree x y positionHash
positionHashQuantifiedGameTree, DynamicMoveData x y positionHash
dynamicMoveData)	= SearchState x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
forall x y positionHash.
SearchState x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
Search.SearchState.getPositionHashQuantifiedGameTree (SearchState x y positionHash
 -> PositionHashQuantifiedGameTree x y positionHash)
-> (SearchState x y positionHash
    -> DynamicMoveData x y positionHash)
-> SearchState x y positionHash
-> (PositionHashQuantifiedGameTree x y positionHash,
    DynamicMoveData x y positionHash)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& SearchState x y positionHash -> DynamicMoveData x y positionHash
forall x y positionHash.
SearchState x y positionHash -> DynamicMoveData x y positionHash
Search.SearchState.getDynamicMoveData (SearchState x y positionHash
 -> (PositionHashQuantifiedGameTree x y positionHash,
     DynamicMoveData x y positionHash))
-> SearchState x y positionHash
-> (PositionHashQuantifiedGameTree x y positionHash,
    DynamicMoveData x y positionHash)
forall a b. (a -> b) -> a -> b
$ SearchState x y positionHash
searchState

				useTranspositions :: Bool
useTranspositions		= Bool -> (NPositions -> Bool) -> Maybe NPositions -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False (NPositions
searchDepth NPositions -> NPositions -> Bool
forall a. Ord a => a -> a -> Bool
>=) Maybe NPositions
maybeMinimumTranspositionSearchDepth
				(positionHash
positionHash, QuantifiedGame x y
quantifiedGame)	= PositionHashQuantifiedGameTree x y positionHash -> positionHash
forall x y positionHash.
PositionHashQuantifiedGameTree x y positionHash -> positionHash
Evaluation.PositionHashQuantifiedGameTree.getRootPositionHash (PositionHashQuantifiedGameTree x y positionHash -> positionHash)
-> (PositionHashQuantifiedGameTree x y positionHash
    -> QuantifiedGame x y)
-> PositionHashQuantifiedGameTree x y positionHash
-> (positionHash, QuantifiedGame x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& PositionHashQuantifiedGameTree x y positionHash
-> QuantifiedGame x y
forall x y positionHash.
PositionHashQuantifiedGameTree x y positionHash
-> QuantifiedGame x y
Evaluation.PositionHashQuantifiedGameTree.getRootQuantifiedGame (PositionHashQuantifiedGameTree x y positionHash
 -> (positionHash, QuantifiedGame x y))
-> PositionHashQuantifiedGameTree x y positionHash
-> (positionHash, QuantifiedGame x y)
forall a b. (a -> b) -> a -> b
$ PositionHashQuantifiedGameTree x y positionHash
positionHashQuantifiedGameTree
				game :: Game x y
game				= QuantifiedGame x y -> Game x y
forall x y. QuantifiedGame x y -> Game x y
Evaluation.QuantifiedGame.getGame QuantifiedGame x y
quantifiedGame	-- Prior to application of any move from the forest.
				(NPositions
nPlies, NPositions
nDistinctPositions)	= Game x y -> NPositions
forall x y. Game x y -> NPositions
getNPlies (Game x y -> NPositions)
-> (Game x y -> NPositions) -> Game x y -> (NPositions, NPositions)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& InstancesByPosition (Position x y) -> NPositions
forall position. InstancesByPosition position -> NPositions
State.InstancesByPosition.getNDistinctPositions (InstancesByPosition (Position x y) -> NPositions)
-> (Game x y -> InstancesByPosition (Position x y))
-> Game x y
-> NPositions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game x y -> InstancesByPosition (Position x y)
forall x y. Game x y -> InstancesByPosition x y
Model.Game.getInstancesByPosition (Game x y -> (NPositions, NPositions))
-> Game x y -> (NPositions, NPositions)
forall a b. (a -> b) -> a -> b
$ Game x y
game	-- Count the distinct positions since the last irreversible move.

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

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

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

-- | Mutator.
addNPositionsToResult :: Type.Count.NPositions -> Transformation x y positionHash
addNPositionsToResult :: NPositions -> Transformation x y positionHash
addNPositionsToResult NPositions
nPositions result :: Result x y positionHash
result@MkResult { getNPositionsEvaluated :: forall x y positionHash. Result x y positionHash -> NPositions
getNPositionsEvaluated = NPositions
nPositionsEvaluated }	= Bool -> Transformation x y positionHash
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (NPositions
nPositions NPositions -> NPositions -> Bool
forall a. Ord a => a -> a -> Bool
> NPositions
0) Result x y positionHash
result {
	getNPositionsEvaluated :: NPositions
getNPositionsEvaluated	= NPositions
nPositions NPositions -> NPositions -> NPositions
forall a. Num a => a -> a -> a
+ NPositions
nPositionsEvaluated
}