{-# LANGUAGE MultiParamTypeClasses #-}
module BishBosh.Component.Zobrist(
Hashable1D(..),
Hashable2D(..),
Zobrist(
getRandomForBlacksMove
),
dereferenceRandomByCoordinatesByRankByLogicalColour,
dereferenceRandomByCastleableRooksXByLogicalColour,
dereferenceRandomByEnPassantAbscissa,
hash2D,
combine,
mkZobrist
) where
import Control.Arrow((***))
import Data.Array.IArray((!))
import qualified BishBosh.Attribute.LogicalColour as Attribute.LogicalColour
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.Data.Exception as Data.Exception
import qualified Control.Exception
import qualified Data.Array.IArray
import qualified Data.Bits
import qualified Data.Default
import qualified Data.Foldable
import qualified Data.List
import qualified System.Random
import qualified ToolShed.System.Random
type Index x y = (Attribute.LogicalColour.LogicalColour, Attribute.Rank.Rank, Cartesian.Coordinates.Coordinates x y)
data Zobrist x y positionHash = MkZobrist {
Zobrist x y positionHash -> positionHash
getRandomForBlacksMove :: positionHash,
Zobrist x y positionHash -> Array (Index x y) positionHash
getRandomByCoordinatesByRankByLogicalColour :: Data.Array.IArray.Array (Index x y) positionHash,
Zobrist x y positionHash
-> ArrayByLogicalColour [(x, positionHash)]
getRandomByCastleableRooksXByLogicalColour :: Attribute.LogicalColour.ArrayByLogicalColour [(x, positionHash)],
Zobrist x y positionHash -> ArrayByAbscissa x positionHash
getRandomByEnPassantAbscissa :: Cartesian.Abscissa.ArrayByAbscissa x positionHash
} deriving Int -> Zobrist x y positionHash -> ShowS
[Zobrist x y positionHash] -> ShowS
Zobrist x y positionHash -> String
(Int -> Zobrist x y positionHash -> ShowS)
-> (Zobrist x y positionHash -> String)
-> ([Zobrist x y positionHash] -> ShowS)
-> Show (Zobrist x y positionHash)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall x y positionHash.
(Enum x, Enum y, Ord y, Show positionHash, Show x, Show y, Ix x) =>
Int -> Zobrist x y positionHash -> ShowS
forall x y positionHash.
(Enum x, Enum y, Ord y, Show positionHash, Show x, Show y, Ix x) =>
[Zobrist x y positionHash] -> ShowS
forall x y positionHash.
(Enum x, Enum y, Ord y, Show positionHash, Show x, Show y, Ix x) =>
Zobrist x y positionHash -> String
showList :: [Zobrist x y positionHash] -> ShowS
$cshowList :: forall x y positionHash.
(Enum x, Enum y, Ord y, Show positionHash, Show x, Show y, Ix x) =>
[Zobrist x y positionHash] -> ShowS
show :: Zobrist x y positionHash -> String
$cshow :: forall x y positionHash.
(Enum x, Enum y, Ord y, Show positionHash, Show x, Show y, Ix x) =>
Zobrist x y positionHash -> String
showsPrec :: Int -> Zobrist x y positionHash -> ShowS
$cshowsPrec :: forall x y positionHash.
(Enum x, Enum y, Ord y, Show positionHash, Show x, Show y, Ix x) =>
Int -> Zobrist x y positionHash -> ShowS
Show
instance Foldable (Zobrist x y) where
foldr :: (a -> b -> b) -> b -> Zobrist x y a -> b
foldr a -> b -> b
f b
i MkZobrist {
getRandomForBlacksMove :: forall x y positionHash. Zobrist x y positionHash -> positionHash
getRandomForBlacksMove = a
randomForBlacksMove,
getRandomByCoordinatesByRankByLogicalColour :: forall x y positionHash.
Zobrist x y positionHash -> Array (Index x y) positionHash
getRandomByCoordinatesByRankByLogicalColour = Array (Index x y) a
randomByCoordinatesByRankByLogicalColour,
getRandomByCastleableRooksXByLogicalColour :: forall x y positionHash.
Zobrist x y positionHash
-> ArrayByLogicalColour [(x, positionHash)]
getRandomByCastleableRooksXByLogicalColour = ArrayByLogicalColour [(x, a)]
randomByCastleableRooksXByLogicalColour,
getRandomByEnPassantAbscissa :: forall x y positionHash.
Zobrist x y positionHash -> ArrayByAbscissa x positionHash
getRandomByEnPassantAbscissa = ArrayByAbscissa x a
randomByEnPassantAbscissa
} = (a -> b -> b) -> b -> ArrayByAbscissa 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 x y) 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 x y) a
randomByCoordinatesByRankByLogicalColour
) ArrayByLogicalColour [(x, a)]
randomByCastleableRooksXByLogicalColour
) ArrayByAbscissa x a
randomByEnPassantAbscissa
instance (
Data.Array.IArray.Ix x,
Data.Bits.FiniteBits positionHash,
Enum x,
Enum y,
Ord y,
System.Random.Random positionHash
) => Data.Default.Default (Zobrist x y positionHash) where
def :: Zobrist x y positionHash
def = Maybe Int -> StdGen -> Zobrist x y positionHash
forall x positionHash y randomGen.
(Ix x, FiniteBits positionHash, Enum x, Enum y, Ord y,
RandomGen randomGen, Random positionHash) =>
Maybe Int -> randomGen -> Zobrist x y positionHash
mkZobrist Maybe Int
forall a. Maybe a
Nothing (StdGen -> Zobrist x y positionHash)
-> StdGen -> Zobrist x y positionHash
forall a b. (a -> b) -> a -> b
$ Int -> StdGen
System.Random.mkStdGen Int
0
measureHammingDistances :: Data.Bits.Bits positionHash => Zobrist x y positionHash -> [Int]
measureHammingDistances :: Zobrist x y positionHash -> [Int]
measureHammingDistances = ((positionHash, positionHash) -> Int)
-> [(positionHash, positionHash)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (positionHash -> Int
forall a. Bits a => a -> Int
Data.Bits.popCount (positionHash -> Int)
-> ((positionHash, positionHash) -> positionHash)
-> (positionHash, positionHash)
-> Int
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)] -> [Int])
-> (Zobrist x y positionHash -> [(positionHash, positionHash)])
-> Zobrist x y positionHash
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [positionHash] -> [(positionHash, positionHash)]
forall a. [a] -> [(a, a)]
getCombinations ([positionHash] -> [(positionHash, positionHash)])
-> (Zobrist x y positionHash -> [positionHash])
-> Zobrist x y positionHash
-> [(positionHash, positionHash)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zobrist x y 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.Array.IArray.Ix x,
Data.Bits.FiniteBits positionHash,
Enum x,
Enum y,
Ord y,
System.Random.RandomGen randomGen,
System.Random.Random positionHash
)
=> Maybe Int
-> randomGen
-> Zobrist x y positionHash
mkZobrist :: Maybe Int -> randomGen -> Zobrist x y positionHash
mkZobrist Maybe Int
maybeMinimumHammingDistance randomGen
randomGen
| Just Int
minimumHammingDistance <- Maybe Int
maybeMinimumHammingDistance
, let minimumHammingDistance' :: Int
minimumHammingDistance' = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Zobrist x y positionHash -> [Int]
forall positionHash x y.
Bits positionHash =>
Zobrist x y positionHash -> [Int]
measureHammingDistances Zobrist x y positionHash
zobrist
, Int
minimumHammingDistance' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minimumHammingDistance = Exception -> Zobrist x y positionHash
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Zobrist x y positionHash)
-> (String -> Exception) -> String -> Zobrist x y 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
. (Int, Int) -> ShowS
forall a. Show a => a -> ShowS
shows (Int
minimumHammingDistance', Int
minimumHammingDistance) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" => use more than " (String -> Zobrist x y positionHash)
-> String -> Zobrist x y positionHash
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Show a => a -> ShowS
shows (positionHash -> Int
forall b. FiniteBits b => b -> Int
Data.Bits.finiteBitSize positionHash
randomForBlacksMove) String
" bits, or re-seed the generator & hope."
| Bool
otherwise = Zobrist x y positionHash
zobrist
where
((positionHash
randomForBlacksMove, Array (Index x y) 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 x y) positionHash)
-> (randomGen, randomGen)
-> (positionHash, Array (Index x y) positionHash)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Index x y, Index x y)
-> [positionHash] -> Array (Index x y) positionHash
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
Data.Array.IArray.listArray (Index x y
forall a. Bounded a => a
minBound, Index x y
forall a. Bounded a => a
maxBound) ([positionHash] -> Array (Index x y) positionHash)
-> (randomGen -> [positionHash])
-> randomGen
-> Array (Index x y) 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 x y) positionHash))
-> (randomGen -> (randomGen, randomGen))
-> randomGen
-> (positionHash, Array (Index x y) 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 x y) positionHash))
-> (randomGen
-> (Array LogicalColour [(x, positionHash)], Array x positionHash))
-> (randomGen, randomGen)
-> ((positionHash, Array (Index x y) 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
Attribute.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
forall x. Enum x => x
Cartesian.Abscissa.xMin, x
forall x. Enum x => 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 x.
(IArray a e, Ix x, Enum x) =>
[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 x y) positionHash),
(Array LogicalColour [(x, positionHash)], Array x positionHash)))
-> (randomGen, randomGen)
-> ((positionHash, Array (Index x y) 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 x y positionHash
zobrist = MkZobrist :: forall x y positionHash.
positionHash
-> Array (Index x y) positionHash
-> ArrayByLogicalColour [(x, positionHash)]
-> ArrayByAbscissa x positionHash
-> Zobrist x y positionHash
MkZobrist {
getRandomForBlacksMove :: positionHash
getRandomForBlacksMove = positionHash
randomForBlacksMove,
getRandomByCoordinatesByRankByLogicalColour :: Array (Index x y) positionHash
getRandomByCoordinatesByRankByLogicalColour = Array (Index x y) positionHash
randomByCoordinatesByRankByLogicalColour,
getRandomByCastleableRooksXByLogicalColour :: Array LogicalColour [(x, positionHash)]
getRandomByCastleableRooksXByLogicalColour = Array LogicalColour [(x, positionHash)]
randomByCastleableRooksXByLogicalColour,
getRandomByEnPassantAbscissa :: Array x positionHash
getRandomByEnPassantAbscissa = Array x positionHash
randomByEnPassantAbscissa
}
dereferenceRandomByCoordinatesByRankByLogicalColour :: (
Enum x,
Enum y,
Ord x,
Ord y
)
=> Index x y
-> Zobrist x y positionHash
-> positionHash
dereferenceRandomByCoordinatesByRankByLogicalColour :: Index x y -> Zobrist x y positionHash -> positionHash
dereferenceRandomByCoordinatesByRankByLogicalColour Index x y
index MkZobrist { getRandomByCoordinatesByRankByLogicalColour :: forall x y positionHash.
Zobrist x y positionHash -> Array (Index x y) positionHash
getRandomByCoordinatesByRankByLogicalColour = Array (Index x y) positionHash
randomByCoordinatesByRankByLogicalColour } = Array (Index x y) positionHash
randomByCoordinatesByRankByLogicalColour Array (Index x y) positionHash -> Index x y -> positionHash
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Index x y
index
dereferenceRandomByCastleableRooksXByLogicalColour
:: Eq x
=> Attribute.LogicalColour.LogicalColour
-> x
-> Zobrist x y positionHash
-> Maybe positionHash
dereferenceRandomByCastleableRooksXByLogicalColour :: LogicalColour
-> x -> Zobrist x y positionHash -> Maybe positionHash
dereferenceRandomByCastleableRooksXByLogicalColour LogicalColour
logicalColour x
x MkZobrist { getRandomByCastleableRooksXByLogicalColour :: forall x y positionHash.
Zobrist x y positionHash
-> ArrayByLogicalColour [(x, positionHash)]
getRandomByCastleableRooksXByLogicalColour = ArrayByLogicalColour [(x, positionHash)]
randomByCastleableRooksXByLogicalColour } = 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
:: Data.Array.IArray.Ix x
=> x
-> Zobrist x y positionHash
-> positionHash
dereferenceRandomByEnPassantAbscissa :: x -> Zobrist x y positionHash -> positionHash
dereferenceRandomByEnPassantAbscissa x
x MkZobrist { getRandomByEnPassantAbscissa :: forall x y positionHash.
Zobrist x y positionHash -> ArrayByAbscissa x positionHash
getRandomByEnPassantAbscissa = ArrayByAbscissa x positionHash
randomByEnPassantAbscissa } = ArrayByAbscissa x positionHash
randomByEnPassantAbscissa ArrayByAbscissa x positionHash -> x -> positionHash
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! x
x
class Hashable1D hashable x where
listRandoms1D :: hashable x -> Zobrist x y positionHash -> [positionHash]
class Hashable2D hashable x y where
listRandoms2D :: hashable x y -> Zobrist x y positionHash -> [positionHash]
combiningOp :: Data.Bits.Bits positionHash => positionHash -> positionHash -> positionHash
combiningOp :: positionHash -> positionHash -> positionHash
combiningOp = positionHash -> positionHash -> positionHash
forall a. Bits a => a -> a -> a
Data.Bits.xor
hash2D :: (
Data.Bits.Bits positionHash,
Hashable2D hashable x y
)
=> hashable x y
-> Zobrist x y positionHash
-> positionHash
hash2D :: hashable x y -> Zobrist x y positionHash -> positionHash
hash2D hashable x y
hashable = (positionHash -> positionHash -> positionHash)
-> [positionHash] -> positionHash
forall a. (a -> a -> a) -> [a] -> a
Data.List.foldl1' positionHash -> positionHash -> positionHash
forall a. Bits a => a -> a -> a
combiningOp ([positionHash] -> positionHash)
-> (Zobrist x y positionHash -> [positionHash])
-> Zobrist x y positionHash
-> positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. hashable x y -> Zobrist x y positionHash -> [positionHash]
forall (hashable :: * -> * -> *) x y positionHash.
Hashable2D hashable x y =>
hashable x y -> Zobrist x y positionHash -> [positionHash]
listRandoms2D hashable x y
hashable
combine :: Data.Bits.Bits positionHash => positionHash -> [positionHash] -> positionHash
combine :: positionHash -> [positionHash] -> positionHash
combine = (positionHash -> positionHash -> positionHash)
-> positionHash -> [positionHash] -> positionHash
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' positionHash -> positionHash -> positionHash
forall a. Bits a => a -> a -> a
combiningOp