{-# LANGUAGE CPP #-}
{-
	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@]	Facilitates matching of the current /position/ in a tree built from standard openings.
-}

module BishBosh.ContextualNotation.PositionHashQualifiedMoveTree(
-- * Types
-- ** Type-synonyms
--	Tree,
--	OnymousQualifiedMove,
--	FindMatch,
	TryToMatchMoves,
	TryToMatchViaJoiningMove,
	TryToMatchColourFlippedPosition,
	PreferVictories,
	MatchSwitches,
-- ** Data-types
	NodeLabel(),
	PositionHashQualifiedMoveTree(),
-- * Functions
--	onymiseQualifiedMove,
--	colourFlipper,
--	findNextOnymousQualifiedMovesForGame,
	findNextOnymousQualifiedMovesForPosition,
--	findNextJoiningOnymousQualifiedMovesFromPosition,
	findNextOnymousQualifiedMoves,
--	shortListMostVictorious,
	maybeRandomlySelectOnymousQualifiedMove,
-- ** Constructors
	fromQualifiedMoveForest,
-- ** Predicates
--	cantConverge,
	isTerminal
 ) where

import			Control.Arrow((&&&), (***))
import qualified	BishBosh.Attribute.MoveType			as Attribute.MoveType
import qualified	BishBosh.Colour.LogicalColour			as Colour.LogicalColour
import qualified	BishBosh.Component.Piece			as Component.Piece
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.ContextualNotation.QualifiedMoveForest	as ContextualNotation.QualifiedMoveForest
import qualified	BishBosh.Model.Game				as Model.Game
import qualified	BishBosh.Property.Reflectable			as Property.Reflectable
import qualified	BishBosh.Rule.Result				as Rule.Result
import qualified	BishBosh.State.Board				as State.Board
import qualified	BishBosh.StateProperty.Censor			as StateProperty.Censor
import qualified	BishBosh.StateProperty.Hashable			as StateProperty.Hashable
import qualified	BishBosh.Type.Count				as Type.Count
import qualified	BishBosh.Type.Crypto				as Type.Crypto
import qualified	Control.Arrow
import qualified	Control.Exception
import qualified	Data.Bits
import qualified	Data.Default
import qualified	Data.Foldable
import qualified	Data.List
import qualified	Data.List.Extra
import qualified	Data.Maybe
import qualified	Data.Tree
import qualified	Data.Tuple
import qualified	System.Random
import qualified	ToolShed.System.Random

#ifdef USE_PARALLEL
import qualified	Control.Parallel.Strategies
#endif

-- | Each label of the tree contains a /Zobrist-hash/ of the current position, augmented (except in the case of the apex-game) by the last /move/ that was played, & any conclusive result.
data NodeLabel positionHash	= MkNodeLabel {
	NodeLabel positionHash -> positionHash
getPositionHash				:: positionHash,
	NodeLabel positionHash
-> Maybe (QualifiedMove, Maybe OnymousResult)
getMaybeQualifiedMoveWithOnymousResult	:: Maybe (Component.QualifiedMove.QualifiedMove, Maybe ContextualNotation.QualifiedMoveForest.OnymousResult)
}

-- | The tree of /qualified move/s.
type Tree positionHash	= Data.Tree.Tree (NodeLabel positionHash)

-- | Constructor.
data PositionHashQualifiedMoveTree positionHash	= MkPositionHashQualifiedMoveTree {
	PositionHashQualifiedMoveTree positionHash -> Zobrist positionHash
getZobrist		:: Component.Zobrist.Zobrist positionHash,	-- ^ Used to hash each position in the tree.
	PositionHashQualifiedMoveTree positionHash -> Tree positionHash
getTree			:: Tree positionHash,
	PositionHashQualifiedMoveTree positionHash -> NPieces
getMinimumPieces	:: ! Type.Count.NPieces,			-- ^ The minimum number of /piece/s remaining after the last /move/ in any game defined in the tree.
	PositionHashQualifiedMoveTree positionHash -> Bool
getHasAnyVictories	:: Bool						-- ^ Whether a victory has been recorded for any game in the tree; which won't be the case if it was constructed from a PGN-database containing standard-openings.
}

-- | Constructor: augment the specified /qualified-move forest/ with a /Zobrist-hash/ of the /position/ & include the default initial game at the apex.
fromQualifiedMoveForest
	:: Data.Bits.Bits positionHash
	=> Bool	-- ^ IncrementalEvaluation.
	-> Component.Zobrist.Zobrist positionHash
	-> ContextualNotation.QualifiedMoveForest.QualifiedMoveForest
	-> PositionHashQualifiedMoveTree positionHash
{-# SPECIALISE fromQualifiedMoveForest :: Bool -> Component.Zobrist.Zobrist Type.Crypto.PositionHash -> ContextualNotation.QualifiedMoveForest.QualifiedMoveForest -> PositionHashQualifiedMoveTree Type.Crypto.PositionHash #-}
fromQualifiedMoveForest :: Bool
-> Zobrist positionHash
-> QualifiedMoveForest
-> PositionHashQualifiedMoveTree positionHash
fromQualifiedMoveForest Bool
incrementalEvaluation Zobrist positionHash
zobrist QualifiedMoveForest
qualifiedMoveForest	= MkPositionHashQualifiedMoveTree :: forall positionHash.
Zobrist positionHash
-> Tree positionHash
-> NPieces
-> Bool
-> PositionHashQualifiedMoveTree positionHash
MkPositionHashQualifiedMoveTree {
	getZobrist :: Zobrist positionHash
getZobrist		= Zobrist positionHash
zobrist,
	getTree :: Tree positionHash
getTree			= Tree positionHash
tree,
	getMinimumPieces :: NPieces
getMinimumPieces	= QualifiedMoveForest -> NPieces
ContextualNotation.QualifiedMoveForest.findMinimumPieces QualifiedMoveForest
qualifiedMoveForest,
	getHasAnyVictories :: Bool
getHasAnyVictories	= (NodeLabel positionHash -> Bool) -> Tree positionHash -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.Foldable.any (
		Bool
-> ((QualifiedMove, Maybe OnymousResult) -> Bool)
-> Maybe (QualifiedMove, Maybe OnymousResult)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False {-no QualifiedMove-} (
			Bool -> (OnymousResult -> Bool) -> Maybe OnymousResult -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False {-no OnymousResult-} (
				Bool -> Bool
not (Bool -> Bool) -> (OnymousResult -> Bool) -> OnymousResult -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result -> Bool
Rule.Result.isDraw (Result -> Bool)
-> (OnymousResult -> Result) -> OnymousResult -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnymousResult -> Result
forall a b. (a, b) -> b
snd {-Result-}
			) (Maybe OnymousResult -> Bool)
-> ((QualifiedMove, Maybe OnymousResult) -> Maybe OnymousResult)
-> (QualifiedMove, Maybe OnymousResult)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualifiedMove, Maybe OnymousResult) -> Maybe OnymousResult
forall a b. (a, b) -> b
snd {-Maybe OnymousResult-}
		) (Maybe (QualifiedMove, Maybe OnymousResult) -> Bool)
-> (NodeLabel positionHash
    -> Maybe (QualifiedMove, Maybe OnymousResult))
-> NodeLabel positionHash
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeLabel positionHash
-> Maybe (QualifiedMove, Maybe OnymousResult)
forall positionHash.
NodeLabel positionHash
-> Maybe (QualifiedMove, Maybe OnymousResult)
getMaybeQualifiedMoveWithOnymousResult
	) Tree positionHash
tree
} where
	initialGame :: Game
initialGame		= Game
forall a. Default a => a
Data.Default.def
	initialPositionHash :: positionHash
initialPositionHash	= Zobrist positionHash -> Game -> positionHash
forall positionHash hashable.
(Bits positionHash, Hashable hashable) =>
Zobrist positionHash -> hashable -> positionHash
StateProperty.Hashable.hash Zobrist positionHash
zobrist Game
initialGame
	tree :: Tree positionHash
tree			= Node :: forall a. a -> Forest a -> Tree a
Data.Tree.Node {
		rootLabel :: NodeLabel positionHash
Data.Tree.rootLabel	= positionHash
-> Maybe (QualifiedMove, Maybe OnymousResult)
-> NodeLabel positionHash
forall positionHash.
positionHash
-> Maybe (QualifiedMove, Maybe OnymousResult)
-> NodeLabel positionHash
MkNodeLabel positionHash
initialPositionHash Maybe (QualifiedMove, Maybe OnymousResult)
forall a. Maybe a
Nothing,
		subForest :: Forest (NodeLabel positionHash)
Data.Tree.subForest	= (Tree (QualifiedMove, Maybe OnymousResult) -> Tree positionHash)
-> [Tree (QualifiedMove, Maybe OnymousResult)]
-> Forest (NodeLabel positionHash)
forall a b. (a -> b) -> [a] -> [b]
map (
			if Bool
incrementalEvaluation
				then let
					slave :: Game
-> positionHash
-> Tree (QualifiedMove, Maybe OnymousResult)
-> Tree positionHash
slave Game
game positionHash
positionHash Data.Tree.Node {
						rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel	= label :: (QualifiedMove, Maybe OnymousResult)
label@(QualifiedMove
qualifiedMove, Maybe OnymousResult
_),
						subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest	= [Tree (QualifiedMove, Maybe OnymousResult)]
qualifiedMoveForest'
					} = Node :: forall a. a -> Forest a -> Tree a
Data.Tree.Node {
						rootLabel :: NodeLabel positionHash
Data.Tree.rootLabel	= positionHash
-> Maybe (QualifiedMove, Maybe OnymousResult)
-> NodeLabel positionHash
forall positionHash.
positionHash
-> Maybe (QualifiedMove, Maybe OnymousResult)
-> NodeLabel positionHash
MkNodeLabel positionHash
positionHash' (Maybe (QualifiedMove, Maybe OnymousResult)
 -> NodeLabel positionHash)
-> Maybe (QualifiedMove, Maybe OnymousResult)
-> NodeLabel positionHash
forall a b. (a -> b) -> a -> b
$ (QualifiedMove, Maybe OnymousResult)
-> Maybe (QualifiedMove, Maybe OnymousResult)
forall a. a -> Maybe a
Just (QualifiedMove, Maybe OnymousResult)
label,
						subForest :: Forest (NodeLabel positionHash)
Data.Tree.subForest	= (Tree (QualifiedMove, Maybe OnymousResult) -> Tree positionHash)
-> [Tree (QualifiedMove, Maybe OnymousResult)]
-> Forest (NodeLabel positionHash)
forall a b. (a -> b) -> [a] -> [b]
map (Game
-> positionHash
-> Tree (QualifiedMove, Maybe OnymousResult)
-> Tree positionHash
slave Game
game' positionHash
positionHash') [Tree (QualifiedMove, Maybe OnymousResult)]
qualifiedMoveForest'	-- Recurse.
					} where
						game' :: Game
game'		= QualifiedMove -> Transformation
Model.Game.applyQualifiedMove QualifiedMove
qualifiedMove 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 Game
-> positionHash
-> Tree (QualifiedMove, Maybe OnymousResult)
-> Tree positionHash
slave Game
initialGame positionHash
initialPositionHash
				else let
					slave :: Game
-> Tree (QualifiedMove, Maybe OnymousResult) -> Tree positionHash
slave Game
game Data.Tree.Node {
						rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel	= label :: (QualifiedMove, Maybe OnymousResult)
label@(QualifiedMove
qualifiedMove, Maybe OnymousResult
_),
						subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest	= [Tree (QualifiedMove, Maybe OnymousResult)]
qualifiedMoveForest'
					} = Node :: forall a. a -> Forest a -> Tree a
Data.Tree.Node {
						rootLabel :: NodeLabel positionHash
Data.Tree.rootLabel	= positionHash
-> Maybe (QualifiedMove, Maybe OnymousResult)
-> NodeLabel positionHash
forall positionHash.
positionHash
-> Maybe (QualifiedMove, Maybe OnymousResult)
-> NodeLabel positionHash
MkNodeLabel (Zobrist positionHash -> Game -> positionHash
forall positionHash hashable.
(Bits positionHash, Hashable hashable) =>
Zobrist positionHash -> hashable -> positionHash
StateProperty.Hashable.hash Zobrist positionHash
zobrist Game
game') (Maybe (QualifiedMove, Maybe OnymousResult)
 -> NodeLabel positionHash)
-> Maybe (QualifiedMove, Maybe OnymousResult)
-> NodeLabel positionHash
forall a b. (a -> b) -> a -> b
$ (QualifiedMove, Maybe OnymousResult)
-> Maybe (QualifiedMove, Maybe OnymousResult)
forall a. a -> Maybe a
Just (QualifiedMove, Maybe OnymousResult)
label,	-- Hash the game after applying the move.
						subForest :: Forest (NodeLabel positionHash)
Data.Tree.subForest	= (Tree (QualifiedMove, Maybe OnymousResult) -> Tree positionHash)
-> [Tree (QualifiedMove, Maybe OnymousResult)]
-> Forest (NodeLabel positionHash)
forall a b. (a -> b) -> [a] -> [b]
map (Game
-> Tree (QualifiedMove, Maybe OnymousResult) -> Tree positionHash
slave Game
game') [Tree (QualifiedMove, Maybe OnymousResult)]
qualifiedMoveForest'	-- Recurse.
					} where
						game' :: Game
game'	= QualifiedMove -> Transformation
Model.Game.applyQualifiedMove QualifiedMove
qualifiedMove Game
game
				in Game
-> Tree (QualifiedMove, Maybe OnymousResult) -> Tree positionHash
slave Game
initialGame
		) ([Tree (QualifiedMove, Maybe OnymousResult)]
 -> Forest (NodeLabel positionHash))
-> [Tree (QualifiedMove, Maybe OnymousResult)]
-> Forest (NodeLabel positionHash)
forall a b. (a -> b) -> a -> b
$ QualifiedMoveForest -> [Tree (QualifiedMove, Maybe OnymousResult)]
ContextualNotation.QualifiedMoveForest.deconstruct QualifiedMoveForest
qualifiedMoveForest
	}

-- | Predicate.
isTerminal :: PositionHashQualifiedMoveTree positionHash -> Bool
isTerminal :: PositionHashQualifiedMoveTree positionHash -> Bool
isTerminal MkPositionHashQualifiedMoveTree { getTree :: forall positionHash.
PositionHashQualifiedMoveTree positionHash -> Tree positionHash
getTree = Data.Tree.Node { subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest = [] } }	= Bool
True
isTerminal PositionHashQualifiedMoveTree positionHash
_												= Bool
False

{- |
	* Determines whether, based on the current number of pieces, the specified game can't migrate to any /position/ defined in the tree.

	* CAVEAT: a negative result doesn't imply that convergence is possible, since other factors may prevent it.
-}
cantConverge :: PositionHashQualifiedMoveTree positionHash -> Model.Game.Game -> Bool
cantConverge :: PositionHashQualifiedMoveTree positionHash -> Game -> Bool
cantConverge MkPositionHashQualifiedMoveTree { getMinimumPieces :: forall positionHash.
PositionHashQualifiedMoveTree positionHash -> NPieces
getMinimumPieces = NPieces
minimumPieces }	= (NPieces -> NPieces -> Bool
forall a. Ord a => a -> a -> Bool
< NPieces
minimumPieces) (NPieces -> Bool) -> (Game -> NPieces) -> Game -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Board -> NPieces
State.Board.getNPieces (Board -> NPieces) -> (Game -> Board) -> Game -> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game -> Board
Model.Game.getBoard

-- | A /qualified move/ annotated by the name & ultimate /result/, of each /game/ from which it could have originated.
type OnymousQualifiedMove	= (Component.QualifiedMove.QualifiedMove, [ContextualNotation.QualifiedMoveForest.OnymousResult])

-- | Find the /onymous result/s for all /game/s originating from the specified tree.
onymiseQualifiedMove :: Tree positionHash -> OnymousQualifiedMove
onymiseQualifiedMove :: Tree positionHash -> OnymousQualifiedMove
onymiseQualifiedMove	= (
	(QualifiedMove, Maybe OnymousResult) -> QualifiedMove
forall a b. (a, b) -> a
fst {-qualifiedMove-} ((QualifiedMove, Maybe OnymousResult) -> QualifiedMove)
-> ([(QualifiedMove, Maybe OnymousResult)]
    -> (QualifiedMove, Maybe OnymousResult))
-> [(QualifiedMove, Maybe OnymousResult)]
-> QualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(QualifiedMove, Maybe OnymousResult)]
-> (QualifiedMove, Maybe OnymousResult)
forall a. [a] -> a
head ([(QualifiedMove, Maybe OnymousResult)] -> QualifiedMove)
-> ([(QualifiedMove, Maybe OnymousResult)] -> [OnymousResult])
-> [(QualifiedMove, Maybe OnymousResult)]
-> OnymousQualifiedMove
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((QualifiedMove, Maybe OnymousResult) -> Maybe OnymousResult)
-> [(QualifiedMove, Maybe OnymousResult)] -> [OnymousResult]
forall a b. (a -> Maybe b) -> [a] -> [b]
Data.Maybe.mapMaybe (QualifiedMove, Maybe OnymousResult) -> Maybe OnymousResult
forall a b. (a, b) -> b
snd {-Maybe OnymousResult-}
 ) ([(QualifiedMove, Maybe OnymousResult)] -> OnymousQualifiedMove)
-> (Tree positionHash -> [(QualifiedMove, Maybe OnymousResult)])
-> Tree positionHash
-> OnymousQualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	\[(QualifiedMove, Maybe OnymousResult)]
l -> Bool
-> [(QualifiedMove, Maybe OnymousResult)]
-> [(QualifiedMove, Maybe OnymousResult)]
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(QualifiedMove, Maybe OnymousResult)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(QualifiedMove, Maybe OnymousResult)]
l) [(QualifiedMove, Maybe OnymousResult)]
l
 ) ([(QualifiedMove, Maybe OnymousResult)]
 -> [(QualifiedMove, Maybe OnymousResult)])
-> (Tree positionHash -> [(QualifiedMove, Maybe OnymousResult)])
-> Tree positionHash
-> [(QualifiedMove, Maybe OnymousResult)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeLabel positionHash -> (QualifiedMove, Maybe OnymousResult))
-> [NodeLabel positionHash]
-> [(QualifiedMove, Maybe OnymousResult)]
forall a b. (a -> b) -> [a] -> [b]
map (
	\MkNodeLabel { getMaybeQualifiedMoveWithOnymousResult :: forall positionHash.
NodeLabel positionHash
-> Maybe (QualifiedMove, Maybe OnymousResult)
getMaybeQualifiedMoveWithOnymousResult = Just (QualifiedMove, Maybe OnymousResult)
qualifiedMoveWithOnymousResult } -> (QualifiedMove, Maybe OnymousResult)
qualifiedMoveWithOnymousResult
 ) ([NodeLabel positionHash]
 -> [(QualifiedMove, Maybe OnymousResult)])
-> (Tree positionHash -> [NodeLabel positionHash])
-> Tree positionHash
-> [(QualifiedMove, Maybe OnymousResult)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree positionHash -> [NodeLabel positionHash]
forall a. Tree a -> [a]
Data.Tree.flatten

-- | The type of a function used to locate a match in the tree.
type FindMatch positionHash	= PositionHashQualifiedMoveTree positionHash -> Model.Game.Game -> [OnymousQualifiedMove]

-- | For any exactly matching /game/ in the tree, return the subsequent /qualifiedMove/s.
findNextOnymousQualifiedMovesForGame :: FindMatch positionHash
findNextOnymousQualifiedMovesForGame :: FindMatch positionHash
findNextOnymousQualifiedMovesForGame MkPositionHashQualifiedMoveTree { getTree :: forall positionHash.
PositionHashQualifiedMoveTree positionHash -> Tree positionHash
getTree = Tree positionHash
tree } Game
requiredGame	= [Turn] -> [Tree positionHash] -> [OnymousQualifiedMove]
forall positionHash.
[Turn] -> [Tree positionHash] -> [OnymousQualifiedMove]
slave (
	Game -> [Turn]
Model.Game.listTurnsChronologically Game
requiredGame
 ) ([Tree positionHash] -> [OnymousQualifiedMove])
-> [Tree positionHash] -> [OnymousQualifiedMove]
forall a b. (a -> b) -> a -> b
$ Tree positionHash -> [Tree positionHash]
forall a. Tree a -> Forest a
Data.Tree.subForest {-remove the apex which lacks a founding move-} Tree positionHash
tree where
	slave :: [Component.Turn.Turn] -> [Tree positionHash] -> [OnymousQualifiedMove]
	slave :: [Turn] -> [Tree positionHash] -> [OnymousQualifiedMove]
slave (Turn
turn : [Turn]
remainingTurns)	= [OnymousQualifiedMove]
-> (Tree positionHash -> [OnymousQualifiedMove])
-> Maybe (Tree positionHash)
-> [OnymousQualifiedMove]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [] {-match-failure-} (
		[Turn] -> [Tree positionHash] -> [OnymousQualifiedMove]
forall positionHash.
[Turn] -> [Tree positionHash] -> [OnymousQualifiedMove]
slave [Turn]
remainingTurns ([Tree positionHash] -> [OnymousQualifiedMove])
-> (Tree positionHash -> [Tree positionHash])
-> Tree positionHash
-> [OnymousQualifiedMove]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree positionHash -> [Tree positionHash]
forall a. Tree a -> Forest a
Data.Tree.subForest	-- Recurse.
	 ) (Maybe (Tree positionHash) -> [OnymousQualifiedMove])
-> ([Tree positionHash] -> Maybe (Tree positionHash))
-> [Tree positionHash]
-> [OnymousQualifiedMove]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree positionHash -> Bool)
-> [Tree positionHash] -> Maybe (Tree positionHash)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (
		\Data.Tree.Node {
			rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel	= MkNodeLabel { getMaybeQualifiedMoveWithOnymousResult :: forall positionHash.
NodeLabel positionHash
-> Maybe (QualifiedMove, Maybe OnymousResult)
getMaybeQualifiedMoveWithOnymousResult = Just (QualifiedMove
qualifiedMove, Maybe OnymousResult
_) }
		} -> QualifiedMove
qualifiedMove QualifiedMove -> QualifiedMove -> Bool
forall a. Eq a => a -> a -> Bool
== Turn -> QualifiedMove
Component.Turn.getQualifiedMove Turn
turn
	 )
	slave [Turn]
_ {-none left to match-}	= (Tree positionHash -> OnymousQualifiedMove)
-> [Tree positionHash] -> [OnymousQualifiedMove]
forall a b. (a -> b) -> [a] -> [b]
map Tree positionHash -> OnymousQualifiedMove
forall positionHash. Tree positionHash -> OnymousQualifiedMove
onymiseQualifiedMove

{- |
	* For all matching /position/s, return the subsequent /qualifiedMove/.

	* By matching the /position/ rather than the precise sequence of /move/s, transpositions <https://www.chessprogramming.org/Transposition> can also be identified.

	* N.B.: a comparison between the number of pieces in the game we're required to match & the decreasing number of pieces down the tree, permits early termination of the search.

	* CAVEAT: a null list can result from either match-failure, or a match with the final /move/ of a /game/.
-}
findNextOnymousQualifiedMovesForPosition :: Data.Bits.Bits positionHash => FindMatch positionHash
findNextOnymousQualifiedMovesForPosition :: FindMatch positionHash
findNextOnymousQualifiedMovesForPosition PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree Game
requiredGame
	| PositionHashQualifiedMoveTree positionHash -> Game -> Bool
forall positionHash.
PositionHashQualifiedMoveTree positionHash -> Game -> Bool
cantConverge PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree Game
requiredGame	= []	-- The game we're required to match has fewer pieces than any defined in the tree.
	| Bool
otherwise							= (NPieces, NPieces)
-> Tree (NodeLabel positionHash) -> [OnymousQualifiedMove]
forall a.
(Ord a, Num a, Enum a) =>
(a, a) -> Tree (NodeLabel positionHash) -> [OnymousQualifiedMove]
slave (
		(
			((NPieces -> NPieces)
 -> (NPieces -> NPieces)
 -> (NPieces, NPieces)
 -> (NPieces, NPieces))
-> (NPieces -> NPieces, NPieces -> NPieces)
-> (NPieces, NPieces)
-> (NPieces, NPieces)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (NPieces -> NPieces)
-> (NPieces -> NPieces) -> (NPieces, NPieces) -> (NPieces, NPieces)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***) ((NPieces -> NPieces, NPieces -> NPieces)
 -> (NPieces, NPieces) -> (NPieces, NPieces))
-> ((NPieces -> NPieces)
    -> (NPieces -> NPieces, NPieces -> NPieces))
-> (NPieces -> NPieces)
-> (NPieces, NPieces)
-> (NPieces, NPieces)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((NPieces -> NPieces) -> NPieces -> NPieces
forall a. a -> a
id ((NPieces -> NPieces) -> NPieces -> NPieces)
-> ((NPieces -> NPieces) -> NPieces -> NPieces)
-> (NPieces -> NPieces)
-> (NPieces -> NPieces, NPieces -> NPieces)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (NPieces -> NPieces) -> NPieces -> NPieces
forall a. a -> a
id) ((NPieces -> NPieces) -> (NPieces, NPieces) -> (NPieces, NPieces))
-> (NPieces -> NPieces) -> (NPieces, NPieces) -> (NPieces, NPieces)
forall a b. (a -> b) -> a -> b
$ (NPieces
Component.Piece.nPiecesPerSide NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
-)	-- Find the number of pieces at the apex of the tree, in excess of the requiredGame, to be taken before a match can be found.
		) ((NPieces, NPieces) -> (NPieces, NPieces))
-> (Game -> (NPieces, NPieces)) -> Game -> (NPieces, NPieces)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoordinatesByRankByLogicalColour -> (NPieces, NPieces)
forall censor. Censor censor => censor -> (NPieces, NPieces)
StateProperty.Censor.countPiecesByLogicalColour (CoordinatesByRankByLogicalColour -> (NPieces, NPieces))
-> (Game -> CoordinatesByRankByLogicalColour)
-> Game
-> (NPieces, NPieces)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Board -> CoordinatesByRankByLogicalColour
State.Board.getCoordinatesByRankByLogicalColour (Board -> CoordinatesByRankByLogicalColour)
-> (Game -> Board) -> Game -> CoordinatesByRankByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game -> Board
Model.Game.getBoard (Game -> (NPieces, NPieces)) -> Game -> (NPieces, NPieces)
forall a b. (a -> b) -> a -> b
$ Game
requiredGame
	) (Tree (NodeLabel positionHash) -> [OnymousQualifiedMove])
-> Tree (NodeLabel positionHash) -> [OnymousQualifiedMove]
forall a b. (a -> b) -> a -> b
$ PositionHashQualifiedMoveTree positionHash
-> Tree (NodeLabel positionHash)
forall positionHash.
PositionHashQualifiedMoveTree positionHash -> Tree positionHash
getTree PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree
	where
		slave :: (a, a) -> Tree (NodeLabel positionHash) -> [OnymousQualifiedMove]
slave (a, a)
nPiecesDiff Data.Tree.Node {
			rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel	= MkNodeLabel { getPositionHash :: forall positionHash. NodeLabel positionHash -> positionHash
getPositionHash = positionHash
positionHash },
			subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest	= Forest (NodeLabel positionHash)
forest
		} = (
			case (a, a) -> a
forall a b. (a, b) -> b
snd {-mover-} (a, a)
nPiecesDiff a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` a
0 of	-- N.B. equivalent to 'signum' to slightly better performance.
				Ordering
GT			-> [OnymousQualifiedMove] -> [OnymousQualifiedMove]
forall a. a -> a
id					-- This node can't match, but there may be a match further down the tree.
				Ordering
EQ
					| positionHash
positionHash positionHash -> positionHash -> Bool
forall a. Eq a => a -> a -> Bool
== Zobrist positionHash -> Game -> positionHash
forall positionHash hashable.
(Bits positionHash, Hashable hashable) =>
Zobrist positionHash -> hashable -> positionHash
StateProperty.Hashable.hash (
						PositionHashQualifiedMoveTree positionHash -> Zobrist positionHash
forall positionHash.
PositionHashQualifiedMoveTree positionHash -> Zobrist positionHash
getZobrist PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree
					) Game
requiredGame	-> ((Tree (NodeLabel positionHash) -> OnymousQualifiedMove)
-> Forest (NodeLabel positionHash) -> [OnymousQualifiedMove]
forall a b. (a -> b) -> [a] -> [b]
map Tree (NodeLabel positionHash) -> OnymousQualifiedMove
forall positionHash. Tree positionHash -> OnymousQualifiedMove
onymiseQualifiedMove Forest (NodeLabel positionHash)
forest [OnymousQualifiedMove]
-> [OnymousQualifiedMove] -> [OnymousQualifiedMove]
forall a. [a] -> [a] -> [a]
++) -- The position matches, so one can select any move from the forest.
					| Bool
otherwise	-> [OnymousQualifiedMove] -> [OnymousQualifiedMove]
forall a. a -> a
id					-- This node doesn't match, but there may be a match further down the tree.
				Ordering
_			-> [OnymousQualifiedMove]
-> [OnymousQualifiedMove] -> [OnymousQualifiedMove]
forall a b. a -> b -> a
const []				-- Terminate the recursion, since from here down the tree, the mover has insufficient pieces to match the required game.
		 ) ([OnymousQualifiedMove] -> [OnymousQualifiedMove])
-> [OnymousQualifiedMove] -> [OnymousQualifiedMove]
forall a b. (a -> b) -> a -> b
$ (Tree (NodeLabel positionHash) -> [OnymousQualifiedMove])
-> Forest (NodeLabel positionHash) -> [OnymousQualifiedMove]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (
			\node :: Tree (NodeLabel positionHash)
node@Data.Tree.Node {
				rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel	= MkNodeLabel { getMaybeQualifiedMoveWithOnymousResult :: forall positionHash.
NodeLabel positionHash
-> Maybe (QualifiedMove, Maybe OnymousResult)
getMaybeQualifiedMoveWithOnymousResult = Just (QualifiedMove
qualifiedMove, Maybe OnymousResult
_) }
			} -> (a, a) -> Tree (NodeLabel positionHash) -> [OnymousQualifiedMove]
slave (
				(a, a) -> (a, a)
forall a b. (a, b) -> (b, a)
Data.Tuple.swap ((a, a) -> (a, a)) -> (a, a) -> (a, a)
forall a b. (a -> b) -> a -> b
$ (
					if MoveType -> Bool
Attribute.MoveType.isCapture (MoveType -> Bool) -> MoveType -> Bool
forall a b. (a -> b) -> a -> b
$! QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType QualifiedMove
qualifiedMove
						then (a -> a) -> (a, a) -> (a, a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first a -> a
forall a. Enum a => a -> a
pred	-- Decrement opponent's piece-count.
						else (a, a) -> (a, a)
forall a. a -> a
id
				) (a, a)
nPiecesDiff
			) Tree (NodeLabel positionHash)
node	-- Recurse.
		 ) Forest (NodeLabel positionHash)
forest

-- | Finds any single /move/s which can join the current /position/ with a member of the forest.
findNextJoiningOnymousQualifiedMovesFromPosition :: Data.Bits.Bits positionHash => FindMatch positionHash
findNextJoiningOnymousQualifiedMovesFromPosition :: FindMatch positionHash
findNextJoiningOnymousQualifiedMovesFromPosition PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree Game
game
	| Game -> Bool
Model.Game.isTerminated Game
game	= []
	| Bool
otherwise			= [
		([OnymousQualifiedMove] -> [OnymousResult])
-> (QualifiedMove, [OnymousQualifiedMove]) -> OnymousQualifiedMove
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second ((OnymousQualifiedMove -> [OnymousResult])
-> [OnymousQualifiedMove] -> [OnymousResult]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap OnymousQualifiedMove -> [OnymousResult]
forall a b. (a, b) -> b
snd {-[OnymousResult]-}) (QualifiedMove, [OnymousQualifiedMove])
movePair |	-- Discard the opponent's matching move, but cite the names of archived games it reached.
			movePair :: (QualifiedMove, [OnymousQualifiedMove])
movePair@(QualifiedMove
_, OnymousQualifiedMove
_ : [OnymousQualifiedMove]
_)	<-
#ifdef USE_PARALLEL
				Strategy [(QualifiedMove, [OnymousQualifiedMove])]
-> [(QualifiedMove, [OnymousQualifiedMove])]
-> [(QualifiedMove, [OnymousQualifiedMove])]
forall a. Strategy a -> a -> a
Control.Parallel.Strategies.withStrategy (
					Strategy (QualifiedMove, [OnymousQualifiedMove])
-> Strategy [(QualifiedMove, [OnymousQualifiedMove])]
forall a. Strategy a -> Strategy [a]
Control.Parallel.Strategies.parList (Strategy (QualifiedMove, [OnymousQualifiedMove])
 -> Strategy [(QualifiedMove, [OnymousQualifiedMove])])
-> Strategy (QualifiedMove, [OnymousQualifiedMove])
-> Strategy [(QualifiedMove, [OnymousQualifiedMove])]
forall a b. (a -> b) -> a -> b
$ Strategy QualifiedMove
-> Strategy [OnymousQualifiedMove]
-> Strategy (QualifiedMove, [OnymousQualifiedMove])
forall a b. Strategy a -> Strategy b -> Strategy (a, b)
Control.Parallel.Strategies.evalTuple2 Strategy QualifiedMove
forall a. Strategy a
Control.Parallel.Strategies.r0 {-pre-match move-} Strategy [OnymousQualifiedMove]
forall a. NFData a => Strategy a
Control.Parallel.Strategies.rdeepseq {-matching moves-}
				) ([(QualifiedMove, [OnymousQualifiedMove])]
 -> [(QualifiedMove, [OnymousQualifiedMove])])
-> ([QualifiedMove] -> [(QualifiedMove, [OnymousQualifiedMove])])
-> [QualifiedMove]
-> [(QualifiedMove, [OnymousQualifiedMove])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
#endif
				(QualifiedMove -> (QualifiedMove, [OnymousQualifiedMove]))
-> [QualifiedMove] -> [(QualifiedMove, [OnymousQualifiedMove])]
forall a b. (a -> b) -> [a] -> [b]
map (
					QualifiedMove -> QualifiedMove
forall a. a -> a
id (QualifiedMove -> QualifiedMove)
-> (QualifiedMove -> [OnymousQualifiedMove])
-> QualifiedMove
-> (QualifiedMove, [OnymousQualifiedMove])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& FindMatch positionHash
forall positionHash. Bits positionHash => FindMatch positionHash
findNextOnymousQualifiedMovesForPosition PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree (Game -> [OnymousQualifiedMove])
-> (QualifiedMove -> Game)
-> QualifiedMove
-> [OnymousQualifiedMove]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualifiedMove -> Transformation
`Model.Game.applyQualifiedMove` Game
game)	-- Apply this player's move.
				) ([QualifiedMove] -> [(QualifiedMove, [OnymousQualifiedMove])])
-> [QualifiedMove] -> [(QualifiedMove, [OnymousQualifiedMove])]
forall a b. (a -> b) -> a -> b
$ Game -> [QualifiedMove]
Model.Game.findQualifiedMovesAvailableToNextPlayer Game
game
	] -- List-comprehension.

-- | Whether to attempt to exactly match moves with a standard opening; transpositions won't be matched.
type TryToMatchMoves	= Bool

-- | Whether to attempt to join the current position to a standard opening that's only one ply away.
type TryToMatchViaJoiningMove	= Bool

-- | Whether to attempt to match a colour-flipped version of the current position with a standard opening
type TryToMatchColourFlippedPosition	= Bool

-- | The switches used to control attempts to find a match amongst standard openings.
type MatchSwitches	= (TryToMatchMoves, TryToMatchViaJoiningMove, TryToMatchColourFlippedPosition)

-- | Whether from all matching positions extracted from the tree, to prefer moves which result in a greater probability of victory, for the player who has the next move.
type PreferVictories	= Bool

-- | Transform an arbitrary match-function to operate on the colour-flipped game.
colourFlipper :: FindMatch positionHash -> FindMatch positionHash
colourFlipper :: FindMatch positionHash -> FindMatch positionHash
colourFlipper FindMatch positionHash
findMatch PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree	= (OnymousQualifiedMove -> OnymousQualifiedMove)
-> [OnymousQualifiedMove] -> [OnymousQualifiedMove]
forall a b. (a -> b) -> [a] -> [b]
map (
	QualifiedMove -> QualifiedMove
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX {-reflect matching moves back into the original domain-} (QualifiedMove -> QualifiedMove)
-> ([OnymousResult] -> [OnymousResult])
-> OnymousQualifiedMove
-> OnymousQualifiedMove
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (OnymousResult -> OnymousResult)
-> [OnymousResult] -> [OnymousResult]
forall a b. (a -> b) -> [a] -> [b]
map (
		(String -> String) -> OnymousResult -> OnymousResult
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first ((String -> String) -> OnymousResult -> OnymousResult)
-> (String -> String) -> OnymousResult -> OnymousResult
forall a b. (a -> b) -> a -> b
$ String -> String -> String
showString String
"Colour-flipped:\t"
	)
 ) ([OnymousQualifiedMove] -> [OnymousQualifiedMove])
-> (Game -> [OnymousQualifiedMove])
-> Game
-> [OnymousQualifiedMove]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FindMatch positionHash
findMatch PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree (Game -> [OnymousQualifiedMove])
-> Transformation -> Game -> [OnymousQualifiedMove]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transformation
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX

{- |
	* Calls 'findNextOnymousQualifiedMovesForGame' to find an exact match for the current /game/ in the tree.

	* Calls 'findNextOnymousQualifiedMovesForPosition' to find a match for the current /position/ in the tree.

	* On failure, it searches the tree to find a match for the colour-flipped /position/.

	* On failure, it searches for any /move/ which can be used to join the /position/ with the tree.

	* On failure, it searches for any /move/ which can be used to join the colour-flipped /position/ with the tree.

	* CAVEAT: the order of these searches has been hard-coded.
-}
findNextOnymousQualifiedMoves
	:: Data.Bits.Bits positionHash
	=> MatchSwitches
	-> FindMatch positionHash
findNextOnymousQualifiedMoves :: MatchSwitches -> FindMatch positionHash
findNextOnymousQualifiedMoves (Bool
tryToMatchMoves, Bool
tryToMatchViaJoiningMove, Bool
tryToMatchColourFlippedPosition) PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree Game
game
	| PositionHashQualifiedMoveTree positionHash -> Game -> Bool
forall positionHash.
PositionHashQualifiedMoveTree positionHash -> Game -> Bool
cantConverge PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree Game
game	= []	-- The specified game is smaller than any defined in the tree.
	| Bool
otherwise						= [OnymousQualifiedMove]
-> Maybe [OnymousQualifiedMove] -> [OnymousQualifiedMove]
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe [] (Maybe [OnymousQualifiedMove] -> [OnymousQualifiedMove])
-> ([[OnymousQualifiedMove]] -> Maybe [OnymousQualifiedMove])
-> [[OnymousQualifiedMove]]
-> [OnymousQualifiedMove]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([OnymousQualifiedMove] -> Bool)
-> [[OnymousQualifiedMove]] -> Maybe [OnymousQualifiedMove]
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (
		Bool -> Bool
not (Bool -> Bool)
-> ([OnymousQualifiedMove] -> Bool)
-> [OnymousQualifiedMove]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OnymousQualifiedMove] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null	-- Accept the results from the first match-function which returns any.
	) ([[OnymousQualifiedMove]] -> [OnymousQualifiedMove])
-> [[OnymousQualifiedMove]] -> [OnymousQualifiedMove]
forall a b. (a -> b) -> a -> b
$ (
		if Bool
tryToMatchMoves
			then (FindMatch positionHash
forall positionHash. FindMatch positionHash
findNextOnymousQualifiedMovesForGame PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree Game
game [OnymousQualifiedMove]
-> [[OnymousQualifiedMove]] -> [[OnymousQualifiedMove]]
forall a. a -> [a] -> [a]
:)
			else [[OnymousQualifiedMove]] -> [[OnymousQualifiedMove]]
forall a. a -> a
id
	) [
		FindMatch positionHash -> FindMatch positionHash
transformation FindMatch positionHash
findMatch PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree Game
game |
			FindMatch positionHash
findMatch	<- FindMatch positionHash
forall positionHash. Bits positionHash => FindMatch positionHash
findNextOnymousQualifiedMovesForPosition FindMatch positionHash
-> [FindMatch positionHash] -> [FindMatch positionHash]
forall a. a -> [a] -> [a]
: [FindMatch positionHash
forall positionHash. Bits positionHash => FindMatch positionHash
findNextJoiningOnymousQualifiedMovesFromPosition | Bool
tryToMatchViaJoiningMove] {-list-comprehension-},
			FindMatch positionHash -> FindMatch positionHash
transformation	<- FindMatch positionHash -> FindMatch positionHash
forall a. a -> a
id (FindMatch positionHash -> FindMatch positionHash)
-> [FindMatch positionHash -> FindMatch positionHash]
-> [FindMatch positionHash -> FindMatch positionHash]
forall a. a -> [a] -> [a]
: [FindMatch positionHash -> FindMatch positionHash
forall positionHash.
FindMatch positionHash -> FindMatch positionHash
colourFlipper | Bool
tryToMatchColourFlippedPosition] -- Transform an arbitrary match-function to operate on either the original or the colour-flipped game.
	] -- List-comprehension.

-- | Shortlist matching moves extracted from the tree, prefering those after which the player who makes it, has the greatest recorded incidence of victory.
shortListMostVictorious
	:: Colour.LogicalColour.LogicalColour	-- ^ The player who is next to move.
	-> [OnymousQualifiedMove]
	-> [OnymousQualifiedMove]
shortListMostVictorious :: LogicalColour -> [OnymousQualifiedMove] -> [OnymousQualifiedMove]
shortListMostVictorious LogicalColour
nextLogicalColour	= [[OnymousQualifiedMove]] -> [OnymousQualifiedMove]
forall a. [a] -> a
last {-highest scoring group-} ([[OnymousQualifiedMove]] -> [OnymousQualifiedMove])
-> ([OnymousQualifiedMove] -> [[OnymousQualifiedMove]])
-> [OnymousQualifiedMove]
-> [OnymousQualifiedMove]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OnymousQualifiedMove -> NPieces)
-> [OnymousQualifiedMove] -> [[OnymousQualifiedMove]]
forall b a. Ord b => (a -> b) -> [a] -> [[a]]
Data.List.Extra.groupSortOn (
	(NPieces -> OnymousResult -> NPieces)
-> NPieces -> [OnymousResult] -> NPieces
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
		\NPieces
acc -> ((NPieces -> NPieces) -> NPieces -> NPieces
forall a b. (a -> b) -> a -> b
$ NPieces
acc) ((NPieces -> NPieces) -> NPieces)
-> (OnymousResult -> NPieces -> NPieces)
-> OnymousResult
-> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NPieces -> NPieces)
-> (LogicalColour -> NPieces -> NPieces)
-> Maybe LogicalColour
-> NPieces
-> NPieces
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe NPieces -> NPieces
forall a. a -> a
id {-draw-} (
			\LogicalColour
victorsLogicalColour -> if LogicalColour
victorsLogicalColour LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour
nextLogicalColour then NPieces -> NPieces
forall a. Enum a => a -> a
succ else NPieces -> NPieces
forall a. Enum a => a -> a
pred	-- Score the result, according to which side we'd like to win.
		) (Maybe LogicalColour -> NPieces -> NPieces)
-> (OnymousResult -> Maybe LogicalColour)
-> OnymousResult
-> NPieces
-> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result -> Maybe LogicalColour
Rule.Result.findMaybeVictor (Result -> Maybe LogicalColour)
-> (OnymousResult -> Result)
-> OnymousResult
-> Maybe LogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnymousResult -> Result
forall a b. (a, b) -> b
snd {-result-}
	) (NPieces
0 :: Int) ([OnymousResult] -> NPieces)
-> (OnymousQualifiedMove -> [OnymousResult])
-> OnymousQualifiedMove
-> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnymousQualifiedMove -> [OnymousResult]
forall a b. (a, b) -> b
snd {-[OnymousResult]-}
 )

-- | Randomly select a /qualifiedMove/ from matching /position/s in the tree, & supply the names of those archived games from which it originated.
maybeRandomlySelectOnymousQualifiedMove :: (
	Data.Bits.Bits		positionHash,
	System.Random.RandomGen	randomGen
 )
	=> randomGen
	-> PreferVictories
	-> MatchSwitches
	-> PositionHashQualifiedMoveTree positionHash
	-> Model.Game.Game
	-> Maybe (Component.QualifiedMove.QualifiedMove, [ContextualNotation.QualifiedMoveForest.Name])
maybeRandomlySelectOnymousQualifiedMove :: randomGen
-> Bool
-> MatchSwitches
-> PositionHashQualifiedMoveTree positionHash
-> Game
-> Maybe (QualifiedMove, [String])
maybeRandomlySelectOnymousQualifiedMove randomGen
randomGen Bool
preferVictories MatchSwitches
matchSwitches PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree Game
game	= case MatchSwitches -> FindMatch positionHash
forall positionHash.
Bits positionHash =>
MatchSwitches -> FindMatch positionHash
findNextOnymousQualifiedMoves MatchSwitches
matchSwitches PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree Game
game of
	[]			-> Maybe (QualifiedMove, [String])
forall a. Maybe a
Nothing
	[OnymousQualifiedMove]
onymousQualifiedMoves	-> (OnymousQualifiedMove -> (QualifiedMove, [String]))
-> Maybe OnymousQualifiedMove -> Maybe (QualifiedMove, [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (
		([OnymousResult] -> [String])
-> OnymousQualifiedMove -> (QualifiedMove, [String])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second (([OnymousResult] -> [String])
 -> OnymousQualifiedMove -> (QualifiedMove, [String]))
-> ([OnymousResult] -> [String])
-> OnymousQualifiedMove
-> (QualifiedMove, [String])
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Eq a => [a] -> [a]
Data.List.nub ([String] -> [String])
-> ([OnymousResult] -> [String]) -> [OnymousResult] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OnymousResult -> String) -> [OnymousResult] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map OnymousResult -> String
forall a b. (a, b) -> a
fst {-Name-}
	 ) (Maybe OnymousQualifiedMove -> Maybe (QualifiedMove, [String]))
-> ([OnymousQualifiedMove] -> Maybe OnymousQualifiedMove)
-> [OnymousQualifiedMove]
-> Maybe (QualifiedMove, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. randomGen -> [OnymousQualifiedMove] -> Maybe OnymousQualifiedMove
forall (foldable :: * -> *) randomGen a.
(Foldable foldable, RandomGen randomGen) =>
randomGen -> foldable a -> Maybe a
ToolShed.System.Random.select randomGen
randomGen ([OnymousQualifiedMove] -> Maybe (QualifiedMove, [String]))
-> [OnymousQualifiedMove] -> Maybe (QualifiedMove, [String])
forall a b. (a -> b) -> a -> b
$ (
		if Bool
preferVictories Bool -> Bool -> Bool
&& PositionHashQualifiedMoveTree positionHash -> Bool
forall positionHash.
PositionHashQualifiedMoveTree positionHash -> Bool
getHasAnyVictories PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree
			then LogicalColour -> [OnymousQualifiedMove] -> [OnymousQualifiedMove]
shortListMostVictorious (LogicalColour -> [OnymousQualifiedMove] -> [OnymousQualifiedMove])
-> LogicalColour
-> [OnymousQualifiedMove]
-> [OnymousQualifiedMove]
forall a b. (a -> b) -> a -> b
$ Game -> LogicalColour
Model.Game.getNextLogicalColour Game
game
			else [OnymousQualifiedMove] -> [OnymousQualifiedMove]
forall a. a -> a
id
	 ) [OnymousQualifiedMove]
onymousQualifiedMoves