{-# LANGUAGE LambdaCase #-}
{-
	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@]

	* Defines chess as a constant tree of all possible moves.

	* Because of the conceptually infinite size of this data-structure, care must be taken not to attempt to call 'show', '(==)', ...
-}

module BishBosh.Model.GameTree(
-- * Types
-- ** Type-synonyms
	BareGameTree,
	MoveFrequency,
--	Transformation,
-- ** Data-types
	GameTree(
--		MkGameTree,
		deconstruct
	),
-- * Function
--	compareByMVVLVA,
--	getLastMove,
--	staticExchangeEvaluation,
--	getRankAndMove,
	countGames,
	countPositions,
	traceRoute,
	sortGameTree,
	toMoveFrequency,
-- ** Constructor
	fromBareGameTree,
	fromGame
) where

import			Control.Arrow((&&&))
import qualified	BishBosh.Attribute.CaptureMoveSortAlgorithm	as Attribute.CaptureMoveSortAlgorithm
import qualified	BishBosh.Attribute.MoveType			as Attribute.MoveType
import qualified	BishBosh.Attribute.Rank				as Attribute.Rank
import qualified	BishBosh.Colour.LogicalColour			as Colour.LogicalColour
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.Data.RoseTree				as Data.RoseTree
import qualified	BishBosh.Model.Game				as Model.Game
import qualified	BishBosh.Model.MoveFrequency			as Model.MoveFrequency
import qualified	BishBosh.Notation.MoveNotation			as Notation.MoveNotation
import qualified	BishBosh.Property.Arboreal			as Property.Arboreal
import qualified	BishBosh.Property.Empty				as Property.Empty
import qualified	BishBosh.Property.Null				as Property.Null
import qualified	BishBosh.Property.Opposable			as Property.Opposable
import qualified	BishBosh.Type.Count				as Type.Count
import qualified	BishBosh.Type.Mass				as Type.Mass
import qualified	Control.Exception
import qualified	Data.Default
import qualified	Data.Foldable
import qualified	Data.List
import qualified	Data.Maybe
import qualified	Data.Tree

-- | Each node defines the state of the game.
type BareGameTree	= Data.Tree.Tree Model.Game.Game

-- | Forwards request to 'Component.Turn.compareByMVVLVA'.
compareByMVVLVA
	:: Attribute.Rank.EvaluateRank
	-> BareGameTree
	-> BareGameTree
	-> Ordering
compareByMVVLVA :: EvaluateRank -> BareGameTree -> BareGameTree -> Ordering
compareByMVVLVA EvaluateRank
evaluateRank Data.Tree.Node { rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = Game
gameL } Data.Tree.Node { rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = Game
gameR }	= (Turn -> Turn -> Ordering) -> (Turn, Turn) -> Ordering
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (
	EvaluateRank -> Turn -> Turn -> Ordering
Component.Turn.compareByMVVLVA EvaluateRank
evaluateRank
 ) ((Turn, Turn) -> Ordering)
-> ((Game -> Turn) -> (Turn, Turn)) -> (Game -> Turn) -> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	((Game -> Turn) -> Game -> Turn
forall a b. (a -> b) -> a -> b
$ Game
gameL) ((Game -> Turn) -> Turn)
-> ((Game -> Turn) -> Turn) -> (Game -> Turn) -> (Turn, Turn)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((Game -> Turn) -> Game -> Turn
forall a b. (a -> b) -> a -> b
$ Game
gameR)
 ) ((Game -> Turn) -> Ordering) -> (Game -> Turn) -> Ordering
forall a b. (a -> b) -> a -> b
$ Maybe Turn -> Turn
forall a. HasCallStack => Maybe a -> a
Data.Maybe.fromJust (Maybe Turn -> Turn) -> (Game -> Maybe Turn) -> Game -> Turn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game -> Maybe Turn
Model.Game.maybeLastTurn

-- | Get the last move responsible for the current position.
getLastMove :: BareGameTree -> Component.Move.Move
{-# INLINE getLastMove #-}
getLastMove :: BareGameTree -> Move
getLastMove Data.Tree.Node { rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = Game
game }	= QualifiedMove -> Move
Component.QualifiedMove.getMove (QualifiedMove -> Move)
-> (Maybe Turn -> QualifiedMove) -> Maybe Turn -> Move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn -> QualifiedMove
Component.Turn.getQualifiedMove (Turn -> QualifiedMove)
-> (Maybe Turn -> Turn) -> Maybe Turn -> QualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Turn -> Turn
forall a. HasCallStack => Maybe a -> a
Data.Maybe.fromJust (Maybe Turn -> Move) -> Maybe Turn -> Move
forall a b. (a -> b) -> a -> b
$ Game -> Maybe Turn
Model.Game.maybeLastTurn Game
game

{- |
	* <https://www.chessprogramming.org/Static_Exchange_Evaluation>.

	* Returns the net /rankValue/-difference in the /piece/s lost by either side, after a continuous battle at the specified coordinates.

	* CAVEAT: assumes that the battle continues until either player concludes it's disadvantageous to continue, or fire-power has been exhausted.
-}
staticExchangeEvaluation
	:: Attribute.Rank.EvaluateRank
	-> BareGameTree
	-> Type.Mass.RankValue
staticExchangeEvaluation :: EvaluateRank -> BareGameTree -> RankValue
staticExchangeEvaluation EvaluateRank
evaluateRank node :: BareGameTree
node@Data.Tree.Node { rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = Game
game }	= RankValue -> (Rank -> RankValue) -> Maybe Rank -> RankValue
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe RankValue
0 {-nothing taken-} (BareGameTree -> Rank -> RankValue
slave BareGameTree
node) (Maybe Rank -> RankValue) -> Maybe Rank -> RankValue
forall a b. (a -> b) -> a -> b
$ Game -> Maybe Rank
getMaybeImplicitlyTakenRank Game
game where	-- Find the rank of any victim.
	getMaybeImplicitlyTakenRank :: Model.Game.Game -> Maybe Attribute.Rank.Rank
	getMaybeImplicitlyTakenRank :: Game -> Maybe Rank
getMaybeImplicitlyTakenRank Game
game'	= MoveType -> Maybe Rank
Attribute.MoveType.getMaybeImplicitlyTakenRank (MoveType -> Maybe Rank)
-> (Turn -> MoveType) -> Turn -> Maybe Rank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType (QualifiedMove -> MoveType)
-> (Turn -> QualifiedMove) -> Turn -> MoveType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn -> QualifiedMove
Component.Turn.getQualifiedMove (Turn -> Maybe Rank) -> Maybe Turn -> Maybe Rank
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Game -> Maybe Turn
Model.Game.maybeLastTurn Game
game'

	slave :: BareGameTree -> Attribute.Rank.Rank -> Type.Mass.RankValue
	slave :: BareGameTree -> Rank -> RankValue
slave node' :: BareGameTree
node'@Data.Tree.Node { subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest = Forest Game
forest' }	= RankValue -> RankValue -> RankValue
forall a. Ord a => a -> a -> a
max RankValue
0 {-this player shouldn't progress the battle-} (RankValue -> RankValue)
-> (Rank -> RankValue) -> Rank -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RankValue -> RankValue -> RankValue
forall a. Num a => a -> a -> a
subtract (
		case (BareGameTree -> Bool) -> Forest Game -> Forest Game
forall a. (a -> Bool) -> [a] -> [a]
filter (
			(
				Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Move -> Coordinates
Component.Move.getDestination (BareGameTree -> Move
getLastMove BareGameTree
node')
			) (Coordinates -> Bool)
-> (BareGameTree -> Coordinates) -> BareGameTree -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move -> Coordinates
Component.Move.getDestination (Move -> Coordinates)
-> (BareGameTree -> Move) -> BareGameTree -> Coordinates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BareGameTree -> Move
getLastMove	-- Find counter-attacks at the same coordinates.
		 ) Forest Game
forest' of
			[]		-> RankValue
0	-- Fire-power has been exhausted => terminate recursion.
			Forest Game
forest''	-> let
				node'' :: BareGameTree
node''@Data.Tree.Node { rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = Game
game'' }	= (BareGameTree -> BareGameTree -> Ordering)
-> Forest Game -> BareGameTree
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
Data.List.minimumBy (
					\Data.Tree.Node { rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = Game
gameL } Data.Tree.Node { rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = Game
gameR } -> (Turn -> Turn -> Ordering) -> (Turn, Turn) -> Ordering
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (
						EvaluateRank -> Turn -> Turn -> Ordering
Component.Turn.compareByLVA EvaluateRank
evaluateRank
					) ((Turn, Turn) -> Ordering)
-> ((Game -> Turn) -> (Turn, Turn)) -> (Game -> Turn) -> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
						((Game -> Turn) -> Game -> Turn
forall a b. (a -> b) -> a -> b
$ Game
gameL) ((Game -> Turn) -> Turn)
-> ((Game -> Turn) -> Turn) -> (Game -> Turn) -> (Turn, Turn)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((Game -> Turn) -> Game -> Turn
forall a b. (a -> b) -> a -> b
$ Game
gameR)
					) ((Game -> Turn) -> Ordering) -> (Game -> Turn) -> Ordering
forall a b. (a -> b) -> a -> b
$ Turn -> Maybe Turn -> Turn
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (
						Exception -> Turn
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Turn) -> Exception -> Turn
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkResultUndefined String
"BishBosh.Model.GameTree:\tModel.Game.maybeLastTurn failed."
					) (Maybe Turn -> Turn) -> (Game -> Maybe Turn) -> Game -> Turn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game -> Maybe Turn
Model.Game.maybeLastTurn
				 ) Forest Game
forest'' -- Select the least valuable aggressor.
			 in BareGameTree -> Rank -> RankValue
slave BareGameTree
node'' (Rank -> RankValue)
-> (Maybe Rank -> Rank) -> Maybe Rank -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Rank -> Rank
forall a. HasCallStack => Maybe a -> a
Data.Maybe.fromJust (Maybe Rank -> RankValue) -> Maybe Rank -> RankValue
forall a b. (a -> b) -> a -> b
$ Game -> Maybe Rank
getMaybeImplicitlyTakenRank Game
game''	-- Recurse.
	 ) (RankValue -> RankValue)
-> (Rank -> RankValue) -> Rank -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RankValue -> RankValue
forall a b. (Real a, Fractional b) => a -> b
realToFrac (RankValue -> RankValue) -> EvaluateRank -> Rank -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvaluateRank
evaluateRank {-of victim-}

-- | Accessor.
getRankAndMove :: Model.MoveFrequency.GetRankAndMove BareGameTree Component.Move.Move
{-# INLINE getRankAndMove #-}
getRankAndMove :: GetRankAndMove BareGameTree Move
getRankAndMove Data.Tree.Node { rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = Game
game }	= (Turn -> Rank
Component.Turn.getRank (Turn -> Rank) -> (Turn -> Move) -> Turn -> (Rank, Move)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove -> Move
Component.QualifiedMove.getMove (QualifiedMove -> Move) -> (Turn -> QualifiedMove) -> Turn -> Move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn -> QualifiedMove
Component.Turn.getQualifiedMove) (Turn -> (Rank, Move))
-> (Maybe Turn -> Turn) -> Maybe Turn -> (Rank, Move)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Turn -> Turn
forall a. HasCallStack => Maybe a -> a
Data.Maybe.fromJust (Maybe Turn -> (Rank, Move)) -> Maybe Turn -> (Rank, Move)
forall a b. (a -> b) -> a -> b
$ Game -> Maybe Turn
Model.Game.maybeLastTurn Game
game

-- | Wrap a 'BareGameTree'.
newtype GameTree	= MkGameTree {
	GameTree -> BareGameTree
deconstruct	:: BareGameTree
} deriving Int -> GameTree -> ShowS
[GameTree] -> ShowS
GameTree -> String
(Int -> GameTree -> ShowS)
-> (GameTree -> String) -> ([GameTree] -> ShowS) -> Show GameTree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GameTree] -> ShowS
$cshowList :: [GameTree] -> ShowS
show :: GameTree -> String
$cshow :: GameTree -> String
showsPrec :: Int -> GameTree -> ShowS
$cshowsPrec :: Int -> GameTree -> ShowS
Show {-CAVEAT: required by QuickCheck, but shouldn't actually be called-}

instance Data.Default.Default GameTree where
	def :: GameTree
def	= Game -> GameTree
fromGame Game
forall a. Default a => a
Data.Default.def

instance Property.Arboreal.Prunable GameTree where
	prune :: Int -> GameTree -> GameTree
prune Int
depth MkGameTree { deconstruct :: GameTree -> BareGameTree
deconstruct = BareGameTree
bareGameTree }	= BareGameTree -> GameTree
MkGameTree (BareGameTree -> GameTree) -> BareGameTree -> GameTree
forall a b. (a -> b) -> a -> b
$ Int -> Transformation Game
forall a. Int -> Transformation a
Data.RoseTree.prune Int
depth BareGameTree
bareGameTree

instance Notation.MoveNotation.ShowNotation GameTree where
	showsNotation :: MoveNotation -> GameTree -> ShowS
showsNotation MoveNotation
moveNotation MkGameTree {
		deconstruct :: GameTree -> BareGameTree
deconstruct	= bareGameTree :: BareGameTree
bareGameTree@Data.Tree.Node {
			rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel	= Game
game,
			subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest	= Forest Game
forest
		}
	} = String -> ShowS
showString (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ if Game -> Bool
forall a. Null a => a -> Bool
Property.Null.isNull Game
game
		then (Game -> String) -> Forest Game -> String
forall a. (a -> String) -> Forest a -> String
Data.RoseTree.drawForest Game -> String
toString Forest Game
forest
		else (Game -> String) -> BareGameTree -> String
forall a. (a -> String) -> Tree a -> String
Data.RoseTree.drawTree Game -> String
toString BareGameTree
bareGameTree
		where
			toString :: Game -> String
toString	= MoveNotation -> Turn -> String
forall a. ShowNotation a => MoveNotation -> a -> String
Notation.MoveNotation.showNotation MoveNotation
moveNotation (Turn -> String) -> (Game -> Turn) -> Game -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Turn -> Turn
forall a. HasCallStack => Maybe a -> a
Data.Maybe.fromJust (Maybe Turn -> Turn) -> (Game -> Maybe Turn) -> Game -> Turn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game -> Maybe Turn
Model.Game.maybeLastTurn

-- | Constructor.
fromBareGameTree :: BareGameTree -> GameTree
fromBareGameTree :: BareGameTree -> GameTree
fromBareGameTree	= BareGameTree -> GameTree
MkGameTree

-- | Constructs a game-tree with the specified game at its root.
fromGame :: Model.Game.Game -> GameTree
fromGame :: Game -> GameTree
fromGame	= BareGameTree -> GameTree
MkGameTree (BareGameTree -> GameTree)
-> (Game -> BareGameTree) -> Game -> GameTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Game -> (Game, [Game])) -> Game -> BareGameTree
forall b a. (b -> (a, [b])) -> b -> Tree a
Data.Tree.unfoldTree (
	\Game
game -> (
		Game
game,
		if Game -> Bool
Model.Game.isTerminated Game
game
			then []
			else (QualifiedMove -> Game) -> [QualifiedMove] -> [Game]
forall a b. (a -> b) -> [a] -> [b]
map (
				QualifiedMove -> Transformation
`Model.Game.applyQualifiedMove` Game
game
			) ([QualifiedMove] -> [Game]) -> [QualifiedMove] -> [Game]
forall a b. (a -> b) -> a -> b
$ Game -> [QualifiedMove]
Model.Game.findQualifiedMovesAvailableToNextPlayer Game
game
	) -- Pair.
 )

{- |
	* Counts the number of /game-state/s in the constant game of chess, at the specified depth, including any which terminated earlier.

	* N.B.: some of the /game-state/s may have identical positions, reached by different sequences of /move/s.
-}
countGames :: Property.Arboreal.Depth -> Type.Count.NGames
countGames :: Int -> Int
countGames Int
depth	= BareGameTree -> Int
forall nodes a. Num nodes => Tree a -> nodes
Data.RoseTree.countTerminalNodes (BareGameTree -> Int)
-> (GameTree -> BareGameTree) -> GameTree -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Transformation Game
forall a. Int -> Transformation a
Data.RoseTree.prune Int
depth Transformation Game
-> (GameTree -> BareGameTree) -> GameTree -> BareGameTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameTree -> BareGameTree
deconstruct (GameTree -> Int) -> GameTree -> Int
forall a b. (a -> b) -> a -> b
$ (GameTree
forall a. Default a => a
Data.Default.def :: GameTree)

-- | Counts the number of possible positions in chess, down to the specified depth. N.B.: some of these may be transpositions.
countPositions :: Property.Arboreal.Depth -> Type.Count.NPositions
countPositions :: Int -> Int
countPositions Int
depth	= Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> (GameTree -> Int) -> GameTree -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
pred {-the apex is constructed without moving-} (Int -> Int) -> (GameTree -> Int) -> GameTree -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BareGameTree -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.Foldable.length (BareGameTree -> Int)
-> (GameTree -> BareGameTree) -> GameTree -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Transformation Game
forall a. Int -> Transformation a
Data.RoseTree.prune Int
depth Transformation Game
-> (GameTree -> BareGameTree) -> GameTree -> BareGameTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameTree -> BareGameTree
deconstruct (GameTree -> Int) -> GameTree -> Int
forall a b. (a -> b) -> a -> b
$ (GameTree
forall a. Default a => a
Data.Default.def :: GameTree)

-- | Trace the route down the tree which matches the specified list of turns.
traceRoute
	:: GameTree
	-> [Component.Turn.Turn]	-- ^ The data against which, nodes from the tree should be matched.
	-> Maybe [Model.Game.Game]	-- ^ Returns 'Nothing' on match-failure.
traceRoute :: GameTree -> [Turn] -> Maybe [Game]
traceRoute MkGameTree { deconstruct :: GameTree -> BareGameTree
deconstruct = BareGameTree
bareGameTree }	= (Turn -> Game -> Bool) -> BareGameTree -> [Turn] -> Maybe [Game]
forall datum a.
(datum -> IsMatch a) -> Tree a -> [datum] -> Maybe [a]
Data.RoseTree.traceRoute (\Turn
turn -> (Maybe Turn -> Maybe Turn -> Bool
forall a. Eq a => a -> a -> Bool
== Turn -> Maybe Turn
forall a. a -> Maybe a
Just Turn
turn) (Maybe Turn -> Bool) -> (Game -> Maybe Turn) -> Game -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game -> Maybe Turn
Model.Game.maybeLastTurn) BareGameTree
bareGameTree

-- | Focus the underlying type.
type MoveFrequency	= Model.MoveFrequency.MoveFrequency Component.Move.Move

-- | Self-documentation.
type Transformation	= GameTree -> GameTree

{- |
	* Independently sorts the forest of moves at each node of the tree, without regard to runtime-data.

	* Depending on preferences, the list of moves available from each position is sorted by; either those which capture a valuable piece using a cheap piece, or those which win extended battles at a specific location.

	* The above sort-algorithms are stable & can therefore be applied independently.
-}
sortGameTree
	:: Maybe Attribute.CaptureMoveSortAlgorithm.CaptureMoveSortAlgorithm
	-> Attribute.Rank.EvaluateRank
	-> MoveFrequency
	-> Transformation
sortGameTree :: Maybe CaptureMoveSortAlgorithm
-> EvaluateRank -> MoveFrequency -> GameTree -> GameTree
sortGameTree Maybe CaptureMoveSortAlgorithm
maybeCaptureMoveSortAlgorithm EvaluateRank
evaluateRank MoveFrequency
standardOpeningMoveFrequency MkGameTree { deconstruct :: GameTree -> BareGameTree
deconstruct = BareGameTree
bareGameTree }	= BareGameTree -> GameTree
MkGameTree (BareGameTree -> GameTree) -> BareGameTree -> GameTree
forall a b. (a -> b) -> a -> b
$ (Game -> Forest Game -> Forest Game) -> Transformation Game
forall a. (a -> Forest a -> Forest a) -> Transformation a
Data.RoseTree.mapForest (
	\Game
game -> (Forest Game -> Forest Game)
-> (CaptureMoveSortAlgorithm -> Forest Game -> Forest Game)
-> Maybe CaptureMoveSortAlgorithm
-> Forest Game
-> Forest Game
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Forest Game -> Forest Game
forall a. a -> a
id (
		\case
			CaptureMoveSortAlgorithm
Attribute.CaptureMoveSortAlgorithm.MVVLVA	-> (BareGameTree -> BareGameTree -> Ordering)
-> Forest Game -> Forest Game
forall a. (a -> a -> Ordering) -> [a] -> [a]
Data.List.sortBy ((BareGameTree -> BareGameTree -> Ordering)
 -> Forest Game -> Forest Game)
-> (BareGameTree -> BareGameTree -> Ordering)
-> Forest Game
-> Forest Game
forall a b. (a -> b) -> a -> b
$ EvaluateRank -> BareGameTree -> BareGameTree -> Ordering
compareByMVVLVA EvaluateRank
evaluateRank
			CaptureMoveSortAlgorithm
Attribute.CaptureMoveSortAlgorithm.SEE		-> (BareGameTree -> RankValue) -> Forest Game -> Forest Game
forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn ((BareGameTree -> RankValue) -> Forest Game -> Forest Game)
-> (BareGameTree -> RankValue) -> Forest Game -> Forest Game
forall a b. (a -> b) -> a -> b
$ RankValue -> RankValue
forall a. Num a => a -> a
negate {-largest first-} (RankValue -> RankValue)
-> (BareGameTree -> RankValue) -> BareGameTree -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvaluateRank -> BareGameTree -> RankValue
staticExchangeEvaluation EvaluateRank
evaluateRank
	 ) Maybe CaptureMoveSortAlgorithm
maybeCaptureMoveSortAlgorithm (Forest Game -> Forest Game)
-> (Forest Game -> Forest Game) -> Forest Game -> Forest Game
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
		if MoveFrequency -> Bool
forall a. Null a => a -> Bool
Property.Null.isNull MoveFrequency
standardOpeningMoveFrequency
			then Forest Game -> Forest Game
forall a. a -> a
id
			else LogicalColour
-> GetRankAndMove BareGameTree Move
-> MoveFrequency
-> Forest Game
-> Forest Game
forall move a.
Ord move =>
LogicalColour
-> GetRankAndMove a move -> MoveFrequency move -> [a] -> [a]
Model.MoveFrequency.sortByDescendingMoveFrequency (Game -> LogicalColour
Model.Game.getNextLogicalColour Game
game) GetRankAndMove BareGameTree Move
getRankAndMove MoveFrequency
standardOpeningMoveFrequency
	 )
 ) BareGameTree
bareGameTree

{- |
	* Count the instances of each /move/ in the specified tree.

	* CAVEAT: assumes that root game hasn't any pre-applied moves; which might occur in a test-case.

	* CAVEAT: ambiguity remains regarding the /move-type/ (especially any piece taken).

	* CAVEAT: a node is counted as just one instance of the move, rather than the number of games which passed through that node.
	Had the move-frequency been derived from a list of games, a different distribution would result,
	but then early moves would appear popular rather than just the consequence of limited choice.
-}
toMoveFrequency :: GameTree -> MoveFrequency
toMoveFrequency :: GameTree -> MoveFrequency
toMoveFrequency MkGameTree { deconstruct :: GameTree -> BareGameTree
deconstruct = BareGameTree
bareGameTree } = LogicalColour -> MoveFrequency -> BareGameTree -> MoveFrequency
slave LogicalColour
forall a. Bounded a => a
maxBound {-logicalColour-} MoveFrequency
forall a. Empty a => a
Property.Empty.empty {-MoveFrequency-} BareGameTree
bareGameTree where
	slave :: Colour.LogicalColour.LogicalColour -> MoveFrequency -> BareGameTree -> MoveFrequency
	slave :: LogicalColour -> MoveFrequency -> BareGameTree -> MoveFrequency
slave LogicalColour
_ MoveFrequency
moveFrequency Data.Tree.Node { subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest = [] }			= MoveFrequency
moveFrequency
	slave LogicalColour
logicalColour MoveFrequency
moveFrequency Data.Tree.Node { subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest = Forest Game
forest }	= (MoveFrequency -> BareGameTree -> MoveFrequency)
-> MoveFrequency -> Forest Game -> MoveFrequency
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
		LogicalColour -> MoveFrequency -> BareGameTree -> MoveFrequency
slave {-recurse-} (LogicalColour -> MoveFrequency -> BareGameTree -> MoveFrequency)
-> LogicalColour -> MoveFrequency -> BareGameTree -> MoveFrequency
forall a b. (a -> b) -> a -> b
$ LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
logicalColour
	 ) (
		LogicalColour
-> GetRankAndMove BareGameTree Move
-> MoveFrequency
-> Forest Game
-> MoveFrequency
forall move a.
Ord move =>
LogicalColour
-> GetRankAndMove a move
-> MoveFrequency move
-> [a]
-> MoveFrequency move
Model.MoveFrequency.insertMoves LogicalColour
logicalColour GetRankAndMove BareGameTree Move
getRankAndMove MoveFrequency
moveFrequency Forest Game
forest
	 ) Forest Game
forest