{-# 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.StateProperty.Hashable as StateProperty.Hashable
import qualified BishBosh.Type.Crypto as Type.Crypto
import qualified BishBosh.Type.Mass as Type.Mass
import qualified Control.Arrow
import qualified Control.Monad.Reader
import qualified Data.Bits
import qualified Data.Maybe
import qualified Data.Tree
#ifdef USE_UNBOXED_ARRAYS
import qualified Data.Array.Unboxed
#endif
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
-> BarePositionHashQuantifiedGameTree positionHash
-> BarePositionHashQuantifiedGameTree positionHash
forall tree. Prunable tree => Int -> tree -> tree
Property.Arboreal.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 :: (
#ifdef USE_UNBOXED_ARRAYS
Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray pieceSquareValue,
#endif
Data.Bits.Bits positionHash,
Fractional pieceSquareValue,
Real pieceSquareValue
)
=> Input.EvaluationOptions.EvaluationOptions pieceSquareValue
-> Input.SearchOptions.SearchOptions
-> Component.Zobrist.Zobrist positionHash
-> Model.GameTree.MoveFrequency
-> Model.Game.Game
-> PositionHashQuantifiedGameTree positionHash
{-# SPECIALISE mkPositionHashQuantifiedGameTree
:: Input.EvaluationOptions.EvaluationOptions Type.Mass.PieceSquareValue
-> Input.SearchOptions.SearchOptions
-> Component.Zobrist.Zobrist Type.Crypto.PositionHash
-> Model.GameTree.MoveFrequency
-> Model.Game.Game
-> PositionHashQuantifiedGameTree Type.Crypto.PositionHash
#-}
mkPositionHashQuantifiedGameTree :: EvaluationOptions pieceSquareValue
-> SearchOptions
-> Zobrist positionHash
-> MoveFrequency
-> Game
-> PositionHashQuantifiedGameTree positionHash
mkPositionHashQuantifiedGameTree EvaluationOptions pieceSquareValue
evaluationOptions SearchOptions
searchOptions Zobrist positionHash
zobrist MoveFrequency
moveFrequency Game
seedGame = BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
forall positionHash.
BarePositionHashQuantifiedGameTree positionHash
-> PositionHashQuantifiedGameTree positionHash
MkPositionHashQuantifiedGameTree (
if EvaluationOptions pieceSquareValue -> Bool
forall pieceSquareValue. EvaluationOptions pieceSquareValue -> Bool
Input.EvaluationOptions.getIncrementalEvaluation EvaluationOptions pieceSquareValue
evaluationOptions
then let
apexPositionHash :: positionHash
apexPositionHash = Game -> Zobrist positionHash -> positionHash
forall positionHash hashable.
(Bits positionHash, Hashable hashable) =>
hashable -> Zobrist positionHash -> positionHash
StateProperty.Hashable.hash Game
seedGame Zobrist positionHash
zobrist
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 pieceSquareValue) QuantifiedGame
-> EvaluationOptions pieceSquareValue -> QuantifiedGame
forall r a. Reader r a -> r -> a
Control.Monad.Reader.runReader (
Maybe pieceSquareValue
-> Game
-> Reader (EvaluationOptions pieceSquareValue) QuantifiedGame
forall pieceSquareValue.
(Fractional pieceSquareValue, Real pieceSquareValue) =>
Maybe pieceSquareValue
-> Game -> Reader pieceSquareValue QuantifiedGame
Evaluation.QuantifiedGame.fromGame Maybe pieceSquareValue
forall a. Maybe a
Nothing Game
seedGame
) EvaluationOptions pieceSquareValue
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 pieceSquareValue
-> positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash)
-> Maybe (PieceSquareByCoordinatesByRank pieceSquareValue)
-> 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 pieceSquareValue) QuantifiedGame
-> EvaluationOptions pieceSquareValue -> QuantifiedGame
forall r a. Reader r a -> r -> a
Control.Monad.Reader.runReader (
Maybe pieceSquareValue
-> Game
-> Reader (EvaluationOptions pieceSquareValue) QuantifiedGame
forall pieceSquareValue.
(Fractional pieceSquareValue, Real pieceSquareValue) =>
Maybe pieceSquareValue
-> Game -> Reader pieceSquareValue QuantifiedGame
Evaluation.QuantifiedGame.fromGame Maybe pieceSquareValue
forall a. Maybe a
Nothing Game
game'
) EvaluationOptions pieceSquareValue
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 pieceSquareValue
pieceSquareByCoordinatesByRank -> let
slave :: pieceSquareValue
-> positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash
slave pieceSquareValue
pieceSquareValue 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 pieceSquareValue) QuantifiedGame
-> EvaluationOptions pieceSquareValue -> QuantifiedGame
forall r a. Reader r a -> r -> a
Control.Monad.Reader.runReader (
Maybe pieceSquareValue
-> Game
-> Reader (EvaluationOptions pieceSquareValue) QuantifiedGame
forall pieceSquareValue.
(Fractional pieceSquareValue, Real pieceSquareValue) =>
Maybe pieceSquareValue
-> Game -> Reader pieceSquareValue QuantifiedGame
Evaluation.QuantifiedGame.fromGame (pieceSquareValue -> Maybe pieceSquareValue
forall a. a -> Maybe a
Just pieceSquareValue
pieceSquareValue') Game
game'
) EvaluationOptions pieceSquareValue
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 (pieceSquareValue
-> positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash
slave pieceSquareValue
pieceSquareValue' positionHash
positionHash' Game
game') [Tree Game]
gameForest'
} where
pieceSquareValue' :: pieceSquareValue
pieceSquareValue' = pieceSquareValue
-> PieceSquareByCoordinatesByRank pieceSquareValue
-> Game
-> pieceSquareValue
forall pieceSquareValue.
Num pieceSquareValue =>
pieceSquareValue
-> PieceSquareByCoordinatesByRank pieceSquareValue
-> Game
-> pieceSquareValue
Evaluation.Fitness.measurePieceSquareValueIncrementally pieceSquareValue
pieceSquareValue PieceSquareByCoordinatesByRank pieceSquareValue
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 pieceSquareValue
-> positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash
slave (pieceSquareValue
-> positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash)
-> pieceSquareValue
-> positionHash
-> Game
-> Tree Game
-> BarePositionHashQuantifiedGameTree positionHash
forall a b. (a -> b) -> a -> b
$ PieceSquareByCoordinatesByRank pieceSquareValue
-> Game -> pieceSquareValue
forall pieceSquareValue.
Num pieceSquareValue =>
PieceSquareByCoordinatesByRank pieceSquareValue
-> Game -> pieceSquareValue
Evaluation.Fitness.measurePieceSquareValue PieceSquareByCoordinatesByRank pieceSquareValue
pieceSquareByCoordinatesByRank Game
seedGame
) (
EvaluationOptions pieceSquareValue
-> Maybe (PieceSquareByCoordinatesByRank pieceSquareValue)
forall pieceSquareValue.
EvaluationOptions pieceSquareValue
-> Maybe (PieceSquareByCoordinatesByRank pieceSquareValue)
Input.EvaluationOptions.getMaybePieceSquareByCoordinatesByRank EvaluationOptions pieceSquareValue
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 (Game -> NodeLabel positionHash)
-> Tree Game -> BarePositionHashQuantifiedGameTree positionHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (
(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
. (
(Game -> Zobrist positionHash -> positionHash
forall positionHash hashable.
(Bits positionHash, Hashable hashable) =>
hashable -> Zobrist positionHash -> 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 pieceSquareValue) QuantifiedGame
-> EvaluationOptions pieceSquareValue -> QuantifiedGame
forall r a. Reader r a -> r -> a
`Control.Monad.Reader.runReader` EvaluationOptions pieceSquareValue
evaluationOptions) (Reader (EvaluationOptions pieceSquareValue) QuantifiedGame
-> QuantifiedGame)
-> (Game
-> Reader (EvaluationOptions pieceSquareValue) QuantifiedGame)
-> Game
-> QuantifiedGame
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe pieceSquareValue
-> Game
-> Reader (EvaluationOptions pieceSquareValue) QuantifiedGame
forall pieceSquareValue.
(Fractional pieceSquareValue, Real pieceSquareValue) =>
Maybe pieceSquareValue
-> Game -> Reader pieceSquareValue QuantifiedGame
Evaluation.QuantifiedGame.fromGame Maybe pieceSquareValue
forall a. Maybe a
Nothing
)
) 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
) (
Rank -> RankValues -> RankValue
`Input.RankValues.findRankValue` EvaluationOptions pieceSquareValue -> RankValues
forall pieceSquareValue.
EvaluationOptions pieceSquareValue -> RankValues
Input.EvaluationOptions.getRankValues EvaluationOptions pieceSquareValue
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
`fmap` 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
traceMatchingMoves
:: PositionHashQuantifiedGameTree positionHash
-> [Component.QualifiedMove.QualifiedMove]
-> Maybe [NodeLabel positionHash]
traceMatchingMoves :: PositionHashQuantifiedGameTree positionHash
-> [QualifiedMove] -> Maybe [NodeLabel positionHash]
traceMatchingMoves MkPositionHashQuantifiedGameTree { deconstruct :: forall positionHash.
PositionHashQuantifiedGameTree positionHash
-> BarePositionHashQuantifiedGameTree positionHash
deconstruct = BarePositionHashQuantifiedGameTree positionHash
barePositionHashQuantifiedGameTree } = (QualifiedMove -> IsMatch (NodeLabel positionHash))
-> BarePositionHashQuantifiedGameTree positionHash
-> [QualifiedMove]
-> 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]
promoteMatchingMoves
:: [Component.QualifiedMove.QualifiedMove]
-> Forest positionHash
-> Maybe (Forest positionHash)
promoteMatchingMoves :: [QualifiedMove]
-> Forest positionHash -> Maybe (Forest positionHash)
promoteMatchingMoves = (QualifiedMove -> IsMatch (NodeLabel positionHash))
-> [QualifiedMove]
-> 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'
)