{-
	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@]

	* Constructs a tree in which each node contains;
	a /Zobrist-hash/;
	a /quantifiedGame/ with one of the moves available to its parent node applied;
	& an evaluation of the fitness of the resulting position.

	* Each forest in the tree is sorted, before evaluation of its fitness is performed.

	* CAVEAT: promotions are insufficiently frequent to be treated specially when sorting.
-}

module BishBosh.Evaluation.PositionHashQuantifiedGameTree(
-- * Types
-- ** Type-synonyms
--	BarePositionHashQuantifiedGameTree,
	Forest,
-- ** Data-types
	NodeLabel(
--		MkNodeLabel,
		getPositionHash,
		getQuantifiedGame
	),
	PositionHashQuantifiedGameTree(
		MkPositionHashQuantifiedGameTree,
		deconstruct
	),
-- * Functions
	reduce,
	traceRoute,
	resign,
	traceMatchingMoveSequence,
	promoteMatchingMoveSequence,
	sortNonCaptureMoves,
-- ** Accessors
	getRootQuantifiedGame',
	getRootPositionHash,
	getRootQuantifiedGame,
-- ** Constructor
	fromBarePositionHashQuantifiedGameTree,
	mkPositionHashQuantifiedGameTree
-- ** Predicates
--	equalsLastQualifiedMove
 ) where

import			Control.Arrow((&&&))
import qualified	BishBosh.Component.QualifiedMove		as Component.QualifiedMove
import qualified	BishBosh.Component.Turn				as Component.Turn
import qualified	BishBosh.Component.Zobrist			as Component.Zobrist
import qualified	BishBosh.Data.RoseTree				as Data.RoseTree
import qualified	BishBosh.Evaluation.Fitness			as Evaluation.Fitness
import qualified	BishBosh.Evaluation.QuantifiedGame		as Evaluation.QuantifiedGame
import qualified	BishBosh.Input.EvaluationOptions		as Input.EvaluationOptions
import qualified	BishBosh.Input.RankValues			as Input.RankValues
import qualified	BishBosh.Input.SearchOptions			as Input.SearchOptions
import qualified	BishBosh.Metric.WeightedMeanAndCriterionValues	as Metric.WeightedMeanAndCriterionValues
import qualified	BishBosh.Model.Game				as Model.Game
import qualified	BishBosh.Model.GameTree				as Model.GameTree
import qualified	BishBosh.Notation.MoveNotation			as Notation.MoveNotation
import qualified	BishBosh.Property.Arboreal			as Property.Arboreal
import qualified	BishBosh.Property.Null				as Property.Null
import qualified	BishBosh.StateProperty.Hashable			as StateProperty.Hashable
import qualified	BishBosh.Type.Crypto				as Type.Crypto
import qualified	Control.Arrow
import qualified	Control.Monad.Reader
import qualified	Data.Bits
import qualified	Data.Maybe
import qualified	Data.Tree

-- | Define a node in the tree to contain the hash of a /game/ & an evaluation of the fitness of that /game/.
data NodeLabel positionHash	= MkNodeLabel {
	NodeLabel positionHash -> positionHash
getPositionHash		:: positionHash,	-- ^ The hash of the /game/ contained in 'getQuantifiedGame'.
	NodeLabel positionHash -> QuantifiedGame
getQuantifiedGame	:: Evaluation.QuantifiedGame.QuantifiedGame
} deriving (NodeLabel positionHash -> NodeLabel positionHash -> Bool
(NodeLabel positionHash -> NodeLabel positionHash -> Bool)
-> (NodeLabel positionHash -> NodeLabel positionHash -> Bool)
-> Eq (NodeLabel positionHash)
forall positionHash.
Eq positionHash =>
NodeLabel positionHash -> NodeLabel positionHash -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeLabel positionHash -> NodeLabel positionHash -> Bool
$c/= :: forall positionHash.
Eq positionHash =>
NodeLabel positionHash -> NodeLabel positionHash -> Bool
== :: NodeLabel positionHash -> NodeLabel positionHash -> Bool
$c== :: forall positionHash.
Eq positionHash =>
NodeLabel positionHash -> NodeLabel positionHash -> Bool
Eq, Int -> NodeLabel positionHash -> ShowS
[NodeLabel positionHash] -> ShowS
NodeLabel positionHash -> String
(Int -> NodeLabel positionHash -> ShowS)
-> (NodeLabel positionHash -> String)
-> ([NodeLabel positionHash] -> ShowS)
-> Show (NodeLabel positionHash)
forall positionHash.
Show positionHash =>
Int -> NodeLabel positionHash -> ShowS
forall positionHash.
Show positionHash =>
[NodeLabel positionHash] -> ShowS
forall positionHash.
Show positionHash =>
NodeLabel positionHash -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeLabel positionHash] -> ShowS
$cshowList :: forall positionHash.
Show positionHash =>
[NodeLabel positionHash] -> ShowS
show :: NodeLabel positionHash -> String
$cshow :: forall positionHash.
Show positionHash =>
NodeLabel positionHash -> String
showsPrec :: Int -> NodeLabel positionHash -> ShowS
$cshowsPrec :: forall positionHash.
Show positionHash =>
Int -> NodeLabel positionHash -> ShowS
Show)

instance Notation.MoveNotation.ShowNotationFloat (NodeLabel positionHash) where
	showsNotationFloat :: MoveNotation
-> (Double -> ShowS) -> NodeLabel positionHash -> ShowS
showsNotationFloat MoveNotation
moveNotation Double -> ShowS
showsDouble MkNodeLabel { getQuantifiedGame :: forall positionHash. NodeLabel positionHash -> QuantifiedGame
getQuantifiedGame = QuantifiedGame
quantifiedGame }	= MoveNotation -> Turn -> ShowS
forall a. ShowNotation a => MoveNotation -> a -> ShowS
Notation.MoveNotation.showsNotation MoveNotation
moveNotation (
		QuantifiedGame -> Turn
Evaluation.QuantifiedGame.getLastTurn QuantifiedGame
quantifiedGame
	 ) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"\t=> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ShowS
showsDouble (
		Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Double)
-> (WeightedMeanAndCriterionValues -> Double)
-> WeightedMeanAndCriterionValues
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WeightedMeanAndCriterionValues -> Double
Metric.WeightedMeanAndCriterionValues.getWeightedMean (WeightedMeanAndCriterionValues -> Double)
-> WeightedMeanAndCriterionValues -> Double
forall a b. (a -> b) -> a -> b
$ QuantifiedGame -> WeightedMeanAndCriterionValues
Evaluation.QuantifiedGame.getWeightedMeanAndCriterionValues QuantifiedGame
quantifiedGame
	 )

instance Property.Null.Null (NodeLabel positionHash) where
	isNull :: NodeLabel positionHash -> Bool
isNull MkNodeLabel { getQuantifiedGame :: forall positionHash. NodeLabel positionHash -> QuantifiedGame
getQuantifiedGame = QuantifiedGame
quantifiedGame }	= QuantifiedGame -> Bool
forall a. Null a => a -> Bool
Property.Null.isNull QuantifiedGame
quantifiedGame

-- | Whether the last qualifiedMove of the /game/ in a node, matches a specified /QualifiedMove/.
equalsLastQualifiedMove :: Component.QualifiedMove.QualifiedMove -> Data.RoseTree.IsMatch (NodeLabel positionHash)
equalsLastQualifiedMove :: QualifiedMove -> IsMatch (NodeLabel positionHash)
equalsLastQualifiedMove QualifiedMove
qualifiedMove MkNodeLabel { getQuantifiedGame :: forall positionHash. NodeLabel positionHash -> QuantifiedGame
getQuantifiedGame = QuantifiedGame
quantifiedGame }	= (QualifiedMove -> QualifiedMove -> Bool
forall a. Eq a => a -> a -> Bool
== QualifiedMove
qualifiedMove) (QualifiedMove -> Bool) -> (Turn -> QualifiedMove) -> Turn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn -> QualifiedMove
Component.Turn.getQualifiedMove (Turn -> Bool) -> Turn -> Bool
forall a b. (a -> b) -> a -> b
$ QuantifiedGame -> Turn
Evaluation.QuantifiedGame.getLastTurn QuantifiedGame
quantifiedGame

-- | The tree resulting from each possible move-choice applied to a /game/, including a position-hash & an evaluation of the resulting fitness.
type BarePositionHashQuantifiedGameTree positionHash	= Data.Tree.Tree (NodeLabel positionHash)

-- | Accessor.
getRootQuantifiedGame' :: BarePositionHashQuantifiedGameTree positionHash -> Evaluation.QuantifiedGame.QuantifiedGame
getRootQuantifiedGame' :: BarePositionHashQuantifiedGameTree positionHash -> QuantifiedGame
getRootQuantifiedGame' Data.Tree.Node {
	rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel	= MkNodeLabel { getQuantifiedGame :: forall positionHash. NodeLabel positionHash -> QuantifiedGame
getQuantifiedGame = QuantifiedGame
quantifiedGame }
} = QuantifiedGame
quantifiedGame

-- | Wrap the bare tree.
newtype PositionHashQuantifiedGameTree positionHash	= MkPositionHashQuantifiedGameTree {
	PositionHashQuantifiedGameTree positionHash
-> BarePositionHashQuantifiedGameTree positionHash
deconstruct	:: BarePositionHashQuantifiedGameTree positionHash
} deriving PositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash -> Bool
(PositionHashQuantifiedGameTree positionHash
 -> PositionHashQuantifiedGameTree positionHash -> Bool)
-> (PositionHashQuantifiedGameTree positionHash
    -> PositionHashQuantifiedGameTree positionHash -> Bool)
-> Eq (PositionHashQuantifiedGameTree positionHash)
forall positionHash.
Eq positionHash =>
PositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash -> Bool
$c/= :: forall positionHash.
Eq positionHash =>
PositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash -> Bool
== :: PositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash -> Bool
$c== :: forall positionHash.
Eq positionHash =>
PositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash -> Bool
Eq

instance Property.Arboreal.Prunable (PositionHashQuantifiedGameTree positionHash) where
	prune :: Int
-> PositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
prune Int
depth MkPositionHashQuantifiedGameTree { deconstruct :: forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> BarePositionHashQuantifiedGameTree positionHash
deconstruct = BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree }	= BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
forall positionHash.
BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
MkPositionHashQuantifiedGameTree (BarePositionHashQuantifiedGameTree positionHash
 -> PositionHashQuantifiedGameTree positionHash)
-> BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
forall a b. (a -> b) -> a -> b
$ Int -> Transformation (NodeLabel positionHash)
forall a. Int -> Transformation a
Data.RoseTree.prune Int
depth BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree

instance Notation.MoveNotation.ShowNotationFloat (PositionHashQuantifiedGameTree positionHash) where
	showsNotationFloat :: MoveNotation
-> (Double -> ShowS)
-> PositionHashQuantifiedGameTree positionHash
-> ShowS
showsNotationFloat MoveNotation
moveNotation Double -> ShowS
showsDouble MkPositionHashQuantifiedGameTree { deconstruct :: forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> BarePositionHashQuantifiedGameTree positionHash
deconstruct = BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree } = String -> ShowS
showString (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ (
		if NodeLabel positionHash -> Bool
forall a. Null a => a -> Bool
Property.Null.isNull (NodeLabel positionHash -> Bool)
-> (BarePositionHashQuantifiedGameTree positionHash
    -> NodeLabel positionHash)
-> BarePositionHashQuantifiedGameTree positionHash
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BarePositionHashQuantifiedGameTree positionHash
-> NodeLabel positionHash
forall a. Tree a -> a
Data.Tree.rootLabel (BarePositionHashQuantifiedGameTree positionHash -> Bool)
-> BarePositionHashQuantifiedGameTree positionHash -> Bool
forall a b. (a -> b) -> a -> b
$ BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree
			then (NodeLabel positionHash -> String)
-> Forest (NodeLabel positionHash) -> String
forall a. (a -> String) -> Forest a -> String
Data.RoseTree.drawForest NodeLabel positionHash -> String
forall a. ShowNotationFloat a => a -> String
toString (Forest (NodeLabel positionHash) -> String)
-> (BarePositionHashQuantifiedGameTree positionHash
    -> Forest (NodeLabel positionHash))
-> BarePositionHashQuantifiedGameTree positionHash
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BarePositionHashQuantifiedGameTree positionHash
-> Forest (NodeLabel positionHash)
forall a. Tree a -> Forest a
Data.Tree.subForest
			else (NodeLabel positionHash -> String)
-> BarePositionHashQuantifiedGameTree positionHash -> String
forall a. (a -> String) -> Tree a -> String
Data.RoseTree.drawTree NodeLabel positionHash -> String
forall a. ShowNotationFloat a => a -> String
toString
	 ) BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree where
		toString :: a -> String
toString a
nodeLabel	= MoveNotation -> (Double -> ShowS) -> a -> ShowS
forall a.
ShowNotationFloat a =>
MoveNotation -> (Double -> ShowS) -> a -> ShowS
Notation.MoveNotation.showsNotationFloat MoveNotation
moveNotation Double -> ShowS
showsDouble a
nodeLabel String
""

-- | Constructor.
fromBarePositionHashQuantifiedGameTree :: BarePositionHashQuantifiedGameTree positionHash -> PositionHashQuantifiedGameTree positionHash
fromBarePositionHashQuantifiedGameTree :: BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
fromBarePositionHashQuantifiedGameTree	= BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
forall positionHash.
BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
MkPositionHashQuantifiedGameTree

-- | Constructor.
mkPositionHashQuantifiedGameTree
	:: Data.Bits.Bits positionHash
	=> Input.EvaluationOptions.EvaluationOptions
	-> Input.SearchOptions.SearchOptions
	-> Component.Zobrist.Zobrist positionHash
	-> Model.GameTree.MoveFrequency
	-> Model.Game.Game	-- ^ The current state of the /game/.
	-> PositionHashQuantifiedGameTree positionHash
{-# SPECIALISE mkPositionHashQuantifiedGameTree
	:: Input.EvaluationOptions.EvaluationOptions
	-> Input.SearchOptions.SearchOptions
	-> Component.Zobrist.Zobrist Type.Crypto.PositionHash
	-> Model.GameTree.MoveFrequency
	-> Model.Game.Game
	-> PositionHashQuantifiedGameTree Type.Crypto.PositionHash
 #-}
mkPositionHashQuantifiedGameTree :: EvaluationOptions
-> SearchOptions
-> Zobrist positionHash
-> MoveFrequency
-> Game
-> PositionHashQuantifiedGameTree positionHash
mkPositionHashQuantifiedGameTree EvaluationOptions
evaluationOptions SearchOptions
searchOptions Zobrist positionHash
zobrist MoveFrequency
moveFrequency Game
seedGame	= BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
forall positionHash.
BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
MkPositionHashQuantifiedGameTree (
	if EvaluationOptions -> Bool
Input.EvaluationOptions.getIncrementalEvaluation EvaluationOptions
evaluationOptions
		then let
			apexPositionHash :: positionHash
apexPositionHash	= Zobrist positionHash -> Game -> positionHash
forall positionHash hashable.
(Bits positionHash, Hashable hashable) =>
Zobrist positionHash -> hashable -> positionHash
StateProperty.Hashable.hash Zobrist positionHash
zobrist Game
seedGame
		in Node :: forall a. a -> Forest a -> Tree a
Data.Tree.Node {
			rootLabel :: NodeLabel positionHash
Data.Tree.rootLabel	= positionHash -> QuantifiedGame -> NodeLabel positionHash
forall positionHash.
positionHash -> QuantifiedGame -> NodeLabel positionHash
MkNodeLabel positionHash
apexPositionHash (QuantifiedGame -> NodeLabel positionHash)
-> QuantifiedGame -> NodeLabel positionHash
forall a b. (a -> b) -> a -> b
$ Reader EvaluationOptions QuantifiedGame
-> EvaluationOptions -> QuantifiedGame
forall r a. Reader r a -> r -> a
Control.Monad.Reader.runReader (
				Maybe Double -> Game -> Reader EvaluationOptions QuantifiedGame
Evaluation.QuantifiedGame.fromGame Maybe Double
forall a. Maybe a
Nothing Game
seedGame
			) EvaluationOptions
evaluationOptions,	-- Neither the previous positionHash nor the previous pieceSquareValueDifference, are available to support incremental construction.
			subForest :: Forest (NodeLabel positionHash)
Data.Tree.subForest	= (Tree Game -> BarePositionHashQuantifiedGameTree positionHash)
-> [Tree Game] -> Forest (NodeLabel positionHash)
forall a b. (a -> b) -> [a] -> [b]
map (
				(positionHash
 -> Game
 -> Tree Game
 -> BarePositionHashQuantifiedGameTree positionHash)
-> (PieceSquareByCoordinatesByRank
    -> positionHash
    -> Game
    -> Tree Game
    -> BarePositionHashQuantifiedGameTree positionHash)
-> Maybe PieceSquareByCoordinatesByRank
-> positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
					let
						slave :: positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash
slave positionHash
positionHash Game
game Data.Tree.Node {
							rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel	= Game
game',
							subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest	= [Tree Game]
gameForest'
						} = Node :: forall a. a -> Forest a -> Tree a
Data.Tree.Node {
							rootLabel :: NodeLabel positionHash
Data.Tree.rootLabel	= positionHash -> QuantifiedGame -> NodeLabel positionHash
forall positionHash.
positionHash -> QuantifiedGame -> NodeLabel positionHash
MkNodeLabel positionHash
positionHash' (QuantifiedGame -> NodeLabel positionHash)
-> QuantifiedGame -> NodeLabel positionHash
forall a b. (a -> b) -> a -> b
$ Reader EvaluationOptions QuantifiedGame
-> EvaluationOptions -> QuantifiedGame
forall r a. Reader r a -> r -> a
Control.Monad.Reader.runReader (
								Maybe Double -> Game -> Reader EvaluationOptions QuantifiedGame
Evaluation.QuantifiedGame.fromGame Maybe Double
forall a. Maybe a
Nothing Game
game'
							) EvaluationOptions
evaluationOptions,
							subForest :: Forest (NodeLabel positionHash)
Data.Tree.subForest	= (Tree Game -> BarePositionHashQuantifiedGameTree positionHash)
-> [Tree Game] -> Forest (NodeLabel positionHash)
forall a b. (a -> b) -> [a] -> [b]
map (positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash
slave positionHash
positionHash' Game
game') [Tree Game]
gameForest'	-- Recurse.
						} where
							positionHash' :: positionHash
positionHash'	= Game
-> positionHash -> Game -> Zobrist positionHash -> positionHash
forall positionHash.
Bits positionHash =>
Game
-> positionHash -> Game -> Zobrist positionHash -> positionHash
Model.Game.updateIncrementalPositionHash Game
game positionHash
positionHash Game
game' Zobrist positionHash
zobrist
					in positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash
slave
				) (
					\PieceSquareByCoordinatesByRank
pieceSquareByCoordinatesByRank -> let
						slave :: Double
-> positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash
slave Double
pieceSquareValueDifference positionHash
positionHash Game
game Data.Tree.Node {
							rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel	= Game
game',
							subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest	= [Tree Game]
gameForest'
						} = Node :: forall a. a -> Forest a -> Tree a
Data.Tree.Node {
							rootLabel :: NodeLabel positionHash
Data.Tree.rootLabel	= positionHash -> QuantifiedGame -> NodeLabel positionHash
forall positionHash.
positionHash -> QuantifiedGame -> NodeLabel positionHash
MkNodeLabel positionHash
positionHash' (QuantifiedGame -> NodeLabel positionHash)
-> QuantifiedGame -> NodeLabel positionHash
forall a b. (a -> b) -> a -> b
$ Reader EvaluationOptions QuantifiedGame
-> EvaluationOptions -> QuantifiedGame
forall r a. Reader r a -> r -> a
Control.Monad.Reader.runReader (
								Maybe Double -> Game -> Reader EvaluationOptions QuantifiedGame
Evaluation.QuantifiedGame.fromGame (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
pieceSquareValueDifference') Game
game'
							) EvaluationOptions
evaluationOptions,
							subForest :: Forest (NodeLabel positionHash)
Data.Tree.subForest	= (Tree Game -> BarePositionHashQuantifiedGameTree positionHash)
-> [Tree Game] -> Forest (NodeLabel positionHash)
forall a b. (a -> b) -> [a] -> [b]
map (Double
-> positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash
slave Double
pieceSquareValueDifference' positionHash
positionHash' Game
game') [Tree Game]
gameForest'	-- Recurse.
						} where
							pieceSquareValueDifference' :: Double
pieceSquareValueDifference'	= Double -> PieceSquareByCoordinatesByRank -> Game -> Double
Evaluation.Fitness.measurePieceSquareValueDifferenceIncrementally Double
pieceSquareValueDifference PieceSquareByCoordinatesByRank
pieceSquareByCoordinatesByRank Game
game'
							positionHash' :: positionHash
positionHash'			= Game
-> positionHash -> Game -> Zobrist positionHash -> positionHash
forall positionHash.
Bits positionHash =>
Game
-> positionHash -> Game -> Zobrist positionHash -> positionHash
Model.Game.updateIncrementalPositionHash Game
game positionHash
positionHash Game
game' Zobrist positionHash
zobrist
					in Double
-> positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash
slave (Double
 -> positionHash
 -> Game
 -> Tree Game
 -> BarePositionHashQuantifiedGameTree positionHash)
-> Double
-> positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash
forall a b. (a -> b) -> a -> b
$ PieceSquareByCoordinatesByRank -> Game -> Double
Evaluation.Fitness.measurePieceSquareValueDifference PieceSquareByCoordinatesByRank
pieceSquareByCoordinatesByRank Game
seedGame
				) (
					EvaluationOptions -> Maybe PieceSquareByCoordinatesByRank
Input.EvaluationOptions.getMaybePieceSquareByCoordinatesByRank EvaluationOptions
evaluationOptions
				) positionHash
apexPositionHash Game
seedGame
			) ([Tree Game] -> Forest (NodeLabel positionHash))
-> [Tree Game] -> Forest (NodeLabel positionHash)
forall a b. (a -> b) -> a -> b
$ Tree Game -> [Tree Game]
forall a. Tree a -> Forest a
Data.Tree.subForest Tree Game
bareGameTree
		}
		else (positionHash -> QuantifiedGame -> NodeLabel positionHash)
-> (positionHash, QuantifiedGame) -> NodeLabel positionHash
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry positionHash -> QuantifiedGame -> NodeLabel positionHash
forall positionHash.
positionHash -> QuantifiedGame -> NodeLabel positionHash
MkNodeLabel ((positionHash, QuantifiedGame) -> NodeLabel positionHash)
-> (Game -> (positionHash, QuantifiedGame))
-> Game
-> NodeLabel positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
			Zobrist positionHash -> Game -> positionHash
forall positionHash hashable.
(Bits positionHash, Hashable hashable) =>
Zobrist positionHash -> hashable -> positionHash
StateProperty.Hashable.hash Zobrist positionHash
zobrist (Game -> positionHash)
-> (Game -> QuantifiedGame)
-> Game
-> (positionHash, QuantifiedGame)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Reader EvaluationOptions QuantifiedGame
-> EvaluationOptions -> QuantifiedGame
forall r a. Reader r a -> r -> a
`Control.Monad.Reader.runReader` EvaluationOptions
evaluationOptions) (Reader EvaluationOptions QuantifiedGame -> QuantifiedGame)
-> (Game -> Reader EvaluationOptions QuantifiedGame)
-> Game
-> QuantifiedGame
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Double -> Game -> Reader EvaluationOptions QuantifiedGame
Evaluation.QuantifiedGame.fromGame Maybe Double
forall a. Maybe a
Nothing
		) (Game -> NodeLabel positionHash)
-> Tree Game -> BarePositionHashQuantifiedGameTree positionHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree Game
bareGameTree
 ) where
	bareGameTree :: Tree Game
bareGameTree	= GameTree -> Tree Game
Model.GameTree.deconstruct (GameTree -> Tree Game)
-> (GameTree -> GameTree) -> GameTree -> Tree Game
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe CaptureMoveSortAlgorithm
-> EvaluateRank -> MoveFrequency -> GameTree -> GameTree
Model.GameTree.sortGameTree (
		SearchOptions -> Maybe CaptureMoveSortAlgorithm
Input.SearchOptions.getMaybeCaptureMoveSortAlgorithm SearchOptions
searchOptions
	 ) (
		RankValues -> EvaluateRank
Input.RankValues.findRankValue (RankValues -> EvaluateRank) -> RankValues -> EvaluateRank
forall a b. (a -> b) -> a -> b
$ EvaluationOptions -> RankValues
Input.EvaluationOptions.getRankValues EvaluationOptions
evaluationOptions
	 ) MoveFrequency
moveFrequency (GameTree -> Tree Game) -> GameTree -> Tree Game
forall a b. (a -> b) -> a -> b
$ Game -> GameTree
Model.GameTree.fromGame Game
seedGame

-- | Accessor.
getRootPositionHash :: PositionHashQuantifiedGameTree positionHash -> positionHash
getRootPositionHash :: PositionHashQuantifiedGameTree positionHash -> positionHash
getRootPositionHash MkPositionHashQuantifiedGameTree {
	deconstruct :: forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> BarePositionHashQuantifiedGameTree positionHash
deconstruct = Data.Tree.Node {
		rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel	= MkNodeLabel { getPositionHash :: forall positionHash. NodeLabel positionHash -> positionHash
getPositionHash = positionHash
positionHash }
	}
} = positionHash
positionHash

-- | Accessor.
getRootQuantifiedGame :: PositionHashQuantifiedGameTree positionHash -> Evaluation.QuantifiedGame.QuantifiedGame
getRootQuantifiedGame :: PositionHashQuantifiedGameTree positionHash -> QuantifiedGame
getRootQuantifiedGame MkPositionHashQuantifiedGameTree {
	deconstruct :: forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> BarePositionHashQuantifiedGameTree positionHash
deconstruct = Data.Tree.Node {
		rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel	= MkNodeLabel { getQuantifiedGame :: forall positionHash. NodeLabel positionHash -> QuantifiedGame
getQuantifiedGame = QuantifiedGame
quantifiedGame }
	}
} = QuantifiedGame
quantifiedGame

-- | Forward request.
reduce
	:: Data.RoseTree.IsMatch (NodeLabel positionHash)
	-> PositionHashQuantifiedGameTree positionHash
	-> Maybe (PositionHashQuantifiedGameTree positionHash)
reduce :: IsMatch (NodeLabel positionHash)
-> PositionHashQuantifiedGameTree positionHash
-> Maybe (PositionHashQuantifiedGameTree positionHash)
reduce IsMatch (NodeLabel positionHash)
isMatch MkPositionHashQuantifiedGameTree { deconstruct :: forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> BarePositionHashQuantifiedGameTree positionHash
deconstruct = BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree }	= BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
forall positionHash.
BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
MkPositionHashQuantifiedGameTree (BarePositionHashQuantifiedGameTree positionHash
 -> PositionHashQuantifiedGameTree positionHash)
-> Maybe (BarePositionHashQuantifiedGameTree positionHash)
-> Maybe (PositionHashQuantifiedGameTree positionHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IsMatch (NodeLabel positionHash)
-> BarePositionHashQuantifiedGameTree positionHash
-> Maybe (BarePositionHashQuantifiedGameTree positionHash)
forall a. IsMatch a -> Tree a -> Maybe (Tree a)
Data.RoseTree.reduce IsMatch (NodeLabel positionHash)
isMatch BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree

-- | Forward request.
traceRoute
	:: (Component.Turn.Turn -> Data.RoseTree.IsMatch (NodeLabel positionHash))
	-> PositionHashQuantifiedGameTree positionHash
	-> [Component.Turn.Turn]
	-> Maybe [NodeLabel positionHash]
traceRoute :: (Turn -> IsMatch (NodeLabel positionHash))
-> PositionHashQuantifiedGameTree positionHash
-> [Turn]
-> Maybe [NodeLabel positionHash]
traceRoute Turn -> IsMatch (NodeLabel positionHash)
isMatch MkPositionHashQuantifiedGameTree { deconstruct :: forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> BarePositionHashQuantifiedGameTree positionHash
deconstruct = BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree }	= (Turn -> IsMatch (NodeLabel positionHash))
-> BarePositionHashQuantifiedGameTree positionHash
-> [Turn]
-> Maybe [NodeLabel positionHash]
forall datum a.
(datum -> IsMatch a) -> Tree a -> [datum] -> Maybe [a]
Data.RoseTree.traceRoute Turn -> IsMatch (NodeLabel positionHash)
isMatch BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree

-- | Follow the specified move-sequence down the /positionHashQuantifiedGameTree/.
traceMatchingMoveSequence
	:: PositionHashQuantifiedGameTree positionHash
	-> Component.QualifiedMove.QualifiedMoveSequence
	-> Maybe [NodeLabel positionHash]	-- ^ Returns 'Nothing', on failure to match a move.
traceMatchingMoveSequence :: PositionHashQuantifiedGameTree positionHash
-> QualifiedMoveSequence -> Maybe [NodeLabel positionHash]
traceMatchingMoveSequence MkPositionHashQuantifiedGameTree { deconstruct :: forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> BarePositionHashQuantifiedGameTree positionHash
deconstruct = BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree }	= (QualifiedMove -> IsMatch (NodeLabel positionHash))
-> BarePositionHashQuantifiedGameTree positionHash
-> QualifiedMoveSequence
-> Maybe [NodeLabel positionHash]
forall datum a.
(datum -> IsMatch a) -> Tree a -> [datum] -> Maybe [a]
Data.RoseTree.traceRoute QualifiedMove -> IsMatch (NodeLabel positionHash)
forall positionHash.
QualifiedMove -> IsMatch (NodeLabel positionHash)
equalsLastQualifiedMove BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree

-- | Amend the apex-game to reflect the resignation of the next player.
resign :: PositionHashQuantifiedGameTree positionHash -> PositionHashQuantifiedGameTree positionHash
resign :: PositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
resign MkPositionHashQuantifiedGameTree {
	deconstruct :: forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> BarePositionHashQuantifiedGameTree positionHash
deconstruct	= barePositionHashQuantifiedGameTree :: BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree@Data.Tree.Node {
		rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel	= nodeLabel :: NodeLabel positionHash
nodeLabel@MkNodeLabel { getQuantifiedGame :: forall positionHash. NodeLabel positionHash -> QuantifiedGame
getQuantifiedGame = QuantifiedGame
quantifiedGame }
	}
} = BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
forall positionHash.
BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
MkPositionHashQuantifiedGameTree (BarePositionHashQuantifiedGameTree positionHash
 -> PositionHashQuantifiedGameTree positionHash)
-> BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
forall a b. (a -> b) -> a -> b
$ BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree {
	rootLabel :: NodeLabel positionHash
Data.Tree.rootLabel	= NodeLabel positionHash
nodeLabel {
		getQuantifiedGame :: QuantifiedGame
getQuantifiedGame	= QuantifiedGame
quantifiedGame { getGame :: Game
Evaluation.QuantifiedGame.getGame = Transformation
Model.Game.resign Transformation -> Transformation
forall a b. (a -> b) -> a -> b
$ QuantifiedGame -> Game
Evaluation.QuantifiedGame.getGame QuantifiedGame
quantifiedGame }
	}
}

-- | Self-documentation.
type Forest positionHash	= [BarePositionHashQuantifiedGameTree positionHash]

{- |
	* Promotes the first matching /move/ to the head of the forest, then descends & recursively promotes the next matching move in the sub-forest.

	* N.B.: this can be used to dynamically re-order the forest when a transposition is detected.
-}
promoteMatchingMoveSequence
	:: Component.QualifiedMove.QualifiedMoveSequence	-- ^ The list of qualifiedMoves, which should be promoted at successively deeper levels in the tree.
	-> Forest positionHash
	-> Maybe (Forest positionHash)				-- ^ Returns 'Nothing' on failure to match a move.
promoteMatchingMoveSequence :: QualifiedMoveSequence
-> Forest positionHash -> Maybe (Forest positionHash)
promoteMatchingMoveSequence	= (QualifiedMove -> IsMatch (NodeLabel positionHash))
-> QualifiedMoveSequence
-> Forest positionHash
-> Maybe (Forest positionHash)
forall datum a.
(datum -> IsMatch a) -> [datum] -> [Tree a] -> Maybe [Tree a]
Data.RoseTree.promote QualifiedMove -> IsMatch (NodeLabel positionHash)
forall positionHash.
QualifiedMove -> IsMatch (NodeLabel positionHash)
equalsLastQualifiedMove

{- |
	* Sorts the forest, starting just after any initial capture-moves.

	* N.B.: this can be used to dynamically re-order the forest using the killer heuristic.
-}
sortNonCaptureMoves
	:: (Forest positionHash -> Forest positionHash)
	-> Forest positionHash
	-> Forest positionHash
sortNonCaptureMoves :: (Forest positionHash -> Forest positionHash)
-> Forest positionHash -> Forest positionHash
sortNonCaptureMoves Forest positionHash -> Forest positionHash
sortForest	= (Forest positionHash -> Forest positionHash -> Forest positionHash)
-> (Forest positionHash, Forest positionHash)
-> Forest positionHash
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Forest positionHash -> Forest positionHash -> Forest positionHash
forall a. [a] -> [a] -> [a]
(++) ((Forest positionHash, Forest positionHash) -> Forest positionHash)
-> (Forest positionHash
    -> (Forest positionHash, Forest positionHash))
-> Forest positionHash
-> Forest positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Forest positionHash -> Forest positionHash)
-> (Forest positionHash, Forest positionHash)
-> (Forest positionHash, Forest positionHash)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second Forest positionHash -> Forest positionHash
sortForest ((Forest positionHash, Forest positionHash)
 -> (Forest positionHash, Forest positionHash))
-> (Forest positionHash
    -> (Forest positionHash, Forest positionHash))
-> Forest positionHash
-> (Forest positionHash, Forest positionHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BarePositionHashQuantifiedGameTree positionHash -> Bool)
-> Forest positionHash
-> (Forest positionHash, Forest positionHash)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (
	Turn -> Bool
Component.Turn.isCapture (Turn -> Bool)
-> (BarePositionHashQuantifiedGameTree positionHash -> Turn)
-> BarePositionHashQuantifiedGameTree positionHash
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame -> Turn
Evaluation.QuantifiedGame.getLastTurn (QuantifiedGame -> Turn)
-> (BarePositionHashQuantifiedGameTree positionHash
    -> QuantifiedGame)
-> BarePositionHashQuantifiedGameTree positionHash
-> Turn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BarePositionHashQuantifiedGameTree positionHash -> QuantifiedGame
forall positionHash.
BarePositionHashQuantifiedGameTree positionHash -> QuantifiedGame
getRootQuantifiedGame'	-- Shield any capture-moves, which were previously advanced by static sorting, from the sort.
 )