{-# LANGUAGE CPP #-}
module BishBosh.ContextualNotation.PositionHashQualifiedMoveTree(
TryToMatchMoves,
TryToMatchViaJoiningMove,
TryToMatchColourFlippedPosition,
PreferVictories,
MatchSwitches,
NodeLabel(),
PositionHashQualifiedMoveTree(),
findNextOnymousQualifiedMovesForPosition,
findNextOnymousQualifiedMoves,
maybeRandomlySelectOnymousQualifiedMove,
fromQualifiedMoveForest,
isTerminal
) where
import Control.Arrow((&&&), (***))
import qualified BishBosh.Attribute.LogicalColour as Attribute.LogicalColour
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.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 System.Random
import qualified ToolShed.System.Random
#ifdef USE_PARALLEL
import qualified Control.Parallel.Strategies
#endif
data NodeLabel positionHash = MkNodeLabel {
NodeLabel positionHash -> positionHash
getPositionHash :: positionHash,
NodeLabel positionHash
-> Maybe (QualifiedMove, Maybe OnymousResult)
getMaybeQualifiedMoveWithOnymousResult :: Maybe (Component.QualifiedMove.QualifiedMove, Maybe ContextualNotation.QualifiedMoveForest.OnymousResult)
}
type Tree positionHash = Data.Tree.Tree (NodeLabel positionHash)
data PositionHashQualifiedMoveTree positionHash = MkPositionHashQualifiedMoveTree {
PositionHashQualifiedMoveTree positionHash -> Zobrist positionHash
getZobrist :: Component.Zobrist.Zobrist positionHash,
PositionHashQualifiedMoveTree positionHash -> Tree positionHash
getTree :: Tree positionHash,
PositionHashQualifiedMoveTree positionHash -> NPieces
getMinimumPieces :: ! Type.Count.NPieces,
PositionHashQualifiedMoveTree positionHash -> Bool
getHasAnyVictories :: Bool
}
fromQualifiedMoveForest
:: Data.Bits.Bits positionHash
=> Bool
-> 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 (
Bool -> (OnymousResult -> Bool) -> Maybe OnymousResult -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False (
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
) (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 (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 = Game -> Zobrist positionHash -> positionHash
forall positionHash hashable.
(Bits positionHash, Hashable hashable) =>
hashable -> Zobrist positionHash -> positionHash
StateProperty.Hashable.hash Game
initialGame Zobrist positionHash
zobrist
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'
} 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 (Game -> Zobrist positionHash -> positionHash
forall positionHash hashable.
(Bits positionHash, Hashable hashable) =>
hashable -> Zobrist positionHash -> positionHash
StateProperty.Hashable.hash Game
game' Zobrist positionHash
zobrist) (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
-> Tree (QualifiedMove, Maybe OnymousResult) -> Tree positionHash
slave Game
game') [Tree (QualifiedMove, Maybe OnymousResult)]
qualifiedMoveForest'
} 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
}
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
cantConverge :: Model.Game.Game -> PositionHashQualifiedMoveTree positionHash -> Bool
cantConverge :: Game -> PositionHashQualifiedMoveTree positionHash -> Bool
cantConverge Game
game MkPositionHashQualifiedMoveTree { getMinimumPieces :: forall positionHash.
PositionHashQualifiedMoveTree positionHash -> NPieces
getMinimumPieces = NPieces
minimumPieces } = Board -> NPieces
State.Board.getNPieces (Game -> Board
Model.Game.getBoard Game
game) NPieces -> NPieces -> Bool
forall a. Ord a => a -> a -> Bool
< NPieces
minimumPieces
type OnymousQualifiedMove = (Component.QualifiedMove.QualifiedMove, [ContextualNotation.QualifiedMoveForest.OnymousResult])
onymiseQualifiedMove :: Tree positionHash -> OnymousQualifiedMove
onymiseQualifiedMove :: Tree positionHash -> OnymousQualifiedMove
onymiseQualifiedMove = (
(QualifiedMove, Maybe OnymousResult) -> QualifiedMove
forall a b. (a, b) -> a
fst ((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
) ([(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
type FindMatch positionHash = Model.Game.Game -> PositionHashQualifiedMoveTree positionHash -> [OnymousQualifiedMove]
findNextOnymousQualifiedMovesForGame :: FindMatch positionHash
findNextOnymousQualifiedMovesForGame :: FindMatch positionHash
findNextOnymousQualifiedMovesForGame Game
requiredGame = [Turn] -> Forest (NodeLabel positionHash) -> [OnymousQualifiedMove]
forall positionHash.
[Turn] -> Forest (NodeLabel positionHash) -> [OnymousQualifiedMove]
slave (
Game -> [Turn]
Model.Game.listTurnsChronologically Game
requiredGame
) (Forest (NodeLabel positionHash) -> [OnymousQualifiedMove])
-> (PositionHashQualifiedMoveTree positionHash
-> Forest (NodeLabel positionHash))
-> PositionHashQualifiedMoveTree positionHash
-> [OnymousQualifiedMove]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (NodeLabel positionHash) -> Forest (NodeLabel positionHash)
forall a. Tree a -> Forest a
Data.Tree.subForest (Tree (NodeLabel positionHash) -> Forest (NodeLabel positionHash))
-> (PositionHashQualifiedMoveTree positionHash
-> Tree (NodeLabel positionHash))
-> PositionHashQualifiedMoveTree positionHash
-> Forest (NodeLabel positionHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionHashQualifiedMoveTree positionHash
-> Tree (NodeLabel positionHash)
forall positionHash.
PositionHashQualifiedMoveTree positionHash -> Tree positionHash
getTree where
slave :: [Turn] -> Forest (NodeLabel positionHash) -> [OnymousQualifiedMove]
slave (Turn
turn : [Turn]
remainingTurns) = [OnymousQualifiedMove]
-> (Tree (NodeLabel positionHash) -> [OnymousQualifiedMove])
-> Maybe (Tree (NodeLabel positionHash))
-> [OnymousQualifiedMove]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [] (
[Turn] -> Forest (NodeLabel positionHash) -> [OnymousQualifiedMove]
slave [Turn]
remainingTurns (Forest (NodeLabel positionHash) -> [OnymousQualifiedMove])
-> (Tree (NodeLabel positionHash)
-> Forest (NodeLabel positionHash))
-> Tree (NodeLabel positionHash)
-> [OnymousQualifiedMove]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (NodeLabel positionHash) -> Forest (NodeLabel positionHash)
forall a. Tree a -> Forest a
Data.Tree.subForest
) (Maybe (Tree (NodeLabel positionHash)) -> [OnymousQualifiedMove])
-> (Forest (NodeLabel positionHash)
-> Maybe (Tree (NodeLabel positionHash)))
-> Forest (NodeLabel positionHash)
-> [OnymousQualifiedMove]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree (NodeLabel positionHash) -> Bool)
-> Forest (NodeLabel positionHash)
-> Maybe (Tree (NodeLabel 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]
_ = (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
findNextOnymousQualifiedMovesForPosition :: Data.Bits.Bits positionHash => FindMatch positionHash
{-# SPECIALISE findNextOnymousQualifiedMovesForPosition :: FindMatch Type.Crypto.PositionHash #-}
findNextOnymousQualifiedMovesForPosition :: FindMatch positionHash
findNextOnymousQualifiedMovesForPosition Game
requiredGame PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree
| Game -> PositionHashQualifiedMoveTree positionHash -> Bool
forall positionHash.
Game -> PositionHashQualifiedMoveTree positionHash -> Bool
cantConverge Game
requiredGame PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree = []
| 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)
nPiecesDiffByLogicalColour (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
nPiecesDiffByLogicalColour :: (Type.Count.NPieces, Type.Count.NPieces)
(positionHash
requiredPositionHash, (NPieces, NPieces)
nPiecesDiffByLogicalColour) = (Game -> Zobrist positionHash -> positionHash
forall positionHash hashable.
(Bits positionHash, Hashable hashable) =>
hashable -> Zobrist positionHash -> positionHash
`StateProperty.Hashable.hash` PositionHashQualifiedMoveTree positionHash -> Zobrist positionHash
forall positionHash.
PositionHashQualifiedMoveTree positionHash -> Zobrist positionHash
getZobrist PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree) (Game -> positionHash)
-> (Game -> (NPieces, NPieces))
-> Game
-> (positionHash, (NPieces, NPieces))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (
((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
-)
) ((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 -> (positionHash, (NPieces, NPieces)))
-> Game -> (positionHash, (NPieces, NPieces))
forall a b. (a -> b) -> a -> b
$ Game
requiredGame
slave :: (a, a) -> Tree (NodeLabel positionHash) -> [OnymousQualifiedMove]
slave (a
nPiecesDiffOpponent, a
nPiecesDiffMover) 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
nPiecesDiffMover a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` a
0 of
Ordering
GT -> [OnymousQualifiedMove] -> [OnymousQualifiedMove]
forall a. a -> a
id
Ordering
EQ
| positionHash
positionHash positionHash -> positionHash -> Bool
forall a. Eq a => a -> a -> Bool
== positionHash
requiredPositionHash -> ((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]
++)
| Bool
otherwise -> [OnymousQualifiedMove] -> [OnymousQualifiedMove]
forall a. a -> a
id
Ordering
_ -> [OnymousQualifiedMove]
-> [OnymousQualifiedMove] -> [OnymousQualifiedMove]
forall a b. a -> b -> a
const []
) ([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
nPiecesDiffMover,
(
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
forall a. Enum a => a -> a
pred
else a -> a
forall a. a -> a
id
) a
nPiecesDiffOpponent
) Tree (NodeLabel positionHash)
node
) Forest (NodeLabel positionHash)
forest
findNextJoiningOnymousQualifiedMovesFromPosition :: Data.Bits.Bits positionHash => FindMatch positionHash
{-# SPECIALISE findNextJoiningOnymousQualifiedMovesFromPosition :: FindMatch Type.Crypto.PositionHash #-}
findNextJoiningOnymousQualifiedMovesFromPosition :: FindMatch positionHash
findNextJoiningOnymousQualifiedMovesFromPosition Game
game PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree
| 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 ) (QualifiedMove, [OnymousQualifiedMove])
movePair |
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 Strategy [OnymousQualifiedMove]
forall a. NFData a => Strategy a
Control.Parallel.Strategies.rdeepseq
) ([(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)
) ([QualifiedMove] -> [(QualifiedMove, [OnymousQualifiedMove])])
-> [QualifiedMove] -> [(QualifiedMove, [OnymousQualifiedMove])]
forall a b. (a -> b) -> a -> b
$ Game -> [QualifiedMove]
Model.Game.findQualifiedMovesAvailableToNextPlayer Game
game
]
type TryToMatchMoves = Bool
type TryToMatchViaJoiningMove = Bool
type TryToMatchColourFlippedPosition = Bool
type MatchSwitches = (TryToMatchMoves, TryToMatchViaJoiningMove, TryToMatchColourFlippedPosition)
type PreferVictories = Bool
findNextOnymousQualifiedMoves
:: Data.Bits.Bits positionHash
=> MatchSwitches
-> FindMatch positionHash
{-# SPECIALISE findNextOnymousQualifiedMoves :: MatchSwitches -> FindMatch Type.Crypto.PositionHash #-}
findNextOnymousQualifiedMoves :: MatchSwitches -> FindMatch positionHash
findNextOnymousQualifiedMoves (Bool
tryToMatchMoves, Bool
tryToMatchViaJoiningMove, Bool
tryToMatchColourFlippedPosition) Game
game PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree
| Game -> PositionHashQualifiedMoveTree positionHash -> Bool
forall positionHash.
Game -> PositionHashQualifiedMoveTree positionHash -> Bool
cantConverge Game
game PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree = []
| 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
) ([[OnymousQualifiedMove]] -> [OnymousQualifiedMove])
-> [[OnymousQualifiedMove]] -> [OnymousQualifiedMove]
forall a b. (a -> b) -> a -> b
$ (
if Bool
tryToMatchMoves
then (FindMatch positionHash
forall positionHash. FindMatch positionHash
findNextOnymousQualifiedMovesForGame Game
game PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree [OnymousQualifiedMove]
-> [[OnymousQualifiedMove]] -> [[OnymousQualifiedMove]]
forall a. a -> [a] -> [a]
:)
else [[OnymousQualifiedMove]] -> [[OnymousQualifiedMove]]
forall a. a -> a
id
) [
FindMatch positionHash -> FindMatch positionHash
colourFlipper FindMatch positionHash
findMatch Game
game PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree |
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] ,
FindMatch positionHash -> FindMatch positionHash
colourFlipper <- 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' Game
game' -> (OnymousQualifiedMove -> OnymousQualifiedMove)
-> [OnymousQualifiedMove] -> [OnymousQualifiedMove]
forall a b. (a -> b) -> [a] -> [b]
map (
QualifiedMove -> QualifiedMove
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX (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])
-> (PositionHashQualifiedMoveTree positionHash
-> [OnymousQualifiedMove])
-> PositionHashQualifiedMoveTree positionHash
-> [OnymousQualifiedMove]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FindMatch positionHash
findMatch' (
Transformation
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX Game
game'
) | Bool
tryToMatchColourFlippedPosition
]
]
shortListMostVictorious
:: Attribute.LogicalColour.LogicalColour
-> [OnymousQualifiedMove]
-> [OnymousQualifiedMove]
shortListMostVictorious :: LogicalColour -> [OnymousQualifiedMove] -> [OnymousQualifiedMove]
shortListMostVictorious LogicalColour
nextLogicalColour = [[OnymousQualifiedMove]] -> [OnymousQualifiedMove]
forall a. [a] -> a
last ([[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 (
\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
) (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
) (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
)
maybeRandomlySelectOnymousQualifiedMove :: (
Data.Bits.Bits positionHash,
System.Random.RandomGen randomGen
)
=> randomGen
-> PreferVictories
-> MatchSwitches
-> Model.Game.Game
-> PositionHashQualifiedMoveTree positionHash
-> Maybe (Component.QualifiedMove.QualifiedMove, [ContextualNotation.QualifiedMoveForest.Name])
{-# SPECIALISE maybeRandomlySelectOnymousQualifiedMove
:: System.Random.RandomGen randomGen
=> randomGen
-> PreferVictories
-> MatchSwitches
-> Model.Game.Game
-> PositionHashQualifiedMoveTree Type.Crypto.PositionHash
-> Maybe (Component.QualifiedMove.QualifiedMove, [ContextualNotation.QualifiedMoveForest.Name])
#-}
maybeRandomlySelectOnymousQualifiedMove :: randomGen
-> Bool
-> MatchSwitches
-> Game
-> PositionHashQualifiedMoveTree positionHash
-> Maybe (QualifiedMove, [String])
maybeRandomlySelectOnymousQualifiedMove randomGen
randomGen Bool
preferVictories MatchSwitches
matchSwitches Game
game PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree = case MatchSwitches -> FindMatch positionHash
forall positionHash.
Bits positionHash =>
MatchSwitches -> FindMatch positionHash
findNextOnymousQualifiedMoves MatchSwitches
matchSwitches Game
game PositionHashQualifiedMoveTree positionHash
positionHashQualifiedMoveTree 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
) (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