{-
	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@]

-}

module BishBosh.Search.DynamicMoveData(
-- * Types
-- ** Type-synonyms
	Transformation,
-- ** Data-types
	KillerMoveKey(),
	DynamicMoveData(
--		MkDynamicMoveData,
		getKillerMoves,
		getTranspositions
	),
-- * Functions
-- ** Constructors
	mkKillerMoveKeyFromTurn,
-- ** Mutators
	updateKillerMoves,
	updateTranspositions,
	euthanise
 ) where

import			Control.Arrow((&&&))
import qualified	BishBosh.Attribute.Rank			as Attribute.Rank
import qualified	BishBosh.Component.Move			as Component.Move
import qualified	BishBosh.Component.QualifiedMove	as Component.QualifiedMove
import qualified	BishBosh.Component.Turn			as Component.Turn
import qualified	BishBosh.Input.SearchOptions		as Input.SearchOptions
import qualified	BishBosh.Property.Empty			as Property.Empty
import qualified	BishBosh.Search.EphemeralData		as Search.EphemeralData
import qualified	BishBosh.Search.KillerMoves		as Search.KillerMoves
import qualified	BishBosh.Search.Transpositions		as Search.Transpositions
import qualified	Data.Maybe

{- |
	* Killer-moves are indexed by both the /move/ & the /rank/ of the piece which made it.

	* CAVEAT: there's still ambiguity in this /key/, since it may match either a different piece of the same /rank/ or have a different /move-type/ (though typically only quiet moves are recorded), in sibling games.
-}
data KillerMoveKey x y	= MkKillerMoveKey (Component.Move.Move x y) Attribute.Rank.Rank deriving (KillerMoveKey x y -> KillerMoveKey x y -> Bool
(KillerMoveKey x y -> KillerMoveKey x y -> Bool)
-> (KillerMoveKey x y -> KillerMoveKey x y -> Bool)
-> Eq (KillerMoveKey x y)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall x y.
(Eq x, Eq y) =>
KillerMoveKey x y -> KillerMoveKey x y -> Bool
/= :: KillerMoveKey x y -> KillerMoveKey x y -> Bool
$c/= :: forall x y.
(Eq x, Eq y) =>
KillerMoveKey x y -> KillerMoveKey x y -> Bool
== :: KillerMoveKey x y -> KillerMoveKey x y -> Bool
$c== :: forall x y.
(Eq x, Eq y) =>
KillerMoveKey x y -> KillerMoveKey x y -> Bool
Eq, Eq (KillerMoveKey x y)
Eq (KillerMoveKey x y)
-> (KillerMoveKey x y -> KillerMoveKey x y -> Ordering)
-> (KillerMoveKey x y -> KillerMoveKey x y -> Bool)
-> (KillerMoveKey x y -> KillerMoveKey x y -> Bool)
-> (KillerMoveKey x y -> KillerMoveKey x y -> Bool)
-> (KillerMoveKey x y -> KillerMoveKey x y -> Bool)
-> (KillerMoveKey x y -> KillerMoveKey x y -> KillerMoveKey x y)
-> (KillerMoveKey x y -> KillerMoveKey x y -> KillerMoveKey x y)
-> Ord (KillerMoveKey x y)
KillerMoveKey x y -> KillerMoveKey x y -> Bool
KillerMoveKey x y -> KillerMoveKey x y -> Ordering
KillerMoveKey x y -> KillerMoveKey x y -> KillerMoveKey x y
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall x y. (Ord x, Ord y) => Eq (KillerMoveKey x y)
forall x y.
(Ord x, Ord y) =>
KillerMoveKey x y -> KillerMoveKey x y -> Bool
forall x y.
(Ord x, Ord y) =>
KillerMoveKey x y -> KillerMoveKey x y -> Ordering
forall x y.
(Ord x, Ord y) =>
KillerMoveKey x y -> KillerMoveKey x y -> KillerMoveKey x y
min :: KillerMoveKey x y -> KillerMoveKey x y -> KillerMoveKey x y
$cmin :: forall x y.
(Ord x, Ord y) =>
KillerMoveKey x y -> KillerMoveKey x y -> KillerMoveKey x y
max :: KillerMoveKey x y -> KillerMoveKey x y -> KillerMoveKey x y
$cmax :: forall x y.
(Ord x, Ord y) =>
KillerMoveKey x y -> KillerMoveKey x y -> KillerMoveKey x y
>= :: KillerMoveKey x y -> KillerMoveKey x y -> Bool
$c>= :: forall x y.
(Ord x, Ord y) =>
KillerMoveKey x y -> KillerMoveKey x y -> Bool
> :: KillerMoveKey x y -> KillerMoveKey x y -> Bool
$c> :: forall x y.
(Ord x, Ord y) =>
KillerMoveKey x y -> KillerMoveKey x y -> Bool
<= :: KillerMoveKey x y -> KillerMoveKey x y -> Bool
$c<= :: forall x y.
(Ord x, Ord y) =>
KillerMoveKey x y -> KillerMoveKey x y -> Bool
< :: KillerMoveKey x y -> KillerMoveKey x y -> Bool
$c< :: forall x y.
(Ord x, Ord y) =>
KillerMoveKey x y -> KillerMoveKey x y -> Bool
compare :: KillerMoveKey x y -> KillerMoveKey x y -> Ordering
$ccompare :: forall x y.
(Ord x, Ord y) =>
KillerMoveKey x y -> KillerMoveKey x y -> Ordering
$cp1Ord :: forall x y. (Ord x, Ord y) => Eq (KillerMoveKey x y)
Ord, Int -> KillerMoveKey x y -> ShowS
[KillerMoveKey x y] -> ShowS
KillerMoveKey x y -> String
(Int -> KillerMoveKey x y -> ShowS)
-> (KillerMoveKey x y -> String)
-> ([KillerMoveKey x y] -> ShowS)
-> Show (KillerMoveKey x y)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall x y. (Show x, Show y) => Int -> KillerMoveKey x y -> ShowS
forall x y. (Show x, Show y) => [KillerMoveKey x y] -> ShowS
forall x y. (Show x, Show y) => KillerMoveKey x y -> String
showList :: [KillerMoveKey x y] -> ShowS
$cshowList :: forall x y. (Show x, Show y) => [KillerMoveKey x y] -> ShowS
show :: KillerMoveKey x y -> String
$cshow :: forall x y. (Show x, Show y) => KillerMoveKey x y -> String
showsPrec :: Int -> KillerMoveKey x y -> ShowS
$cshowsPrec :: forall x y. (Show x, Show y) => Int -> KillerMoveKey x y -> ShowS
Show)

-- | Constructor.
mkKillerMoveKeyFromTurn :: Component.Turn.Turn x y -> KillerMoveKey x y
mkKillerMoveKeyFromTurn :: Turn x y -> KillerMoveKey x y
mkKillerMoveKeyFromTurn	= (Move x y -> Rank -> KillerMoveKey x y)
-> (Move x y, Rank) -> KillerMoveKey x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Move x y -> Rank -> KillerMoveKey x y
forall x y. Move x y -> Rank -> KillerMoveKey x y
MkKillerMoveKey ((Move x y, Rank) -> KillerMoveKey x y)
-> (Turn x y -> (Move x y, Rank)) -> Turn x y -> KillerMoveKey x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Move x y)
-> (Turn x y -> QualifiedMove x y) -> Turn x y -> Move x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove (Turn x y -> Move x y)
-> (Turn x y -> Rank) -> Turn x y -> (Move x y, Rank)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Turn x y -> Rank
forall x y. Turn x y -> Rank
Component.Turn.getRank)

-- | The data on /move/s, gathered while searching.
data DynamicMoveData x y positionHash	= MkDynamicMoveData {
	DynamicMoveData x y positionHash -> KillerMoves (KillerMoveKey x y)
getKillerMoves		:: Search.KillerMoves.KillerMoves (KillerMoveKey x y),
	DynamicMoveData x y positionHash
-> Transpositions (Move x y) positionHash
getTranspositions	:: Search.Transpositions.Transpositions (Component.Move.Move x y) positionHash
}

instance Property.Empty.Empty (DynamicMoveData x y positionHash) where
	empty :: DynamicMoveData x y positionHash
empty = MkDynamicMoveData :: forall x y positionHash.
KillerMoves (KillerMoveKey x y)
-> Transpositions (Move x y) positionHash
-> DynamicMoveData x y positionHash
MkDynamicMoveData {
		getKillerMoves :: KillerMoves (KillerMoveKey x y)
getKillerMoves		= KillerMoves (KillerMoveKey x y)
forall a. Empty a => a
Property.Empty.empty,
		getTranspositions :: Transpositions (Move x y) positionHash
getTranspositions	= Transpositions (Move x y) positionHash
forall a. Empty a => a
Property.Empty.empty
	}

-- | The type of a function which transforms the dynamic move-data.
type Transformation x y positionHash	= DynamicMoveData x y positionHash -> DynamicMoveData x y positionHash

-- | Mutator.
updateKillerMoves :: Search.KillerMoves.Transformation (KillerMoveKey x y) -> Transformation x y positionHash
updateKillerMoves :: Transformation (KillerMoveKey x y)
-> Transformation x y positionHash
updateKillerMoves Transformation (KillerMoveKey x y)
f dynamicMoveData :: DynamicMoveData x y positionHash
dynamicMoveData@MkDynamicMoveData { getKillerMoves :: forall x y positionHash.
DynamicMoveData x y positionHash -> KillerMoves (KillerMoveKey x y)
getKillerMoves = KillerMoves (KillerMoveKey x y)
killerMoves }	= DynamicMoveData x y positionHash
dynamicMoveData { getKillerMoves :: KillerMoves (KillerMoveKey x y)
getKillerMoves = Transformation (KillerMoveKey x y)
f KillerMoves (KillerMoveKey x y)
killerMoves }

-- | Mutator.
updateTranspositions :: Search.Transpositions.Transformation (Component.Move.Move x y) positionHash -> Transformation x y positionHash
updateTranspositions :: Transformation (Move x y) positionHash
-> Transformation x y positionHash
updateTranspositions Transformation (Move x y) positionHash
f dynamicMoveData :: DynamicMoveData x y positionHash
dynamicMoveData@MkDynamicMoveData { getTranspositions :: forall x y positionHash.
DynamicMoveData x y positionHash
-> Transpositions (Move x y) positionHash
getTranspositions = Transpositions (Move x y) positionHash
transpositions }	= DynamicMoveData x y positionHash
dynamicMoveData { getTranspositions :: Transpositions (Move x y) positionHash
getTranspositions = Transformation (Move x y) positionHash
f Transpositions (Move x y) positionHash
transpositions }

-- | Remove archaic data.
euthanise
	:: Component.Move.NPlies			-- ^ The number of plies currently applied to the game.
	-> Input.SearchOptions.MaybeRetireAfterNMoves	-- ^ The number of full moves after which killer-moves should be retired.
	-> Input.SearchOptions.MaybeRetireAfterNMoves	-- ^ The number of full moves after which transpositions should be retired.
	-> Transformation x y positionHash
euthanise :: Int
-> MaybeRetireAfterNMoves
-> MaybeRetireAfterNMoves
-> Transformation x y positionHash
euthanise Int
nPlies MaybeRetireAfterNMoves
maybeRetireKillerMovesAfter MaybeRetireAfterNMoves
maybeRetireTranspositionsAfter MkDynamicMoveData {
	getKillerMoves :: forall x y positionHash.
DynamicMoveData x y positionHash -> KillerMoves (KillerMoveKey x y)
getKillerMoves		= KillerMoves (KillerMoveKey x y)
killerMoves,
	getTranspositions :: forall x y positionHash.
DynamicMoveData x y positionHash
-> Transpositions (Move x y) positionHash
getTranspositions	= Transpositions (Move x y) positionHash
transpositions
} = MkDynamicMoveData :: forall x y positionHash.
KillerMoves (KillerMoveKey x y)
-> Transpositions (Move x y) positionHash
-> DynamicMoveData x y positionHash
MkDynamicMoveData {
	getKillerMoves :: KillerMoves (KillerMoveKey x y)
getKillerMoves	= (KillerMoves (KillerMoveKey x y)
 -> KillerMoves (KillerMoveKey x y))
-> (Int
    -> KillerMoves (KillerMoveKey x y)
    -> KillerMoves (KillerMoveKey x y))
-> MaybeRetireAfterNMoves
-> KillerMoves (KillerMoveKey x y)
-> KillerMoves (KillerMoveKey x y)
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe KillerMoves (KillerMoveKey x y) -> KillerMoves (KillerMoveKey x y)
forall a. a -> a
id (
		Int
-> KillerMoves (KillerMoveKey x y)
-> KillerMoves (KillerMoveKey x y)
forall a. EphemeralData a => Int -> a -> a
Search.EphemeralData.euthanise (Int
 -> KillerMoves (KillerMoveKey x y)
 -> KillerMoves (KillerMoveKey x y))
-> (Int -> Int)
-> Int
-> KillerMoves (KillerMoveKey x y)
-> KillerMoves (KillerMoveKey x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
reduceNPlies	-- When searching for a move at (nPlies + 1), matches with killer-moves from 'iterate (subtract 2) $ pred nPlies' are relevant up to a point. N.B. the opponent's killer-moves are useless.
	) MaybeRetireAfterNMoves
maybeRetireKillerMovesAfter KillerMoves (KillerMoveKey x y)
killerMoves,
	getTranspositions :: Transpositions (Move x y) positionHash
getTranspositions	= (Transpositions (Move x y) positionHash
 -> Transpositions (Move x y) positionHash)
-> (Int
    -> Transpositions (Move x y) positionHash
    -> Transpositions (Move x y) positionHash)
-> MaybeRetireAfterNMoves
-> Transpositions (Move x y) positionHash
-> Transpositions (Move x y) positionHash
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Transpositions (Move x y) positionHash
-> Transpositions (Move x y) positionHash
forall a. a -> a
id (
		Int
-> Transpositions (Move x y) positionHash
-> Transpositions (Move x y) positionHash
forall a. EphemeralData a => Int -> a -> a
Search.EphemeralData.euthanise (Int
 -> Transpositions (Move x y) positionHash
 -> Transpositions (Move x y) positionHash)
-> (Int -> Int)
-> Int
-> Transpositions (Move x y) positionHash
-> Transpositions (Move x y) positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
reduceNPlies
	) MaybeRetireAfterNMoves
maybeRetireTranspositionsAfter Transpositions (Move x y) positionHash
transpositions
} where
	reduceNPlies :: Int -> Int
reduceNPlies	= (Int -> Int -> Int
forall a. Num a => a -> a -> a
`subtract` Int
nPlies) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) {-convert full moves to plies-}