{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Game.Chess.Polyglot (
  -- * Data type
  PolyglotBook
  -- * Built-in books
, defaultBook, twic
  -- * Load and save
, fromByteString, toByteString
, readPolyglotFile, writePolyglotFile
, makeBook, toPGN
  -- * Lookup
, bookPly
, bookPlies
, bookForest
, variations
, findPosition
) where

import Control.Arrow
import Control.Monad.Random (Rand)
import qualified Control.Monad.Random as Rand
import Data.Bits
import Data.ByteString (ByteString)
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString as BS
import Data.FileEmbed
import Data.Foldable (fold)
import Data.List
import Data.Ord
import Data.String (IsString(fromString))
import qualified Data.Vector.Storable as VS
import Data.Tree
import Data.Word
import Foreign.ForeignPtr (castForeignPtr, plusForeignPtr)
import Foreign.Storable
import Game.Chess.Internal
import Game.Chess.PGN
import Game.Chess.Polyglot.Hash
import GHC.Ptr (Ptr, castPtr, plusPtr)
import System.Random (RandomGen)

data BookEntry = BookEntry {
  BookEntry -> Word64
key :: {-# UNPACK #-} !Word64
, BookEntry -> Ply
ply :: {-# UNPACK #-} !Ply
, BookEntry -> Word16
weight :: {-# UNPACK #-} !Word16
, BookEntry -> Word32
learn :: {-# UNPACK #-} !Word32
} deriving (BookEntry -> BookEntry -> Bool
(BookEntry -> BookEntry -> Bool)
-> (BookEntry -> BookEntry -> Bool) -> Eq BookEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BookEntry -> BookEntry -> Bool
$c/= :: BookEntry -> BookEntry -> Bool
== :: BookEntry -> BookEntry -> Bool
$c== :: BookEntry -> BookEntry -> Bool
Eq, Int -> BookEntry -> ShowS
[BookEntry] -> ShowS
BookEntry -> String
(Int -> BookEntry -> ShowS)
-> (BookEntry -> String)
-> ([BookEntry] -> ShowS)
-> Show BookEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BookEntry] -> ShowS
$cshowList :: [BookEntry] -> ShowS
show :: BookEntry -> String
$cshow :: BookEntry -> String
showsPrec :: Int -> BookEntry -> ShowS
$cshowsPrec :: Int -> BookEntry -> ShowS
Show)

instance Ord BookEntry where
  compare :: BookEntry -> BookEntry -> Ordering
compare (BookEntry Word64
k1 Ply
_ Word16
w1 Word32
_) (BookEntry Word64
k2 Ply
_ Word16
w2 Word32
_) =
    Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word64
k1 Word64
k2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Down Word16 -> Down Word16 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Word16 -> Down Word16
forall a. a -> Down a
Down Word16
w1) (Word16 -> Down Word16
forall a. a -> Down a
Down Word16
w2)

instance Storable BookEntry where
  sizeOf :: BookEntry -> Int
sizeOf BookEntry
_ = Int
16
  alignment :: BookEntry -> Int
alignment BookEntry
_ = Word64 -> Int
forall a. Storable a => a -> Int
alignment (Word64
forall a. HasCallStack => a
undefined :: Word64)
  peek :: Ptr BookEntry -> IO BookEntry
peek Ptr BookEntry
ptr = Word64 -> Ply -> Word16 -> Word32 -> BookEntry
BookEntry (Word64 -> Ply -> Word16 -> Word32 -> BookEntry)
-> IO Word64 -> IO (Ply -> Word16 -> Word32 -> BookEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> IO Word64
forall a. (Bits a, Num a, Storable a) => Ptr Word8 -> IO a
peekBE (Ptr BookEntry -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr BookEntry
ptr)
                       IO (Ply -> Word16 -> Word32 -> BookEntry)
-> IO Ply -> IO (Word16 -> Word32 -> BookEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word16 -> Ply
Ply (Word16 -> Ply) -> IO Word16 -> IO Ply
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> IO Word16
forall a. (Bits a, Num a, Storable a) => Ptr Word8 -> IO a
peekBE (Ptr BookEntry -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr BookEntry
ptr Ptr Any -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8))
                       IO (Word16 -> Word32 -> BookEntry)
-> IO Word16 -> IO (Word32 -> BookEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Word8 -> IO Word16
forall a. (Bits a, Num a, Storable a) => Ptr Word8 -> IO a
peekBE (Ptr BookEntry -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr BookEntry
ptr Ptr Any -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
10)
                       IO (Word32 -> BookEntry) -> IO Word32 -> IO BookEntry
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Word8 -> IO Word32
forall a. (Bits a, Num a, Storable a) => Ptr Word8 -> IO a
peekBE (Ptr BookEntry -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr BookEntry
ptr Ptr Any -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12)
  poke :: Ptr BookEntry -> BookEntry -> IO ()
poke Ptr BookEntry
ptr (BookEntry Word64
key (Ply Word16
ply) Word16
weight Word32
learn) = do
    Ptr Word8 -> Word64 -> IO ()
forall a.
(Bits a, Integral a, Num a, Storable a) =>
Ptr Word8 -> a -> IO ()
pokeBE (Ptr BookEntry -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr BookEntry
ptr) Word64
key
    Ptr Word8 -> Word16 -> IO ()
forall a.
(Bits a, Integral a, Num a, Storable a) =>
Ptr Word8 -> a -> IO ()
pokeBE (Ptr BookEntry -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr BookEntry
ptr Ptr Any -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) Word16
ply
    Ptr Word8 -> Word16 -> IO ()
forall a.
(Bits a, Integral a, Num a, Storable a) =>
Ptr Word8 -> a -> IO ()
pokeBE (Ptr BookEntry -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr BookEntry
ptr Ptr Any -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
10) Word16
weight
    Ptr Word8 -> Word32 -> IO ()
forall a.
(Bits a, Integral a, Num a, Storable a) =>
Ptr Word8 -> a -> IO ()
pokeBE (Ptr BookEntry -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr BookEntry
ptr Ptr Any -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12) Word32
learn

peekBE :: forall a. (Bits a, Num a, Storable a) => Ptr Word8 -> IO a
peekBE :: Ptr Word8 -> IO a
peekBE Ptr Word8
ptr = Ptr Word8 -> a -> Int -> IO a
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 (a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)) where
  go :: Ptr b -> t -> t -> IO t
go Ptr b
_ !t
x t
0 = t -> IO t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
x
  go !Ptr b
p !t
x !t
n = Ptr b -> IO b
forall a. Storable a => Ptr a -> IO a
peek Ptr b
p IO b -> (b -> IO t) -> IO t
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 Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (t
x t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 t -> t -> t
forall a. Bits a => a -> a -> a
.|. b -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
w8) (t
n t -> t -> t
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 :: Ptr Word8 -> a -> IO ()
pokeBE Ptr Word8
p a
x = a -> Int -> IO ()
go a
x (a -> Int
forall a. Storable a => a -> Int
sizeOf a
x) where
  go :: a -> Int -> IO ()
go a
_ Int
0 = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  go !a
v !Int
n = Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
p (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v) IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> a -> Int -> IO ()
go (a
v a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) (Int
nInt -> Int -> Int
forall 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")

-- | A Polyglot opening book.
newtype PolyglotBook = Book (VS.Vector BookEntry) deriving (PolyglotBook -> PolyglotBook -> Bool
(PolyglotBook -> PolyglotBook -> Bool)
-> (PolyglotBook -> PolyglotBook -> Bool) -> Eq PolyglotBook
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)

-- | Create a PolyglotBook from a ByteString.
fromByteString :: ByteString -> PolyglotBook
fromByteString :: ByteString -> PolyglotBook
fromByteString ByteString
bs = Vector BookEntry -> PolyglotBook
Book Vector BookEntry
v where
  v :: Vector BookEntry
v = ForeignPtr BookEntry -> Int -> Vector BookEntry
forall a. Storable a => ForeignPtr a -> Int -> Vector a
VS.unsafeFromForeignPtr0 (ForeignPtr Word8 -> Int -> ForeignPtr BookEntry
forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
fptr Int
off) (Int
len Int -> Int -> Int
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 = BookEntry -> Int
forall a. Storable a => a -> Int
sizeOf (BookEntry
forall a. HasCallStack => a
undefined BookEntry -> BookEntry -> BookEntry
forall a. a -> a -> a
`asTypeOf` Vector BookEntry -> BookEntry
forall a. Storable a => Vector a -> a
VS.head Vector BookEntry
v)

toByteString :: PolyglotBook -> ByteString
toByteString :: PolyglotBook -> ByteString
toByteString (Book Vector BookEntry
v) = ForeignPtr Word8 -> Int -> Int -> ByteString
BS.fromForeignPtr (ForeignPtr BookEntry -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr BookEntry
fptr) Int
off (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
elemSize)
 where
  (ForeignPtr BookEntry
fptr, Int
off, Int
len) = Vector BookEntry -> (ForeignPtr BookEntry, Int, Int)
forall a. Storable a => Vector a -> (ForeignPtr a, Int, Int)
VS.unsafeToForeignPtr Vector BookEntry
v
  elemSize :: Int
elemSize = BookEntry -> Int
forall a. Storable a => a -> Int
sizeOf (BookEntry
forall a. HasCallStack => a
undefined BookEntry -> BookEntry -> BookEntry
forall a. a -> a -> a
`asTypeOf` Vector BookEntry -> BookEntry
forall a. Storable a => Vector a -> a
VS.head Vector BookEntry
v)

readPolyglotFile :: FilePath -> IO PolyglotBook
readPolyglotFile :: String -> IO PolyglotBook
readPolyglotFile = (ByteString -> PolyglotBook) -> IO ByteString -> IO PolyglotBook
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> PolyglotBook
fromByteString (IO ByteString -> IO PolyglotBook)
-> (String -> IO ByteString) -> String -> IO PolyglotBook
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 (ByteString -> IO ())
-> (PolyglotBook -> ByteString) -> PolyglotBook -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolyglotBook -> ByteString
toByteString

fromList :: [BookEntry] -> PolyglotBook
fromList :: [BookEntry] -> PolyglotBook
fromList = Vector BookEntry -> PolyglotBook
Book (Vector BookEntry -> PolyglotBook)
-> ([BookEntry] -> Vector BookEntry) -> [BookEntry] -> PolyglotBook
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BookEntry] -> Vector BookEntry
forall a. Storable a => [a] -> Vector a
VS.fromList ([BookEntry] -> Vector BookEntry)
-> ([BookEntry] -> [BookEntry]) -> [BookEntry] -> Vector BookEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BookEntry] -> [BookEntry]
forall a. Ord a => [a] -> [a]
sort

--toList :: PolyglotBook -> [BookEntry]
--toList (Book v) = VS.toList v

toPGN :: PolyglotBook -> Position -> PGN
toPGN :: PolyglotBook -> Position -> PGN
toPGN PolyglotBook
b Position
p = [Game] -> PGN
PGN [[(ByteString, Text)] -> Forest Ply -> Outcome -> Game
gameFromForest [(ByteString, Text)]
meta (PolyglotBook -> Position -> Forest Ply
bookForest PolyglotBook
b Position
p) Outcome
Undecided] where
  meta :: [(ByteString, Text)]
meta | Position
p Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== Position
startpos = []
       | Bool
otherwise     = [(ByteString
"FEN", String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Position -> String
toFEN Position
p)]

makeBook :: PGN -> PolyglotBook
makeBook :: PGN -> PolyglotBook
makeBook = [BookEntry] -> PolyglotBook
fromList ([BookEntry] -> PolyglotBook)
-> (PGN -> [BookEntry]) -> PGN -> PolyglotBook
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree (Rational, Ply) -> [BookEntry])
-> [Tree (Rational, Ply)] -> [BookEntry]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((Position, (Rational, Ply)) -> [[BookEntry]] -> [BookEntry])
-> Tree (Position, (Rational, Ply)) -> [BookEntry]
forall a b. (a -> [b] -> b) -> Tree a -> b
foldTree (Position, (Rational, Ply)) -> [[BookEntry]] -> [BookEntry]
forall a (t :: * -> *).
(RealFrac a, Foldable t) =>
(Position, (a, Ply)) -> t [BookEntry] -> [BookEntry]
f (Tree (Position, (Rational, Ply)) -> [BookEntry])
-> (Tree (Rational, Ply) -> Tree (Position, (Rational, Ply)))
-> Tree (Rational, Ply)
-> [BookEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position
-> Tree (Rational, Ply) -> Tree (Position, (Rational, Ply))
forall a. Position -> Tree (a, Ply) -> Tree (Position, (a, Ply))
annot Position
startpos) ([Tree (Rational, Ply)] -> [BookEntry])
-> (PGN -> [Tree (Rational, Ply)]) -> PGN -> [BookEntry]
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 Forest (a, Ply)
ts) =
    (Position, (a, Ply))
-> Forest (Position, (a, Ply)) -> Tree (Position, (a, Ply))
forall a. a -> Forest a -> Tree a
Node (Position
pos, (a, Ply)
a) (Forest (Position, (a, Ply)) -> Tree (Position, (a, Ply)))
-> Forest (Position, (a, Ply)) -> Tree (Position, (a, Ply))
forall a b. (a -> b) -> a -> b
$ Position -> Tree (a, Ply) -> Tree (Position, (a, Ply))
annot (Position -> Ply -> Position
unsafeDoPly Position
pos ((a, Ply) -> Ply
forall a b. (a, b) -> b
snd (a, Ply)
a)) (Tree (a, Ply) -> Tree (Position, (a, Ply)))
-> Forest (a, Ply) -> Forest (Position, (a, Ply))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Forest (a, Ply)
ts
  f :: (Position, (a, Ply)) -> t [BookEntry] -> [BookEntry]
f (Position
pos, (a
w, Ply
pl)) t [BookEntry]
xs
    | a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0
    = Word64 -> Ply -> Word16 -> Word32 -> BookEntry
BookEntry (Position -> Word64
hashPosition Position
pos) (Position -> Ply -> Ply
toPolyglot Position
pos Ply
pl) (a -> Word16
forall a b. (RealFrac a, Integral b) => a -> b
floor a
w) Word32
0 BookEntry -> [BookEntry] -> [BookEntry]
forall a. a -> [a] -> [a]
: t [BookEntry] -> [BookEntry]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [BookEntry]
xs
    | Bool
otherwise
    = t [BookEntry] -> [BookEntry]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [BookEntry]
xs

bookForest :: PolyglotBook -> Position -> Forest Ply
bookForest :: PolyglotBook -> Position -> Forest Ply
bookForest PolyglotBook
b = ((Tree [(Position, Ply)] -> Tree Ply)
-> [Tree [(Position, Ply)]] -> Forest Ply
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Tree [(Position, Ply)] -> Tree Ply)
 -> [Tree [(Position, Ply)]] -> Forest Ply)
-> (([(Position, Ply)] -> Ply)
    -> Tree [(Position, Ply)] -> Tree Ply)
-> ([(Position, Ply)] -> Ply)
-> [Tree [(Position, Ply)]]
-> Forest Ply
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Position, Ply)] -> Ply) -> Tree [(Position, Ply)] -> Tree Ply
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ((Position, Ply) -> Ply
forall a b. (a, b) -> b
snd ((Position, Ply) -> Ply)
-> ([(Position, Ply)] -> (Position, Ply))
-> [(Position, Ply)]
-> Ply
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Position, Ply)] -> (Position, Ply)
forall a. [a] -> a
head) ([Tree [(Position, Ply)]] -> Forest Ply)
-> (Position -> [Tree [(Position, Ply)]]) -> Position -> Forest Ply
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 ((Ply, Position) -> Tree [(Position, Ply)])
-> [(Ply, Position)] -> [Tree [(Position, Ply)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Ply, Position) -> Bool) -> [(Ply, Position)] -> [(Ply, Position)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Ply, Position) -> Bool) -> (Ply, Position) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Position, Ply)] -> (Ply, Position) -> Bool
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') = [(Position, Ply)]
-> [Tree [(Position, Ply)]] -> Tree [(Position, Ply)]
forall a. a -> Forest a -> Tree a
Node [(Position, Ply)]
pls' ([Tree [(Position, Ply)]] -> Tree [(Position, Ply)])
-> [Tree [(Position, Ply)]] -> Tree [(Position, Ply)]
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) (Position, Ply) -> [(Position, Ply)] -> [(Position, Ply)]
forall a. a -> [a] -> [a]
: [(Position, Ply)]
pls
  plies :: Position -> [(Ply, Position)]
plies Position
p = Ply -> (Ply, Position)
f (Ply -> (Ply, Position)) -> [Ply] -> [(Ply, Position)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PolyglotBook -> Position -> [Ply]
bookPlies PolyglotBook
b Position
p where f :: Ply -> (Ply, Position)
f Ply
pl = (Ply
pl, Position -> Ply -> Position
doPly Position
p Ply
pl)
  seen :: [(a, b)] -> (a, a) -> Bool
seen [(a, b)]
pls (a
_, a
p') = a
p' a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((a, b) -> a) -> [(a, b)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> a
forall a b. (a, b) -> a
fst [(a, b)]
pls

-- | Pick a random ply from the book.
bookPly :: RandomGen g => PolyglotBook -> Position -> Maybe (Rand g Ply)
bookPly :: PolyglotBook -> Position -> Maybe (Rand g Ply)
bookPly PolyglotBook
b Position
pos = case PolyglotBook -> Position -> [BookEntry]
findPosition PolyglotBook
b Position
pos of
  [] -> Maybe (Rand g Ply)
forall a. Maybe a
Nothing
  [BookEntry]
l -> Rand g Ply -> Maybe (Rand g Ply)
forall a. a -> Maybe a
Just (Rand g Ply -> Maybe (Rand g Ply))
-> ([(Ply, Rational)] -> Rand g Ply)
-> [(Ply, Rational)]
-> Maybe (Rand g Ply)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Ply, Rational)] -> Rand g Ply
forall (m :: * -> *) a. MonadRandom m => [(a, Rational)] -> m a
Rand.fromList ([(Ply, Rational)] -> Maybe (Rand g Ply))
-> [(Ply, Rational)] -> Maybe (Rand g Ply)
forall a b. (a -> b) -> a -> b
$ (BookEntry -> (Ply, Rational)) -> [BookEntry] -> [(Ply, Rational)]
forall a b. (a -> b) -> [a] -> [b]
map (BookEntry -> Ply
ply (BookEntry -> Ply)
-> (BookEntry -> Rational) -> BookEntry -> (Ply, Rational)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Word16 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Rational)
-> (BookEntry -> Word16) -> BookEntry -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BookEntry -> Word16
weight) [BookEntry]
l

-- | Probe the book for all plies known for the given position.
bookPlies :: PolyglotBook -> Position -> [Ply]
bookPlies :: PolyglotBook -> Position -> [Ply]
bookPlies PolyglotBook
b Position
pos
  | Position -> Int
halfMoveClock Position
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
150 = []
  | Bool
otherwise = BookEntry -> Ply
ply (BookEntry -> Ply) -> [BookEntry] -> [Ply]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PolyglotBook -> Position -> [BookEntry]
findPosition PolyglotBook
b Position
pos

-- | Predicted Variations.  Return the most popular game.
variations :: PolyglotBook -> Position -> [[Ply]]
variations :: PolyglotBook -> Position -> [[Ply]]
variations PolyglotBook
b = (Tree Ply -> [[Ply]]) -> Forest Ply -> [[Ply]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Ply -> [[[Ply]]] -> [[Ply]]) -> Tree Ply -> [[Ply]]
forall a b. (a -> [b] -> b) -> Tree a -> b
foldTree Ply -> [[[Ply]]] -> [[Ply]]
forall a. a -> [[[a]]] -> [[a]]
f) (Forest Ply -> [[Ply]])
-> (Position -> Forest Ply) -> Position -> [[Ply]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolyglotBook -> Position -> Forest Ply
bookForest PolyglotBook
b where
  f :: a -> [[[a]]] -> [[a]]
f a
a [] = [[a
a]]
  f a
a [[[a]]]
xs = (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> [[a]] -> [[a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[[a]]] -> [[a]]
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [[[a]]]
xs

findPosition :: PolyglotBook -> Position -> [BookEntry]
findPosition :: PolyglotBook -> Position -> [BookEntry]
findPosition (Book Vector BookEntry
v) Position
pos = (BookEntry -> BookEntry) -> [BookEntry] -> [BookEntry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BookEntry -> BookEntry
conv ([BookEntry] -> [BookEntry])
-> (Vector BookEntry -> [BookEntry])
-> Vector BookEntry
-> [BookEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector BookEntry -> [BookEntry]
forall a. Storable a => Vector a -> [a]
VS.toList (Vector BookEntry -> [BookEntry])
-> (Vector BookEntry -> Vector BookEntry)
-> Vector BookEntry
-> [BookEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (BookEntry -> Bool) -> Vector BookEntry -> Vector BookEntry
forall a. Storable a => (a -> Bool) -> Vector a -> Vector a
VS.takeWhile ((Word64
hash Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==) (Word64 -> Bool) -> (BookEntry -> Word64) -> BookEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BookEntry -> Word64
key) (Vector BookEntry -> Vector BookEntry)
-> (Vector BookEntry -> Vector BookEntry)
-> Vector BookEntry
-> Vector BookEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Vector BookEntry -> Vector BookEntry
forall a. Storable a => Int -> Vector a -> Vector a
VS.unsafeDrop (Word64 -> Int
lowerBound Word64
hash) (Vector BookEntry -> [BookEntry])
-> Vector BookEntry -> [BookEntry]
forall a b. (a -> b) -> a -> b
$ Vector BookEntry
v
 where
  conv :: BookEntry -> BookEntry
conv be :: BookEntry
be@BookEntry{Ply
ply :: Ply
ply :: BookEntry -> Ply
ply} = BookEntry
be { ply :: Ply
ply = Position -> Ply -> Ply
fromPolyglot Position
pos Ply
ply }
  hash :: Word64
hash = Position -> Word64
hashPosition Position
pos
  lowerBound :: Word64 -> Int
lowerBound = (Int -> Word64) -> (Int, Int) -> Word64 -> Int
forall a b. (Integral a, Ord b) => (a -> b) -> (a, a) -> b -> a
bsearch (BookEntry -> Word64
key (BookEntry -> Word64) -> (Int -> BookEntry) -> Int -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector BookEntry -> Int -> BookEntry
forall a. Storable a => Vector a -> Int -> a
VS.unsafeIndex Vector BookEntry
v) (Int
0, Vector BookEntry -> Int
forall a. Storable a => Vector a -> Int
VS.length Vector BookEntry
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  bsearch :: (Integral a, Ord b) => (a -> b) -> (a, a) -> b -> a
  bsearch :: (a -> b) -> (a, a) -> b -> a
bsearch a -> b
f (a
lo, a
hi) b
x
    | a
lo a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
hi   = a
lo
    | b
x b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> b
f a
mid = (a -> b) -> (a, a) -> b -> a
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  = (a -> b) -> (a, a) -> b -> a
forall a b. (Integral a, Ord b) => (a -> b) -> (a, a) -> b -> a
bsearch a -> b
f (a
mid a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, a
hi) b
x
   where mid :: a
mid = a
lo a -> a -> a
forall a. Num a => a -> a -> a
+ ((a
hi a -> a -> a
forall a. Num a => a -> a -> a
- a
lo) a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2)