{-# LANGUAGE CPP, FlexibleContexts #-}
module BishBosh.Evaluation.PositionHashQuantifiedGameTree(
Forest,
NodeLabel(
getPositionHash,
getQuantifiedGame
),
PositionHashQuantifiedGameTree(
MkPositionHashQuantifiedGameTree,
deconstruct
),
reduce,
traceRoute,
resign,
traceMatchingMoves,
promoteMatchingMoves,
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.Type.Crypto as Type.Crypto
import qualified BishBosh.Type.Length as Type.Length
import qualified BishBosh.Type.Mass as Type.Mass
import qualified Control.Arrow
import qualified Control.Monad.Reader
import qualified Data.Array.IArray
import qualified Data.Bits
import qualified Data.Maybe
import qualified Data.Tree
#ifdef USE_UNBOXED_ARRAYS
import qualified Data.Array.Unboxed
#endif
data NodeLabel x y positionHash = MkNodeLabel {
NodeLabel x y positionHash -> positionHash
getPositionHash :: positionHash,
NodeLabel x y positionHash -> QuantifiedGame x y
getQuantifiedGame :: Evaluation.QuantifiedGame.QuantifiedGame x y
} deriving (NodeLabel x y positionHash -> NodeLabel x y positionHash -> Bool
(NodeLabel x y positionHash -> NodeLabel x y positionHash -> Bool)
-> (NodeLabel x y positionHash
-> NodeLabel x y positionHash -> Bool)
-> Eq (NodeLabel x y positionHash)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall x y positionHash.
(Enum x, Enum y, Ord x, Ord y, Eq positionHash) =>
NodeLabel x y positionHash -> NodeLabel x y positionHash -> Bool
/= :: NodeLabel x y positionHash -> NodeLabel x y positionHash -> Bool
$c/= :: forall x y positionHash.
(Enum x, Enum y, Ord x, Ord y, Eq positionHash) =>
NodeLabel x y positionHash -> NodeLabel x y positionHash -> Bool
== :: NodeLabel x y positionHash -> NodeLabel x y positionHash -> Bool
$c== :: forall x y positionHash.
(Enum x, Enum y, Ord x, Ord y, Eq positionHash) =>
NodeLabel x y positionHash -> NodeLabel x y positionHash -> Bool
Eq, Int -> NodeLabel x y positionHash -> ShowS
[NodeLabel x y positionHash] -> ShowS
NodeLabel x y positionHash -> String
(Int -> NodeLabel x y positionHash -> ShowS)
-> (NodeLabel x y positionHash -> String)
-> ([NodeLabel x y positionHash] -> ShowS)
-> Show (NodeLabel x y positionHash)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall x y positionHash.
(Enum x, Enum y, Ord x, Ord y, Show positionHash, Show x,
Show y) =>
Int -> NodeLabel x y positionHash -> ShowS
forall x y positionHash.
(Enum x, Enum y, Ord x, Ord y, Show positionHash, Show x,
Show y) =>
[NodeLabel x y positionHash] -> ShowS
forall x y positionHash.
(Enum x, Enum y, Ord x, Ord y, Show positionHash, Show x,
Show y) =>
NodeLabel x y positionHash -> String
showList :: [NodeLabel x y positionHash] -> ShowS
$cshowList :: forall x y positionHash.
(Enum x, Enum y, Ord x, Ord y, Show positionHash, Show x,
Show y) =>
[NodeLabel x y positionHash] -> ShowS
show :: NodeLabel x y positionHash -> String
$cshow :: forall x y positionHash.
(Enum x, Enum y, Ord x, Ord y, Show positionHash, Show x,
Show y) =>
NodeLabel x y positionHash -> String
showsPrec :: Int -> NodeLabel x y positionHash -> ShowS
$cshowsPrec :: forall x y positionHash.
(Enum x, Enum y, Ord x, Ord y, Show positionHash, Show x,
Show y) =>
Int -> NodeLabel x y positionHash -> ShowS
Show)
instance (Enum x, Enum y) => Notation.MoveNotation.ShowNotationFloat (NodeLabel x y positionHash) where
showsNotationFloat :: MoveNotation
-> (Double -> ShowS) -> NodeLabel x y positionHash -> ShowS
showsNotationFloat MoveNotation
moveNotation Double -> ShowS
showsDouble MkNodeLabel { getQuantifiedGame :: forall x y positionHash.
NodeLabel x y positionHash -> QuantifiedGame x y
getQuantifiedGame = QuantifiedGame x y
quantifiedGame } = MoveNotation -> Turn x y -> ShowS
forall a. ShowNotation a => MoveNotation -> a -> ShowS
Notation.MoveNotation.showsNotation MoveNotation
moveNotation (
QuantifiedGame x y -> Turn x y
forall x y. QuantifiedGame x y -> Turn x y
Evaluation.QuantifiedGame.getLastTurn QuantifiedGame x y
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 x y -> WeightedMeanAndCriterionValues
forall x y. QuantifiedGame x y -> WeightedMeanAndCriterionValues
Evaluation.QuantifiedGame.getWeightedMeanAndCriterionValues QuantifiedGame x y
quantifiedGame
)
instance Property.Null.Null (NodeLabel x y positionHash) where
isNull :: NodeLabel x y positionHash -> Bool
isNull MkNodeLabel { getQuantifiedGame :: forall x y positionHash.
NodeLabel x y positionHash -> QuantifiedGame x y
getQuantifiedGame = QuantifiedGame x y
quantifiedGame } = QuantifiedGame x y -> Bool
forall a. Null a => a -> Bool
Property.Null.isNull QuantifiedGame x y
quantifiedGame
equalsLastQualifiedMove :: (Eq x, Eq y) => Component.QualifiedMove.QualifiedMove x y -> Data.RoseTree.IsMatch (NodeLabel x y positionHash)
equalsLastQualifiedMove :: QualifiedMove x y -> IsMatch (NodeLabel x y positionHash)
equalsLastQualifiedMove QualifiedMove x y
qualifiedMove MkNodeLabel { getQuantifiedGame :: forall x y positionHash.
NodeLabel x y positionHash -> QuantifiedGame x y
getQuantifiedGame = QuantifiedGame x y
quantifiedGame } = (QualifiedMove x y -> QualifiedMove x y -> Bool
forall a. Eq a => a -> a -> Bool
== QualifiedMove x y
qualifiedMove) (QualifiedMove x y -> Bool)
-> (Turn x y -> QualifiedMove x y) -> Turn x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove (Turn x y -> Bool) -> Turn x y -> Bool
forall a b. (a -> b) -> a -> b
$ QuantifiedGame x y -> Turn x y
forall x y. QuantifiedGame x y -> Turn x y
Evaluation.QuantifiedGame.getLastTurn QuantifiedGame x y
quantifiedGame
type BarePositionHashQuantifiedGameTree x y positionHash = Data.Tree.Tree (NodeLabel x y positionHash)
getRootQuantifiedGame' :: BarePositionHashQuantifiedGameTree x y positionHash -> Evaluation.QuantifiedGame.QuantifiedGame x y
getRootQuantifiedGame' :: BarePositionHashQuantifiedGameTree x y positionHash
-> QuantifiedGame x y
getRootQuantifiedGame' Data.Tree.Node {
rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = MkNodeLabel { getQuantifiedGame :: forall x y positionHash.
NodeLabel x y positionHash -> QuantifiedGame x y
getQuantifiedGame = QuantifiedGame x y
quantifiedGame }
} = QuantifiedGame x y
quantifiedGame
newtype PositionHashQuantifiedGameTree x y positionHash = MkPositionHashQuantifiedGameTree {
PositionHashQuantifiedGameTree x y positionHash
-> BarePositionHashQuantifiedGameTree x y positionHash
deconstruct :: BarePositionHashQuantifiedGameTree x y positionHash
} deriving PositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash -> Bool
(PositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash -> Bool)
-> (PositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash -> Bool)
-> Eq (PositionHashQuantifiedGameTree x y positionHash)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall x y positionHash.
(Enum x, Enum y, Ord x, Ord y, Eq positionHash) =>
PositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash -> Bool
/= :: PositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash -> Bool
$c/= :: forall x y positionHash.
(Enum x, Enum y, Ord x, Ord y, Eq positionHash) =>
PositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash -> Bool
== :: PositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash -> Bool
$c== :: forall x y positionHash.
(Enum x, Enum y, Ord x, Ord y, Eq positionHash) =>
PositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash -> Bool
Eq
instance Property.Arboreal.Prunable (PositionHashQuantifiedGameTree x y positionHash) where
prune :: Int
-> PositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
prune Int
depth MkPositionHashQuantifiedGameTree { deconstruct :: forall x y positionHash.
PositionHashQuantifiedGameTree x y positionHash
-> BarePositionHashQuantifiedGameTree x y positionHash
deconstruct = BarePositionHashQuantifiedGameTree x y positionHash
barePositionHashQuantifiedGameTree } = BarePositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
forall x y positionHash.
BarePositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
MkPositionHashQuantifiedGameTree (BarePositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash)
-> BarePositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
forall a b. (a -> b) -> a -> b
$ Int
-> BarePositionHashQuantifiedGameTree x y positionHash
-> BarePositionHashQuantifiedGameTree x y positionHash
forall tree. Prunable tree => Int -> tree -> tree
Property.Arboreal.prune Int
depth BarePositionHashQuantifiedGameTree x y positionHash
barePositionHashQuantifiedGameTree
instance (Enum x, Enum y) => Notation.MoveNotation.ShowNotationFloat (PositionHashQuantifiedGameTree x y positionHash) where
showsNotationFloat :: MoveNotation
-> (Double -> ShowS)
-> PositionHashQuantifiedGameTree x y positionHash
-> ShowS
showsNotationFloat MoveNotation
moveNotation Double -> ShowS
showsDouble MkPositionHashQuantifiedGameTree { deconstruct :: forall x y positionHash.
PositionHashQuantifiedGameTree x y positionHash
-> BarePositionHashQuantifiedGameTree x y positionHash
deconstruct = BarePositionHashQuantifiedGameTree x y positionHash
barePositionHashQuantifiedGameTree } = String -> ShowS
showString (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ (
if NodeLabel x y positionHash -> Bool
forall a. Null a => a -> Bool
Property.Null.isNull (NodeLabel x y positionHash -> Bool)
-> (BarePositionHashQuantifiedGameTree x y positionHash
-> NodeLabel x y positionHash)
-> BarePositionHashQuantifiedGameTree x y positionHash
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BarePositionHashQuantifiedGameTree x y positionHash
-> NodeLabel x y positionHash
forall a. Tree a -> a
Data.Tree.rootLabel (BarePositionHashQuantifiedGameTree x y positionHash -> Bool)
-> BarePositionHashQuantifiedGameTree x y positionHash -> Bool
forall a b. (a -> b) -> a -> b
$ BarePositionHashQuantifiedGameTree x y positionHash
barePositionHashQuantifiedGameTree
then (NodeLabel x y positionHash -> String)
-> Forest (NodeLabel x y positionHash) -> String
forall a. (a -> String) -> Forest a -> String
Data.RoseTree.drawForest NodeLabel x y positionHash -> String
forall a. ShowNotationFloat a => a -> String
toString (Forest (NodeLabel x y positionHash) -> String)
-> (BarePositionHashQuantifiedGameTree x y positionHash
-> Forest (NodeLabel x y positionHash))
-> BarePositionHashQuantifiedGameTree x y positionHash
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BarePositionHashQuantifiedGameTree x y positionHash
-> Forest (NodeLabel x y positionHash)
forall a. Tree a -> Forest a
Data.Tree.subForest
else (NodeLabel x y positionHash -> String)
-> BarePositionHashQuantifiedGameTree x y positionHash -> String
forall a. (a -> String) -> Tree a -> String
Data.RoseTree.drawTree NodeLabel x y positionHash -> String
forall a. ShowNotationFloat a => a -> String
toString
) BarePositionHashQuantifiedGameTree x y 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 x y positionHash -> PositionHashQuantifiedGameTree x y positionHash
fromBarePositionHashQuantifiedGameTree :: BarePositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
fromBarePositionHashQuantifiedGameTree = BarePositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
forall x y positionHash.
BarePositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
MkPositionHashQuantifiedGameTree
mkPositionHashQuantifiedGameTree :: (
Data.Array.IArray.Ix x,
#ifdef USE_UNBOXED_ARRAYS
Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray pieceSquareValue,
#endif
Data.Bits.Bits positionHash,
Fractional pieceSquareValue,
Integral x,
Integral y,
Real pieceSquareValue,
Show x,
Show y
)
=> Input.EvaluationOptions.EvaluationOptions pieceSquareValue x y
-> Input.SearchOptions.SearchOptions
-> Component.Zobrist.Zobrist x y positionHash
-> Model.GameTree.MoveFrequency x y
-> Model.Game.Game x y
-> PositionHashQuantifiedGameTree x y positionHash
{-# SPECIALISE mkPositionHashQuantifiedGameTree
:: Input.EvaluationOptions.EvaluationOptions Type.Mass.PieceSquareValue Type.Length.X Type.Length.Y
-> Input.SearchOptions.SearchOptions
-> Component.Zobrist.Zobrist Type.Length.X Type.Length.Y Type.Crypto.PositionHash
-> Model.GameTree.MoveFrequency Type.Length.X Type.Length.Y
-> Model.Game.Game Type.Length.X Type.Length.Y
-> PositionHashQuantifiedGameTree Type.Length.X Type.Length.Y Type.Crypto.PositionHash
#-}
mkPositionHashQuantifiedGameTree :: EvaluationOptions pieceSquareValue x y
-> SearchOptions
-> Zobrist x y positionHash
-> MoveFrequency x y
-> Game x y
-> PositionHashQuantifiedGameTree x y positionHash
mkPositionHashQuantifiedGameTree EvaluationOptions pieceSquareValue x y
evaluationOptions SearchOptions
searchOptions Zobrist x y positionHash
zobrist MoveFrequency x y
moveFrequency Game x y
seedGame = BarePositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
forall x y positionHash.
BarePositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
MkPositionHashQuantifiedGameTree (
if EvaluationOptions pieceSquareValue x y -> Bool
forall pieceSquareValue x y.
EvaluationOptions pieceSquareValue x y -> Bool
Input.EvaluationOptions.getIncrementalEvaluation EvaluationOptions pieceSquareValue x y
evaluationOptions
then let
apexPositionHash :: positionHash
apexPositionHash = 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
seedGame 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 -> QuantifiedGame x y -> NodeLabel x y positionHash
forall x y positionHash.
positionHash -> QuantifiedGame x y -> NodeLabel x y positionHash
MkNodeLabel positionHash
apexPositionHash (QuantifiedGame x y -> NodeLabel x y positionHash)
-> QuantifiedGame x y -> NodeLabel x y positionHash
forall a b. (a -> b) -> a -> b
$ Reader
(EvaluationOptions pieceSquareValue x y) (QuantifiedGame x y)
-> EvaluationOptions pieceSquareValue x y -> QuantifiedGame x y
forall r a. Reader r a -> r -> a
Control.Monad.Reader.runReader (
Maybe pieceSquareValue
-> Game x y
-> Reader
(EvaluationOptions pieceSquareValue x y) (QuantifiedGame x y)
forall x y pieceSquareValue.
(Enum x, Enum y, Fractional pieceSquareValue, Ord x, Ord y,
Real pieceSquareValue, Show x, Show y) =>
Maybe pieceSquareValue
-> Game x y -> Reader pieceSquareValue x y (QuantifiedGame x y)
Evaluation.QuantifiedGame.fromGame Maybe pieceSquareValue
forall a. Maybe a
Nothing Game x y
seedGame
) EvaluationOptions pieceSquareValue x y
evaluationOptions,
subForest :: Forest (NodeLabel x y positionHash)
Data.Tree.subForest = (Tree (Game x y)
-> BarePositionHashQuantifiedGameTree x y positionHash)
-> [Tree (Game x y)] -> Forest (NodeLabel x y positionHash)
forall a b. (a -> b) -> [a] -> [b]
map (
(positionHash
-> Game x y
-> Tree (Game x y)
-> BarePositionHashQuantifiedGameTree x y positionHash)
-> (PieceSquareByCoordinatesByRank x y pieceSquareValue
-> positionHash
-> Game x y
-> Tree (Game x y)
-> BarePositionHashQuantifiedGameTree x y positionHash)
-> Maybe (PieceSquareByCoordinatesByRank x y pieceSquareValue)
-> positionHash
-> Game x y
-> Tree (Game x y)
-> BarePositionHashQuantifiedGameTree x y positionHash
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
let
slave :: positionHash
-> Game x y
-> Tree (Game x y)
-> BarePositionHashQuantifiedGameTree x y positionHash
slave positionHash
positionHash Game x y
game Data.Tree.Node {
rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = Game x y
game',
subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest = [Tree (Game x y)]
gameForest'
} = Node :: forall a. a -> Forest a -> Tree a
Data.Tree.Node {
rootLabel :: NodeLabel x y positionHash
Data.Tree.rootLabel = positionHash -> QuantifiedGame x y -> NodeLabel x y positionHash
forall x y positionHash.
positionHash -> QuantifiedGame x y -> NodeLabel x y positionHash
MkNodeLabel positionHash
positionHash' (QuantifiedGame x y -> NodeLabel x y positionHash)
-> QuantifiedGame x y -> NodeLabel x y positionHash
forall a b. (a -> b) -> a -> b
$ Reader
(EvaluationOptions pieceSquareValue x y) (QuantifiedGame x y)
-> EvaluationOptions pieceSquareValue x y -> QuantifiedGame x y
forall r a. Reader r a -> r -> a
Control.Monad.Reader.runReader (
Maybe pieceSquareValue
-> Game x y
-> Reader
(EvaluationOptions pieceSquareValue x y) (QuantifiedGame x y)
forall x y pieceSquareValue.
(Enum x, Enum y, Fractional pieceSquareValue, Ord x, Ord y,
Real pieceSquareValue, Show x, Show y) =>
Maybe pieceSquareValue
-> Game x y -> Reader pieceSquareValue x y (QuantifiedGame x y)
Evaluation.QuantifiedGame.fromGame Maybe pieceSquareValue
forall a. Maybe a
Nothing Game x y
game'
) EvaluationOptions pieceSquareValue x y
evaluationOptions,
subForest :: Forest (NodeLabel x y positionHash)
Data.Tree.subForest = (Tree (Game x y)
-> BarePositionHashQuantifiedGameTree x y positionHash)
-> [Tree (Game x y)] -> Forest (NodeLabel x y positionHash)
forall a b. (a -> b) -> [a] -> [b]
map (positionHash
-> Game x y
-> Tree (Game x y)
-> BarePositionHashQuantifiedGameTree x y positionHash
slave positionHash
positionHash' Game x y
game') [Tree (Game x y)]
gameForest'
} where
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.updateIncrementalPositionHash Game x y
game positionHash
positionHash Game x y
game' Zobrist x y positionHash
zobrist
in positionHash
-> Game x y
-> Tree (Game x y)
-> BarePositionHashQuantifiedGameTree x y positionHash
slave
) (
\PieceSquareByCoordinatesByRank x y pieceSquareValue
pieceSquareByCoordinatesByRank -> let
slave :: pieceSquareValue
-> positionHash
-> Game x y
-> Tree (Game x y)
-> BarePositionHashQuantifiedGameTree x y positionHash
slave pieceSquareValue
pieceSquareValue positionHash
positionHash Game x y
game Data.Tree.Node {
rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = Game x y
game',
subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest = [Tree (Game x y)]
gameForest'
} = Node :: forall a. a -> Forest a -> Tree a
Data.Tree.Node {
rootLabel :: NodeLabel x y positionHash
Data.Tree.rootLabel = positionHash -> QuantifiedGame x y -> NodeLabel x y positionHash
forall x y positionHash.
positionHash -> QuantifiedGame x y -> NodeLabel x y positionHash
MkNodeLabel positionHash
positionHash' (QuantifiedGame x y -> NodeLabel x y positionHash)
-> QuantifiedGame x y -> NodeLabel x y positionHash
forall a b. (a -> b) -> a -> b
$ Reader
(EvaluationOptions pieceSquareValue x y) (QuantifiedGame x y)
-> EvaluationOptions pieceSquareValue x y -> QuantifiedGame x y
forall r a. Reader r a -> r -> a
Control.Monad.Reader.runReader (
Maybe pieceSquareValue
-> Game x y
-> Reader
(EvaluationOptions pieceSquareValue x y) (QuantifiedGame x y)
forall x y pieceSquareValue.
(Enum x, Enum y, Fractional pieceSquareValue, Ord x, Ord y,
Real pieceSquareValue, Show x, Show y) =>
Maybe pieceSquareValue
-> Game x y -> Reader pieceSquareValue x y (QuantifiedGame x y)
Evaluation.QuantifiedGame.fromGame (pieceSquareValue -> Maybe pieceSquareValue
forall a. a -> Maybe a
Just pieceSquareValue
pieceSquareValue') Game x y
game'
) EvaluationOptions pieceSquareValue x y
evaluationOptions,
subForest :: Forest (NodeLabel x y positionHash)
Data.Tree.subForest = (Tree (Game x y)
-> BarePositionHashQuantifiedGameTree x y positionHash)
-> [Tree (Game x y)] -> Forest (NodeLabel x y positionHash)
forall a b. (a -> b) -> [a] -> [b]
map (pieceSquareValue
-> positionHash
-> Game x y
-> Tree (Game x y)
-> BarePositionHashQuantifiedGameTree x y positionHash
slave pieceSquareValue
pieceSquareValue' positionHash
positionHash' Game x y
game') [Tree (Game x y)]
gameForest'
} where
pieceSquareValue' :: pieceSquareValue
pieceSquareValue' = pieceSquareValue
-> PieceSquareByCoordinatesByRank x y pieceSquareValue
-> Game x y
-> pieceSquareValue
forall x y pieceSquareValue.
(Enum x, Enum y, Num pieceSquareValue, Ord x, Ord y) =>
pieceSquareValue
-> PieceSquareByCoordinatesByRank x y pieceSquareValue
-> Game x y
-> pieceSquareValue
Evaluation.Fitness.measurePieceSquareValueIncrementally pieceSquareValue
pieceSquareValue PieceSquareByCoordinatesByRank x y pieceSquareValue
pieceSquareByCoordinatesByRank 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.updateIncrementalPositionHash Game x y
game positionHash
positionHash Game x y
game' Zobrist x y positionHash
zobrist
in pieceSquareValue
-> positionHash
-> Game x y
-> Tree (Game x y)
-> BarePositionHashQuantifiedGameTree x y positionHash
slave (pieceSquareValue
-> positionHash
-> Game x y
-> Tree (Game x y)
-> BarePositionHashQuantifiedGameTree x y positionHash)
-> pieceSquareValue
-> positionHash
-> Game x y
-> Tree (Game x y)
-> BarePositionHashQuantifiedGameTree x y positionHash
forall a b. (a -> b) -> a -> b
$ PieceSquareByCoordinatesByRank x y pieceSquareValue
-> Game x y -> pieceSquareValue
forall x y pieceSquareValue.
(Enum x, Enum y, Num pieceSquareValue, Ord x, Ord y) =>
PieceSquareByCoordinatesByRank x y pieceSquareValue
-> Game x y -> pieceSquareValue
Evaluation.Fitness.measurePieceSquareValue PieceSquareByCoordinatesByRank x y pieceSquareValue
pieceSquareByCoordinatesByRank Game x y
seedGame
) (
EvaluationOptions pieceSquareValue x y
-> Maybe (PieceSquareByCoordinatesByRank x y pieceSquareValue)
forall pieceSquareValue x y.
EvaluationOptions pieceSquareValue x y
-> Maybe (PieceSquareByCoordinatesByRank x y pieceSquareValue)
Input.EvaluationOptions.getMaybePieceSquareByCoordinatesByRank EvaluationOptions pieceSquareValue x y
evaluationOptions
) positionHash
apexPositionHash Game x y
seedGame
) ([Tree (Game x y)] -> Forest (NodeLabel x y positionHash))
-> [Tree (Game x y)] -> Forest (NodeLabel x y positionHash)
forall a b. (a -> b) -> a -> b
$ Tree (Game x y) -> [Tree (Game x y)]
forall a. Tree a -> Forest a
Data.Tree.subForest Tree (Game x y)
bareGameTree
}
else (Game x y -> NodeLabel x y positionHash)
-> Tree (Game x y)
-> BarePositionHashQuantifiedGameTree x y positionHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (
(positionHash -> QuantifiedGame x y -> NodeLabel x y positionHash)
-> (positionHash, QuantifiedGame x y) -> NodeLabel x y positionHash
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry positionHash -> QuantifiedGame x y -> NodeLabel x y positionHash
forall x y positionHash.
positionHash -> QuantifiedGame x y -> NodeLabel x y positionHash
MkNodeLabel ((positionHash, QuantifiedGame x y) -> NodeLabel x y positionHash)
-> (Game x y -> (positionHash, QuantifiedGame x y))
-> Game x y
-> NodeLabel x y positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
(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` Zobrist x y positionHash
zobrist) (Game x y -> positionHash)
-> (Game x y -> QuantifiedGame x y)
-> Game x y
-> (positionHash, QuantifiedGame x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Reader
(EvaluationOptions pieceSquareValue x y) (QuantifiedGame x y)
-> EvaluationOptions pieceSquareValue x y -> QuantifiedGame x y
forall r a. Reader r a -> r -> a
`Control.Monad.Reader.runReader` EvaluationOptions pieceSquareValue x y
evaluationOptions) (Reader
(EvaluationOptions pieceSquareValue x y) (QuantifiedGame x y)
-> QuantifiedGame x y)
-> (Game x y
-> Reader
(EvaluationOptions pieceSquareValue x y) (QuantifiedGame x y))
-> Game x y
-> QuantifiedGame x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe pieceSquareValue
-> Game x y
-> Reader
(EvaluationOptions pieceSquareValue x y) (QuantifiedGame x y)
forall x y pieceSquareValue.
(Enum x, Enum y, Fractional pieceSquareValue, Ord x, Ord y,
Real pieceSquareValue, Show x, Show y) =>
Maybe pieceSquareValue
-> Game x y -> Reader pieceSquareValue x y (QuantifiedGame x y)
Evaluation.QuantifiedGame.fromGame Maybe pieceSquareValue
forall a. Maybe a
Nothing
)
) Tree (Game x y)
bareGameTree
) where
bareGameTree :: Tree (Game x y)
bareGameTree = GameTree x y -> Tree (Game x y)
forall x y. GameTree x y -> BareGameTree x y
Model.GameTree.deconstruct (GameTree x y -> Tree (Game x y))
-> (GameTree x y -> GameTree x y)
-> GameTree x y
-> Tree (Game x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe CaptureMoveSortAlgorithm
-> EvaluateRank
-> MoveFrequency x y
-> GameTree x y
-> GameTree x y
forall x y.
(Integral x, Integral y) =>
Maybe CaptureMoveSortAlgorithm
-> EvaluateRank -> MoveFrequency x y -> Transformation x y
Model.GameTree.sortGameTree (
SearchOptions -> Maybe CaptureMoveSortAlgorithm
Input.SearchOptions.getMaybeCaptureMoveSortAlgorithm SearchOptions
searchOptions
) (
Rank -> RankValues -> RankValue
`Input.RankValues.findRankValue` EvaluationOptions pieceSquareValue x y -> RankValues
forall pieceSquareValue x y.
EvaluationOptions pieceSquareValue x y -> RankValues
Input.EvaluationOptions.getRankValues EvaluationOptions pieceSquareValue x y
evaluationOptions
) MoveFrequency x y
moveFrequency (GameTree x y -> Tree (Game x y))
-> GameTree x y -> Tree (Game x y)
forall a b. (a -> b) -> a -> b
$ Game x y -> GameTree x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Game x y -> GameTree x y
Model.GameTree.fromGame Game x y
seedGame
getRootPositionHash :: PositionHashQuantifiedGameTree x y positionHash -> positionHash
getRootPositionHash :: PositionHashQuantifiedGameTree x y positionHash -> positionHash
getRootPositionHash MkPositionHashQuantifiedGameTree {
deconstruct :: forall x y positionHash.
PositionHashQuantifiedGameTree x y positionHash
-> BarePositionHashQuantifiedGameTree x y positionHash
deconstruct = 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 }
}
} = positionHash
positionHash
getRootQuantifiedGame :: PositionHashQuantifiedGameTree x y positionHash -> Evaluation.QuantifiedGame.QuantifiedGame x y
getRootQuantifiedGame :: PositionHashQuantifiedGameTree x y positionHash
-> QuantifiedGame x y
getRootQuantifiedGame MkPositionHashQuantifiedGameTree {
deconstruct :: forall x y positionHash.
PositionHashQuantifiedGameTree x y positionHash
-> BarePositionHashQuantifiedGameTree x y positionHash
deconstruct = Data.Tree.Node {
rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = MkNodeLabel { getQuantifiedGame :: forall x y positionHash.
NodeLabel x y positionHash -> QuantifiedGame x y
getQuantifiedGame = QuantifiedGame x y
quantifiedGame }
}
} = QuantifiedGame x y
quantifiedGame
reduce
:: Data.RoseTree.IsMatch (NodeLabel x y positionHash)
-> PositionHashQuantifiedGameTree x y positionHash
-> Maybe (PositionHashQuantifiedGameTree x y positionHash)
reduce :: IsMatch (NodeLabel x y positionHash)
-> PositionHashQuantifiedGameTree x y positionHash
-> Maybe (PositionHashQuantifiedGameTree x y positionHash)
reduce IsMatch (NodeLabel x y positionHash)
isMatch MkPositionHashQuantifiedGameTree { deconstruct :: forall x y positionHash.
PositionHashQuantifiedGameTree x y positionHash
-> BarePositionHashQuantifiedGameTree x y positionHash
deconstruct = BarePositionHashQuantifiedGameTree x y positionHash
barePositionHashQuantifiedGameTree } = BarePositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
forall x y positionHash.
BarePositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
MkPositionHashQuantifiedGameTree (BarePositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash)
-> Maybe (BarePositionHashQuantifiedGameTree x y positionHash)
-> Maybe (PositionHashQuantifiedGameTree x y positionHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IsMatch (NodeLabel x y positionHash)
-> BarePositionHashQuantifiedGameTree x y positionHash
-> Maybe (BarePositionHashQuantifiedGameTree x y positionHash)
forall a. IsMatch a -> Tree a -> Maybe (Tree a)
Data.RoseTree.reduce IsMatch (NodeLabel x y positionHash)
isMatch BarePositionHashQuantifiedGameTree x y positionHash
barePositionHashQuantifiedGameTree
traceRoute
:: (Component.Turn.Turn x y -> Data.RoseTree.IsMatch (NodeLabel x y positionHash))
-> PositionHashQuantifiedGameTree x y positionHash
-> [Component.Turn.Turn x y]
-> Maybe [NodeLabel x y positionHash]
traceRoute :: (Turn x y -> IsMatch (NodeLabel x y positionHash))
-> PositionHashQuantifiedGameTree x y positionHash
-> [Turn x y]
-> Maybe [NodeLabel x y positionHash]
traceRoute Turn x y -> IsMatch (NodeLabel x y positionHash)
isMatch MkPositionHashQuantifiedGameTree { deconstruct :: forall x y positionHash.
PositionHashQuantifiedGameTree x y positionHash
-> BarePositionHashQuantifiedGameTree x y positionHash
deconstruct = BarePositionHashQuantifiedGameTree x y positionHash
barePositionHashQuantifiedGameTree } = (Turn x y -> IsMatch (NodeLabel x y positionHash))
-> BarePositionHashQuantifiedGameTree x y positionHash
-> [Turn x y]
-> Maybe [NodeLabel x y positionHash]
forall datum a.
(datum -> IsMatch a) -> Tree a -> [datum] -> Maybe [a]
Data.RoseTree.traceRoute Turn x y -> IsMatch (NodeLabel x y positionHash)
isMatch BarePositionHashQuantifiedGameTree x y positionHash
barePositionHashQuantifiedGameTree
traceMatchingMoves
:: (Eq x, Eq y)
=> PositionHashQuantifiedGameTree x y positionHash
-> [Component.QualifiedMove.QualifiedMove x y]
-> Maybe [NodeLabel x y positionHash]
traceMatchingMoves :: PositionHashQuantifiedGameTree x y positionHash
-> [QualifiedMove x y] -> Maybe [NodeLabel x y positionHash]
traceMatchingMoves MkPositionHashQuantifiedGameTree { deconstruct :: forall x y positionHash.
PositionHashQuantifiedGameTree x y positionHash
-> BarePositionHashQuantifiedGameTree x y positionHash
deconstruct = BarePositionHashQuantifiedGameTree x y positionHash
barePositionHashQuantifiedGameTree } = (QualifiedMove x y -> IsMatch (NodeLabel x y positionHash))
-> BarePositionHashQuantifiedGameTree x y positionHash
-> [QualifiedMove x y]
-> Maybe [NodeLabel x y positionHash]
forall datum a.
(datum -> IsMatch a) -> Tree a -> [datum] -> Maybe [a]
Data.RoseTree.traceRoute QualifiedMove x y -> IsMatch (NodeLabel x y positionHash)
forall x y positionHash.
(Eq x, Eq y) =>
QualifiedMove x y -> IsMatch (NodeLabel x y positionHash)
equalsLastQualifiedMove BarePositionHashQuantifiedGameTree x y positionHash
barePositionHashQuantifiedGameTree
resign :: PositionHashQuantifiedGameTree x y positionHash -> PositionHashQuantifiedGameTree x y positionHash
resign :: PositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
resign MkPositionHashQuantifiedGameTree {
deconstruct :: forall x y positionHash.
PositionHashQuantifiedGameTree x y positionHash
-> BarePositionHashQuantifiedGameTree x y positionHash
deconstruct = barePositionHashQuantifiedGameTree :: BarePositionHashQuantifiedGameTree x y positionHash
barePositionHashQuantifiedGameTree@Data.Tree.Node {
rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = nodeLabel :: NodeLabel x y positionHash
nodeLabel@MkNodeLabel { getQuantifiedGame :: forall x y positionHash.
NodeLabel x y positionHash -> QuantifiedGame x y
getQuantifiedGame = QuantifiedGame x y
quantifiedGame }
}
} = BarePositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
forall x y positionHash.
BarePositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
MkPositionHashQuantifiedGameTree (BarePositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash)
-> BarePositionHashQuantifiedGameTree x y positionHash
-> PositionHashQuantifiedGameTree x y positionHash
forall a b. (a -> b) -> a -> b
$ BarePositionHashQuantifiedGameTree x y positionHash
barePositionHashQuantifiedGameTree {
rootLabel :: NodeLabel x y positionHash
Data.Tree.rootLabel = NodeLabel x y positionHash
nodeLabel {
getQuantifiedGame :: QuantifiedGame x y
getQuantifiedGame = QuantifiedGame x y
quantifiedGame { getGame :: Game x y
Evaluation.QuantifiedGame.getGame = Transformation x y
forall x y. Transformation x y
Model.Game.resign Transformation x y -> Transformation x y
forall a b. (a -> b) -> a -> b
$ QuantifiedGame x y -> Game x y
forall x y. QuantifiedGame x y -> Game x y
Evaluation.QuantifiedGame.getGame QuantifiedGame x y
quantifiedGame }
}
}
type Forest x y positionHash = [BarePositionHashQuantifiedGameTree x y positionHash]
promoteMatchingMoves
:: (Eq x, Eq y)
=> [Component.QualifiedMove.QualifiedMove x y]
-> Forest x y positionHash
-> Maybe (Forest x y positionHash)
promoteMatchingMoves :: [QualifiedMove x y]
-> Forest x y positionHash -> Maybe (Forest x y positionHash)
promoteMatchingMoves = (QualifiedMove x y -> IsMatch (NodeLabel x y positionHash))
-> [QualifiedMove x y]
-> Forest x y positionHash
-> Maybe (Forest x y positionHash)
forall datum a.
(datum -> IsMatch a) -> [datum] -> [Tree a] -> Maybe [Tree a]
Data.RoseTree.promote QualifiedMove x y -> IsMatch (NodeLabel x y positionHash)
forall x y positionHash.
(Eq x, Eq y) =>
QualifiedMove x y -> IsMatch (NodeLabel x y positionHash)
equalsLastQualifiedMove
sortNonCaptureMoves
:: (Forest x y positionHash -> Forest x y positionHash)
-> Forest x y positionHash
-> Forest x y positionHash
sortNonCaptureMoves :: (Forest x y positionHash -> Forest x y positionHash)
-> Forest x y positionHash -> Forest x y positionHash
sortNonCaptureMoves Forest x y positionHash -> Forest x y positionHash
sortForest = (Forest x y positionHash
-> Forest x y positionHash -> Forest x y positionHash)
-> (Forest x y positionHash, Forest x y positionHash)
-> Forest x y positionHash
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Forest x y positionHash
-> Forest x y positionHash -> Forest x y positionHash
forall a. [a] -> [a] -> [a]
(++) ((Forest x y positionHash, Forest x y positionHash)
-> Forest x y positionHash)
-> (Forest x y positionHash
-> (Forest x y positionHash, Forest x y positionHash))
-> Forest x y positionHash
-> Forest x y positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Forest x y positionHash -> Forest x y positionHash)
-> (Forest x y positionHash, Forest x y positionHash)
-> (Forest x y positionHash, Forest x y positionHash)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second Forest x y positionHash -> Forest x y positionHash
sortForest ((Forest x y positionHash, Forest x y positionHash)
-> (Forest x y positionHash, Forest x y positionHash))
-> (Forest x y positionHash
-> (Forest x y positionHash, Forest x y positionHash))
-> Forest x y positionHash
-> (Forest x y positionHash, Forest x y positionHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BarePositionHashQuantifiedGameTree x y positionHash -> Bool)
-> Forest x y positionHash
-> (Forest x y positionHash, Forest x y positionHash)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (
Turn x y -> Bool
forall x y. Turn x y -> Bool
Component.Turn.isCapture (Turn x y -> Bool)
-> (BarePositionHashQuantifiedGameTree x y positionHash
-> Turn x y)
-> BarePositionHashQuantifiedGameTree x y positionHash
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantifiedGame x y -> Turn x y
forall x y. QuantifiedGame x y -> Turn x y
Evaluation.QuantifiedGame.getLastTurn (QuantifiedGame x y -> Turn x y)
-> (BarePositionHashQuantifiedGameTree x y positionHash
-> QuantifiedGame x y)
-> BarePositionHashQuantifiedGameTree x y positionHash
-> Turn x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BarePositionHashQuantifiedGameTree x y positionHash
-> QuantifiedGame x y
forall x y positionHash.
BarePositionHashQuantifiedGameTree x y positionHash
-> QuantifiedGame x y
getRootQuantifiedGame'
)