module BishBosh.Search.Transpositions (
Transformation,
Transpositions(),
find,
insert
) where
import qualified BishBosh.Property.Empty as Property.Empty
import qualified BishBosh.Search.EphemeralData as Search.EphemeralData
import qualified BishBosh.Search.TranspositionValue as Search.TranspositionValue
import qualified Data.Foldable
import qualified Data.Map as Map
import qualified Data.Maybe
newtype Transpositions qualifiedMove positionHash = MkTranspositions {
Transpositions qualifiedMove positionHash
-> Map positionHash (TranspositionValue qualifiedMove)
deconstruct :: Map.Map positionHash (Search.TranspositionValue.TranspositionValue qualifiedMove)
}
instance Property.Empty.Empty (Transpositions qualifiedMove positionHash) where
empty :: Transpositions qualifiedMove positionHash
empty = Map positionHash (TranspositionValue qualifiedMove)
-> Transpositions qualifiedMove positionHash
forall qualifiedMove positionHash.
Map positionHash (TranspositionValue qualifiedMove)
-> Transpositions qualifiedMove positionHash
MkTranspositions Map positionHash (TranspositionValue qualifiedMove)
forall a. Empty a => a
Property.Empty.empty
instance Search.EphemeralData.EphemeralData (Transpositions qualifiedMove positionHash) where
getSize :: Transpositions qualifiedMove positionHash -> NPlies
getSize MkTranspositions { deconstruct :: forall qualifiedMove positionHash.
Transpositions qualifiedMove positionHash
-> Map positionHash (TranspositionValue qualifiedMove)
deconstruct = Map positionHash (TranspositionValue qualifiedMove)
byPositionHash } = Map positionHash (TranspositionValue qualifiedMove) -> NPlies
forall (t :: * -> *) a. Foldable t => t a -> NPlies
Data.Foldable.length Map positionHash (TranspositionValue qualifiedMove)
byPositionHash
euthanise :: NPlies
-> Transpositions qualifiedMove positionHash
-> Transpositions qualifiedMove positionHash
euthanise NPlies
nPlies MkTranspositions { deconstruct :: forall qualifiedMove positionHash.
Transpositions qualifiedMove positionHash
-> Map positionHash (TranspositionValue qualifiedMove)
deconstruct = Map positionHash (TranspositionValue qualifiedMove)
byPositionHash } = Map positionHash (TranspositionValue qualifiedMove)
-> Transpositions qualifiedMove positionHash
forall qualifiedMove positionHash.
Map positionHash (TranspositionValue qualifiedMove)
-> Transpositions qualifiedMove positionHash
MkTranspositions (Map positionHash (TranspositionValue qualifiedMove)
-> Transpositions qualifiedMove positionHash)
-> Map positionHash (TranspositionValue qualifiedMove)
-> Transpositions qualifiedMove positionHash
forall a b. (a -> b) -> a -> b
$ (TranspositionValue qualifiedMove -> Bool)
-> Map positionHash (TranspositionValue qualifiedMove)
-> Map positionHash (TranspositionValue qualifiedMove)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ((NPlies -> NPlies -> Bool
forall a. Ord a => a -> a -> Bool
> NPlies
nPlies) (NPlies -> Bool)
-> (TranspositionValue qualifiedMove -> NPlies)
-> TranspositionValue qualifiedMove
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TranspositionValue qualifiedMove -> NPlies
forall qualifiedMove. TranspositionValue qualifiedMove -> NPlies
Search.TranspositionValue.getNPlies) Map positionHash (TranspositionValue qualifiedMove)
byPositionHash
find
:: Ord positionHash
=> positionHash
-> Transpositions qualifiedMove positionHash
-> Maybe (Search.TranspositionValue.TranspositionValue qualifiedMove)
find :: positionHash
-> Transpositions qualifiedMove positionHash
-> Maybe (TranspositionValue qualifiedMove)
find positionHash
positionHash MkTranspositions { deconstruct :: forall qualifiedMove positionHash.
Transpositions qualifiedMove positionHash
-> Map positionHash (TranspositionValue qualifiedMove)
deconstruct = Map positionHash (TranspositionValue qualifiedMove)
byPositionHash } = positionHash
-> Map positionHash (TranspositionValue qualifiedMove)
-> Maybe (TranspositionValue qualifiedMove)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup positionHash
positionHash Map positionHash (TranspositionValue qualifiedMove)
byPositionHash
type Transformation qualifiedMove positionHash = Transpositions qualifiedMove positionHash -> Transpositions qualifiedMove positionHash
insert
:: Ord positionHash
=> Search.TranspositionValue.FindFitness qualifiedMove
-> positionHash
-> Search.TranspositionValue.TranspositionValue qualifiedMove
-> Transformation qualifiedMove positionHash
insert :: FindFitness qualifiedMove
-> positionHash
-> TranspositionValue qualifiedMove
-> Transformation qualifiedMove positionHash
insert FindFitness qualifiedMove
findFitness positionHash
positionHash TranspositionValue qualifiedMove
proposedValue MkTranspositions { deconstruct :: forall qualifiedMove positionHash.
Transpositions qualifiedMove positionHash
-> Map positionHash (TranspositionValue qualifiedMove)
deconstruct = Map positionHash (TranspositionValue qualifiedMove)
byPositionHash } = Map positionHash (TranspositionValue qualifiedMove)
-> Transpositions qualifiedMove positionHash
forall qualifiedMove positionHash.
Map positionHash (TranspositionValue qualifiedMove)
-> Transpositions qualifiedMove positionHash
MkTranspositions (Map positionHash (TranspositionValue qualifiedMove)
-> Transpositions qualifiedMove positionHash)
-> Map positionHash (TranspositionValue qualifiedMove)
-> Transpositions qualifiedMove positionHash
forall a b. (a -> b) -> a -> b
$ (Maybe (TranspositionValue qualifiedMove)
-> Maybe (TranspositionValue qualifiedMove))
-> positionHash
-> Map positionHash (TranspositionValue qualifiedMove)
-> Map positionHash (TranspositionValue qualifiedMove)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (
Maybe (TranspositionValue qualifiedMove)
-> (TranspositionValue qualifiedMove
-> Maybe (TranspositionValue qualifiedMove))
-> Maybe (TranspositionValue qualifiedMove)
-> Maybe (TranspositionValue qualifiedMove)
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (TranspositionValue qualifiedMove
-> Maybe (TranspositionValue qualifiedMove)
forall a. a -> Maybe a
Just TranspositionValue qualifiedMove
proposedValue) ((TranspositionValue qualifiedMove
-> Maybe (TranspositionValue qualifiedMove))
-> Maybe (TranspositionValue qualifiedMove)
-> Maybe (TranspositionValue qualifiedMove))
-> (TranspositionValue qualifiedMove
-> Maybe (TranspositionValue qualifiedMove))
-> Maybe (TranspositionValue qualifiedMove)
-> Maybe (TranspositionValue qualifiedMove)
forall a b. (a -> b) -> a -> b
$ \TranspositionValue qualifiedMove
incumbentValue -> if FindFitness qualifiedMove
-> TranspositionValue qualifiedMove
-> TranspositionValue qualifiedMove
-> Bool
forall qualifiedMove.
FindFitness qualifiedMove
-> TranspositionValue qualifiedMove
-> TranspositionValue qualifiedMove
-> Bool
Search.TranspositionValue.isBetter FindFitness qualifiedMove
findFitness TranspositionValue qualifiedMove
proposedValue TranspositionValue qualifiedMove
incumbentValue
then TranspositionValue qualifiedMove
-> Maybe (TranspositionValue qualifiedMove)
forall a. a -> Maybe a
Just TranspositionValue qualifiedMove
proposedValue
else Maybe (TranspositionValue qualifiedMove)
forall a. Maybe a
Nothing
) positionHash
positionHash Map positionHash (TranspositionValue qualifiedMove)
byPositionHash