{-
	Copyright (C) 2018 Dr. Alistair Ward

	This file is part of BishBosh.

	BishBosh is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	BishBosh is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]

	* <https://www.chessprogramming.org/Transposition_Table>.

	* <https://en.wikipedia.org/wiki/Transposition_table>.

	* Valid qualifiedMove-sequences can be recorded against the hash of the position from which they start.
-}

module BishBosh.Search.Transpositions (
-- * Types
-- ** Type-synonyms
	Transformation,
-- ** Data-types
	Transpositions(),
-- * Functions
	find,
-- ** Mutators
	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.Map
import qualified	Data.Maybe

-- | Stores the result of an alpha-beta search from a /position/.
newtype Transpositions qualifiedMove positionHash	= MkTranspositions {
	Transpositions qualifiedMove positionHash
-> Map positionHash (TranspositionValue qualifiedMove)
deconstruct	:: Data.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 k a. Map k a -> NPlies
Data.Map.size 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
Data.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

-- | Returns any value previously recorded when searching from the specified /position/.
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
Data.Map.lookup positionHash
positionHash Map positionHash (TranspositionValue qualifiedMove)
byPositionHash

-- | The type of a function which transforms 'Transpositions'.
type Transformation qualifiedMove positionHash	= Transpositions qualifiedMove positionHash -> Transpositions qualifiedMove positionHash

{- |
	* Optionally record a value found while searching for the optimal move from a position, against the position's hash.

	* If a matching key already exists, it's replaced if the new value is considered to be better.
-}
insert
	:: Ord positionHash
	=> Search.TranspositionValue.FindFitness qualifiedMove
	-> positionHash							-- ^ Represents the game from which the sequence of qualifiedMoves starts.
	-> Search.TranspositionValue.TranspositionValue qualifiedMove	-- ^ The value to record.
	-> 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
Data.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) {-there's no incumbent-} ((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	-- Upgrade.
		else Maybe (TranspositionValue qualifiedMove)
forall a. Maybe a
Nothing	-- Leave incumbent.
 ) positionHash
positionHash Map positionHash (TranspositionValue qualifiedMove)
byPositionHash