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.Game as Model.Game
import qualified BishBosh.Model.GameTree as Model.GameTree
import qualified BishBosh.Property.Tree as Property.Tree
import qualified BishBosh.Text.ShowList as Text.ShowList
import qualified BishBosh.Types as T
import qualified Control.Exception
import qualified Data.Array.IArray
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 {
deconstruct :: BarePositionHashTree positionHash
}
instance (
Data.Bits.FiniteBits positionHash,
Num positionHash,
System.Random.Random positionHash
) => Data.Default.Default (PositionHashTree positionHash) where
def = mkPositionHashTree Data.Default.def (Data.Default.def :: Model.GameTree.GameTree T.X T.Y)
mkPositionHashTree :: (
Data.Array.IArray.Ix x,
Data.Bits.Bits positionHash,
Enum x,
Enum y,
Ord y
)
=> Component.Zobrist.Zobrist x y positionHash
-> Model.GameTree.GameTree x y
-> PositionHashTree positionHash
mkPositionHashTree zobrist = MkPositionHashTree . fmap (`Component.Zobrist.hash2D` zobrist) . Model.GameTree.deconstruct
countDistinctPositions
:: Ord positionHash
=> Property.Tree.Depth
-> PositionHashTree positionHash
-> Model.Game.NGames
countDistinctPositions depth MkPositionHashTree { deconstruct = barePositionHashTree }
| depth < 0 = Control.Exception.throw . Data.Exception.mkOutOfBounds . showString "BishBosh.Component.PositionHashTree.countDistinctPositions:\tdepth" . Text.ShowList.showsAssociation $ shows depth "must be positive"
| otherwise = Data.Set.size $ slave depth barePositionHashTree
where
slave 0 Data.Tree.Node { Data.Tree.rootLabel = hash } = Data.Set.singleton hash
slave _ Data.Tree.Node {
Data.Tree.rootLabel = hash,
Data.Tree.subForest = []
} = Data.Set.singleton hash
slave depth' Data.Tree.Node { Data.Tree.subForest = forest } = Data.List.foldl' (
\s -> Data.Set.union s . slave (pred depth')
) Data.Set.empty forest