{-
	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@]

	* <https://www.chessprogramming.org/Zobrist_Hashing>.

	* Defines the random-numbers required to construct a hash of a chess-position.

	* Facilitates the construction of a hash from arbitrary data.
-}

module BishBosh.Component.Zobrist(
-- * Types
-- ** Type-synonyms
--	Index,
-- ** Data-types
	Zobrist(
--		MkZobrist,
		getRandomForBlacksMove
--		getRandomByCoordinatesByRankByLogicalColour,
--		getRandomByCastleableRooksXByLogicalColour,
--		getRandomByEnPassantAbscissa
	),
-- * Functions
--	measureHammingDistances,
	dereferenceRandomByCoordinatesByRankByLogicalColour,
	dereferenceRandomByCastleableRooksXByLogicalColour,
	dereferenceRandomByEnPassantAbscissa,
-- ** Constructors
	mkZobrist
) where

import			Control.Arrow((***))
import			Data.Array.IArray((!))
import qualified	BishBosh.Attribute.Rank		as Attribute.Rank
import qualified	BishBosh.Cartesian.Abscissa	as Cartesian.Abscissa
import qualified	BishBosh.Cartesian.Coordinates	as Cartesian.Coordinates
import qualified	BishBosh.Colour.LogicalColour	as Colour.LogicalColour
import qualified	BishBosh.Data.Exception		as Data.Exception
import qualified	BishBosh.Type.Length		as Type.Length
import qualified	Control.Exception
import qualified	Data.Array.IArray
import qualified	Data.Bits
import qualified	Data.Default
import qualified	Data.Foldable
import qualified	System.Random
import qualified	ToolShed.System.Random

-- | Used as an index into 'getRandomByCoordinatesByRankByLogicalColour'.
type Index	= (Colour.LogicalColour.LogicalColour, Attribute.Rank.Rank, Cartesian.Coordinates.Coordinates)

-- | The random numbers used to generate a hash, which almost uniquely represent a /position/.
data Zobrist positionHash	= MkZobrist {
	Zobrist positionHash -> positionHash
getRandomForBlacksMove				:: positionHash,								-- ^ Defines a random number to apply when the next move is @Black@'s.
	Zobrist positionHash -> Array Index positionHash
getRandomByCoordinatesByRankByLogicalColour	:: Data.Array.IArray.Array {-Boxed-} Index positionHash,			-- ^ Defines random numbers to represent all combinations of each piece at each coordinate; though @Pawn@s can't exist on the terminal ranks. N.B.: regrettably the array can't be unboxed, because 'Data.Array.Unboxed.UArray' isn't 'Foldable'; cf. 'Data.Array.IArray.Array'.

	Zobrist positionHash -> ArrayByLogicalColour [(X, positionHash)]
getRandomByCastleableRooksXByLogicalColour	:: Colour.LogicalColour.ArrayByLogicalColour [(Type.Length.X, positionHash)],	-- ^ Defines random numbers to represent all combinations of castleable @Rook@s.
	Zobrist positionHash -> Array X positionHash
getRandomByEnPassantAbscissa			:: Data.Array.IArray.Array Type.Length.X positionHash				-- ^ Defines random numbers to represent any file on which capture en-passant might be available.
} deriving X -> Zobrist positionHash -> ShowS
[Zobrist positionHash] -> ShowS
Zobrist positionHash -> String
(X -> Zobrist positionHash -> ShowS)
-> (Zobrist positionHash -> String)
-> ([Zobrist positionHash] -> ShowS)
-> Show (Zobrist positionHash)
forall positionHash.
Show positionHash =>
X -> Zobrist positionHash -> ShowS
forall positionHash.
Show positionHash =>
[Zobrist positionHash] -> ShowS
forall positionHash.
Show positionHash =>
Zobrist positionHash -> String
forall a.
(X -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Zobrist positionHash] -> ShowS
$cshowList :: forall positionHash.
Show positionHash =>
[Zobrist positionHash] -> ShowS
show :: Zobrist positionHash -> String
$cshow :: forall positionHash.
Show positionHash =>
Zobrist positionHash -> String
showsPrec :: X -> Zobrist positionHash -> ShowS
$cshowsPrec :: forall positionHash.
Show positionHash =>
X -> Zobrist positionHash -> ShowS
Show

instance Foldable Zobrist where
	foldr :: (a -> b -> b) -> b -> Zobrist a -> b
foldr a -> b -> b
f b
i MkZobrist {
		getRandomForBlacksMove :: forall positionHash. Zobrist positionHash -> positionHash
getRandomForBlacksMove				= a
randomForBlacksMove,
		getRandomByCoordinatesByRankByLogicalColour :: forall positionHash.
Zobrist positionHash -> Array Index positionHash
getRandomByCoordinatesByRankByLogicalColour	= Array Index a
randomByCoordinatesByRankByLogicalColour,
		getRandomByCastleableRooksXByLogicalColour :: forall positionHash.
Zobrist positionHash -> ArrayByLogicalColour [(X, positionHash)]
getRandomByCastleableRooksXByLogicalColour	= ArrayByLogicalColour [(X, a)]
randomByCastleableRooksXByLogicalColour,
		getRandomByEnPassantAbscissa :: forall positionHash. Zobrist positionHash -> Array X positionHash
getRandomByEnPassantAbscissa			= Array X a
randomByEnPassantAbscissa
	} = (a -> b -> b) -> b -> Array X a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Data.Foldable.foldr a -> b -> b
f (
		([(X, a)] -> b -> b) -> b -> ArrayByLogicalColour [(X, a)] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Data.Foldable.foldr (
			(b -> [(X, a)] -> b) -> [(X, a)] -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((b -> [(X, a)] -> b) -> [(X, a)] -> b -> b)
-> (((X, a) -> b -> b) -> b -> [(X, a)] -> b)
-> ((X, a) -> b -> b)
-> [(X, a)]
-> b
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((X, a) -> b -> b) -> b -> [(X, a)] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (((X, a) -> b -> b) -> [(X, a)] -> b -> b)
-> ((X, a) -> b -> b) -> [(X, a)] -> b -> b
forall a b. (a -> b) -> a -> b
$ a -> b -> b
f (a -> b -> b) -> ((X, a) -> a) -> (X, a) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (X, a) -> a
forall a b. (a, b) -> b
snd
		) (
			(a -> b -> b) -> b -> Array Index a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Data.Foldable.foldr a -> b -> b
f (
				a -> b -> b
f a
randomForBlacksMove b
i
			) Array Index a
randomByCoordinatesByRankByLogicalColour
		) ArrayByLogicalColour [(X, a)]
randomByCastleableRooksXByLogicalColour
	 ) Array X a
randomByEnPassantAbscissa

instance (
	Data.Bits.FiniteBits	positionHash,
	System.Random.Random	positionHash
 ) => Data.Default.Default (Zobrist positionHash) where
	def :: Zobrist positionHash
def	= Maybe X -> StdGen -> Zobrist positionHash
forall positionHash randomGen.
(FiniteBits positionHash, RandomGen randomGen,
 Random positionHash) =>
Maybe X -> randomGen -> Zobrist positionHash
mkZobrist Maybe X
forall a. Maybe a
Nothing (StdGen -> Zobrist positionHash) -> StdGen -> Zobrist positionHash
forall a b. (a -> b) -> a -> b
$ X -> StdGen
System.Random.mkStdGen X
0

{- |
	* <https://www.chessprogramming.org/Population_Count#HammingDistance>.

	* Quantifies the Hamming distance between all combinations of pairs of the random numbers used to compose hashes.

	* CAVEAT: <https://en.wikipedia.org/wiki/Linear_independence> a better measure of the suitability of the selected random numbers
-}
measureHammingDistances :: Data.Bits.Bits positionHash => Zobrist positionHash -> [Int]
measureHammingDistances :: Zobrist positionHash -> [X]
measureHammingDistances	= ((positionHash, positionHash) -> X)
-> [(positionHash, positionHash)] -> [X]
forall a b. (a -> b) -> [a] -> [b]
map (positionHash -> X
forall a. Bits a => a -> X
Data.Bits.popCount (positionHash -> X)
-> ((positionHash, positionHash) -> positionHash)
-> (positionHash, positionHash)
-> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (positionHash -> positionHash -> positionHash)
-> (positionHash, positionHash) -> positionHash
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry positionHash -> positionHash -> positionHash
forall a. Bits a => a -> a -> a
Data.Bits.xor) ([(positionHash, positionHash)] -> [X])
-> (Zobrist positionHash -> [(positionHash, positionHash)])
-> Zobrist positionHash
-> [X]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [positionHash] -> [(positionHash, positionHash)]
forall a. [a] -> [(a, a)]
getCombinations ([positionHash] -> [(positionHash, positionHash)])
-> (Zobrist positionHash -> [positionHash])
-> Zobrist positionHash
-> [(positionHash, positionHash)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zobrist positionHash -> [positionHash]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList where
	getCombinations :: [a] -> [(a, a)]
	getCombinations :: [a] -> [(a, a)]
getCombinations (a
x : [a]
remainder)	= (a -> (a, a)) -> [a] -> [(a, a)]
forall a b. (a -> b) -> [a] -> [b]
map ((,) a
x) [a]
remainder [(a, a)] -> [(a, a)] -> [(a, a)]
forall a. [a] -> [a] -> [a]
++ [a] -> [(a, a)]
forall a. [a] -> [(a, a)]
getCombinations [a]
remainder	-- CAVEAT: O(n^2) time-complexity.
	getCombinations [a]
_		= []

-- | Smart constructor.
mkZobrist :: (
	Data.Bits.FiniteBits	positionHash,
	System.Random.RandomGen randomGen,
	System.Random.Random	positionHash
 )
	=> Maybe Int	-- ^ The optional minimum acceptable Hamming-distance between any two of the selected random numbers.
	-> randomGen
	-> Zobrist positionHash
mkZobrist :: Maybe X -> randomGen -> Zobrist positionHash
mkZobrist Maybe X
maybeMinimumHammingDistance randomGen
randomGen
	| Just X
minimumHammingDistance <- Maybe X
maybeMinimumHammingDistance
	, let minimumHammingDistance' :: X
minimumHammingDistance'	= [X] -> X
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([X] -> X) -> [X] -> X
forall a b. (a -> b) -> a -> b
$ Zobrist positionHash -> [X]
forall positionHash.
Bits positionHash =>
Zobrist positionHash -> [X]
measureHammingDistances Zobrist positionHash
zobrist
	, X
minimumHammingDistance' X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
minimumHammingDistance	= Exception -> Zobrist positionHash
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Zobrist positionHash)
-> (String -> Exception) -> String -> Zobrist positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkRequestFailure (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Component.Zobrist.mkZobrist:\tthe minimum Hamming-distance between the selected random numbers doesn't reach the configured minimum " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (X, X) -> ShowS
forall a. Show a => a -> ShowS
shows (X
minimumHammingDistance', X
minimumHammingDistance) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" => use more than " (String -> Zobrist positionHash) -> String -> Zobrist positionHash
forall a b. (a -> b) -> a -> b
$ X -> ShowS
forall a. Show a => a -> ShowS
shows (positionHash -> X
forall b. FiniteBits b => b -> X
Data.Bits.finiteBitSize positionHash
randomForBlacksMove) String
" bits, or re-seed the generator & hope."
	| Bool
otherwise						= Zobrist positionHash
zobrist
	where
		((positionHash
randomForBlacksMove, Array Index positionHash
randomByCoordinatesByRankByLogicalColour), (Array LogicalColour [(X, positionHash)]
randomByCastleableRooksXByLogicalColour, Array X positionHash
randomByEnPassantAbscissa))	= (
			(
				[positionHash] -> positionHash
forall a. [a] -> a
head ([positionHash] -> positionHash)
-> (randomGen -> [positionHash]) -> randomGen -> positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. randomGen -> [positionHash]
forall a g. (Random a, RandomGen g) => g -> [a]
System.Random.randoms (randomGen -> positionHash)
-> (randomGen -> Array Index positionHash)
-> (randomGen, randomGen)
-> (positionHash, Array Index positionHash)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Index, Index) -> [positionHash] -> Array Index positionHash
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
Data.Array.IArray.listArray (Index
forall a. Bounded a => a
minBound, Index
forall a. Bounded a => a
maxBound) ([positionHash] -> Array Index positionHash)
-> (randomGen -> [positionHash])
-> randomGen
-> Array Index positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. randomGen -> [positionHash]
forall a g. (Random a, RandomGen g) => g -> [a]
System.Random.randoms
			) ((randomGen, randomGen)
 -> (positionHash, Array Index positionHash))
-> (randomGen -> (randomGen, randomGen))
-> randomGen
-> (positionHash, Array Index positionHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. randomGen -> (randomGen, randomGen)
forall g. RandomGen g => g -> (g, g)
System.Random.split
		 ) (randomGen -> (positionHash, Array Index positionHash))
-> (randomGen
    -> (Array LogicalColour [(X, positionHash)], Array X positionHash))
-> (randomGen, randomGen)
-> ((positionHash, Array Index positionHash),
    (Array LogicalColour [(X, positionHash)], Array X positionHash))
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (
			(
				[[(X, positionHash)]] -> Array LogicalColour [(X, positionHash)]
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Colour.LogicalColour.listArrayByLogicalColour ([[(X, positionHash)]] -> Array LogicalColour [(X, positionHash)])
-> (randomGen -> [[(X, positionHash)]])
-> randomGen
-> Array LogicalColour [(X, positionHash)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (randomGen -> [(X, positionHash)])
-> [randomGen] -> [[(X, positionHash)]]
forall a b. (a -> b) -> [a] -> [b]
map (
					[X] -> [positionHash] -> [(X, positionHash)]
forall a b. [a] -> [b] -> [(a, b)]
zip [X
Cartesian.Abscissa.xMin, X
Cartesian.Abscissa.xMax] ([positionHash] -> [(X, positionHash)])
-> (randomGen -> [positionHash])
-> randomGen
-> [(X, positionHash)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. randomGen -> [positionHash]
forall a g. (Random a, RandomGen g) => g -> [a]
System.Random.randoms
				) ([randomGen] -> [[(X, positionHash)]])
-> (randomGen -> [randomGen]) -> randomGen -> [[(X, positionHash)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. randomGen -> [randomGen]
forall randomGen. RandomGen randomGen => randomGen -> [randomGen]
ToolShed.System.Random.randomGens (randomGen -> Array LogicalColour [(X, positionHash)])
-> (randomGen -> Array X positionHash)
-> (randomGen, randomGen)
-> (Array LogicalColour [(X, positionHash)], Array X positionHash)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [positionHash] -> Array X positionHash
forall (a :: * -> * -> *) e. IArray a e => [e] -> a X e
Cartesian.Abscissa.listArrayByAbscissa ([positionHash] -> Array X positionHash)
-> (randomGen -> [positionHash])
-> randomGen
-> Array X positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. randomGen -> [positionHash]
forall a g. (Random a, RandomGen g) => g -> [a]
System.Random.randoms
			) ((randomGen, randomGen)
 -> (Array LogicalColour [(X, positionHash)], Array X positionHash))
-> (randomGen -> (randomGen, randomGen))
-> randomGen
-> (Array LogicalColour [(X, positionHash)], Array X positionHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. randomGen -> (randomGen, randomGen)
forall g. RandomGen g => g -> (g, g)
System.Random.split
		 ) ((randomGen, randomGen)
 -> ((positionHash, Array Index positionHash),
     (Array LogicalColour [(X, positionHash)], Array X positionHash)))
-> (randomGen, randomGen)
-> ((positionHash, Array Index positionHash),
    (Array LogicalColour [(X, positionHash)], Array X positionHash))
forall a b. (a -> b) -> a -> b
$ randomGen -> (randomGen, randomGen)
forall g. RandomGen g => g -> (g, g)
System.Random.split randomGen
randomGen

		zobrist :: Zobrist positionHash
zobrist	= MkZobrist :: forall positionHash.
positionHash
-> Array Index positionHash
-> ArrayByLogicalColour [(X, positionHash)]
-> Array X positionHash
-> Zobrist positionHash
MkZobrist {
			getRandomForBlacksMove :: positionHash
getRandomForBlacksMove				= positionHash
randomForBlacksMove,
			getRandomByCoordinatesByRankByLogicalColour :: Array Index positionHash
getRandomByCoordinatesByRankByLogicalColour	= Array Index positionHash
randomByCoordinatesByRankByLogicalColour,
			getRandomByCastleableRooksXByLogicalColour :: Array LogicalColour [(X, positionHash)]
getRandomByCastleableRooksXByLogicalColour	= Array LogicalColour [(X, positionHash)]
randomByCastleableRooksXByLogicalColour,
			getRandomByEnPassantAbscissa :: Array X positionHash
getRandomByEnPassantAbscissa			= Array X positionHash
randomByEnPassantAbscissa
		}

-- | Dereferences 'getRandomByCoordinatesByRankByLogicalColour' using the specified index.
dereferenceRandomByCoordinatesByRankByLogicalColour :: Zobrist positionHash -> Index -> positionHash
dereferenceRandomByCoordinatesByRankByLogicalColour :: Zobrist positionHash -> Index -> positionHash
dereferenceRandomByCoordinatesByRankByLogicalColour MkZobrist { getRandomByCoordinatesByRankByLogicalColour :: forall positionHash.
Zobrist positionHash -> Array Index positionHash
getRandomByCoordinatesByRankByLogicalColour = Array Index positionHash
randomByCoordinatesByRankByLogicalColour }	= (Array Index positionHash
randomByCoordinatesByRankByLogicalColour Array Index positionHash -> Index -> positionHash
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)

-- | Dereferences 'getRandomByCastleableRooksXByLogicalColour' using the specified abscissa.
dereferenceRandomByCastleableRooksXByLogicalColour
	:: Zobrist positionHash
	-> Colour.LogicalColour.LogicalColour
	-> Type.Length.X
	-> Maybe positionHash	-- ^ The existence of a result depends on whether there remain any Rooks which can castle.
dereferenceRandomByCastleableRooksXByLogicalColour :: Zobrist positionHash -> LogicalColour -> X -> Maybe positionHash
dereferenceRandomByCastleableRooksXByLogicalColour MkZobrist { getRandomByCastleableRooksXByLogicalColour :: forall positionHash.
Zobrist positionHash -> ArrayByLogicalColour [(X, positionHash)]
getRandomByCastleableRooksXByLogicalColour = ArrayByLogicalColour [(X, positionHash)]
randomByCastleableRooksXByLogicalColour } LogicalColour
logicalColour X
x	= X -> [(X, positionHash)] -> Maybe positionHash
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup X
x ([(X, positionHash)] -> Maybe positionHash)
-> [(X, positionHash)] -> Maybe positionHash
forall a b. (a -> b) -> a -> b
$ ArrayByLogicalColour [(X, positionHash)]
randomByCastleableRooksXByLogicalColour ArrayByLogicalColour [(X, positionHash)]
-> LogicalColour -> [(X, positionHash)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour

-- | Dereferences 'getRandomByEnPassantAbscissa' using the specified abscissa.
dereferenceRandomByEnPassantAbscissa :: Zobrist positionHash -> Type.Length.X -> positionHash
dereferenceRandomByEnPassantAbscissa :: Zobrist positionHash -> X -> positionHash
dereferenceRandomByEnPassantAbscissa MkZobrist { getRandomByEnPassantAbscissa :: forall positionHash. Zobrist positionHash -> Array X positionHash
getRandomByEnPassantAbscissa = Array X positionHash
randomByEnPassantAbscissa }	= (Array X positionHash
randomByEnPassantAbscissa Array X positionHash -> X -> positionHash
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)