module BishBosh.Component.Zobrist(
Zobrist(
getRandomForBlacksMove
),
dereferenceRandomByCoordinatesByRankByLogicalColour,
dereferenceRandomByCastleableRooksXByLogicalColour,
dereferenceRandomByEnPassantAbscissa,
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
type Index = (Colour.LogicalColour.LogicalColour, Attribute.Rank.Rank, Cartesian.Coordinates.Coordinates)
data Zobrist positionHash = MkZobrist {
Zobrist positionHash -> positionHash
getRandomForBlacksMove :: positionHash,
Zobrist positionHash -> Array Index positionHash
getRandomByCoordinatesByRankByLogicalColour :: Data.Array.IArray.Array Index positionHash,
Zobrist positionHash -> ArrayByLogicalColour [(X, positionHash)]
getRandomByCastleableRooksXByLogicalColour :: Colour.LogicalColour.ArrayByLogicalColour [(Type.Length.X, positionHash)],
Zobrist positionHash -> Array X positionHash
getRandomByEnPassantAbscissa :: Data.Array.IArray.Array Type.Length.X positionHash
} 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
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
getCombinations [a]
_ = []
mkZobrist :: (
Data.Bits.FiniteBits positionHash,
System.Random.RandomGen randomGen,
System.Random.Random positionHash
)
=> Maybe Int
-> 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
}
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
!)
dereferenceRandomByCastleableRooksXByLogicalColour
:: Zobrist positionHash
-> Colour.LogicalColour.LogicalColour
-> Type.Length.X
-> Maybe positionHash
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
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
!)