{-
	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/ with a tree built from standard openings.
-}

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

import			Control.Arrow((&&&), (***))
import qualified	BishBosh.Attribute.MoveType			as Attribute.MoveType
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.Model.Result				as Model.Result
import qualified	BishBosh.Property.Reflectable			as Property.Reflectable
import qualified	BishBosh.State.Board				as State.Board
import qualified	BishBosh.Types					as T
import qualified	Control.Arrow
import qualified	Control.DeepSeq
import qualified	Control.Parallel.Strategies
import qualified	Data.Array.IArray
import qualified	Data.Bits
import qualified	Data.Default
import qualified	Data.List
import qualified	Data.List.Extra
import qualified	Data.Maybe
import qualified	Data.Tree
import qualified	Factory.Math.Statistics
import qualified	System.Random
import qualified	ToolShed.System.Random

-- | 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 x y positionHash	= MkNodeLabel {
	NodeLabel x y positionHash -> positionHash
getPositionHash				:: positionHash,
	NodeLabel x y positionHash
-> Maybe (QualifiedMove x y, Maybe OnymousResult)
getMaybeQualifiedMoveWithOnymousResult	:: Maybe (Component.QualifiedMove.QualifiedMove x y, Maybe ContextualNotation.QualifiedMoveForest.OnymousResult)
}

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

-- | Constructor.
data PositionHashQualifiedMoveTree x y positionHash	= MkPositionHashQualifiedMoveTree {
	PositionHashQualifiedMoveTree x y positionHash
-> Zobrist x y positionHash
getZobrist		:: Component.Zobrist.Zobrist x y positionHash,	-- ^ Used to hash each position in the tree.
	PositionHashQualifiedMoveTree x y positionHash
-> Tree x y positionHash
getTree			:: Tree x y positionHash,
	PositionHashQualifiedMoveTree x y positionHash -> NPieces
getMinimumPieces	:: Component.Piece.NPieces			-- ^ The minimum number of pieces remaining after the last move in any game defined in the tree.
}

-- | Augment the specified /qualified-move forest/ with a zobrist-hash of the /position/ & include the default initial game at the apex.
fromQualifiedMoveForest :: (
	Data.Array.IArray.Ix	x,
	Data.Bits.Bits		positionHash,
	Enum			x,
	Enum			y,
	Ord			y,
	Show			x,
	Show			y
 )
	=> Bool	-- ^ IncrementalEvaluation.
	-> Component.Zobrist.Zobrist x y positionHash
	-> ContextualNotation.QualifiedMoveForest.QualifiedMoveForest x y
	-> PositionHashQualifiedMoveTree x y positionHash
{-# SPECIALISE fromQualifiedMoveForest :: Bool -> Component.Zobrist.Zobrist T.X T.Y T.PositionHash -> ContextualNotation.QualifiedMoveForest.QualifiedMoveForest T.X T.Y -> PositionHashQualifiedMoveTree T.X T.Y T.PositionHash #-}
fromQualifiedMoveForest :: Bool
-> Zobrist x y positionHash
-> QualifiedMoveForest x y
-> PositionHashQualifiedMoveTree x y positionHash
fromQualifiedMoveForest Bool
incrementalEvaluation Zobrist x y positionHash
zobrist QualifiedMoveForest x y
qualifiedMoveForest	= MkPositionHashQualifiedMoveTree :: forall x y positionHash.
Zobrist x y positionHash
-> Tree x y positionHash
-> NPieces
-> PositionHashQualifiedMoveTree x y positionHash
MkPositionHashQualifiedMoveTree {
	getZobrist :: Zobrist x y positionHash
getZobrist		= Zobrist x y positionHash
zobrist,
	getTree :: Tree x y positionHash
getTree			= let
		initialGame :: Game x y
initialGame		= Game x y
forall a. Default a => a
Data.Default.def
		initialPositionHash :: positionHash
initialPositionHash	= Game x y -> Zobrist x y positionHash -> positionHash
forall positionHash (hashable :: * -> * -> *) x y.
(Bits positionHash, Hashable2D hashable x y) =>
hashable x y -> Zobrist x y positionHash -> positionHash
Component.Zobrist.hash2D Game x y
initialGame Zobrist x y positionHash
zobrist
	in Node :: forall a. a -> Forest a -> Tree a
Data.Tree.Node {
		rootLabel :: NodeLabel x y positionHash
Data.Tree.rootLabel	= positionHash
-> Maybe (QualifiedMove x y, Maybe OnymousResult)
-> NodeLabel x y positionHash
forall x y positionHash.
positionHash
-> Maybe (QualifiedMove x y, Maybe OnymousResult)
-> NodeLabel x y positionHash
MkNodeLabel positionHash
initialPositionHash Maybe (QualifiedMove x y, Maybe OnymousResult)
forall a. Maybe a
Nothing,
		subForest :: Forest (NodeLabel x y positionHash)
Data.Tree.subForest	= (Tree (QualifiedMove x y, Maybe OnymousResult)
 -> Tree x y positionHash)
-> [Tree (QualifiedMove x y, Maybe OnymousResult)]
-> Forest (NodeLabel x y positionHash)
forall a b. (a -> b) -> [a] -> [b]
map (
			if Bool
incrementalEvaluation
				then let
					slave :: Game x y
-> positionHash
-> Tree (QualifiedMove x y, Maybe OnymousResult)
-> Tree x y positionHash
slave Game x y
game positionHash
positionHash Data.Tree.Node {
						rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel	= label :: (QualifiedMove x y, Maybe OnymousResult)
label@(QualifiedMove x y
qualifiedMove, Maybe OnymousResult
_),
						subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest	= [Tree (QualifiedMove x y, Maybe OnymousResult)]
qualifiedMoveForest'
					} = Node :: forall a. a -> Forest a -> Tree a
Data.Tree.Node {
						rootLabel :: NodeLabel x y positionHash
Data.Tree.rootLabel	= positionHash
-> Maybe (QualifiedMove x y, Maybe OnymousResult)
-> NodeLabel x y positionHash
forall x y positionHash.
positionHash
-> Maybe (QualifiedMove x y, Maybe OnymousResult)
-> NodeLabel x y positionHash
MkNodeLabel positionHash
positionHash' (Maybe (QualifiedMove x y, Maybe OnymousResult)
 -> NodeLabel x y positionHash)
-> Maybe (QualifiedMove x y, Maybe OnymousResult)
-> NodeLabel x y positionHash
forall a b. (a -> b) -> a -> b
$ (QualifiedMove x y, Maybe OnymousResult)
-> Maybe (QualifiedMove x y, Maybe OnymousResult)
forall a. a -> Maybe a
Just (QualifiedMove x y, Maybe OnymousResult)
label,
						subForest :: Forest (NodeLabel x y positionHash)
Data.Tree.subForest	= (Tree (QualifiedMove x y, Maybe OnymousResult)
 -> Tree x y positionHash)
-> [Tree (QualifiedMove x y, Maybe OnymousResult)]
-> Forest (NodeLabel x y positionHash)
forall a b. (a -> b) -> [a] -> [b]
map (Game x y
-> positionHash
-> Tree (QualifiedMove x y, Maybe OnymousResult)
-> Tree x y positionHash
slave Game x y
game' positionHash
positionHash') [Tree (QualifiedMove x y, Maybe OnymousResult)]
qualifiedMoveForest'	-- Recurse.
					} where
						game' :: Game x y
game'		= QualifiedMove x y -> Transformation x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
QualifiedMove x y -> Transformation x y
Model.Game.applyQualifiedMove QualifiedMove x y
qualifiedMove Game x y
game
						positionHash' :: positionHash
positionHash'	= Game x y
-> positionHash
-> Game x y
-> Zobrist x y positionHash
-> positionHash
forall x positionHash y.
(Ix x, Bits positionHash, Enum x, Enum y, Ord y) =>
Game x y
-> positionHash
-> Game x y
-> Zobrist x y positionHash
-> positionHash
Model.Game.incrementalHash Game x y
game positionHash
positionHash Game x y
game' Zobrist x y positionHash
zobrist
				in Game x y
-> positionHash
-> Tree (QualifiedMove x y, Maybe OnymousResult)
-> Tree x y positionHash
slave Game x y
initialGame positionHash
initialPositionHash
				else let
					slave :: Game x y
-> Tree (QualifiedMove x y, Maybe OnymousResult)
-> Tree x y positionHash
slave Game x y
game Data.Tree.Node {
						rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel	= label :: (QualifiedMove x y, Maybe OnymousResult)
label@(QualifiedMove x y
qualifiedMove, Maybe OnymousResult
_),
						subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest	= [Tree (QualifiedMove x y, Maybe OnymousResult)]
qualifiedMoveForest'
					} = Node :: forall a. a -> Forest a -> Tree a
Data.Tree.Node {
						rootLabel :: NodeLabel x y positionHash
Data.Tree.rootLabel	= positionHash
-> Maybe (QualifiedMove x y, Maybe OnymousResult)
-> NodeLabel x y positionHash
forall x y positionHash.
positionHash
-> Maybe (QualifiedMove x y, Maybe OnymousResult)
-> NodeLabel x y positionHash
MkNodeLabel (Game x y -> Zobrist x y positionHash -> positionHash
forall positionHash (hashable :: * -> * -> *) x y.
(Bits positionHash, Hashable2D hashable x y) =>
hashable x y -> Zobrist x y positionHash -> positionHash
Component.Zobrist.hash2D Game x y
game' Zobrist x y positionHash
zobrist) (Maybe (QualifiedMove x y, Maybe OnymousResult)
 -> NodeLabel x y positionHash)
-> Maybe (QualifiedMove x y, Maybe OnymousResult)
-> NodeLabel x y positionHash
forall a b. (a -> b) -> a -> b
$ (QualifiedMove x y, Maybe OnymousResult)
-> Maybe (QualifiedMove x y, Maybe OnymousResult)
forall a. a -> Maybe a
Just (QualifiedMove x y, Maybe OnymousResult)
label,	-- Hash the game after applying the move.
						subForest :: Forest (NodeLabel x y positionHash)
Data.Tree.subForest	= (Tree (QualifiedMove x y, Maybe OnymousResult)
 -> Tree x y positionHash)
-> [Tree (QualifiedMove x y, Maybe OnymousResult)]
-> Forest (NodeLabel x y positionHash)
forall a b. (a -> b) -> [a] -> [b]
map (Game x y
-> Tree (QualifiedMove x y, Maybe OnymousResult)
-> Tree x y positionHash
slave Game x y
game') [Tree (QualifiedMove x y, Maybe OnymousResult)]
qualifiedMoveForest'	-- Recurse.
					} where
						game' :: Game x y
game'	= QualifiedMove x y -> Transformation x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
QualifiedMove x y -> Transformation x y
Model.Game.applyQualifiedMove QualifiedMove x y
qualifiedMove Game x y
game
				in Game x y
-> Tree (QualifiedMove x y, Maybe OnymousResult)
-> Tree x y positionHash
slave Game x y
initialGame
		) ([Tree (QualifiedMove x y, Maybe OnymousResult)]
 -> Forest (NodeLabel x y positionHash))
-> [Tree (QualifiedMove x y, Maybe OnymousResult)]
-> Forest (NodeLabel x y positionHash)
forall a b. (a -> b) -> a -> b
$ QualifiedMoveForest x y
-> [Tree (QualifiedMove x y, Maybe OnymousResult)]
forall x y. QualifiedMoveForest x y -> [QualifiedMoveTree x y]
ContextualNotation.QualifiedMoveForest.deconstruct QualifiedMoveForest x y
qualifiedMoveForest
	},
	getMinimumPieces :: NPieces
getMinimumPieces	= QualifiedMoveForest x y -> NPieces
forall x y. QualifiedMoveForest x y -> NPieces
ContextualNotation.QualifiedMoveForest.findMinimumPieces QualifiedMoveForest x y
qualifiedMoveForest
}

-- | Predicate.
isTerminal :: PositionHashQualifiedMoveTree x y positionHash -> Bool
isTerminal :: PositionHashQualifiedMoveTree x y positionHash -> Bool
isTerminal MkPositionHashQualifiedMoveTree { getTree :: forall x y positionHash.
PositionHashQualifiedMoveTree x y positionHash
-> Tree x y positionHash
getTree = Data.Tree.Node { subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest = [] } }	= Bool
True
isTerminal PositionHashQualifiedMoveTree x y 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 :: Model.Game.Game x y -> PositionHashQualifiedMoveTree x y positionHash -> Bool
cantConverge :: Game x y -> PositionHashQualifiedMoveTree x y positionHash -> Bool
cantConverge Game x y
game MkPositionHashQualifiedMoveTree { getMinimumPieces :: forall x y positionHash.
PositionHashQualifiedMoveTree x y positionHash -> NPieces
getMinimumPieces = NPieces
minimumPieces }	= Board x y -> NPieces
forall x y. Board x y -> NPieces
State.Board.getNPieces (Game x y -> Board x y
forall x y. Game x y -> Board x y
Model.Game.getBoard Game x y
game) NPieces -> NPieces -> Bool
forall a. Ord a => a -> a -> Bool
< NPieces
minimumPieces

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

-- | Find the /onymous result/s for all /game/s originating from the specified tree.
onymiseQualifiedMove :: Tree x y positionHash -> OnymousQualifiedMove x y
onymiseQualifiedMove :: Tree x y positionHash -> OnymousQualifiedMove x y
onymiseQualifiedMove	= (
	(QualifiedMove x y, Maybe OnymousResult) -> QualifiedMove x y
forall a b. (a, b) -> a
fst {-qualifiedMove-} ((QualifiedMove x y, Maybe OnymousResult) -> QualifiedMove x y)
-> ([(QualifiedMove x y, Maybe OnymousResult)]
    -> (QualifiedMove x y, Maybe OnymousResult))
-> [(QualifiedMove x y, Maybe OnymousResult)]
-> QualifiedMove x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(QualifiedMove x y, Maybe OnymousResult)]
-> (QualifiedMove x y, Maybe OnymousResult)
forall a. [a] -> a
head ([(QualifiedMove x y, Maybe OnymousResult)] -> QualifiedMove x y)
-> ([(QualifiedMove x y, Maybe OnymousResult)] -> [OnymousResult])
-> [(QualifiedMove x y, Maybe OnymousResult)]
-> OnymousQualifiedMove x y
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((QualifiedMove x y, Maybe OnymousResult) -> Maybe OnymousResult)
-> [(QualifiedMove x y, Maybe OnymousResult)] -> [OnymousResult]
forall a b. (a -> Maybe b) -> [a] -> [b]
Data.Maybe.mapMaybe (QualifiedMove x y, Maybe OnymousResult) -> Maybe OnymousResult
forall a b. (a, b) -> b
snd {-Maybe OnymousResult-}
 ) ([(QualifiedMove x y, Maybe OnymousResult)]
 -> OnymousQualifiedMove x y)
-> (Tree x y positionHash
    -> [(QualifiedMove x y, Maybe OnymousResult)])
-> Tree x y positionHash
-> OnymousQualifiedMove x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeLabel x y positionHash
 -> (QualifiedMove x y, Maybe OnymousResult))
-> [NodeLabel x y positionHash]
-> [(QualifiedMove x y, Maybe OnymousResult)]
forall a b. (a -> b) -> [a] -> [b]
map (
	\MkNodeLabel { getMaybeQualifiedMoveWithOnymousResult :: forall x y positionHash.
NodeLabel x y positionHash
-> Maybe (QualifiedMove x y, Maybe OnymousResult)
getMaybeQualifiedMoveWithOnymousResult = Just (QualifiedMove x y, Maybe OnymousResult)
qualifiedMoveWithOnymousResult } -> (QualifiedMove x y, Maybe OnymousResult)
qualifiedMoveWithOnymousResult
 ) ([NodeLabel x y positionHash]
 -> [(QualifiedMove x y, Maybe OnymousResult)])
-> (Tree x y positionHash -> [NodeLabel x y positionHash])
-> Tree x y positionHash
-> [(QualifiedMove x y, Maybe OnymousResult)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree x y positionHash -> [NodeLabel x y positionHash]
forall a. Tree a -> [a]
Data.Tree.flatten

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

-- | For any exactly matching /game/ in the tree, return the subsequent /qualifiedMove/s.
findNextOnymousQualifiedMovesForGame :: (Eq x, Eq y) => FindMatch x y positionHash
findNextOnymousQualifiedMovesForGame :: FindMatch x y positionHash
findNextOnymousQualifiedMovesForGame Game x y
requiredGame	= [Turn x y]
-> Forest (NodeLabel x y positionHash)
-> [OnymousQualifiedMove x y]
forall x y positionHash.
(Eq x, Eq y) =>
[Turn x y]
-> Forest (NodeLabel x y positionHash)
-> [OnymousQualifiedMove x y]
slave (
	Game x y -> [Turn x y]
forall x y. Game x y -> [Turn x y]
Model.Game.listTurnsChronologically Game x y
requiredGame
 ) (Forest (NodeLabel x y positionHash) -> [OnymousQualifiedMove x y])
-> (PositionHashQualifiedMoveTree x y positionHash
    -> Forest (NodeLabel x y positionHash))
-> PositionHashQualifiedMoveTree x y positionHash
-> [OnymousQualifiedMove x y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (NodeLabel x y positionHash)
-> Forest (NodeLabel x y positionHash)
forall a. Tree a -> Forest a
Data.Tree.subForest {-remove the apex which lacks a founding move-} (Tree (NodeLabel x y positionHash)
 -> Forest (NodeLabel x y positionHash))
-> (PositionHashQualifiedMoveTree x y positionHash
    -> Tree (NodeLabel x y positionHash))
-> PositionHashQualifiedMoveTree x y positionHash
-> Forest (NodeLabel x y positionHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionHashQualifiedMoveTree x y positionHash
-> Tree (NodeLabel x y positionHash)
forall x y positionHash.
PositionHashQualifiedMoveTree x y positionHash
-> Tree x y positionHash
getTree where
	slave :: [Turn x y]
-> Forest (NodeLabel x y positionHash)
-> [OnymousQualifiedMove x y]
slave (Turn x y
turn : [Turn x y]
remainingTurns)	= [OnymousQualifiedMove x y]
-> (Tree (NodeLabel x y positionHash)
    -> [OnymousQualifiedMove x y])
-> Maybe (Tree (NodeLabel x y positionHash))
-> [OnymousQualifiedMove x y]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [] {-match-failure-} (
		[Turn x y]
-> Forest (NodeLabel x y positionHash)
-> [OnymousQualifiedMove x y]
slave [Turn x y]
remainingTurns (Forest (NodeLabel x y positionHash) -> [OnymousQualifiedMove x y])
-> (Tree (NodeLabel x y positionHash)
    -> Forest (NodeLabel x y positionHash))
-> Tree (NodeLabel x y positionHash)
-> [OnymousQualifiedMove x y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (NodeLabel x y positionHash)
-> Forest (NodeLabel x y positionHash)
forall a. Tree a -> Forest a
Data.Tree.subForest	-- Recurse.
	 ) (Maybe (Tree (NodeLabel x y positionHash))
 -> [OnymousQualifiedMove x y])
-> (Forest (NodeLabel x y positionHash)
    -> Maybe (Tree (NodeLabel x y positionHash)))
-> Forest (NodeLabel x y positionHash)
-> [OnymousQualifiedMove x y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree (NodeLabel x y positionHash) -> Bool)
-> Forest (NodeLabel x y positionHash)
-> Maybe (Tree (NodeLabel x y 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 x y positionHash.
NodeLabel x y positionHash
-> Maybe (QualifiedMove x y, Maybe OnymousResult)
getMaybeQualifiedMoveWithOnymousResult = Just (QualifiedMove x y
qualifiedMove, Maybe OnymousResult
_) }
		} -> QualifiedMove x y
qualifiedMove QualifiedMove x y -> QualifiedMove x y -> Bool
forall a. Eq a => a -> a -> Bool
== Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove Turn x y
turn
	 )
	slave [Turn x y]
_ {-none left to match-}	= (Tree (NodeLabel x y positionHash) -> OnymousQualifiedMove x y)
-> Forest (NodeLabel x y positionHash)
-> [OnymousQualifiedMove x y]
forall a b. (a -> b) -> [a] -> [b]
map Tree (NodeLabel x y positionHash) -> OnymousQualifiedMove x y
forall x y positionHash.
Tree x y positionHash -> OnymousQualifiedMove x y
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.

	* CAVEAT: a null list can result from either match-failure, or a match with the final /move/ of a /game/.
-}
findNextOnymousQualifiedMovesForPosition :: (
	Data.Array.IArray.Ix	x,
	Data.Bits.Bits		positionHash,
	Enum			x,
	Enum			y,
	Ord			y
 ) => FindMatch x y positionHash
{-# SPECIALISE findNextOnymousQualifiedMovesForPosition :: FindMatch T.X T.Y T.PositionHash #-}
findNextOnymousQualifiedMovesForPosition :: FindMatch x y positionHash
findNextOnymousQualifiedMovesForPosition Game x y
requiredGame positionHashQualifiedMoveTree :: PositionHashQualifiedMoveTree x y positionHash
positionHashQualifiedMoveTree@MkPositionHashQualifiedMoveTree {
	getZobrist :: forall x y positionHash.
PositionHashQualifiedMoveTree x y positionHash
-> Zobrist x y positionHash
getZobrist	= Zobrist x y positionHash
zobrist,
	getTree :: forall x y positionHash.
PositionHashQualifiedMoveTree x y positionHash
-> Tree x y positionHash
getTree		= Tree x y positionHash
tree
}
	| Game x y -> PositionHashQualifiedMoveTree x y positionHash -> Bool
forall x y positionHash.
Game x y -> PositionHashQualifiedMoveTree x y positionHash -> Bool
cantConverge Game x y
requiredGame PositionHashQualifiedMoveTree x y positionHash
positionHashQualifiedMoveTree	= []	-- The specified game has fewer pieces than any defined in the tree.
	| Bool
otherwise							= NPieces -> Tree x y positionHash -> [OnymousQualifiedMove x y]
forall x y.
NPieces
-> Tree (NodeLabel x y positionHash) -> [OnymousQualifiedMove x y]
slave (NPieces
2 NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
* NPieces
Component.Piece.nPiecesPerSide) Tree x y positionHash
tree
	where
		slave :: NPieces
-> Tree (NodeLabel x y positionHash) -> [OnymousQualifiedMove x y]
slave NPieces
nPieces Data.Tree.Node {
			rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel	= MkNodeLabel { getPositionHash :: forall x y positionHash. NodeLabel x y positionHash -> positionHash
getPositionHash = positionHash
positionHash },
			subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest	= Forest (NodeLabel x y positionHash)
forest
		}
			| NPieces
nPieces NPieces -> NPieces -> Bool
forall a. Ord a => a -> a -> Bool
< Board x y -> NPieces
forall x y. Board x y -> NPieces
State.Board.getNPieces (
				Game x y -> Board x y
forall x y. Game x y -> Board x y
Model.Game.getBoard Game x y
requiredGame
			)		= []	-- There are fewer pieces remaining in the tree than required.
			| Bool
otherwise	= (
				if positionHash
positionHash positionHash -> positionHash -> Bool
forall a. Eq a => a -> a -> Bool
== Game x y -> Zobrist x y positionHash -> positionHash
forall positionHash (hashable :: * -> * -> *) x y.
(Bits positionHash, Hashable2D hashable x y) =>
hashable x y -> Zobrist x y positionHash -> positionHash
Component.Zobrist.hash2D Game x y
requiredGame Zobrist x y positionHash
zobrist
					then (
						(Tree (NodeLabel x y positionHash) -> OnymousQualifiedMove x y)
-> Forest (NodeLabel x y positionHash)
-> [OnymousQualifiedMove x y]
forall a b. (a -> b) -> [a] -> [b]
map Tree (NodeLabel x y positionHash) -> OnymousQualifiedMove x y
forall x y positionHash.
Tree x y positionHash -> OnymousQualifiedMove x y
onymiseQualifiedMove Forest (NodeLabel x y positionHash)
forest [OnymousQualifiedMove x y]
-> [OnymousQualifiedMove x y] -> [OnymousQualifiedMove x y]
forall a. [a] -> [a] -> [a]
++	-- The Zobrist-hash/position matches, so one can select any move from the forest.
					) -- Section.
					else [OnymousQualifiedMove x y] -> [OnymousQualifiedMove x y]
forall a. a -> a
id
			) ([OnymousQualifiedMove x y] -> [OnymousQualifiedMove x y])
-> [OnymousQualifiedMove x y] -> [OnymousQualifiedMove x y]
forall a b. (a -> b) -> a -> b
$ (Tree (NodeLabel x y positionHash) -> [OnymousQualifiedMove x y])
-> Forest (NodeLabel x y positionHash)
-> [OnymousQualifiedMove x y]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (
				\node :: Tree (NodeLabel x y positionHash)
node@Data.Tree.Node {
					rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel	= MkNodeLabel { getMaybeQualifiedMoveWithOnymousResult :: forall x y positionHash.
NodeLabel x y positionHash
-> Maybe (QualifiedMove x y, Maybe OnymousResult)
getMaybeQualifiedMoveWithOnymousResult = Just (QualifiedMove x y
qualifiedMove, Maybe OnymousResult
_) }
				} -> NPieces
-> Tree (NodeLabel x y positionHash) -> [OnymousQualifiedMove x y]
slave (
					MoveType -> NPieces -> NPieces
forall nPieces. Enum nPieces => MoveType -> nPieces -> nPieces
Attribute.MoveType.nPiecesMutator (QualifiedMove x y -> MoveType
forall x y. QualifiedMove x y -> MoveType
Component.QualifiedMove.getMoveType QualifiedMove x y
qualifiedMove) NPieces
nPieces
				) Tree (NodeLabel x y positionHash)
node -- Recurse to see if deeper matches exist.
			) Forest (NodeLabel x y positionHash)
forest

-- | Finds any single /move/s which can join the current /position/ with a member of the forest.
findNextJoiningOnymousQualifiedMovesFromPosition :: (
	Data.Array.IArray.Ix	x,
	Data.Bits.Bits		positionHash,
	Control.DeepSeq.NFData	x,
	Control.DeepSeq.NFData	y,
	Enum			x,
	Enum			y,
	Ord			y,
	Show			x,
	Show			y
 ) => FindMatch x y positionHash
{-# SPECIALISE findNextJoiningOnymousQualifiedMovesFromPosition :: FindMatch T.X T.Y T.PositionHash #-}
findNextJoiningOnymousQualifiedMovesFromPosition :: FindMatch x y positionHash
findNextJoiningOnymousQualifiedMovesFromPosition Game x y
game PositionHashQualifiedMoveTree x y positionHash
positionHashQualifiedMoveTree	= [
	(
		QualifiedMove x y
preMatchQualifiedMove,
		(OnymousQualifiedMove x y -> [OnymousResult])
-> [OnymousQualifiedMove x y] -> [OnymousResult]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap OnymousQualifiedMove x y -> [OnymousResult]
forall a b. (a, b) -> b
snd {-[OnymousResult]-} [OnymousQualifiedMove x y]
matchingOnymousQualifiedMoves	-- Discard the opponent's matching move, but cite the names of archived games it reached.
	) |
		Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Game x y -> Bool
forall x y. Game x y -> Bool
Model.Game.isTerminated Game x y
game,
		(QualifiedMove x y
preMatchQualifiedMove, [OnymousQualifiedMove x y]
matchingOnymousQualifiedMoves)	<- Strategy [(QualifiedMove x y, [OnymousQualifiedMove x y])]
-> [(QualifiedMove x y, [OnymousQualifiedMove x y])]
-> [(QualifiedMove x y, [OnymousQualifiedMove x y])]
forall a. Strategy a -> a -> a
Control.Parallel.Strategies.withStrategy (
			Strategy (QualifiedMove x y, [OnymousQualifiedMove x y])
-> Strategy [(QualifiedMove x y, [OnymousQualifiedMove x y])]
forall a. Strategy a -> Strategy [a]
Control.Parallel.Strategies.parList (Strategy (QualifiedMove x y, [OnymousQualifiedMove x y])
 -> Strategy [(QualifiedMove x y, [OnymousQualifiedMove x y])])
-> Strategy (QualifiedMove x y, [OnymousQualifiedMove x y])
-> Strategy [(QualifiedMove x y, [OnymousQualifiedMove x y])]
forall a b. (a -> b) -> a -> b
$ Strategy (QualifiedMove x y)
-> Strategy [OnymousQualifiedMove x y]
-> Strategy (QualifiedMove x y, [OnymousQualifiedMove x y])
forall a b. Strategy a -> Strategy b -> Strategy (a, b)
Control.Parallel.Strategies.parTuple2 Strategy (QualifiedMove x y)
forall a. Strategy a
Control.Parallel.Strategies.r0 Strategy [OnymousQualifiedMove x y]
forall a. NFData a => Strategy a
Control.Parallel.Strategies.rdeepseq
		) ([(QualifiedMove x y, [OnymousQualifiedMove x y])]
 -> [(QualifiedMove x y, [OnymousQualifiedMove x y])])
-> ([QualifiedMove x y]
    -> [(QualifiedMove x y, [OnymousQualifiedMove x y])])
-> [QualifiedMove x y]
-> [(QualifiedMove x y, [OnymousQualifiedMove x y])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualifiedMove x y
 -> (QualifiedMove x y, [OnymousQualifiedMove x y]))
-> [QualifiedMove x y]
-> [(QualifiedMove x y, [OnymousQualifiedMove x y])]
forall a b. (a -> b) -> [a] -> [b]
map (
			QualifiedMove x y -> QualifiedMove x y
forall a. a -> a
id (QualifiedMove x y -> QualifiedMove x y)
-> (QualifiedMove x y -> [OnymousQualifiedMove x y])
-> QualifiedMove x y
-> (QualifiedMove x y, [OnymousQualifiedMove x y])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (FindMatch x y positionHash
forall x positionHash y.
(Ix x, Bits positionHash, Enum x, Enum y, Ord y) =>
FindMatch x y positionHash
`findNextOnymousQualifiedMovesForPosition` PositionHashQualifiedMoveTree x y positionHash
positionHashQualifiedMoveTree) (Game x y -> [OnymousQualifiedMove x y])
-> (QualifiedMove x y -> Game x y)
-> QualifiedMove x y
-> [OnymousQualifiedMove x y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualifiedMove x y -> Transformation x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
QualifiedMove x y -> Transformation x y
`Model.Game.applyQualifiedMove` Game x y
game)	-- Apply this player's move.
		) ([QualifiedMove x y]
 -> [(QualifiedMove x y, [OnymousQualifiedMove x y])])
-> [QualifiedMove x y]
-> [(QualifiedMove x y, [OnymousQualifiedMove x y])]
forall a b. (a -> b) -> a -> b
$ Game x y -> [QualifiedMove x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Game x y -> [QualifiedMove x y]
Model.Game.findQualifiedMovesAvailableToNextPlayer Game x y
game,
		Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [OnymousQualifiedMove x y] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OnymousQualifiedMove x y]
matchingOnymousQualifiedMoves
 ] -- List-comprehension.

{- |
	* 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.Array.IArray.Ix	x,
	Data.Bits.Bits		positionHash,
	Control.DeepSeq.NFData	x,
	Control.DeepSeq.NFData	y,
	Enum			x,
	Enum			y,
	Ord			y,
	Show			x,
	Show			y
 )
	=> (Bool, Bool, Bool)	-- ^ MatchSwitches.
	-> FindMatch x y positionHash
{-# SPECIALISE findNextOnymousQualifiedMoves :: (Bool, Bool, Bool) -> FindMatch T.X T.Y T.PositionHash #-}
findNextOnymousQualifiedMoves :: (Bool, Bool, Bool) -> FindMatch x y positionHash
findNextOnymousQualifiedMoves (Bool
tryToMatchMoves, Bool
tryToMatchViaJoiningMove, Bool
tryToMatchColourFlippedPosition) Game x y
game PositionHashQualifiedMoveTree x y positionHash
positionHashQualifiedMoveTree
	| Game x y -> PositionHashQualifiedMoveTree x y positionHash -> Bool
forall x y positionHash.
Game x y -> PositionHashQualifiedMoveTree x y positionHash -> Bool
cantConverge Game x y
game PositionHashQualifiedMoveTree x y positionHash
positionHashQualifiedMoveTree	= []	-- The specified game is smaller than any defined in the tree.
	| Bool
otherwise						= [OnymousQualifiedMove x y]
-> Maybe [OnymousQualifiedMove x y] -> [OnymousQualifiedMove x y]
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe [] (Maybe [OnymousQualifiedMove x y] -> [OnymousQualifiedMove x y])
-> ([[OnymousQualifiedMove x y]]
    -> Maybe [OnymousQualifiedMove x y])
-> [[OnymousQualifiedMove x y]]
-> [OnymousQualifiedMove x y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([OnymousQualifiedMove x y] -> Bool)
-> [[OnymousQualifiedMove x y]] -> Maybe [OnymousQualifiedMove x y]
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (
		Bool -> Bool
not (Bool -> Bool)
-> ([OnymousQualifiedMove x y] -> Bool)
-> [OnymousQualifiedMove x y]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OnymousQualifiedMove x y] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null	-- Accept the results from the first match-function which returns any.
	) ([[OnymousQualifiedMove x y]] -> [OnymousQualifiedMove x y])
-> [[OnymousQualifiedMove x y]] -> [OnymousQualifiedMove x y]
forall a b. (a -> b) -> a -> b
$ (
		if Bool
tryToMatchMoves
			then (FindMatch x y positionHash
forall x y positionHash. (Eq x, Eq y) => FindMatch x y positionHash
findNextOnymousQualifiedMovesForGame Game x y
game PositionHashQualifiedMoveTree x y positionHash
positionHashQualifiedMoveTree [OnymousQualifiedMove x y]
-> [[OnymousQualifiedMove x y]] -> [[OnymousQualifiedMove x y]]
forall a. a -> [a] -> [a]
:)
			else [[OnymousQualifiedMove x y]] -> [[OnymousQualifiedMove x y]]
forall a. a -> a
id
	) [
		FindMatch x y positionHash -> FindMatch x y positionHash
colourFlipper FindMatch x y positionHash
findMatch Game x y
game PositionHashQualifiedMoveTree x y positionHash
positionHashQualifiedMoveTree |
			FindMatch x y positionHash
findMatch	<- FindMatch x y positionHash
forall x positionHash y.
(Ix x, Bits positionHash, Enum x, Enum y, Ord y) =>
FindMatch x y positionHash
findNextOnymousQualifiedMovesForPosition FindMatch x y positionHash
-> [FindMatch x y positionHash] -> [FindMatch x y positionHash]
forall a. a -> [a] -> [a]
: [FindMatch x y positionHash
forall x positionHash y.
(Ix x, Bits positionHash, NFData x, NFData y, Enum x, Enum y,
 Ord y, Show x, Show y) =>
FindMatch x y positionHash
findNextJoiningOnymousQualifiedMovesFromPosition | Bool
tryToMatchViaJoiningMove] {-list-comprehension-},
			FindMatch x y positionHash -> FindMatch x y positionHash
colourFlipper	<- FindMatch x y positionHash -> FindMatch x y positionHash
forall a. a -> a
id (FindMatch x y positionHash -> FindMatch x y positionHash)
-> [FindMatch x y positionHash -> FindMatch x y positionHash]
-> [FindMatch x y positionHash -> FindMatch x y positionHash]
forall a. a -> [a] -> [a]
: [
				\FindMatch x y positionHash
findMatch' Game x y
game' -> (OnymousQualifiedMove x y -> OnymousQualifiedMove x y)
-> [OnymousQualifiedMove x y] -> [OnymousQualifiedMove x y]
forall a b. (a -> b) -> [a] -> [b]
map (
					QualifiedMove x y -> QualifiedMove x y
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX {-reflect matching moves back into the original domain-} (QualifiedMove x y -> QualifiedMove x y)
-> ([OnymousResult] -> [OnymousResult])
-> OnymousQualifiedMove x y
-> OnymousQualifiedMove x y
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 x y] -> [OnymousQualifiedMove x y])
-> (PositionHashQualifiedMoveTree x y positionHash
    -> [OnymousQualifiedMove x y])
-> PositionHashQualifiedMoveTree x y positionHash
-> [OnymousQualifiedMove x y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FindMatch x y positionHash
findMatch' (
					Game x y -> Game x y
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX Game x y
game'
				) | Bool
tryToMatchColourFlippedPosition
			] -- Transform an arbitrary match-function to operate on either the original or the colour-flipped game.
	] -- List-comprehension.

-- | Randomly select a /qualifiedMove/ from matching /position/s in the tree, & supply the names of those archived games from which it originated.
maybeRandomlySelectOnymousQualifiedMove :: (
	Control.DeepSeq.NFData	x,
	Control.DeepSeq.NFData	y,
	Data.Array.IArray.Ix	x,
	Data.Bits.Bits		positionHash,
	Enum			x,
	Enum			y,
	Ord			y,
	Show			x,
	Show			y,
	System.Random.RandomGen	randomGen
 )
	=> randomGen
	-> (Bool, Bool, Bool)	-- ^ MatchSwitches.
	-> Model.Game.Game x y
	-> PositionHashQualifiedMoveTree x y positionHash
	-> Maybe (Component.QualifiedMove.QualifiedMove x y, [ContextualNotation.QualifiedMoveForest.Name])
{-# SPECIALISE maybeRandomlySelectOnymousQualifiedMove
	:: System.Random.RandomGen randomGen
	=> randomGen
	-> (Bool, Bool, Bool)
	-> Model.Game.Game T.X T.Y
	-> PositionHashQualifiedMoveTree T.X T.Y T.PositionHash
	-> Maybe (Component.QualifiedMove.QualifiedMove T.X T.Y, [ContextualNotation.QualifiedMoveForest.Name])
 #-}
maybeRandomlySelectOnymousQualifiedMove :: randomGen
-> (Bool, Bool, Bool)
-> Game x y
-> PositionHashQualifiedMoveTree x y positionHash
-> Maybe (QualifiedMove x y, [String])
maybeRandomlySelectOnymousQualifiedMove randomGen
randomGen (Bool, Bool, Bool)
matchSwitches Game x y
game PositionHashQualifiedMoveTree x y positionHash
positionHashQualifiedMoveTree	= case (Bool, Bool, Bool) -> FindMatch x y positionHash
forall x positionHash y.
(Ix x, Bits positionHash, NFData x, NFData y, Enum x, Enum y,
 Ord y, Show x, Show y) =>
(Bool, Bool, Bool) -> FindMatch x y positionHash
findNextOnymousQualifiedMoves (Bool, Bool, Bool)
matchSwitches Game x y
game PositionHashQualifiedMoveTree x y positionHash
positionHashQualifiedMoveTree of
	[]			-> Maybe (QualifiedMove x y, [String])
forall a. Maybe a
Nothing
	[OnymousQualifiedMove x y]
onymousQualifiedMoves	-> (OnymousQualifiedMove x y -> (QualifiedMove x y, [String]))
-> Maybe (OnymousQualifiedMove x y)
-> Maybe (QualifiedMove x y, [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (
		([OnymousResult] -> [String])
-> OnymousQualifiedMove x y -> (QualifiedMove x y, [String])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second (([OnymousResult] -> [String])
 -> OnymousQualifiedMove x y -> (QualifiedMove x y, [String]))
-> ([OnymousResult] -> [String])
-> OnymousQualifiedMove x y
-> (QualifiedMove x y, [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 x y)
 -> Maybe (QualifiedMove x y, [String]))
-> ([[OnymousQualifiedMove x y]]
    -> Maybe (OnymousQualifiedMove x y))
-> [[OnymousQualifiedMove x y]]
-> Maybe (QualifiedMove x y, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. randomGen
-> [OnymousQualifiedMove x y] -> Maybe (OnymousQualifiedMove x y)
forall (foldable :: * -> *) randomGen a.
(Foldable foldable, RandomGen randomGen) =>
randomGen -> foldable a -> Maybe a
ToolShed.System.Random.select randomGen
randomGen ([OnymousQualifiedMove x y] -> Maybe (OnymousQualifiedMove x y))
-> ([[OnymousQualifiedMove x y]] -> [OnymousQualifiedMove x y])
-> [[OnymousQualifiedMove x y]]
-> Maybe (OnymousQualifiedMove x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[OnymousQualifiedMove x y]] -> [OnymousQualifiedMove x y]
forall a. [a] -> a
last {-highest scoring group-} ([[OnymousQualifiedMove x y]]
 -> Maybe (QualifiedMove x y, [String]))
-> [[OnymousQualifiedMove x y]]
-> Maybe (QualifiedMove x y, [String])
forall a b. (a -> b) -> a -> b
$ (OnymousQualifiedMove x y -> Rational)
-> [OnymousQualifiedMove x y] -> [[OnymousQualifiedMove x y]]
forall b a. Ord b => (a -> b) -> [a] -> [[a]]
Data.List.Extra.groupSortOn (
		(
			[NPieces] -> Rational
forall (foldable :: * -> *) result value.
(Foldable foldable, Fractional result, Real value) =>
foldable value -> result
Factory.Math.Statistics.getMean	:: [Int] -> Rational
		) ([NPieces] -> Rational)
-> (OnymousQualifiedMove x y -> [NPieces])
-> OnymousQualifiedMove x y
-> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OnymousResult -> NPieces) -> [OnymousResult] -> [NPieces]
forall a b. (a -> b) -> [a] -> [b]
map (
			 NPieces
-> (LogicalColour -> NPieces) -> Maybe LogicalColour -> NPieces
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe NPieces
0 {-a draw-} (
				\LogicalColour
victorsLogicalColour -> (
					if LogicalColour
victorsLogicalColour LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== Game x y -> LogicalColour
forall x y. Game x y -> LogicalColour
Model.Game.getNextLogicalColour Game x y
game
						then NPieces -> NPieces
forall a. a -> a
id
						else NPieces -> NPieces
forall a. Num a => a -> a
negate
				) NPieces
1 {-victory-}
			) (Maybe LogicalColour -> NPieces)
-> (OnymousResult -> Maybe LogicalColour)
-> OnymousResult
-> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result -> Maybe LogicalColour
Model.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-}	-- Score the result, according to which side we'd like to win.
		) ([OnymousResult] -> [NPieces])
-> (OnymousQualifiedMove x y -> [OnymousResult])
-> OnymousQualifiedMove x y
-> [NPieces]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnymousQualifiedMove x y -> [OnymousResult]
forall a b. (a, b) -> b
snd {-[OnymousResult]-}
	 ) [OnymousQualifiedMove x y]
onymousQualifiedMoves