{-
	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,
--	addNMovesToResult
 ) where

import			BishBosh.Model.Game((=~))
import			Control.Applicative((<|>))
import			Control.Arrow((&&&))
import qualified	BishBosh.Component.Move					as Component.Move
import qualified	BishBosh.Component.QualifiedMove			as Component.QualifiedMove
import qualified	BishBosh.Component.Turn					as Component.Turn
import qualified	BishBosh.Data.Exception					as Data.Exception
import qualified	BishBosh.Evaluation.PositionHashQuantifiedGameTree	as Evaluation.PositionHashQuantifiedGameTree
import qualified	BishBosh.Evaluation.QuantifiedGame			as Evaluation.QuantifiedGame
import qualified	BishBosh.Input.SearchOptions				as Input.SearchOptions
import qualified	BishBosh.Model.Game					as Model.Game
import qualified	BishBosh.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.Types						as T
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 criterionValue weightedMean	= MkResult {
	Result x y positionHash criterionValue weightedMean
-> DynamicMoveData x y positionHash
getDynamicMoveData	:: Search.DynamicMoveData.DynamicMoveData x y positionHash,	-- ^ Killer moves & transpositions.
	Result x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
getQuantifiedGame	:: Evaluation.QuantifiedGame.QuantifiedGame x y criterionValue weightedMean,
	Result x y positionHash criterionValue weightedMean -> NPlies
getNPliesEvaluated	:: Component.Move.NPlies					-- ^ The total number of nodes analysed, before making the selection.
}

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

	* CAVEAT: abandons the fitness component of the quantified game.
-}
extractSelectedTurns
	:: Component.Move.NPlies
	-> Result x y positionHash criterionValue weightedMean
	-> (Search.DynamicMoveData.DynamicMoveData x y positionHash, [Component.Turn.Turn x y], Component.Move.NPlies)
extractSelectedTurns :: NPlies
-> Result x y positionHash criterionValue weightedMean
-> (DynamicMoveData x y positionHash, [Turn x y], NPlies)
extractSelectedTurns NPlies
nPlies MkResult {
	getDynamicMoveData :: forall x y positionHash criterionValue weightedMean.
Result x y positionHash criterionValue weightedMean
-> DynamicMoveData x y positionHash
getDynamicMoveData	= DynamicMoveData x y positionHash
dynamicMoveData,
	getQuantifiedGame :: forall x y positionHash criterionValue weightedMean.
Result x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
getQuantifiedGame	= QuantifiedGame x y criterionValue weightedMean
quantifiedGame,
	getNPliesEvaluated :: forall x y positionHash criterionValue weightedMean.
Result x y positionHash criterionValue weightedMean -> NPlies
getNPliesEvaluated	= NPlies
nPliesEvaluated
} = (
	DynamicMoveData x y positionHash
dynamicMoveData,
	NPlies
-> QuantifiedGame x y criterionValue weightedMean -> [Turn x y]
forall x y criterionValue weightedMean.
NPlies
-> QuantifiedGame x y criterionValue weightedMean -> [Turn x y]
Evaluation.QuantifiedGame.getLatestTurns NPlies
nPlies QuantifiedGame x y criterionValue weightedMean
quantifiedGame,
	NPlies
nPliesEvaluated
 )

-- | 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
. NPlies -> KillerMoveKey x y -> Transformation (KillerMoveKey x y)
forall killerMoveKey.
Ord killerMoveKey =>
NPlies -> killerMoveKey -> Transformation killerMoveKey
Search.KillerMoves.insert (
			TurnsByLogicalColour (Turn x y) -> NPlies
forall turn. TurnsByLogicalColour turn -> NPlies
State.TurnsByLogicalColour.getNPlies (TurnsByLogicalColour (Turn x y) -> NPlies)
-> TurnsByLogicalColour (Turn x y) -> NPlies
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,
	Real	weightedMean,
	Show	x,
	Show	y
 )
	=> Evaluation.PositionHashQuantifiedGameTree.PositionHashQuantifiedGameTree x y positionHash criterionValue weightedMean
	-> Search.TranspositionValue.TranspositionValue (Component.QualifiedMove.QualifiedMove x y)
	-> Evaluation.QuantifiedGame.QuantifiedGame x y criterionValue weightedMean
findTranspositionTerminalQuantifiedGame :: PositionHashQuantifiedGameTree
  x y positionHash criterionValue weightedMean
-> TranspositionValue (QualifiedMove x y)
-> QuantifiedGame x y criterionValue weightedMean
findTranspositionTerminalQuantifiedGame PositionHashQuantifiedGameTree
  x y positionHash criterionValue weightedMean
positionHashQuantifiedGameTree TranspositionValue (QualifiedMove x y)
transpositionValue	= QuantifiedGame x y criterionValue weightedMean
-> ([NodeLabel x y positionHash criterionValue weightedMean]
    -> QuantifiedGame x y criterionValue weightedMean)
-> Maybe [NodeLabel x y positionHash criterionValue weightedMean]
-> QuantifiedGame x y criterionValue weightedMean
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
	Exception -> QuantifiedGame x y criterionValue weightedMean
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> QuantifiedGame x y criterionValue weightedMean)
-> (String -> Exception)
-> String
-> QuantifiedGame x y criterionValue weightedMean
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 criterionValue weightedMean)
-> String -> QuantifiedGame x y criterionValue weightedMean
forall a b. (a -> b) -> a -> b
$ (
		MoveNotation
-> NPlies
-> PositionHashQuantifiedGameTree
     x y positionHash criterionValue weightedMean
-> String
-> String
forall a.
ShowNotationFloat a =>
MoveNotation -> NPlies -> a -> String -> String
Notation.MoveNotation.showsNotationFloatToNDecimals MoveNotation
forall a. Default a => a
Data.Default.def {-move-notation-} NPlies
3 {-decimal digits-} (PositionHashQuantifiedGameTree
   x y positionHash criterionValue weightedMean
 -> String -> String)
-> PositionHashQuantifiedGameTree
     x y positionHash criterionValue weightedMean
-> String
-> String
forall a b. (a -> b) -> a -> b
$ NPlies
-> PositionHashQuantifiedGameTree
     x y positionHash criterionValue weightedMean
-> PositionHashQuantifiedGameTree
     x y positionHash criterionValue weightedMean
forall tree. Prunable tree => NPlies -> tree -> tree
Property.Arboreal.prune NPlies
inferredSearchDepth PositionHashQuantifiedGameTree
  x y positionHash criterionValue weightedMean
positionHashQuantifiedGameTree
	 ) String
""
 ) (
	(
		if NPlies -> Bool
forall a. Integral a => a -> Bool
even NPlies
inferredSearchDepth
			then QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
forall weightedMean x y criterionValue.
Num weightedMean =>
QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
Evaluation.QuantifiedGame.negateFitness	-- The opponent made the last move in the list, & therefore defined the fitness.
			else QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
forall a. a -> a
id
	) (QuantifiedGame x y criterionValue weightedMean
 -> QuantifiedGame x y criterionValue weightedMean)
-> ([NodeLabel x y positionHash criterionValue weightedMean]
    -> QuantifiedGame x y criterionValue weightedMean)
-> [NodeLabel x y positionHash criterionValue weightedMean]
-> QuantifiedGame x y criterionValue weightedMean
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeLabel x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
forall x y positionHash criterionValue weightedMean.
NodeLabel x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
Evaluation.PositionHashQuantifiedGameTree.getQuantifiedGame (NodeLabel x y positionHash criterionValue weightedMean
 -> QuantifiedGame x y criterionValue weightedMean)
-> ([NodeLabel x y positionHash criterionValue weightedMean]
    -> NodeLabel x y positionHash criterionValue weightedMean)
-> [NodeLabel x y positionHash criterionValue weightedMean]
-> QuantifiedGame x y criterionValue weightedMean
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NodeLabel x y positionHash criterionValue weightedMean]
-> NodeLabel x y positionHash criterionValue weightedMean
forall a. [a] -> a
last
 ) (Maybe [NodeLabel x y positionHash criterionValue weightedMean]
 -> QuantifiedGame x y criterionValue weightedMean)
-> ([QualifiedMove x y]
    -> Maybe [NodeLabel x y positionHash criterionValue weightedMean])
-> [QualifiedMove x y]
-> QuantifiedGame x y criterionValue weightedMean
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionHashQuantifiedGameTree
  x y positionHash criterionValue weightedMean
-> [QualifiedMove x y]
-> Maybe [NodeLabel x y positionHash criterionValue weightedMean]
forall x y positionHash criterionValue weightedMean.
(Eq x, Eq y) =>
PositionHashQuantifiedGameTree
  x y positionHash criterionValue weightedMean
-> [QualifiedMove x y]
-> Maybe [NodeLabel x y positionHash criterionValue weightedMean]
Evaluation.PositionHashQuantifiedGameTree.traceMatchingMoves PositionHashQuantifiedGameTree
  x y positionHash criterionValue weightedMean
positionHashQuantifiedGameTree ([QualifiedMove x y]
 -> QuantifiedGame x y criterionValue weightedMean)
-> [QualifiedMove x y]
-> QuantifiedGame x y criterionValue weightedMean
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 :: NPlies
inferredSearchDepth	= TranspositionValue (QualifiedMove x y) -> NPlies
forall qualifiedMove. TranspositionValue qualifiedMove -> NPlies
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,
	Real	weightedMean,
	Show	x,
	Show	y
 )
	=> Search.TranspositionValue.IsOptimal
	-> Component.Move.NPlies
	-> positionHash
	-> [Component.Turn.Turn x y]
	-> Evaluation.PositionHashQuantifiedGameTree.PositionHashQuantifiedGameTree x y positionHash criterionValue weightedMean
	-> Search.DynamicMoveData.Transformation x y positionHash
updateTranspositions :: Bool
-> NPlies
-> positionHash
-> [Turn x y]
-> PositionHashQuantifiedGameTree
     x y positionHash criterionValue weightedMean
-> Transformation x y positionHash
updateTranspositions Bool
isOptimal NPlies
nPlies positionHash
positionHash [Turn x y]
turns PositionHashQuantifiedGameTree
  x y positionHash criterionValue weightedMean
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) weightedMean
-> positionHash
-> TranspositionValue (QualifiedMove x y)
-> Transformation (QualifiedMove x y) positionHash
forall positionHash weightedMean qualifiedMove.
(Ord positionHash, Ord weightedMean) =>
FindFitness qualifiedMove weightedMean
-> positionHash
-> TranspositionValue qualifiedMove
-> Transformation qualifiedMove positionHash
Search.Transpositions.insert (
	QuantifiedGame x y criterionValue weightedMean -> weightedMean
forall x y criterionValue weightedMean.
QuantifiedGame x y criterionValue weightedMean -> weightedMean
Evaluation.QuantifiedGame.getFitness (QuantifiedGame x y criterionValue weightedMean -> weightedMean)
-> (TranspositionValue (QualifiedMove x y)
    -> QuantifiedGame x y criterionValue weightedMean)
-> FindFitness (QualifiedMove x y) weightedMean
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionHashQuantifiedGameTree
  x y positionHash criterionValue weightedMean
-> TranspositionValue (QualifiedMove x y)
-> QuantifiedGame x y criterionValue weightedMean
forall x y weightedMean positionHash criterionValue.
(Eq x, Eq y, Enum x, Enum y, Real weightedMean, Show x, Show y) =>
PositionHashQuantifiedGameTree
  x y positionHash criterionValue weightedMean
-> TranspositionValue (QualifiedMove x y)
-> QuantifiedGame x y criterionValue weightedMean
findTranspositionTerminalQuantifiedGame PositionHashQuantifiedGameTree
  x y positionHash criterionValue weightedMean
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
-> NPlies
-> [QualifiedMove x y]
-> TranspositionValue (QualifiedMove x y)
forall qualifiedMove.
Bool
-> NPlies -> [qualifiedMove] -> TranspositionValue qualifiedMove
Search.TranspositionValue.mkTranspositionValue Bool
isOptimal NPlies
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,
	Eq	criterionValue,
	Ord	positionHash,
	Ord	x,
	Ord	y,
	Real	weightedMean,
	Show	x,
	Show	y
 )
	=> Input.SearchOptions.SearchDepth	-- ^ The depth to which the tree should be searched; i.e. the number of plies to look-ahead.
	-> Search.SearchState.SearchState x y positionHash criterionValue weightedMean
	-> Input.SearchOptions.Reader (Result x y positionHash criterionValue weightedMean)
{-# SPECIALISE negaMax :: Input.SearchOptions.SearchDepth -> Search.SearchState.SearchState T.X T.Y T.PositionHash T.CriterionValue T.WeightedMean -> Input.SearchOptions.Reader (Result T.X T.Y T.PositionHash T.CriterionValue T.WeightedMean) #-}
negaMax :: NPlies
-> SearchState x y positionHash criterionValue weightedMean
-> Reader (Result x y positionHash criterionValue weightedMean)
negaMax NPlies
initialSearchDepth SearchState x y positionHash criterionValue weightedMean
initialSearchState	= do
	Maybe NPlies
maybeMinimumTranspositionSearchDepth	<- (SearchOptions -> Maybe NPlies)
-> ReaderT SearchOptions Identity (Maybe NPlies)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Control.Monad.Reader.asks SearchOptions -> Maybe NPlies
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 -> NPlies
getNPlies	= TurnsByLogicalColour (Turn x y) -> NPlies
forall turn. TurnsByLogicalColour turn -> NPlies
State.TurnsByLogicalColour.getNPlies (TurnsByLogicalColour (Turn x y) -> NPlies)
-> (Game x y -> TurnsByLogicalColour (Turn x y))
-> Game x y
-> NPlies
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 criterionValue weightedMean
			-> Input.SearchOptions.SearchDepth
			-> Search.SearchState.SearchState x y positionHash criterionValue weightedMean
			-> Result x y positionHash criterionValue weightedMean
-}
		descend :: (Maybe (QuantifiedGame x y criterionValue weightedMean),
 Maybe (QuantifiedGame x y criterionValue weightedMean))
-> NPlies
-> SearchState x y positionHash criterionValue weightedMean
-> Result x y positionHash criterionValue weightedMean
descend (Maybe (QuantifiedGame x y criterionValue weightedMean)
maybeAlphaQuantifiedGame, Maybe (QuantifiedGame x y criterionValue weightedMean)
maybeBetaQuantifiedGame) NPlies
searchDepth SearchState x y positionHash criterionValue weightedMean
searchState
			| NPlies
searchDepth NPlies -> NPlies -> Bool
forall a. Eq a => a -> a -> Bool
== NPlies
0 Bool -> Bool -> Bool
|| Game x y -> Bool
forall x y. Game x y -> Bool
Model.Game.isTerminated Game x y
game	= MkResult :: forall x y positionHash criterionValue weightedMean.
DynamicMoveData x y positionHash
-> QuantifiedGame x y criterionValue weightedMean
-> NPlies
-> Result x y positionHash criterionValue weightedMean
MkResult {
				getDynamicMoveData :: DynamicMoveData x y positionHash
getDynamicMoveData	= DynamicMoveData x y positionHash
dynamicMoveData,
				getQuantifiedGame :: QuantifiedGame x y criterionValue weightedMean
getQuantifiedGame	= QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
forall weightedMean x y criterionValue.
Num weightedMean =>
QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
Evaluation.QuantifiedGame.negateFitness QuantifiedGame x y criterionValue weightedMean
quantifiedGame,	-- CAVEAT: zero new moves have been applied, so the last move was the opponent's.
				getNPliesEvaluated :: NPlies
getNPliesEvaluated	= NPlies
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 criterionValue weightedMean
selectMaxUsingTranspositions	= (Forest x y positionHash criterionValue weightedMean
 -> Forest x y positionHash criterionValue weightedMean)
-> Result x y positionHash criterionValue weightedMean
selectMaxWithSorter ((Forest x y positionHash criterionValue weightedMean
  -> Forest x y positionHash criterionValue weightedMean)
 -> Result x y positionHash criterionValue weightedMean)
-> (Forest x y positionHash criterionValue weightedMean
    -> Forest x y positionHash criterionValue weightedMean)
-> Result x y positionHash criterionValue weightedMean
forall a b. (a -> b) -> a -> b
$ Forest x y positionHash criterionValue weightedMean
-> Maybe (Forest x y positionHash criterionValue weightedMean)
-> Forest x y positionHash criterionValue weightedMean
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (
					Exception -> Forest x y positionHash criterionValue weightedMean
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Forest x y positionHash criterionValue weightedMean)
-> (String -> Exception)
-> String
-> Forest x y positionHash criterionValue weightedMean
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 criterionValue weightedMean)
-> String -> Forest x y positionHash criterionValue weightedMean
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 criterionValue weightedMean)
 -> Forest x y positionHash criterionValue weightedMean)
-> (Forest x y positionHash criterionValue weightedMean
    -> Maybe (Forest x y positionHash criterionValue weightedMean))
-> Forest x y positionHash criterionValue weightedMean
-> Forest x y positionHash criterionValue weightedMean
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [QualifiedMove x y]
-> Forest x y positionHash criterionValue weightedMean
-> Maybe (Forest x y positionHash criterionValue weightedMean)
forall x y positionHash criterionValue weightedMean.
(Eq x, Eq y) =>
[QualifiedMove x y]
-> Forest x y positionHash criterionValue weightedMean
-> Maybe (Forest x y positionHash criterionValue weightedMean)
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) -> NPlies
forall qualifiedMove. TranspositionValue qualifiedMove -> NPlies
Search.TranspositionValue.inferSearchDepth TranspositionValue (QualifiedMove x y)
transpositionValue NPlies -> NPlies -> Bool
forall a. Ord a => a -> a -> Bool
< NPlies
searchDepth
				then Result x y positionHash criterionValue weightedMean
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 criterionValue weightedMean
transposedQuantifiedGame	= PositionHashQuantifiedGameTree
  x y positionHash criterionValue weightedMean
-> TranspositionValue (QualifiedMove x y)
-> QuantifiedGame x y criterionValue weightedMean
forall x y weightedMean positionHash criterionValue.
(Eq x, Eq y, Enum x, Enum y, Real weightedMean, Show x, Show y) =>
PositionHashQuantifiedGameTree
  x y positionHash criterionValue weightedMean
-> TranspositionValue (QualifiedMove x y)
-> QuantifiedGame x y criterionValue weightedMean
findTranspositionTerminalQuantifiedGame PositionHashQuantifiedGameTree
  x y positionHash criterionValue weightedMean
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 criterionValue weightedMean.
DynamicMoveData x y positionHash
-> QuantifiedGame x y criterionValue weightedMean
-> NPlies
-> Result x y positionHash criterionValue weightedMean
MkResult {
						getDynamicMoveData :: DynamicMoveData x y positionHash
getDynamicMoveData	= DynamicMoveData x y positionHash
dynamicMoveData,
						getQuantifiedGame :: QuantifiedGame x y criterionValue weightedMean
getQuantifiedGame	= Bool
-> QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (QuantifiedGame x y criterionValue weightedMean
transposedQuantifiedGame QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean -> Bool
forall a. Eq a => a -> a -> Bool
== Result x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
forall x y positionHash criterionValue weightedMean.
Result x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
getQuantifiedGame Result x y positionHash criterionValue weightedMean
selectMaxUsingTranspositions) QuantifiedGame x y criterionValue weightedMean
transposedQuantifiedGame,
						getNPliesEvaluated :: NPlies
getNPliesEvaluated	= NPlies
0
					}
					else Result x y positionHash criterionValue weightedMean
-> (QuantifiedGame x y criterionValue weightedMean
    -> Result x y positionHash criterionValue weightedMean)
-> Maybe (QuantifiedGame x y criterionValue weightedMean)
-> Result x y positionHash criterionValue weightedMean
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Result x y positionHash criterionValue weightedMean
selectMaxUsingTranspositions (
						\QuantifiedGame x y criterionValue weightedMean
betaQuantifiedGame -> if QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean -> Ordering
forall weightedMean x y criterionValue.
Ord weightedMean =>
QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean -> Ordering
Evaluation.QuantifiedGame.compareFitness QuantifiedGame x y criterionValue weightedMean
transposedQuantifiedGame QuantifiedGame x y criterionValue weightedMean
betaQuantifiedGame Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT
							then Result x y positionHash criterionValue weightedMean
selectMaxUsingTranspositions
							else MkResult :: forall x y positionHash criterionValue weightedMean.
DynamicMoveData x y positionHash
-> QuantifiedGame x y criterionValue weightedMean
-> NPlies
-> Result x y positionHash criterionValue weightedMean
MkResult {
								getDynamicMoveData :: DynamicMoveData x y positionHash
getDynamicMoveData	= DynamicMoveData x y positionHash
dynamicMoveData,
								getQuantifiedGame :: QuantifiedGame x y criterionValue weightedMean
getQuantifiedGame	= Bool
-> QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (QuantifiedGame x y criterionValue weightedMean
betaQuantifiedGame QuantifiedGame x y criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean -> Bool
forall a. Eq a => a -> a -> Bool
== Result x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
forall x y positionHash criterionValue weightedMean.
Result x y positionHash criterionValue weightedMean
-> QuantifiedGame x y criterionValue weightedMean
getQuantifiedGame Result x y positionHash criterionValue weightedMean
selectMaxUsingTranspositions) QuantifiedGame x y criterionValue weightedMean
betaQuantifiedGame,
								getNPliesEvaluated :: NPlies
getNPliesEvaluated	= NPlies
0
							}
					) Maybe (QuantifiedGame x y criterionValue weightedMean)
maybeBetaQuantifiedGame
			| Bool
otherwise	= (Forest x y positionHash criterionValue weightedMean
 -> Forest x y positionHash criterionValue weightedMean)
-> Result x y positionHash criterionValue weightedMean
selectMaxWithSorter Forest x y positionHash criterionValue weightedMean
-> Forest x y positionHash criterionValue weightedMean
forall a. a -> a
id
			where
				(PositionHashQuantifiedGameTree
  x y positionHash criterionValue weightedMean
positionHashQuantifiedGameTree, DynamicMoveData x y positionHash
dynamicMoveData)	= SearchState x y positionHash criterionValue weightedMean
-> PositionHashQuantifiedGameTree
     x y positionHash criterionValue weightedMean
forall x y positionHash criterionValue weightedMean.
SearchState x y positionHash criterionValue weightedMean
-> PositionHashQuantifiedGameTree
     x y positionHash criterionValue weightedMean
Search.SearchState.getPositionHashQuantifiedGameTree (SearchState x y positionHash criterionValue weightedMean
 -> PositionHashQuantifiedGameTree
      x y positionHash criterionValue weightedMean)
-> (SearchState x y positionHash criterionValue weightedMean
    -> DynamicMoveData x y positionHash)
-> SearchState x y positionHash criterionValue weightedMean
-> (PositionHashQuantifiedGameTree
      x y positionHash criterionValue weightedMean,
    DynamicMoveData x y positionHash)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& SearchState x y positionHash criterionValue weightedMean
-> DynamicMoveData x y positionHash
forall x y positionHash criterionValue weightedMean.
SearchState x y positionHash criterionValue weightedMean
-> DynamicMoveData x y positionHash
Search.SearchState.getDynamicMoveData (SearchState x y positionHash criterionValue weightedMean
 -> (PositionHashQuantifiedGameTree
       x y positionHash criterionValue weightedMean,
     DynamicMoveData x y positionHash))
-> SearchState x y positionHash criterionValue weightedMean
-> (PositionHashQuantifiedGameTree
      x y positionHash criterionValue weightedMean,
    DynamicMoveData x y positionHash)
forall a b. (a -> b) -> a -> b
$ SearchState x y positionHash criterionValue weightedMean
searchState

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

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

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

-- | Mutator.
addNMovesToResult :: Component.Move.NPlies -> Transformation x y positionHash criterionValue weightedMean
addNMovesToResult :: NPlies
-> Transformation x y positionHash criterionValue weightedMean
addNMovesToResult NPlies
nPlies result :: Result x y positionHash criterionValue weightedMean
result@MkResult { getNPliesEvaluated :: forall x y positionHash criterionValue weightedMean.
Result x y positionHash criterionValue weightedMean -> NPlies
getNPliesEvaluated = NPlies
nPliesEvaluated }	= Bool -> Transformation x y positionHash criterionValue weightedMean
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (NPlies
nPlies NPlies -> NPlies -> Bool
forall a. Ord a => a -> a -> Bool
> NPlies
0) Result x y positionHash criterionValue weightedMean
result {
	getNPliesEvaluated :: NPlies
getNPliesEvaluated	= NPlies
nPlies NPlies -> NPlies -> NPlies
forall a. Num a => a -> a -> a
+ NPlies
nPliesEvaluated
}