{-
	Copyright (C) 2018 Dr. Alistair Ward

	This file is part of BishBosh.

	BishBosh is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	BishBosh is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]
-}

module BishBosh.Model.PositionHashTree(
-- * Types
-- ** Type-synonyms
--	BarePositionHashTree,
-- ** Data-types
	PositionHashTree(),
-- * Functions
	countDistinctPositions,
-- ** Constructors
	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

-- | The hash of a /game-tree/.
type BarePositionHashTree positionHash	= Data.Tree.Tree positionHash

-- | Wrap a 'BarePositionHashTree'.
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)

-- | Hash the specified 'game-tree/.
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

-- | Count the number of distinct positions, irrespective of the sequence of moves taken to reach that terminal state.
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	-- Having reached the maximum depth, include this game's 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	-- Being unable to descend further, include the terminal game's 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') {-recurse-}
		 ) Set positionHash
forall a. Empty a => a
Property.Empty.empty [BarePositionHashTree positionHash]
forest