{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module Game.Chess.Polyglot (
PolyglotBook, BookEntry(..), beKey, bePly, beWeight, beLearn
, defaultBook, twic
, fromByteString, toByteString
, readPolyglotFile, writePolyglotFile
, makeBook, toPGN
, bookPly
, bookPlies
, bookForest
, variations
, findPosition, hashPosition
) where
import Control.Arrow (Arrow ((&&&)))
import Control.Lens (makeLenses)
import Control.Monad.Random (Rand)
import qualified Control.Monad.Random as Rand
import Data.Bits (Bits (shiftL, shiftR, (.|.)))
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS
import Data.FileEmbed (embedFile)
import Data.Foldable (fold)
import Data.Hashable (Hashable)
import Data.List (sort)
import Data.Ord (Down (Down))
import Data.String (IsString (fromString))
import Data.Tree (Tree (Node), foldTree)
import Data.Vector.Instances ()
import qualified Data.Vector.Storable as VS
import Data.Word (Word16, Word32, Word64, Word8)
import Foreign.ForeignPtr (castForeignPtr, plusForeignPtr)
import Foreign.Storable (Storable (alignment, peek, poke, pokeElemOff, sizeOf))
import GHC.Generics (Generic)
import GHC.Ptr (Ptr, castPtr, plusPtr)
import Game.Chess.Internal (Color (..), Ply (..),
Position (color, halfMoveClock),
bKscm, bQscm, canCastleKingside,
canCastleQueenside, doPly, move,
startpos, toFEN, unpack,
unsafeDoPly, wKscm, wQscm)
import Game.Chess.Internal.Square
import Game.Chess.PGN (Outcome (Undecided), PGN (..),
gameFromForest, weightedForest)
import Game.Chess.Polyglot.Hash (hashPosition)
import System.Random (RandomGen)
data BookEntry a = BE {
forall a. BookEntry a -> Word64
_beKey :: {-# UNPACK #-} !Word64
, forall a. BookEntry a -> a
_bePly :: !a
, forall a. BookEntry a -> Word16
_beWeight :: {-# UNPACK #-} !Word16
, forall a. BookEntry a -> Word32
_beLearn :: {-# UNPACK #-} !Word32
} deriving (BookEntry a -> BookEntry a -> Bool
forall a. Eq a => BookEntry a -> BookEntry a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BookEntry a -> BookEntry a -> Bool
$c/= :: forall a. Eq a => BookEntry a -> BookEntry a -> Bool
== :: BookEntry a -> BookEntry a -> Bool
$c== :: forall a. Eq a => BookEntry a -> BookEntry a -> Bool
Eq, forall a b. a -> BookEntry b -> BookEntry a
forall a b. (a -> b) -> BookEntry a -> BookEntry b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> BookEntry b -> BookEntry a
$c<$ :: forall a b. a -> BookEntry b -> BookEntry a
fmap :: forall a b. (a -> b) -> BookEntry a -> BookEntry b
$cfmap :: forall a b. (a -> b) -> BookEntry a -> BookEntry b
Functor, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (BookEntry a) x -> BookEntry a
forall a x. BookEntry a -> Rep (BookEntry a) x
$cto :: forall a x. Rep (BookEntry a) x -> BookEntry a
$cfrom :: forall a x. BookEntry a -> Rep (BookEntry a) x
Generic, Int -> BookEntry a -> ShowS
forall a. Show a => Int -> BookEntry a -> ShowS
forall a. Show a => [BookEntry a] -> ShowS
forall a. Show a => BookEntry a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BookEntry a] -> ShowS
$cshowList :: forall a. Show a => [BookEntry a] -> ShowS
show :: BookEntry a -> String
$cshow :: forall a. Show a => BookEntry a -> String
showsPrec :: Int -> BookEntry a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> BookEntry a -> ShowS
Show)
instance Hashable a => Hashable (BookEntry a)
makeLenses ''BookEntry
instance Ord a => Ord (BookEntry a) where
compare :: BookEntry a -> BookEntry a -> Ordering
compare (BE Word64
k1 a
p1 Word16
w1 Word32
_) (BE Word64
k2 a
p2 Word16
w2 Word32
_) =
Word64
k1 forall a. Ord a => a -> a -> Ordering
`compare` Word64
k2 forall a. Semigroup a => a -> a -> a
<> forall a. a -> Down a
Down Word16
w1 forall a. Ord a => a -> a -> Ordering
`compare` forall a. a -> Down a
Down Word16
w2 forall a. Semigroup a => a -> a -> a
<> a
p1 forall a. Ord a => a -> a -> Ordering
`compare` a
p2
instance Storable (BookEntry Word16) where
sizeOf :: BookEntry Word16 -> Int
sizeOf BookEntry Word16
_ = Int
16
alignment :: BookEntry Word16 -> Int
alignment BookEntry Word16
_ = forall a. Storable a => a -> Int
alignment (forall a. HasCallStack => a
undefined :: Word64)
peek :: Ptr (BookEntry Word16) -> IO (BookEntry Word16)
peek Ptr (BookEntry Word16)
ptr = forall a. Word64 -> a -> Word16 -> Word32 -> BookEntry a
BE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Bits a, Num a, Storable a) => Ptr Word8 -> IO a
peekBE (forall a b. Ptr a -> Ptr b
castPtr Ptr (BookEntry Word16)
ptr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. (Bits a, Num a, Storable a) => Ptr Word8 -> IO a
peekBE (forall a b. Ptr a -> Ptr b
castPtr Ptr (BookEntry Word16)
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. (Bits a, Num a, Storable a) => Ptr Word8 -> IO a
peekBE (forall a b. Ptr a -> Ptr b
castPtr Ptr (BookEntry Word16)
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
10)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. (Bits a, Num a, Storable a) => Ptr Word8 -> IO a
peekBE (forall a b. Ptr a -> Ptr b
castPtr Ptr (BookEntry Word16)
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12)
poke :: Ptr (BookEntry Word16) -> BookEntry Word16 -> IO ()
poke Ptr (BookEntry Word16)
ptr BE { Word16
Word32
Word64
_beLearn :: Word32
_beWeight :: Word16
_bePly :: Word16
_beKey :: Word64
_beLearn :: forall a. BookEntry a -> Word32
_beWeight :: forall a. BookEntry a -> Word16
_bePly :: forall a. BookEntry a -> a
_beKey :: forall a. BookEntry a -> Word64
.. } = do
forall a.
(Bits a, Integral a, Num a, Storable a) =>
Ptr Word8 -> a -> IO ()
pokeBE (forall a b. Ptr a -> Ptr b
castPtr Ptr (BookEntry Word16)
ptr) Word64
_beKey
forall a.
(Bits a, Integral a, Num a, Storable a) =>
Ptr Word8 -> a -> IO ()
pokeBE (forall a b. Ptr a -> Ptr b
castPtr Ptr (BookEntry Word16)
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) Word16
_bePly
forall a.
(Bits a, Integral a, Num a, Storable a) =>
Ptr Word8 -> a -> IO ()
pokeBE (forall a b. Ptr a -> Ptr b
castPtr Ptr (BookEntry Word16)
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
10) Word16
_beWeight
forall a.
(Bits a, Integral a, Num a, Storable a) =>
Ptr Word8 -> a -> IO ()
pokeBE (forall a b. Ptr a -> Ptr b
castPtr Ptr (BookEntry Word16)
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12) Word32
_beLearn
peekBE :: forall a. (Bits a, Num a, Storable a) => Ptr Word8 -> IO a
peekBE :: forall a. (Bits a, Num a, Storable a) => Ptr Word8 -> IO a
peekBE Ptr Word8
ptr = forall {b} {t} {t}.
(Storable b, Bits t, Integral b, Num t, Num t, Eq t) =>
Ptr b -> t -> t -> IO t
go Ptr Word8
ptr a
0 (forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)) where
go :: Ptr b -> t -> t -> IO t
go Ptr b
_ !t
x t
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure t
x
go !Ptr b
p !t
x !t
n = forall a. Storable a => Ptr a -> IO a
peek Ptr b
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
w8 ->
Ptr b -> t -> t -> IO t
go (Ptr b
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (t
x forall a. Bits a => a -> Int -> a
`shiftL` Int
8 forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral b
w8) (t
n forall a. Num a => a -> a -> a
- t
1)
pokeBE :: forall a. (Bits a, Integral a, Num a, Storable a) => Ptr Word8 -> a -> IO ()
pokeBE :: forall a.
(Bits a, Integral a, Num a, Storable a) =>
Ptr Word8 -> a -> IO ()
pokeBE Ptr Word8
p a
x = forall {t}. (Integral t, Bits t) => t -> Int -> IO ()
go a
x (forall a. Storable a => a -> Int
sizeOf a
x) where
go :: t -> Int -> IO ()
go t
_ Int
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
go !t
v !Int
n = forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
p (Int
nforall a. Num a => a -> a -> a
-Int
1) (forall a b. (Integral a, Num b) => a -> b
fromIntegral t
v) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> t -> Int -> IO ()
go (t
v forall a. Bits a => a -> Int -> a
`shiftR` Int
8) (Int
nforall a. Num a => a -> a -> a
-Int
1)
defaultBook, twic :: PolyglotBook
defaultBook :: PolyglotBook
defaultBook = PolyglotBook
twic
twic :: PolyglotBook
twic = ByteString -> PolyglotBook
fromByteString $(embedFile "book/twic-9g.bin")
newtype PolyglotBook = Book (VS.Vector (BookEntry Word16)) deriving (PolyglotBook -> PolyglotBook -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PolyglotBook -> PolyglotBook -> Bool
$c/= :: PolyglotBook -> PolyglotBook -> Bool
== :: PolyglotBook -> PolyglotBook -> Bool
$c== :: PolyglotBook -> PolyglotBook -> Bool
Eq, Eq PolyglotBook
Int -> PolyglotBook -> Int
PolyglotBook -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: PolyglotBook -> Int
$chash :: PolyglotBook -> Int
hashWithSalt :: Int -> PolyglotBook -> Int
$chashWithSalt :: Int -> PolyglotBook -> Int
Hashable)
instance Semigroup PolyglotBook where
Book Vector (BookEntry Word16)
a <> :: PolyglotBook -> PolyglotBook -> PolyglotBook
<> Book Vector (BookEntry Word16)
b = [BookEntry Word16] -> PolyglotBook
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => Vector a -> [a]
VS.toList forall a b. (a -> b) -> a -> b
$ Vector (BookEntry Word16)
a forall a. Semigroup a => a -> a -> a
<> Vector (BookEntry Word16)
b
instance Monoid PolyglotBook where
mempty :: PolyglotBook
mempty = Vector (BookEntry Word16) -> PolyglotBook
Book forall a. Monoid a => a
mempty
fromByteString :: ByteString -> PolyglotBook
fromByteString :: ByteString -> PolyglotBook
fromByteString ByteString
bs = Vector (BookEntry Word16) -> PolyglotBook
Book Vector (BookEntry Word16)
v where
v :: Vector (BookEntry Word16)
v = forall a. ForeignPtr a -> Int -> Vector a
VS.unsafeFromForeignPtr0 (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
fptr Int
off) (Int
len forall a. Integral a => a -> a -> a
`div` Int
elemSize)
(ForeignPtr Word8
fptr, Int
off, Int
len) = ByteString -> (ForeignPtr Word8, Int, Int)
BS.toForeignPtr ByteString
bs
elemSize :: Int
elemSize = forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined forall a. a -> a -> a
`asTypeOf` forall a. Storable a => Vector a -> a
VS.head Vector (BookEntry Word16)
v)
toByteString :: PolyglotBook -> ByteString
toByteString :: PolyglotBook -> ByteString
toByteString (Book Vector (BookEntry Word16)
v) = ForeignPtr Word8 -> Int -> Int -> ByteString
BS.fromForeignPtr (forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr (BookEntry Word16)
fptr) Int
off (Int
len forall a. Num a => a -> a -> a
* Int
elemSize)
where
(ForeignPtr (BookEntry Word16)
fptr, Int
off, Int
len) = forall a. Vector a -> (ForeignPtr a, Int, Int)
VS.unsafeToForeignPtr Vector (BookEntry Word16)
v
elemSize :: Int
elemSize = forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined forall a. a -> a -> a
`asTypeOf` forall a. Storable a => Vector a -> a
VS.head Vector (BookEntry Word16)
v)
readPolyglotFile :: FilePath -> IO PolyglotBook
readPolyglotFile :: String -> IO PolyglotBook
readPolyglotFile = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> PolyglotBook
fromByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ByteString
BS.readFile
writePolyglotFile :: FilePath -> PolyglotBook -> IO ()
writePolyglotFile :: String -> PolyglotBook -> IO ()
writePolyglotFile String
fp = String -> ByteString -> IO ()
BS.writeFile String
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolyglotBook -> ByteString
toByteString
fromList :: [BookEntry Word16] -> PolyglotBook
fromList :: [BookEntry Word16] -> PolyglotBook
fromList = Vector (BookEntry Word16) -> PolyglotBook
Book forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => [a] -> Vector a
VS.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort
toPGN :: PolyglotBook -> Position -> PGN
toPGN :: PolyglotBook -> Position -> PGN
toPGN PolyglotBook
b Position
p = [Game] -> PGN
PGN [[(Text, Text)] -> [Tree Ply] -> Outcome -> Game
gameFromForest [(Text, Text)]
meta (PolyglotBook -> Position -> [Tree Ply]
bookForest PolyglotBook
b Position
p) Outcome
Undecided] where
meta :: [(Text, Text)]
meta | Position
p forall a. Eq a => a -> a -> Bool
== Position
startpos = []
| Bool
otherwise = [(Text
"FEN", forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ Position -> String
toFEN Position
p)]
makeBook :: PGN -> PolyglotBook
makeBook :: PGN -> PolyglotBook
makeBook = [BookEntry Word16] -> PolyglotBook
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> [b] -> b) -> Tree a -> b
foldTree forall {a} {t :: * -> *}.
(RealFrac a, Foldable t) =>
(Position, (a, Ply)) -> t [BookEntry Word16] -> [BookEntry Word16]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Position -> Tree (a, Ply) -> Tree (Position, (a, Ply))
annot Position
startpos) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGN -> [Tree (Rational, Ply)]
weightedForest
where
annot :: Position -> Tree (a, Ply) -> Tree (Position, (a, Ply))
annot Position
pos (Node (a, Ply)
a [Tree (a, Ply)]
ts) =
forall a. a -> [Tree a] -> Tree a
Node (Position
pos, (a, Ply)
a) forall a b. (a -> b) -> a -> b
$ Position -> Tree (a, Ply) -> Tree (Position, (a, Ply))
annot (Position -> Ply -> Position
unsafeDoPly Position
pos (forall a b. (a, b) -> b
snd (a, Ply)
a)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree (a, Ply)]
ts
f :: (Position, (a, Ply)) -> t [BookEntry Word16] -> [BookEntry Word16]
f (Position
pos, (a
w, Ply
pl)) t [BookEntry Word16]
xs
| a
w forall a. Ord a => a -> a -> Bool
> a
0
= forall a. Word64 -> a -> Word16 -> Word32 -> BookEntry a
BE (Position -> Word64
hashPosition Position
pos) (Position -> Ply -> Word16
fromPly Position
pos Ply
pl) (forall a b. (RealFrac a, Integral b) => a -> b
floor a
w) Word32
0 forall a. a -> [a] -> [a]
: forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [BookEntry Word16]
xs
| Bool
otherwise
= forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [BookEntry Word16]
xs
bookForest :: PolyglotBook -> Position -> [Tree Ply]
bookForest :: PolyglotBook -> Position -> [Tree Ply]
bookForest PolyglotBook
b = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Position, Ply)] -> Position -> [Tree [(Position, Ply)]]
forest [] where
forest :: [(Position, Ply)] -> Position -> [Tree [(Position, Ply)]]
forest [(Position, Ply)]
pls Position
p = [(Position, Ply)]
-> Position -> (Ply, Position) -> Tree [(Position, Ply)]
tree [(Position, Ply)]
pls Position
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b} {a}. Eq a => [(a, b)] -> (a, a) -> Bool
seen [(Position, Ply)]
pls) (Position -> [(Ply, Position)]
plies Position
p)
tree :: [(Position, Ply)]
-> Position -> (Ply, Position) -> Tree [(Position, Ply)]
tree [(Position, Ply)]
pls Position
p (Ply
pl, Position
p') = forall a. a -> [Tree a] -> Tree a
Node [(Position, Ply)]
pls' forall a b. (a -> b) -> a -> b
$ [(Position, Ply)] -> Position -> [Tree [(Position, Ply)]]
forest [(Position, Ply)]
pls' Position
p' where pls' :: [(Position, Ply)]
pls' = (Position
p, Ply
pl) forall a. a -> [a] -> [a]
: [(Position, Ply)]
pls
plies :: Position -> [(Ply, Position)]
plies Position
p = BookEntry Ply -> (Ply, Position)
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PolyglotBook -> Position -> [BookEntry Ply]
bookPlies PolyglotBook
b Position
p where f :: BookEntry Ply -> (Ply, Position)
f (forall a. BookEntry a -> a
_bePly -> Ply
pl) = (Ply
pl, HasCallStack => Position -> Ply -> Position
doPly Position
p Ply
pl)
seen :: [(a, b)] -> (a, a) -> Bool
seen [(a, b)]
pls (a
_, a
p') = a
p' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(a, b)]
pls
bookPly :: RandomGen g => PolyglotBook -> Position -> Maybe (Rand g Ply)
bookPly :: forall g.
RandomGen g =>
PolyglotBook -> Position -> Maybe (Rand g Ply)
bookPly PolyglotBook
b Position
pos = case PolyglotBook -> Position -> [BookEntry Ply]
findPosition PolyglotBook
b Position
pos of
[] -> forall a. Maybe a
Nothing
[BookEntry Ply]
l -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadRandom m => [(a, Rational)] -> m a
Rand.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. BookEntry a -> a
_bePly forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BookEntry a -> Word16
_beWeight) [BookEntry Ply]
l
bookPlies :: PolyglotBook -> Position -> [BookEntry Ply]
bookPlies :: PolyglotBook -> Position -> [BookEntry Ply]
bookPlies PolyglotBook
b Position
pos
| Position -> Int
halfMoveClock Position
pos forall a. Ord a => a -> a -> Bool
> Int
150 = []
| Bool
otherwise = PolyglotBook -> Position -> [BookEntry Ply]
findPosition PolyglotBook
b Position
pos
variations :: PolyglotBook -> Position -> [[Ply]]
variations :: PolyglotBook -> Position -> [[Ply]]
variations PolyglotBook
b = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> [b] -> b) -> Tree a -> b
foldTree forall {a}. a -> [[[a]]] -> [[a]]
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolyglotBook -> Position -> [Tree Ply]
bookForest PolyglotBook
b where
f :: a -> [[[a]]] -> [[a]]
f a
a [] = [[a
a]]
f a
a [[[a]]]
xs = (a
a forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [[[a]]]
xs
findPosition :: PolyglotBook -> Position -> [BookEntry Ply]
findPosition :: PolyglotBook -> Position -> [BookEntry Ply]
findPosition (Book Vector (BookEntry Word16)
v) Position
pos =
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Position -> Word16 -> Ply
toPly Position
pos) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Storable a => Vector a -> [a]
VS.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Storable a => (a -> Bool) -> Vector a -> Vector a
VS.takeWhile ((Word64
hash forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BookEntry a -> Word64
_beKey) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Storable a => Int -> Vector a -> Vector a
VS.unsafeDrop (Word64 -> Int
lowerBound Word64
hash) forall a b. (a -> b) -> a -> b
$ Vector (BookEntry Word16)
v
where
hash :: Word64
hash = Position -> Word64
hashPosition Position
pos
lowerBound :: Word64 -> Int
lowerBound = forall a b. (Integral a, Ord b) => (a -> b) -> (a, a) -> b -> a
bsearch (forall a. BookEntry a -> Word64
_beKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => Vector a -> Int -> a
VS.unsafeIndex Vector (BookEntry Word16)
v) (Int
0, forall a. Storable a => Vector a -> Int
VS.length Vector (BookEntry Word16)
v forall a. Num a => a -> a -> a
- Int
1)
bsearch :: (Integral a, Ord b) => (a -> b) -> (a, a) -> b -> a
bsearch :: forall a b. (Integral a, Ord b) => (a -> b) -> (a, a) -> b -> a
bsearch a -> b
f (a
lo, a
hi) b
x
| a
lo forall a. Ord a => a -> a -> Bool
>= a
hi = a
lo
| b
x forall a. Ord a => a -> a -> Bool
<= a -> b
f a
mid = forall a b. (Integral a, Ord b) => (a -> b) -> (a, a) -> b -> a
bsearch a -> b
f (a
lo, a
mid) b
x
| Bool
otherwise = forall a b. (Integral a, Ord b) => (a -> b) -> (a, a) -> b -> a
bsearch a -> b
f (a
mid forall a. Num a => a -> a -> a
+ a
1, a
hi) b
x
where mid :: a
mid = a
lo forall a. Num a => a -> a -> a
+ ((a
hi forall a. Num a => a -> a -> a
- a
lo) forall a. Integral a => a -> a -> a
`div` a
2)
toPly :: Position -> Word16 -> Ply
toPly :: Position -> Word16 -> Ply
toPly Position
pos pl :: Word16
pl@(Ply -> (Square, Square, Maybe PieceType)
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Ply
Ply -> (Square
src, Square
dst, Maybe PieceType
_)) = case Position -> Color
color Position
pos of
Color
White | Square
src forall a. Eq a => a -> a -> Bool
== Square
E1
, Position -> Bool
canCastleKingside Position
pos
, Square
dst forall a. Eq a => a -> a -> Bool
== Square
H1
-> Ply
wKscm
| Square
src forall a. Eq a => a -> a -> Bool
== Square
E1
, Position -> Bool
canCastleQueenside Position
pos
, Square
dst forall a. Eq a => a -> a -> Bool
== Square
A1
-> Ply
wQscm
Color
Black | Square
src forall a. Eq a => a -> a -> Bool
== Square
E8
, Position -> Bool
canCastleKingside Position
pos
, Square
dst forall a. Eq a => a -> a -> Bool
== Square
H8
-> Ply
bKscm
| Square
src forall a. Eq a => a -> a -> Bool
== Square
E8
, Position -> Bool
canCastleQueenside Position
pos
, Square
dst forall a. Eq a => a -> a -> Bool
== Square
A8
-> Ply
bQscm
Color
_ -> Word16 -> Ply
Ply Word16
pl
fromPly :: Position -> Ply -> Word16
fromPly :: Position -> Ply -> Word16
fromPly Position
pos pl :: Ply
pl@(Ply -> (Square, Square, Maybe PieceType)
unpack -> (Square
src, Square
dst, Maybe PieceType
_)) = Ply -> Word16
unPly forall a b. (a -> b) -> a -> b
$ case Position -> Color
color Position
pos of
Color
White | Square
src forall a. Eq a => a -> a -> Bool
== Square
E1
, Position -> Bool
canCastleKingside Position
pos
, Square
dst forall a. Eq a => a -> a -> Bool
== Square
G1
-> Square
src Square -> Square -> Ply
`move` Square
H1
| Square
src forall a. Eq a => a -> a -> Bool
== Square
E1
, Position -> Bool
canCastleQueenside Position
pos
, Square
dst forall a. Eq a => a -> a -> Bool
== Square
C1
-> Square
src Square -> Square -> Ply
`move` Square
A1
Color
Black | Square
src forall a. Eq a => a -> a -> Bool
== Square
E8
, Position -> Bool
canCastleKingside Position
pos
, Square
dst forall a. Eq a => a -> a -> Bool
== Square
G8
-> Square
src Square -> Square -> Ply
`move` Square
H8
| Square
src forall a. Eq a => a -> a -> Bool
== Square
E8
, Position -> Bool
canCastleQueenside Position
pos
, Square
dst forall a. Eq a => a -> a -> Bool
== Square
C8
-> Square
src Square -> Square -> Ply
`move` Square
A8
Color
_ -> Ply
pl