module BishBosh.Evaluation.PositionHashQuantifiedGameTree(
Forest,
NodeLabel(
getPositionHash,
getQuantifiedGame
),
PositionHashQuantifiedGameTree(
MkPositionHashQuantifiedGameTree,
deconstruct
),
reduce,
traceRoute,
resign,
traceMatchingMoveSequence,
promoteMatchingMoveSequence,
sortNonCaptureMoves,
getRootQuantifiedGame',
getRootPositionHash,
getRootQuantifiedGame,
fromBarePositionHashQuantifiedGameTree,
mkPositionHashQuantifiedGameTree
) where
import Control.Arrow((&&&))
import qualified BishBosh.Component.QualifiedMove as Component.QualifiedMove
import qualified BishBosh.Component.Turn as Component.Turn
import qualified BishBosh.Component.Zobrist as Component.Zobrist
import qualified BishBosh.Data.RoseTree as Data.RoseTree
import qualified BishBosh.Evaluation.Fitness as Evaluation.Fitness
import qualified BishBosh.Evaluation.QuantifiedGame as Evaluation.QuantifiedGame
import qualified BishBosh.Input.EvaluationOptions as Input.EvaluationOptions
import qualified BishBosh.Input.RankValues as Input.RankValues
import qualified BishBosh.Input.SearchOptions as Input.SearchOptions
import qualified BishBosh.Metric.WeightedMeanAndCriterionValues as Metric.WeightedMeanAndCriterionValues
import qualified BishBosh.Model.Game as Model.Game
import qualified BishBosh.Model.GameTree as Model.GameTree
import qualified BishBosh.Notation.MoveNotation as Notation.MoveNotation
import qualified BishBosh.Property.Arboreal as Property.Arboreal
import qualified BishBosh.Property.Null as Property.Null
import qualified BishBosh.StateProperty.Hashable as StateProperty.Hashable
import qualified BishBosh.Type.Crypto as Type.Crypto
import qualified Control.Arrow
import qualified Control.Monad.Reader
import qualified Data.Bits
import qualified Data.Maybe
import qualified Data.Tree
data NodeLabel positionHash = MkNodeLabel {
NodeLabel positionHash -> positionHash
getPositionHash :: positionHash,
NodeLabel positionHash -> QuantifiedGame
getQuantifiedGame :: Evaluation.QuantifiedGame.QuantifiedGame
} deriving (NodeLabel positionHash -> NodeLabel positionHash -> Bool
(NodeLabel positionHash -> NodeLabel positionHash -> Bool)
-> (NodeLabel positionHash -> NodeLabel positionHash -> Bool)
-> Eq (NodeLabel positionHash)
forall positionHash.
Eq positionHash =>
NodeLabel positionHash -> NodeLabel positionHash -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeLabel positionHash -> NodeLabel positionHash -> Bool
$c/= :: forall positionHash.
Eq positionHash =>
NodeLabel positionHash -> NodeLabel positionHash -> Bool
== :: NodeLabel positionHash -> NodeLabel positionHash -> Bool
$c== :: forall positionHash.
Eq positionHash =>
NodeLabel positionHash -> NodeLabel positionHash -> Bool
Eq, Int -> NodeLabel positionHash -> ShowS
[NodeLabel positionHash] -> ShowS
NodeLabel positionHash -> String
(Int -> NodeLabel positionHash -> ShowS)
-> (NodeLabel positionHash -> String)
-> ([NodeLabel positionHash] -> ShowS)
-> Show (NodeLabel positionHash)
forall positionHash.
Show positionHash =>
Int -> NodeLabel positionHash -> ShowS
forall positionHash.
Show positionHash =>
[NodeLabel positionHash] -> ShowS
forall positionHash.
Show positionHash =>
NodeLabel positionHash -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeLabel positionHash] -> ShowS
$cshowList :: forall positionHash.
Show positionHash =>
[NodeLabel positionHash] -> ShowS
show :: NodeLabel positionHash -> String
$cshow :: forall positionHash.
Show positionHash =>
NodeLabel positionHash -> String
showsPrec :: Int -> NodeLabel positionHash -> ShowS
$cshowsPrec :: forall positionHash.
Show positionHash =>
Int -> NodeLabel positionHash -> ShowS
Show)
instance Notation.MoveNotation.ShowNotationFloat (NodeLabel positionHash) where
showsNotationFloat :: MoveNotation
-> (Double -> ShowS) -> NodeLabel positionHash -> ShowS
showsNotationFloat MoveNotation
moveNotation Double -> ShowS
showsDouble MkNodeLabel { getQuantifiedGame :: forall positionHash. NodeLabel positionHash -> QuantifiedGame
getQuantifiedGame = QuantifiedGame
quantifiedGame } = MoveNotation -> Turn -> ShowS
forall a. ShowNotation a => MoveNotation -> a -> ShowS
Notation.MoveNotation.showsNotation MoveNotation
moveNotation (
QuantifiedGame -> Turn
Evaluation.QuantifiedGame.getLastTurn QuantifiedGame
quantifiedGame
) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"\t=> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ShowS
showsDouble (
Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Double)
-> (WeightedMeanAndCriterionValues -> Double)
-> WeightedMeanAndCriterionValues
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WeightedMeanAndCriterionValues -> Double
Metric.WeightedMeanAndCriterionValues.getWeightedMean (WeightedMeanAndCriterionValues -> Double)
-> WeightedMeanAndCriterionValues -> Double
forall a b. (a -> b) -> a -> b
$ QuantifiedGame -> WeightedMeanAndCriterionValues
Evaluation.QuantifiedGame.getWeightedMeanAndCriterionValues QuantifiedGame
quantifiedGame
)
instance Property.Null.Null (NodeLabel positionHash) where
isNull :: NodeLabel positionHash -> Bool
isNull MkNodeLabel { getQuantifiedGame :: forall positionHash. NodeLabel positionHash -> QuantifiedGame
getQuantifiedGame = QuantifiedGame
quantifiedGame } = QuantifiedGame -> Bool
forall a. Null a => a -> Bool
Property.Null.isNull QuantifiedGame
quantifiedGame
equalsLastQualifiedMove :: Component.QualifiedMove.QualifiedMove -> Data.RoseTree.IsMatch (NodeLabel positionHash)
equalsLastQualifiedMove :: QualifiedMove -> IsMatch (NodeLabel positionHash)
equalsLastQualifiedMove QualifiedMove
qualifiedMove MkNodeLabel { getQuantifiedGame :: forall positionHash. NodeLabel positionHash -> QuantifiedGame
getQuantifiedGame = QuantifiedGame
quantifiedGame } = (QualifiedMove -> QualifiedMove -> Bool
forall a. Eq a => a -> a -> Bool
== QualifiedMove
qualifiedMove) (QualifiedMove -> Bool) -> (Turn -> QualifiedMove) -> Turn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn -> QualifiedMove
Component.Turn.getQualifiedMove (Turn -> Bool) -> Turn -> Bool
forall a b. (a -> b) -> a -> b
$ QuantifiedGame -> Turn
Evaluation.QuantifiedGame.getLastTurn QuantifiedGame
quantifiedGame
type BarePositionHashQuantifiedGameTree positionHash = Data.Tree.Tree (NodeLabel positionHash)
getRootQuantifiedGame' :: BarePositionHashQuantifiedGameTree positionHash -> Evaluation.QuantifiedGame.QuantifiedGame
getRootQuantifiedGame' :: BarePositionHashQuantifiedGameTree positionHash -> QuantifiedGame
getRootQuantifiedGame' Data.Tree.Node {
rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = MkNodeLabel { getQuantifiedGame :: forall positionHash. NodeLabel positionHash -> QuantifiedGame
getQuantifiedGame = QuantifiedGame
quantifiedGame }
} = QuantifiedGame
quantifiedGame
newtype PositionHashQuantifiedGameTree positionHash = MkPositionHashQuantifiedGameTree {
PositionHashQuantifiedGameTree positionHash
-> BarePositionHashQuantifiedGameTree positionHash
deconstruct :: BarePositionHashQuantifiedGameTree positionHash
} deriving PositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash -> Bool
(PositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash -> Bool)
-> (PositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash -> Bool)
-> Eq (PositionHashQuantifiedGameTree positionHash)
forall positionHash.
Eq positionHash =>
PositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash -> Bool
$c/= :: forall positionHash.
Eq positionHash =>
PositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash -> Bool
== :: PositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash -> Bool
$c== :: forall positionHash.
Eq positionHash =>
PositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash -> Bool
Eq
instance Property.Arboreal.Prunable (PositionHashQuantifiedGameTree positionHash) where
prune :: Int
-> PositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
prune Int
depth MkPositionHashQuantifiedGameTree { deconstruct :: forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> BarePositionHashQuantifiedGameTree positionHash
deconstruct = BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree } = BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
forall positionHash.
BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
MkPositionHashQuantifiedGameTree (BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash)
-> BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
forall a b. (a -> b) -> a -> b
$ Int -> Transformation (NodeLabel positionHash)
forall a. Int -> Transformation a
Data.RoseTree.prune Int
depth BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree
instance Notation.MoveNotation.ShowNotationFloat (PositionHashQuantifiedGameTree positionHash) where
showsNotationFloat :: MoveNotation
-> (Double -> ShowS)
-> PositionHashQuantifiedGameTree positionHash
-> ShowS
showsNotationFloat MoveNotation
moveNotation Double -> ShowS
showsDouble MkPositionHashQuantifiedGameTree { deconstruct :: forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> BarePositionHashQuantifiedGameTree positionHash
deconstruct = BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree } = String -> ShowS
showString (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ (
if NodeLabel positionHash -> Bool
forall a. Null a => a -> Bool
Property.Null.isNull (NodeLabel positionHash -> Bool)
-> (BarePositionHashQuantifiedGameTree positionHash
-> NodeLabel positionHash)
-> BarePositionHashQuantifiedGameTree positionHash
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BarePositionHashQuantifiedGameTree positionHash
-> NodeLabel positionHash
forall a. Tree a -> a
Data.Tree.rootLabel (BarePositionHashQuantifiedGameTree positionHash -> Bool)
-> BarePositionHashQuantifiedGameTree positionHash -> Bool
forall a b. (a -> b) -> a -> b
$ BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree
then (NodeLabel positionHash -> String)
-> Forest (NodeLabel positionHash) -> String
forall a. (a -> String) -> Forest a -> String
Data.RoseTree.drawForest NodeLabel positionHash -> String
forall a. ShowNotationFloat a => a -> String
toString (Forest (NodeLabel positionHash) -> String)
-> (BarePositionHashQuantifiedGameTree positionHash
-> Forest (NodeLabel positionHash))
-> BarePositionHashQuantifiedGameTree positionHash
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BarePositionHashQuantifiedGameTree positionHash
-> Forest (NodeLabel positionHash)
forall a. Tree a -> Forest a
Data.Tree.subForest
else (NodeLabel positionHash -> String)
-> BarePositionHashQuantifiedGameTree positionHash -> String
forall a. (a -> String) -> Tree a -> String
Data.RoseTree.drawTree NodeLabel positionHash -> String
forall a. ShowNotationFloat a => a -> String
toString
) BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree where
toString :: a -> String
toString a
nodeLabel = MoveNotation -> (Double -> ShowS) -> a -> ShowS
forall a.
ShowNotationFloat a =>
MoveNotation -> (Double -> ShowS) -> a -> ShowS
Notation.MoveNotation.showsNotationFloat MoveNotation
moveNotation Double -> ShowS
showsDouble a
nodeLabel String
""
fromBarePositionHashQuantifiedGameTree :: BarePositionHashQuantifiedGameTree positionHash -> PositionHashQuantifiedGameTree positionHash
fromBarePositionHashQuantifiedGameTree :: BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
fromBarePositionHashQuantifiedGameTree = BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
forall positionHash.
BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
MkPositionHashQuantifiedGameTree
mkPositionHashQuantifiedGameTree
:: Data.Bits.Bits positionHash
=> Input.EvaluationOptions.EvaluationOptions
-> Input.SearchOptions.SearchOptions
-> Component.Zobrist.Zobrist positionHash
-> Model.GameTree.MoveFrequency
-> Model.Game.Game
-> PositionHashQuantifiedGameTree positionHash
{-# SPECIALISE mkPositionHashQuantifiedGameTree
:: Input.EvaluationOptions.EvaluationOptions
-> Input.SearchOptions.SearchOptions
-> Component.Zobrist.Zobrist Type.Crypto.PositionHash
-> Model.GameTree.MoveFrequency
-> Model.Game.Game
-> PositionHashQuantifiedGameTree Type.Crypto.PositionHash
#-}
mkPositionHashQuantifiedGameTree :: EvaluationOptions
-> SearchOptions
-> Zobrist positionHash
-> MoveFrequency
-> Game
-> PositionHashQuantifiedGameTree positionHash
mkPositionHashQuantifiedGameTree EvaluationOptions
evaluationOptions SearchOptions
searchOptions Zobrist positionHash
zobrist MoveFrequency
moveFrequency Game
seedGame = BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
forall positionHash.
BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
MkPositionHashQuantifiedGameTree (
if EvaluationOptions -> Bool
Input.EvaluationOptions.getIncrementalEvaluation EvaluationOptions
evaluationOptions
then let
apexPositionHash :: positionHash
apexPositionHash = Zobrist positionHash -> Game -> positionHash
forall positionHash hashable.
(Bits positionHash, Hashable hashable) =>
Zobrist positionHash -> hashable -> positionHash
StateProperty.Hashable.hash Zobrist positionHash
zobrist Game
seedGame
in Node :: forall a. a -> Forest a -> Tree a
Data.Tree.Node {
rootLabel :: NodeLabel positionHash
Data.Tree.rootLabel = positionHash -> QuantifiedGame -> NodeLabel positionHash
forall positionHash.
positionHash -> QuantifiedGame -> NodeLabel positionHash
MkNodeLabel positionHash
apexPositionHash (QuantifiedGame -> NodeLabel positionHash)
-> QuantifiedGame -> NodeLabel positionHash
forall a b. (a -> b) -> a -> b
$ Reader EvaluationOptions QuantifiedGame
-> EvaluationOptions -> QuantifiedGame
forall r a. Reader r a -> r -> a
Control.Monad.Reader.runReader (
Maybe Double -> Game -> Reader EvaluationOptions QuantifiedGame
Evaluation.QuantifiedGame.fromGame Maybe Double
forall a. Maybe a
Nothing Game
seedGame
) EvaluationOptions
evaluationOptions,
subForest :: Forest (NodeLabel positionHash)
Data.Tree.subForest = (Tree Game -> BarePositionHashQuantifiedGameTree positionHash)
-> [Tree Game] -> Forest (NodeLabel positionHash)
forall a b. (a -> b) -> [a] -> [b]
map (
(positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash)
-> (PieceSquareByCoordinatesByRank
-> positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash)
-> Maybe PieceSquareByCoordinatesByRank
-> positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
let
slave :: positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash
slave positionHash
positionHash Game
game Data.Tree.Node {
rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = Game
game',
subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest = [Tree Game]
gameForest'
} = Node :: forall a. a -> Forest a -> Tree a
Data.Tree.Node {
rootLabel :: NodeLabel positionHash
Data.Tree.rootLabel = positionHash -> QuantifiedGame -> NodeLabel positionHash
forall positionHash.
positionHash -> QuantifiedGame -> NodeLabel positionHash
MkNodeLabel positionHash
positionHash' (QuantifiedGame -> NodeLabel positionHash)
-> QuantifiedGame -> NodeLabel positionHash
forall a b. (a -> b) -> a -> b
$ Reader EvaluationOptions QuantifiedGame
-> EvaluationOptions -> QuantifiedGame
forall r a. Reader r a -> r -> a
Control.Monad.Reader.runReader (
Maybe Double -> Game -> Reader EvaluationOptions QuantifiedGame
Evaluation.QuantifiedGame.fromGame Maybe Double
forall a. Maybe a
Nothing Game
game'
) EvaluationOptions
evaluationOptions,
subForest :: Forest (NodeLabel positionHash)
Data.Tree.subForest = (Tree Game -> BarePositionHashQuantifiedGameTree positionHash)
-> [Tree Game] -> Forest (NodeLabel positionHash)
forall a b. (a -> b) -> [a] -> [b]
map (positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash
slave positionHash
positionHash' Game
game') [Tree Game]
gameForest'
} where
positionHash' :: positionHash
positionHash' = Game
-> positionHash -> Game -> Zobrist positionHash -> positionHash
forall positionHash.
Bits positionHash =>
Game
-> positionHash -> Game -> Zobrist positionHash -> positionHash
Model.Game.updateIncrementalPositionHash Game
game positionHash
positionHash Game
game' Zobrist positionHash
zobrist
in positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash
slave
) (
\PieceSquareByCoordinatesByRank
pieceSquareByCoordinatesByRank -> let
slave :: Double
-> positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash
slave Double
pieceSquareValueDifference positionHash
positionHash Game
game Data.Tree.Node {
rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = Game
game',
subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest = [Tree Game]
gameForest'
} = Node :: forall a. a -> Forest a -> Tree a
Data.Tree.Node {
rootLabel :: NodeLabel positionHash
Data.Tree.rootLabel = positionHash -> QuantifiedGame -> NodeLabel positionHash
forall positionHash.
positionHash -> QuantifiedGame -> NodeLabel positionHash
MkNodeLabel positionHash
positionHash' (QuantifiedGame -> NodeLabel positionHash)
-> QuantifiedGame -> NodeLabel positionHash
forall a b. (a -> b) -> a -> b
$ Reader EvaluationOptions QuantifiedGame
-> EvaluationOptions -> QuantifiedGame
forall r a. Reader r a -> r -> a
Control.Monad.Reader.runReader (
Maybe Double -> Game -> Reader EvaluationOptions QuantifiedGame
Evaluation.QuantifiedGame.fromGame (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
pieceSquareValueDifference') Game
game'
) EvaluationOptions
evaluationOptions,
subForest :: Forest (NodeLabel positionHash)
Data.Tree.subForest = (Tree Game -> BarePositionHashQuantifiedGameTree positionHash)
-> [Tree Game] -> Forest (NodeLabel positionHash)
forall a b. (a -> b) -> [a] -> [b]
map (Double
-> positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash
slave Double
pieceSquareValueDifference' positionHash
positionHash' Game
game') [Tree Game]
gameForest'
} where
pieceSquareValueDifference' :: Double
pieceSquareValueDifference' = Double -> PieceSquareByCoordinatesByRank -> Game -> Double
Evaluation.Fitness.measurePieceSquareValueDifferenceIncrementally Double
pieceSquareValueDifference PieceSquareByCoordinatesByRank
pieceSquareByCoordinatesByRank Game
game'
positionHash' :: positionHash
positionHash' = Game
-> positionHash -> Game -> Zobrist positionHash -> positionHash
forall positionHash.
Bits positionHash =>
Game
-> positionHash -> Game -> Zobrist positionHash -> positionHash
Model.Game.updateIncrementalPositionHash Game
game positionHash
positionHash Game
game' Zobrist positionHash
zobrist
in Double
-> positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash
slave (Double
-> positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash)
-> Double
-> positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash
forall a b. (a -> b) -> a -> b
$ PieceSquareByCoordinatesByRank -> Game -> Double
Evaluation.Fitness.measurePieceSquareValueDifference PieceSquareByCoordinatesByRank
pieceSquareByCoordinatesByRank Game
seedGame
) (
EvaluationOptions -> Maybe PieceSquareByCoordinatesByRank
Input.EvaluationOptions.getMaybePieceSquareByCoordinatesByRank EvaluationOptions
evaluationOptions
) positionHash
apexPositionHash Game
seedGame
) ([Tree Game] -> Forest (NodeLabel positionHash))
-> [Tree Game] -> Forest (NodeLabel positionHash)
forall a b. (a -> b) -> a -> b
$ Tree Game -> [Tree Game]
forall a. Tree a -> Forest a
Data.Tree.subForest Tree Game
bareGameTree
}
else (positionHash -> QuantifiedGame -> NodeLabel positionHash)
-> (positionHash, QuantifiedGame) -> NodeLabel positionHash
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry positionHash -> QuantifiedGame -> NodeLabel positionHash
forall positionHash.
positionHash -> QuantifiedGame -> NodeLabel positionHash
MkNodeLabel ((positionHash, QuantifiedGame) -> NodeLabel positionHash)
-> (Game -> (positionHash, QuantifiedGame))
-> Game
-> NodeLabel positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
Zobrist positionHash -> Game -> positionHash
forall positionHash hashable.
(Bits positionHash, Hashable hashable) =>
Zobrist positionHash -> hashable -> positionHash
StateProperty.Hashable.hash Zobrist positionHash
zobrist (Game -> positionHash)
-> (Game -> QuantifiedGame)
-> Game
-> (positionHash, QuantifiedGame)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Reader EvaluationOptions QuantifiedGame
-> EvaluationOptions -> QuantifiedGame
forall r a. Reader r a -> r -> a
`Control.Monad.Reader.runReader` EvaluationOptions
evaluationOptions) (Reader EvaluationOptions QuantifiedGame -> QuantifiedGame)
-> (Game -> Reader EvaluationOptions QuantifiedGame)
-> Game
-> QuantifiedGame
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Double -> Game -> Reader EvaluationOptions QuantifiedGame
Evaluation.QuantifiedGame.fromGame Maybe Double
forall a. Maybe a
Nothing
) (Game -> NodeLabel positionHash)
-> Tree Game -> BarePositionHashQuantifiedGameTree positionHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree Game
bareGameTree
) where
bareGameTree :: Tree Game
bareGameTree = GameTree -> Tree Game
Model.GameTree.deconstruct (GameTree -> Tree Game)
-> (GameTree -> GameTree) -> GameTree -> Tree Game
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe CaptureMoveSortAlgorithm
-> EvaluateRank -> MoveFrequency -> GameTree -> GameTree
Model.GameTree.sortGameTree (
SearchOptions -> Maybe CaptureMoveSortAlgorithm
Input.SearchOptions.getMaybeCaptureMoveSortAlgorithm SearchOptions
searchOptions
) (
RankValues -> EvaluateRank
Input.RankValues.findRankValue (RankValues -> EvaluateRank) -> RankValues -> EvaluateRank
forall a b. (a -> b) -> a -> b
$ EvaluationOptions -> RankValues
Input.EvaluationOptions.getRankValues EvaluationOptions
evaluationOptions
) MoveFrequency
moveFrequency (GameTree -> Tree Game) -> GameTree -> Tree Game
forall a b. (a -> b) -> a -> b
$ Game -> GameTree
Model.GameTree.fromGame Game
seedGame
getRootPositionHash :: PositionHashQuantifiedGameTree positionHash -> positionHash
getRootPositionHash :: PositionHashQuantifiedGameTree positionHash -> positionHash
getRootPositionHash MkPositionHashQuantifiedGameTree {
deconstruct :: forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> BarePositionHashQuantifiedGameTree positionHash
deconstruct = Data.Tree.Node {
rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = MkNodeLabel { getPositionHash :: forall positionHash. NodeLabel positionHash -> positionHash
getPositionHash = positionHash
positionHash }
}
} = positionHash
positionHash
getRootQuantifiedGame :: PositionHashQuantifiedGameTree positionHash -> Evaluation.QuantifiedGame.QuantifiedGame
getRootQuantifiedGame :: PositionHashQuantifiedGameTree positionHash -> QuantifiedGame
getRootQuantifiedGame MkPositionHashQuantifiedGameTree {
deconstruct :: forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> BarePositionHashQuantifiedGameTree positionHash
deconstruct = Data.Tree.Node {
rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = MkNodeLabel { getQuantifiedGame :: forall positionHash. NodeLabel positionHash -> QuantifiedGame
getQuantifiedGame = QuantifiedGame
quantifiedGame }
}
} = QuantifiedGame
quantifiedGame
reduce
:: Data.RoseTree.IsMatch (NodeLabel positionHash)
-> PositionHashQuantifiedGameTree positionHash
-> Maybe (PositionHashQuantifiedGameTree positionHash)
reduce :: IsMatch (NodeLabel positionHash)
-> PositionHashQuantifiedGameTree positionHash
-> Maybe (PositionHashQuantifiedGameTree positionHash)
reduce IsMatch (NodeLabel positionHash)
isMatch MkPositionHashQuantifiedGameTree { deconstruct :: forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> BarePositionHashQuantifiedGameTree positionHash
deconstruct = BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree } = BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
forall positionHash.
BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
MkPositionHashQuantifiedGameTree (BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash)
-> Maybe (BarePositionHashQuantifiedGameTree positionHash)
-> Maybe (PositionHashQuantifiedGameTree positionHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IsMatch (NodeLabel positionHash)
-> BarePositionHashQuantifiedGameTree positionHash
-> Maybe (BarePositionHashQuantifiedGameTree positionHash)
forall a. IsMatch a -> Tree a -> Maybe (Tree a)
Data.RoseTree.reduce IsMatch (NodeLabel positionHash)
isMatch BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree
traceRoute
:: (Component.Turn.Turn -> Data.RoseTree.IsMatch (NodeLabel positionHash))
-> PositionHashQuantifiedGameTree positionHash
-> [Component.Turn.Turn]
-> Maybe [NodeLabel positionHash]
traceRoute :: (Turn -> IsMatch (NodeLabel positionHash))
-> PositionHashQuantifiedGameTree positionHash
-> [Turn]
-> Maybe [NodeLabel positionHash]
traceRoute Turn -> IsMatch (NodeLabel positionHash)
isMatch MkPositionHashQuantifiedGameTree { deconstruct :: forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> BarePositionHashQuantifiedGameTree positionHash
deconstruct = BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree } = (Turn -> IsMatch (NodeLabel positionHash))
-> BarePositionHashQuantifiedGameTree positionHash
-> [Turn]
-> Maybe [NodeLabel positionHash]
forall datum a.
(datum -> IsMatch a) -> Tree a -> [datum] -> Maybe [a]
Data.RoseTree.traceRoute Turn -> IsMatch (NodeLabel positionHash)
isMatch BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree
traceMatchingMoveSequence
:: PositionHashQuantifiedGameTree positionHash
-> Component.QualifiedMove.QualifiedMoveSequence
-> Maybe [NodeLabel positionHash]
traceMatchingMoveSequence :: PositionHashQuantifiedGameTree positionHash
-> QualifiedMoveSequence -> Maybe [NodeLabel positionHash]
traceMatchingMoveSequence MkPositionHashQuantifiedGameTree { deconstruct :: forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> BarePositionHashQuantifiedGameTree positionHash
deconstruct = BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree } = (QualifiedMove -> IsMatch (NodeLabel positionHash))
-> BarePositionHashQuantifiedGameTree positionHash
-> QualifiedMoveSequence
-> Maybe [NodeLabel positionHash]
forall datum a.
(datum -> IsMatch a) -> Tree a -> [datum] -> Maybe [a]
Data.RoseTree.traceRoute QualifiedMove -> IsMatch (NodeLabel positionHash)
forall positionHash.
QualifiedMove -> IsMatch (NodeLabel positionHash)
equalsLastQualifiedMove BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree
resign :: PositionHashQuantifiedGameTree positionHash -> PositionHashQuantifiedGameTree positionHash
resign :: PositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
resign MkPositionHashQuantifiedGameTree {
deconstruct :: forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> BarePositionHashQuantifiedGameTree positionHash
deconstruct = barePositionHashQuantifiedGameTree :: BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree@Data.Tree.Node {
rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = nodeLabel :: NodeLabel positionHash
nodeLabel@MkNodeLabel { getQuantifiedGame :: forall positionHash. NodeLabel positionHash -> QuantifiedGame
getQuantifiedGame = QuantifiedGame
quantifiedGame }
}
} = BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
forall positionHash.
BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
MkPositionHashQuantifiedGameTree (BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash)
-> BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
forall a b. (a -> b) -> a -> b
$ BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree {
rootLabel :: NodeLabel positionHash
Data.Tree.rootLabel = NodeLabel positionHash
nodeLabel {
getQuantifiedGame :: QuantifiedGame
getQuantifiedGame = QuantifiedGame
quantifiedGame { getGame :: Game
Evaluation.QuantifiedGame.getGame = Transformation
Model.Game.resign Transformation -> Transformation
forall a b. (a -> b) -> a -> b
$ QuantifiedGame -> Game
Evaluation.QuantifiedGame.getGame QuantifiedGame
quantifiedGame }
}
}
type Forest positionHash = [BarePositionHashQuantifiedGameTree positionHash]
promoteMatchingMoveSequence
:: Component.QualifiedMove.QualifiedMoveSequence
-> Forest positionHash
-> Maybe (Forest positionHash)
promoteMatchingMoveSequence :: QualifiedMoveSequence
-> Forest positionHash -> Maybe (Forest positionHash)
promoteMatchingMoveSequence = (QualifiedMove -> IsMatch (NodeLabel positionHash))
-> QualifiedMoveSequence
-> Forest positionHash
-> Maybe (Forest positionHash)
forall datum a.
(datum -> IsMatch a) -> [datum] -> [Tree a] -> Maybe [Tree a]
Data.RoseTree.promote QualifiedMove -> IsMatch (NodeLabel positionHash)
forall positionHash.
QualifiedMove -> IsMatch (NodeLabel positionHash)
equalsLastQualifiedMove
sortNonCaptureMoves
:: (Forest positionHash -> Forest positionHash)
-> Forest positionHash
-> Forest positionHash
sortNonCaptureMoves :: (Forest positionHash -> Forest positionHash)
-> Forest positionHash -> Forest positionHash
sortNonCaptureMoves Forest positionHash -> Forest positionHash
sortForest = (Forest positionHash -> Forest positionHash -> Forest positionHash)
-> (Forest positionHash, Forest positionHash)
-> Forest positionHash
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Forest positionHash -> Forest positionHash -> Forest positionHash
forall a. [a] -> [a] -> [a]
(++) ((Forest positionHash, Forest positionHash) -> Forest positionHash)
-> (Forest positionHash
-> (Forest positionHash, Forest positionHash))
-> Forest positionHash
-> Forest positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Forest positionHash -> Forest positionHash)
-> (Forest positionHash, Forest positionHash)
-> (Forest positionHash, Forest positionHash)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second Forest positionHash -> Forest positionHash
sortForest ((Forest positionHash, Forest positionHash)
-> (Forest positionHash, Forest positionHash))
-> (Forest positionHash
-> (Forest positionHash, Forest positionHash))
-> Forest positionHash
-> (Forest positionHash, Forest positionHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BarePositionHashQuantifiedGameTree positionHash -> Bool)
-> Forest positionHash
-> (Forest positionHash, Forest positionHash)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (
Turn -> Bool
Component.Turn.isCapture (Turn -> Bool)
-> (BarePositionHashQuantifiedGameTree positionHash -> Turn)
-> BarePositionHashQuantifiedGameTree positionHash
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame -> Turn
Evaluation.QuantifiedGame.getLastTurn (QuantifiedGame -> Turn)
-> (BarePositionHashQuantifiedGameTree positionHash
-> QuantifiedGame)
-> BarePositionHashQuantifiedGameTree positionHash
-> Turn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BarePositionHashQuantifiedGameTree positionHash -> QuantifiedGame
forall positionHash.
BarePositionHashQuantifiedGameTree positionHash -> QuantifiedGame
getRootQuantifiedGame'
)