module BishBosh.Model.PositionHashTree(
PositionHashTree(),
countDistinctPositions,
mkPositionHashTree
) where
import qualified BishBosh.Component.Zobrist as Component.Zobrist
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Model.GameTree as Model.GameTree
import qualified BishBosh.Property.Arboreal as Property.Arboreal
import qualified BishBosh.Property.Empty as Property.Empty
import qualified BishBosh.StateProperty.Hashable as StateProperty.Hashable
import qualified BishBosh.Text.ShowList as Text.ShowList
import qualified BishBosh.Type.Count as Type.Count
import qualified BishBosh.Type.Crypto as Type.Crypto
import qualified Control.Exception
import qualified Data.Bits
import qualified Data.Default
import qualified Data.List
import qualified Data.Set
import qualified Data.Tree
import qualified System.Random
type BarePositionHashTree positionHash = Data.Tree.Tree positionHash
newtype PositionHashTree positionHash = MkPositionHashTree {
PositionHashTree positionHash -> BarePositionHashTree positionHash
deconstruct :: BarePositionHashTree positionHash
}
instance (
Data.Bits.FiniteBits positionHash,
System.Random.Random positionHash
) => Data.Default.Default (PositionHashTree positionHash) where
def :: PositionHashTree positionHash
def = Zobrist positionHash -> GameTree -> PositionHashTree positionHash
forall positionHash.
Bits positionHash =>
Zobrist positionHash -> GameTree -> PositionHashTree positionHash
mkPositionHashTree Zobrist positionHash
forall a. Default a => a
Data.Default.def (GameTree
forall a. Default a => a
Data.Default.def :: Model.GameTree.GameTree)
mkPositionHashTree
:: Data.Bits.Bits positionHash
=> Component.Zobrist.Zobrist positionHash
-> Model.GameTree.GameTree
-> PositionHashTree positionHash
mkPositionHashTree :: Zobrist positionHash -> GameTree -> PositionHashTree positionHash
mkPositionHashTree Zobrist positionHash
zobrist = BarePositionHashTree positionHash -> PositionHashTree positionHash
forall positionHash.
BarePositionHashTree positionHash -> PositionHashTree positionHash
MkPositionHashTree (BarePositionHashTree positionHash
-> PositionHashTree positionHash)
-> (GameTree -> BarePositionHashTree positionHash)
-> GameTree
-> PositionHashTree positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Game -> positionHash)
-> Tree Game -> BarePositionHashTree positionHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Zobrist positionHash -> Game -> positionHash
forall positionHash hashable.
(Bits positionHash, Hashable hashable) =>
Zobrist positionHash -> hashable -> positionHash
StateProperty.Hashable.hash Zobrist positionHash
zobrist) (Tree Game -> BarePositionHashTree positionHash)
-> (GameTree -> Tree Game)
-> GameTree
-> BarePositionHashTree positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameTree -> Tree Game
Model.GameTree.deconstruct
countDistinctPositions
:: Ord positionHash
=> Property.Arboreal.Depth
-> PositionHashTree positionHash
-> Type.Count.NPositions
{-# SPECIALISE countDistinctPositions :: Property.Arboreal.Depth -> PositionHashTree Type.Crypto.PositionHash -> Type.Count.NPositions #-}
countDistinctPositions :: Depth -> PositionHashTree positionHash -> Depth
countDistinctPositions Depth
depth MkPositionHashTree { deconstruct :: forall positionHash.
PositionHashTree positionHash -> BarePositionHashTree positionHash
deconstruct = BarePositionHashTree positionHash
barePositionHashTree }
| Depth
depth Depth -> Depth -> Bool
forall a. Ord a => a -> a -> Bool
< Depth
0 = Exception -> Depth
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Depth) -> (String -> Exception) -> String -> Depth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkOutOfBounds (String -> Exception) -> (String -> String) -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
"BishBosh.Component.PositionHashTree.countDistinctPositions:\tdepth" (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
Text.ShowList.showsAssociation (String -> Depth) -> String -> Depth
forall a b. (a -> b) -> a -> b
$ Depth -> String -> String
forall a. Show a => a -> String -> String
shows Depth
depth String
"must be positive"
| Bool
otherwise = Depth -> Depth
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Depth -> Depth)
-> (Set positionHash -> Depth) -> Set positionHash -> Depth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set positionHash -> Depth
forall a. Set a -> Depth
Data.Set.size (Set positionHash -> Depth) -> Set positionHash -> Depth
forall a b. (a -> b) -> a -> b
$ Depth -> BarePositionHashTree positionHash -> Set positionHash
forall positionHash.
Ord positionHash =>
Depth -> BarePositionHashTree positionHash -> Set positionHash
slave Depth
depth BarePositionHashTree positionHash
barePositionHashTree
where
slave :: Ord positionHash => Property.Arboreal.Depth -> BarePositionHashTree positionHash -> Data.Set.Set positionHash
slave :: Depth -> BarePositionHashTree positionHash -> Set positionHash
slave Depth
0 Data.Tree.Node { rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = positionHash
hash } = positionHash -> Set positionHash
forall a. a -> Set a
Data.Set.singleton positionHash
hash
slave Depth
_ Data.Tree.Node {
rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = positionHash
hash,
subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest = []
} = positionHash -> Set positionHash
forall a. a -> Set a
Data.Set.singleton positionHash
hash
slave Depth
depth' Data.Tree.Node { subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest = [BarePositionHashTree positionHash]
forest } = (Set positionHash
-> BarePositionHashTree positionHash -> Set positionHash)
-> Set positionHash
-> [BarePositionHashTree positionHash]
-> Set positionHash
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
\Set positionHash
s -> Set positionHash -> Set positionHash -> Set positionHash
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.union Set positionHash
s (Set positionHash -> Set positionHash)
-> (BarePositionHashTree positionHash -> Set positionHash)
-> BarePositionHashTree positionHash
-> Set positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Depth -> BarePositionHashTree positionHash -> Set positionHash
forall positionHash.
Ord positionHash =>
Depth -> BarePositionHashTree positionHash -> Set positionHash
slave (Depth -> Depth
forall a. Enum a => a -> a
pred Depth
depth')
) Set positionHash
forall a. Empty a => a
Property.Empty.empty [BarePositionHashTree positionHash]
forest