{-# LANGUAGE LambdaCase #-}
module BishBosh.Model.GameTree(
BareGameTree,
MoveFrequency,
GameTree(
deconstruct
),
countGames,
countPositions,
traceRoute,
sortGameTree,
toMoveFrequency,
fromBareGameTree,
fromGame
) where
import Control.Arrow((&&&))
import qualified BishBosh.Attribute.CaptureMoveSortAlgorithm as Attribute.CaptureMoveSortAlgorithm
import qualified BishBosh.Attribute.MoveType as Attribute.MoveType
import qualified BishBosh.Attribute.Rank as Attribute.Rank
import qualified BishBosh.Colour.LogicalColour as Colour.LogicalColour
import qualified BishBosh.Component.Move as Component.Move
import qualified BishBosh.Component.QualifiedMove as Component.QualifiedMove
import qualified BishBosh.Component.Turn as Component.Turn
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Data.RoseTree as Data.RoseTree
import qualified BishBosh.Model.Game as Model.Game
import qualified BishBosh.Model.MoveFrequency as Model.MoveFrequency
import qualified BishBosh.Notation.MoveNotation as Notation.MoveNotation
import qualified BishBosh.Property.Arboreal as Property.Arboreal
import qualified BishBosh.Property.Empty as Property.Empty
import qualified BishBosh.Property.Null as Property.Null
import qualified BishBosh.Property.Opposable as Property.Opposable
import qualified BishBosh.Type.Count as Type.Count
import qualified BishBosh.Type.Mass as Type.Mass
import qualified Control.Exception
import qualified Data.Default
import qualified Data.Foldable
import qualified Data.List
import qualified Data.Maybe
import qualified Data.Tree
type BareGameTree = Data.Tree.Tree Model.Game.Game
compareByMVVLVA
:: Attribute.Rank.EvaluateRank
-> BareGameTree
-> BareGameTree
-> Ordering
compareByMVVLVA :: EvaluateRank -> BareGameTree -> BareGameTree -> Ordering
compareByMVVLVA EvaluateRank
evaluateRank Data.Tree.Node { rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = Game
gameL } Data.Tree.Node { rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = Game
gameR } = (Turn -> Turn -> Ordering) -> (Turn, Turn) -> Ordering
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (
EvaluateRank -> Turn -> Turn -> Ordering
Component.Turn.compareByMVVLVA EvaluateRank
evaluateRank
) ((Turn, Turn) -> Ordering)
-> ((Game -> Turn) -> (Turn, Turn)) -> (Game -> Turn) -> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
((Game -> Turn) -> Game -> Turn
forall a b. (a -> b) -> a -> b
$ Game
gameL) ((Game -> Turn) -> Turn)
-> ((Game -> Turn) -> Turn) -> (Game -> Turn) -> (Turn, Turn)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((Game -> Turn) -> Game -> Turn
forall a b. (a -> b) -> a -> b
$ Game
gameR)
) ((Game -> Turn) -> Ordering) -> (Game -> Turn) -> Ordering
forall a b. (a -> b) -> a -> b
$ Maybe Turn -> Turn
forall a. HasCallStack => Maybe a -> a
Data.Maybe.fromJust (Maybe Turn -> Turn) -> (Game -> Maybe Turn) -> Game -> Turn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game -> Maybe Turn
Model.Game.maybeLastTurn
getLastMove :: BareGameTree -> Component.Move.Move
{-# INLINE getLastMove #-}
getLastMove :: BareGameTree -> Move
getLastMove Data.Tree.Node { rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = Game
game } = QualifiedMove -> Move
Component.QualifiedMove.getMove (QualifiedMove -> Move)
-> (Maybe Turn -> QualifiedMove) -> Maybe Turn -> Move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn -> QualifiedMove
Component.Turn.getQualifiedMove (Turn -> QualifiedMove)
-> (Maybe Turn -> Turn) -> Maybe Turn -> QualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Turn -> Turn
forall a. HasCallStack => Maybe a -> a
Data.Maybe.fromJust (Maybe Turn -> Move) -> Maybe Turn -> Move
forall a b. (a -> b) -> a -> b
$ Game -> Maybe Turn
Model.Game.maybeLastTurn Game
game
staticExchangeEvaluation
:: Attribute.Rank.EvaluateRank
-> BareGameTree
-> Type.Mass.RankValue
staticExchangeEvaluation :: EvaluateRank -> BareGameTree -> RankValue
staticExchangeEvaluation EvaluateRank
evaluateRank node :: BareGameTree
node@Data.Tree.Node { rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = Game
game } = RankValue -> EvaluateRank -> Maybe Rank -> RankValue
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe RankValue
0 (BareGameTree -> EvaluateRank
slave BareGameTree
node) (Maybe Rank -> RankValue) -> Maybe Rank -> RankValue
forall a b. (a -> b) -> a -> b
$ Game -> Maybe Rank
getMaybeImplicitlyTakenRank Game
game where
getMaybeImplicitlyTakenRank :: Model.Game.Game -> Maybe Attribute.Rank.Rank
getMaybeImplicitlyTakenRank :: Game -> Maybe Rank
getMaybeImplicitlyTakenRank Game
game' = MoveType -> Maybe Rank
Attribute.MoveType.getMaybeImplicitlyTakenRank (MoveType -> Maybe Rank)
-> (Turn -> MoveType) -> Turn -> Maybe Rank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType (QualifiedMove -> MoveType)
-> (Turn -> QualifiedMove) -> Turn -> MoveType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn -> QualifiedMove
Component.Turn.getQualifiedMove (Turn -> Maybe Rank) -> Maybe Turn -> Maybe Rank
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Game -> Maybe Turn
Model.Game.maybeLastTurn Game
game'
slave :: BareGameTree -> Attribute.Rank.Rank -> Type.Mass.RankValue
slave :: BareGameTree -> EvaluateRank
slave node' :: BareGameTree
node'@Data.Tree.Node { subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest = Forest Game
forest' } = RankValue -> RankValue -> RankValue
forall a. Ord a => a -> a -> a
max RankValue
0 (RankValue -> RankValue) -> EvaluateRank -> EvaluateRank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RankValue -> RankValue -> RankValue
forall a. Num a => a -> a -> a
subtract (
case (BareGameTree -> Bool) -> Forest Game -> Forest Game
forall a. (a -> Bool) -> [a] -> [a]
filter (
(
Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Move -> Coordinates
Component.Move.getDestination (BareGameTree -> Move
getLastMove BareGameTree
node')
) (Coordinates -> Bool)
-> (BareGameTree -> Coordinates) -> BareGameTree -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move -> Coordinates
Component.Move.getDestination (Move -> Coordinates)
-> (BareGameTree -> Move) -> BareGameTree -> Coordinates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BareGameTree -> Move
getLastMove
) Forest Game
forest' of
[] -> RankValue
0
Forest Game
forest'' -> let
node'' :: BareGameTree
node''@Data.Tree.Node { rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = Game
game'' } = (BareGameTree -> BareGameTree -> Ordering)
-> Forest Game -> BareGameTree
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
Data.List.minimumBy (
\Data.Tree.Node { rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = Game
gameL } Data.Tree.Node { rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = Game
gameR } -> (Turn -> Turn -> Ordering) -> (Turn, Turn) -> Ordering
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (
EvaluateRank -> Turn -> Turn -> Ordering
Component.Turn.compareByLVA EvaluateRank
evaluateRank
) ((Turn, Turn) -> Ordering)
-> ((Game -> Turn) -> (Turn, Turn)) -> (Game -> Turn) -> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
((Game -> Turn) -> Game -> Turn
forall a b. (a -> b) -> a -> b
$ Game
gameL) ((Game -> Turn) -> Turn)
-> ((Game -> Turn) -> Turn) -> (Game -> Turn) -> (Turn, Turn)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((Game -> Turn) -> Game -> Turn
forall a b. (a -> b) -> a -> b
$ Game
gameR)
) ((Game -> Turn) -> Ordering) -> (Game -> Turn) -> Ordering
forall a b. (a -> b) -> a -> b
$ Turn -> Maybe Turn -> Turn
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (
Exception -> Turn
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Turn) -> Exception -> Turn
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkResultUndefined String
"BishBosh.Model.GameTree:\tModel.Game.maybeLastTurn failed."
) (Maybe Turn -> Turn) -> (Game -> Maybe Turn) -> Game -> Turn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game -> Maybe Turn
Model.Game.maybeLastTurn
) Forest Game
forest''
in BareGameTree -> EvaluateRank
slave BareGameTree
node'' EvaluateRank -> (Maybe Rank -> Rank) -> Maybe Rank -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Rank -> Rank
forall a. HasCallStack => Maybe a -> a
Data.Maybe.fromJust (Maybe Rank -> RankValue) -> Maybe Rank -> RankValue
forall a b. (a -> b) -> a -> b
$ Game -> Maybe Rank
getMaybeImplicitlyTakenRank Game
game''
) (RankValue -> RankValue) -> EvaluateRank -> EvaluateRank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RankValue -> RankValue
forall a b. (Real a, Fractional b) => a -> b
realToFrac (RankValue -> RankValue) -> EvaluateRank -> EvaluateRank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvaluateRank
evaluateRank
getRankAndMove :: Model.MoveFrequency.GetRankAndMove BareGameTree Component.Move.Move
{-# INLINE getRankAndMove #-}
getRankAndMove :: GetRankAndMove BareGameTree Move
getRankAndMove Data.Tree.Node { rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = Game
game } = (Turn -> Rank
Component.Turn.getRank (Turn -> Rank) -> (Turn -> Move) -> Turn -> (Rank, Move)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove -> Move
Component.QualifiedMove.getMove (QualifiedMove -> Move) -> (Turn -> QualifiedMove) -> Turn -> Move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn -> QualifiedMove
Component.Turn.getQualifiedMove) (Turn -> (Rank, Move))
-> (Maybe Turn -> Turn) -> Maybe Turn -> (Rank, Move)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Turn -> Turn
forall a. HasCallStack => Maybe a -> a
Data.Maybe.fromJust (Maybe Turn -> (Rank, Move)) -> Maybe Turn -> (Rank, Move)
forall a b. (a -> b) -> a -> b
$ Game -> Maybe Turn
Model.Game.maybeLastTurn Game
game
newtype GameTree = MkGameTree {
GameTree -> BareGameTree
deconstruct :: BareGameTree
} deriving Int -> GameTree -> ShowS
[GameTree] -> ShowS
GameTree -> String
(Int -> GameTree -> ShowS)
-> (GameTree -> String) -> ([GameTree] -> ShowS) -> Show GameTree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GameTree] -> ShowS
$cshowList :: [GameTree] -> ShowS
show :: GameTree -> String
$cshow :: GameTree -> String
showsPrec :: Int -> GameTree -> ShowS
$cshowsPrec :: Int -> GameTree -> ShowS
Show
instance Data.Default.Default GameTree where
def :: GameTree
def = Game -> GameTree
fromGame Game
forall a. Default a => a
Data.Default.def
instance Property.Arboreal.Prunable GameTree where
prune :: Int -> GameTree -> GameTree
prune Int
depth MkGameTree { deconstruct :: GameTree -> BareGameTree
deconstruct = BareGameTree
bareGameTree } = BareGameTree -> GameTree
MkGameTree (BareGameTree -> GameTree) -> BareGameTree -> GameTree
forall a b. (a -> b) -> a -> b
$ Int -> Transformation Game
forall a. Int -> Transformation a
Data.RoseTree.prune Int
depth BareGameTree
bareGameTree
instance Notation.MoveNotation.ShowNotation GameTree where
showsNotation :: MoveNotation -> GameTree -> ShowS
showsNotation MoveNotation
moveNotation MkGameTree {
deconstruct :: GameTree -> BareGameTree
deconstruct = bareGameTree :: BareGameTree
bareGameTree@Data.Tree.Node {
rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = Game
game,
subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest = Forest Game
forest
}
} = String -> ShowS
showString (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ if Game -> Bool
forall a. Null a => a -> Bool
Property.Null.isNull Game
game
then (Game -> String) -> Forest Game -> String
forall a. (a -> String) -> Forest a -> String
Data.RoseTree.drawForest Game -> String
toString Forest Game
forest
else (Game -> String) -> BareGameTree -> String
forall a. (a -> String) -> Tree a -> String
Data.RoseTree.drawTree Game -> String
toString BareGameTree
bareGameTree
where
toString :: Game -> String
toString = MoveNotation -> Turn -> String
forall a. ShowNotation a => MoveNotation -> a -> String
Notation.MoveNotation.showNotation MoveNotation
moveNotation (Turn -> String) -> (Game -> Turn) -> Game -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Turn -> Turn
forall a. HasCallStack => Maybe a -> a
Data.Maybe.fromJust (Maybe Turn -> Turn) -> (Game -> Maybe Turn) -> Game -> Turn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game -> Maybe Turn
Model.Game.maybeLastTurn
fromBareGameTree :: BareGameTree -> GameTree
fromBareGameTree :: BareGameTree -> GameTree
fromBareGameTree = BareGameTree -> GameTree
MkGameTree
fromGame :: Model.Game.Game -> GameTree
fromGame :: Game -> GameTree
fromGame = BareGameTree -> GameTree
MkGameTree (BareGameTree -> GameTree)
-> (Game -> BareGameTree) -> Game -> GameTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Game -> (Game, [Game])) -> Game -> BareGameTree
forall b a. (b -> (a, [b])) -> b -> Tree a
Data.Tree.unfoldTree (
\Game
game -> (
Game
game,
if Game -> Bool
Model.Game.isTerminated Game
game
then []
else (QualifiedMove -> Game) -> [QualifiedMove] -> [Game]
forall a b. (a -> b) -> [a] -> [b]
map (
QualifiedMove -> Transformation
`Model.Game.applyQualifiedMove` Game
game
) ([QualifiedMove] -> [Game]) -> [QualifiedMove] -> [Game]
forall a b. (a -> b) -> a -> b
$ Game -> [QualifiedMove]
Model.Game.findQualifiedMovesAvailableToNextPlayer Game
game
)
)
countGames :: Property.Arboreal.Depth -> Type.Count.NGames
countGames :: Int -> Int
countGames Int
depth = BareGameTree -> Int
forall nodes a. Num nodes => Tree a -> nodes
Data.RoseTree.countTerminalNodes (BareGameTree -> Int)
-> (GameTree -> BareGameTree) -> GameTree -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Transformation Game
forall a. Int -> Transformation a
Data.RoseTree.prune Int
depth Transformation Game
-> (GameTree -> BareGameTree) -> GameTree -> BareGameTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameTree -> BareGameTree
deconstruct (GameTree -> Int) -> GameTree -> Int
forall a b. (a -> b) -> a -> b
$ (GameTree
forall a. Default a => a
Data.Default.def :: GameTree)
countPositions :: Property.Arboreal.Depth -> Type.Count.NPositions
countPositions :: Int -> Int
countPositions Int
depth = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> (GameTree -> Int) -> GameTree -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> (GameTree -> Int) -> GameTree -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BareGameTree -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.Foldable.length (BareGameTree -> Int)
-> (GameTree -> BareGameTree) -> GameTree -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Transformation Game
forall a. Int -> Transformation a
Data.RoseTree.prune Int
depth Transformation Game
-> (GameTree -> BareGameTree) -> GameTree -> BareGameTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameTree -> BareGameTree
deconstruct (GameTree -> Int) -> GameTree -> Int
forall a b. (a -> b) -> a -> b
$ (GameTree
forall a. Default a => a
Data.Default.def :: GameTree)
traceRoute
:: GameTree
-> [Component.Turn.Turn]
-> Maybe [Model.Game.Game]
traceRoute :: GameTree -> [Turn] -> Maybe [Game]
traceRoute MkGameTree { deconstruct :: GameTree -> BareGameTree
deconstruct = BareGameTree
bareGameTree } = (Turn -> Game -> Bool) -> BareGameTree -> [Turn] -> Maybe [Game]
forall datum a.
(datum -> IsMatch a) -> Tree a -> [datum] -> Maybe [a]
Data.RoseTree.traceRoute (\Turn
turn -> (Maybe Turn -> Maybe Turn -> Bool
forall a. Eq a => a -> a -> Bool
== Turn -> Maybe Turn
forall a. a -> Maybe a
Just Turn
turn) (Maybe Turn -> Bool) -> (Game -> Maybe Turn) -> Game -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game -> Maybe Turn
Model.Game.maybeLastTurn) BareGameTree
bareGameTree
type MoveFrequency = Model.MoveFrequency.MoveFrequency Component.Move.Move
type Transformation = GameTree -> GameTree
sortGameTree
:: Maybe Attribute.CaptureMoveSortAlgorithm.CaptureMoveSortAlgorithm
-> Attribute.Rank.EvaluateRank
-> MoveFrequency
-> Transformation
sortGameTree :: Maybe CaptureMoveSortAlgorithm
-> EvaluateRank -> MoveFrequency -> GameTree -> GameTree
sortGameTree Maybe CaptureMoveSortAlgorithm
maybeCaptureMoveSortAlgorithm EvaluateRank
evaluateRank MoveFrequency
standardOpeningMoveFrequency MkGameTree { deconstruct :: GameTree -> BareGameTree
deconstruct = BareGameTree
bareGameTree } = BareGameTree -> GameTree
MkGameTree (BareGameTree -> GameTree) -> BareGameTree -> GameTree
forall a b. (a -> b) -> a -> b
$ (Game -> Forest Game -> Forest Game) -> Transformation Game
forall a. (a -> Forest a -> Forest a) -> Transformation a
Data.RoseTree.mapForest (
\Game
game -> (Forest Game -> Forest Game)
-> (CaptureMoveSortAlgorithm -> Forest Game -> Forest Game)
-> Maybe CaptureMoveSortAlgorithm
-> Forest Game
-> Forest Game
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Forest Game -> Forest Game
forall a. a -> a
id (
\case
CaptureMoveSortAlgorithm
Attribute.CaptureMoveSortAlgorithm.MVVLVA -> (BareGameTree -> BareGameTree -> Ordering)
-> Forest Game -> Forest Game
forall a. (a -> a -> Ordering) -> [a] -> [a]
Data.List.sortBy ((BareGameTree -> BareGameTree -> Ordering)
-> Forest Game -> Forest Game)
-> (BareGameTree -> BareGameTree -> Ordering)
-> Forest Game
-> Forest Game
forall a b. (a -> b) -> a -> b
$ EvaluateRank -> BareGameTree -> BareGameTree -> Ordering
compareByMVVLVA EvaluateRank
evaluateRank
CaptureMoveSortAlgorithm
Attribute.CaptureMoveSortAlgorithm.SEE -> (BareGameTree -> RankValue) -> Forest Game -> Forest Game
forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn ((BareGameTree -> RankValue) -> Forest Game -> Forest Game)
-> (BareGameTree -> RankValue) -> Forest Game -> Forest Game
forall a b. (a -> b) -> a -> b
$ RankValue -> RankValue
forall a. Num a => a -> a
negate (RankValue -> RankValue)
-> (BareGameTree -> RankValue) -> BareGameTree -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvaluateRank -> BareGameTree -> RankValue
staticExchangeEvaluation EvaluateRank
evaluateRank
) Maybe CaptureMoveSortAlgorithm
maybeCaptureMoveSortAlgorithm (Forest Game -> Forest Game)
-> (Forest Game -> Forest Game) -> Forest Game -> Forest Game
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
if MoveFrequency -> Bool
forall a. Null a => a -> Bool
Property.Null.isNull MoveFrequency
standardOpeningMoveFrequency
then Forest Game -> Forest Game
forall a. a -> a
id
else LogicalColour
-> GetRankAndMove BareGameTree Move
-> MoveFrequency
-> Forest Game
-> Forest Game
forall move a.
Ord move =>
LogicalColour
-> GetRankAndMove a move -> MoveFrequency move -> [a] -> [a]
Model.MoveFrequency.sortByDescendingMoveFrequency (Game -> LogicalColour
Model.Game.getNextLogicalColour Game
game) GetRankAndMove BareGameTree Move
getRankAndMove MoveFrequency
standardOpeningMoveFrequency
)
) BareGameTree
bareGameTree
toMoveFrequency :: GameTree -> MoveFrequency
toMoveFrequency :: GameTree -> MoveFrequency
toMoveFrequency MkGameTree { deconstruct :: GameTree -> BareGameTree
deconstruct = BareGameTree
bareGameTree } = LogicalColour -> MoveFrequency -> BareGameTree -> MoveFrequency
slave LogicalColour
forall a. Bounded a => a
maxBound MoveFrequency
forall a. Empty a => a
Property.Empty.empty BareGameTree
bareGameTree where
slave :: Colour.LogicalColour.LogicalColour -> MoveFrequency -> BareGameTree -> MoveFrequency
slave :: LogicalColour -> MoveFrequency -> BareGameTree -> MoveFrequency
slave LogicalColour
_ MoveFrequency
moveFrequency Data.Tree.Node { subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest = [] } = MoveFrequency
moveFrequency
slave LogicalColour
logicalColour MoveFrequency
moveFrequency Data.Tree.Node { subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest = Forest Game
forest } = (MoveFrequency -> BareGameTree -> MoveFrequency)
-> MoveFrequency -> Forest Game -> MoveFrequency
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
LogicalColour -> MoveFrequency -> BareGameTree -> MoveFrequency
slave (LogicalColour -> MoveFrequency -> BareGameTree -> MoveFrequency)
-> LogicalColour -> MoveFrequency -> BareGameTree -> MoveFrequency
forall a b. (a -> b) -> a -> b
$ LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
logicalColour
) (
LogicalColour
-> GetRankAndMove BareGameTree Move
-> MoveFrequency
-> Forest Game
-> MoveFrequency
forall move a.
Ord move =>
LogicalColour
-> GetRankAndMove a move
-> MoveFrequency move
-> [a]
-> MoveFrequency move
Model.MoveFrequency.insertMoves LogicalColour
logicalColour GetRankAndMove BareGameTree Move
getRankAndMove MoveFrequency
moveFrequency Forest Game
forest
) Forest Game
forest