{-# 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
data Zobrist x y positionHash = MkZobrist {
getRandomForBlacksMove :: positionHash,
getRandomByCoordinatesByRankByLogicalColour :: Attribute.LogicalColour.ByLogicalColour (Attribute.Rank.ByRank (Cartesian.Coordinates.ByCoordinates x y positionHash)),
getRandomByCastleableRooksXByLogicalColour :: Attribute.LogicalColour.ByLogicalColour [(x, positionHash)],
getRandomByEnPassantAbscissa :: Cartesian.Abscissa.ByAbscissa x positionHash
} deriving Show
instance Foldable (Zobrist x y) where
foldr f i MkZobrist {
getRandomForBlacksMove = randomForBlacksMove,
getRandomByCoordinatesByRankByLogicalColour = randomByCoordinatesByRankByLogicalColour,
getRandomByCastleableRooksXByLogicalColour = randomByCastleableRooksXByLogicalColour,
getRandomByEnPassantAbscissa = randomByEnPassantAbscissa
} = Data.Foldable.foldr f (
Data.Foldable.foldr (
flip . foldr $ f . snd
) (
Data.Foldable.foldr (
flip . Data.Foldable.foldr . flip $ Data.Foldable.foldr f
) (
f randomForBlacksMove i
) randomByCoordinatesByRankByLogicalColour
) randomByCastleableRooksXByLogicalColour
) randomByEnPassantAbscissa
instance (
Data.Array.IArray.Ix x,
Data.Bits.FiniteBits positionHash,
Enum x,
Enum y,
Num positionHash,
Ord y,
System.Random.Random positionHash
) => Data.Default.Default (Zobrist x y positionHash) where
def = mkZobrist Nothing $ System.Random.mkStdGen 0
measureHammingDistances :: Data.Bits.Bits positionHash => Zobrist x y positionHash -> [Int]
measureHammingDistances = map (Data.Bits.popCount . uncurry Data.Bits.xor) . getCombinations . Data.Foldable.toList where
getCombinations :: [a] -> [(a, a)]
getCombinations (x : remainder) = map ((,) x) remainder ++ getCombinations remainder
getCombinations _ = []
mkZobrist :: (
Data.Array.IArray.Ix x,
Data.Bits.FiniteBits positionHash,
Enum x,
Enum y,
Num positionHash,
Ord y,
System.Random.RandomGen randomGen,
System.Random.Random positionHash
)
=> Maybe Int
-> randomGen
-> Zobrist x y positionHash
mkZobrist maybeMinimumHammingDistance randomGen
| Just minimumHammingDistance <- maybeMinimumHammingDistance
, let minimumHammingDistance' = minimum $ measureHammingDistances zobrist
, minimumHammingDistance' < minimumHammingDistance = Control.Exception.throw . Data.Exception.mkRequestFailure . showString "BishBosh.Component.Zobrist.mkZobrist:\tthe minimum Hamming-distance between the selected random numbers doesn't reach the configured minimum " . shows (minimumHammingDistance', minimumHammingDistance) . showString " => use more than " $ shows (Data.Bits.finiteBitSize randomForBlacksMove) " bits, or re-seed the generator & hope."
| otherwise = zobrist
where
((randomForBlacksMove, randomByCoordinatesByRankByLogicalColour), (randomByCastleableRooksXByLogicalColour, randomByEnPassantAbscissa)) = (
(
head . getNonZeroRandoms *** Attribute.LogicalColour.listArrayByLogicalColour . map (
Attribute.Rank.listArrayByRank . map (
Cartesian.Coordinates.listArrayByCoordinates . getNonZeroRandoms
) . ToolShed.System.Random.randomGens
) . ToolShed.System.Random.randomGens
) . System.Random.split
) *** (
(
Attribute.LogicalColour.listArrayByLogicalColour . map (
zip [Cartesian.Abscissa.xMin, Cartesian.Abscissa.xMax] . getNonZeroRandoms
) . ToolShed.System.Random.randomGens *** Cartesian.Abscissa.listArrayByAbscissa . getNonZeroRandoms
) . System.Random.split
) $ System.Random.split randomGen where
getNonZeroRandoms = filter (/= 0) . System.Random.randoms
zobrist = MkZobrist {
getRandomForBlacksMove = randomForBlacksMove,
getRandomByCoordinatesByRankByLogicalColour = randomByCoordinatesByRankByLogicalColour,
getRandomByCastleableRooksXByLogicalColour = randomByCastleableRooksXByLogicalColour,
getRandomByEnPassantAbscissa = randomByEnPassantAbscissa
}
dereferenceRandomByCoordinatesByRankByLogicalColour :: (
Enum x,
Enum y,
Ord x,
Ord y
)
=> Attribute.LogicalColour.LogicalColour
-> Attribute.Rank.Rank
-> Cartesian.Coordinates.Coordinates x y
-> Zobrist x y positionHash
-> positionHash
dereferenceRandomByCoordinatesByRankByLogicalColour logicalColour rank coordinates MkZobrist { getRandomByCoordinatesByRankByLogicalColour = randomByCoordinatesByRankByLogicalColour } = randomByCoordinatesByRankByLogicalColour ! logicalColour ! rank ! coordinates
dereferenceRandomByCastleableRooksXByLogicalColour
:: Eq x
=> Attribute.LogicalColour.LogicalColour
-> x
-> Zobrist x y positionHash
-> Maybe positionHash
dereferenceRandomByCastleableRooksXByLogicalColour logicalColour x MkZobrist { getRandomByCastleableRooksXByLogicalColour = randomByCastleableRooksXByLogicalColour } = lookup x $ randomByCastleableRooksXByLogicalColour ! logicalColour
dereferenceRandomByEnPassantAbscissa
:: Data.Array.IArray.Ix x
=> x
-> Zobrist x y positionHash
-> positionHash
dereferenceRandomByEnPassantAbscissa x MkZobrist { getRandomByEnPassantAbscissa = randomByEnPassantAbscissa } = randomByEnPassantAbscissa ! 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 = Data.Bits.xor
hash2D :: (
Data.Bits.Bits positionHash,
Hashable2D hashable x y
)
=> hashable x y
-> Zobrist x y positionHash
-> positionHash
hash2D hashable = Data.List.foldl1' combiningOp . listRandoms2D hashable
combine :: Data.Bits.Bits positionHash => positionHash -> [positionHash] -> positionHash
combine = Data.List.foldl' combiningOp