{-
	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/Killer_Heuristic>.
-}

module BishBosh.Search.KillerMoves (
-- * Types
-- ** Type-synonyms
	Transformation,
-- ** Data-types
	KillerMoves(),
-- * Functions
	sortByHistoryHeuristic,
-- ** Mutators
	insert
 ) where

import			Control.Arrow((&&&))
import			Data.Array.IArray((!), (//))
import qualified	BishBosh.Attribute.LogicalColour	as Attribute.LogicalColour
import qualified	BishBosh.Component.Move			as Component.Move
import qualified	BishBosh.Property.Empty			as Property.Empty
import qualified	BishBosh.Search.EphemeralData		as Search.EphemeralData
import qualified	Data.Array.IArray
import qualified	Data.Foldable
import qualified	Data.IntMap
import qualified	Data.List
import qualified	Data.Map
import qualified	Data.Map.Strict
import qualified	Data.Maybe

{- |
	* Used to contain the number of instances of each killer-move (a quiet move which triggered beta-cutoff),
	indexed by the logical-colour of the player making the move & the number of plies into the game, at which it occurred.

	* These data can be used to advance the evaluation of identical sibling moves, in the hope of achieving beta-cutoff sooner.
-}
newtype KillerMoves killerMove	= MkKillerMoves {
	KillerMoves killerMove
-> ByLogicalColour (Map killerMove (IntMap NMoves))
deconstruct	:: Attribute.LogicalColour.ByLogicalColour (
		Data.Map.Map killerMove (
			Data.IntMap.IntMap {-by NPlies-} Component.Move.NMoves
		)
	)
}

instance Property.Empty.Empty (KillerMoves killerMove) where
	empty :: KillerMoves killerMove
empty	= ByLogicalColour (Map killerMove (IntMap NMoves))
-> KillerMoves killerMove
forall killerMove.
ByLogicalColour (Map killerMove (IntMap NMoves))
-> KillerMoves killerMove
MkKillerMoves (ByLogicalColour (Map killerMove (IntMap NMoves))
 -> KillerMoves killerMove)
-> ([Map killerMove (IntMap NMoves)]
    -> ByLogicalColour (Map killerMove (IntMap NMoves)))
-> [Map killerMove (IntMap NMoves)]
-> KillerMoves killerMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Map killerMove (IntMap NMoves)]
-> ByLogicalColour (Map killerMove (IntMap NMoves))
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Attribute.LogicalColour.listArrayByLogicalColour ([Map killerMove (IntMap NMoves)] -> KillerMoves killerMove)
-> [Map killerMove (IntMap NMoves)] -> KillerMoves killerMove
forall a b. (a -> b) -> a -> b
$ Map killerMove (IntMap NMoves) -> [Map killerMove (IntMap NMoves)]
forall a. a -> [a]
repeat Map killerMove (IntMap NMoves)
forall k a. Map k a
Data.Map.empty

instance Search.EphemeralData.EphemeralData (KillerMoves killerMove) where
	getSize :: KillerMoves killerMove -> NMoves
getSize MkKillerMoves { deconstruct :: forall killerMove.
KillerMoves killerMove
-> ByLogicalColour (Map killerMove (IntMap NMoves))
deconstruct = ByLogicalColour (Map killerMove (IntMap NMoves))
nInstancesByKeyByNPliesByLogicalColour }	= (NMoves -> Map killerMove (IntMap NMoves) -> NMoves)
-> NMoves
-> ByLogicalColour (Map killerMove (IntMap NMoves))
-> NMoves
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' (
		(NMoves -> IntMap NMoves -> NMoves)
-> NMoves -> Map killerMove (IntMap NMoves) -> NMoves
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Data.Map.foldl' ((NMoves -> IntMap NMoves -> NMoves)
 -> NMoves -> Map killerMove (IntMap NMoves) -> NMoves)
-> (NMoves -> IntMap NMoves -> NMoves)
-> NMoves
-> Map killerMove (IntMap NMoves)
-> NMoves
forall a b. (a -> b) -> a -> b
$ (NMoves -> NMoves -> NMoves) -> NMoves -> IntMap NMoves -> NMoves
forall a b. (a -> b -> a) -> a -> IntMap b -> a
Data.IntMap.foldl' NMoves -> NMoves -> NMoves
forall a. Num a => a -> a -> a
(+)
	 ) NMoves
0 ByLogicalColour (Map killerMove (IntMap NMoves))
nInstancesByKeyByNPliesByLogicalColour

	euthanise :: NMoves -> KillerMoves killerMove -> KillerMoves killerMove
euthanise NMoves
nPlies killerMoves :: KillerMoves killerMove
killerMoves@MkKillerMoves { deconstruct :: forall killerMove.
KillerMoves killerMove
-> ByLogicalColour (Map killerMove (IntMap NMoves))
deconstruct = ByLogicalColour (Map killerMove (IntMap NMoves))
nInstancesByKeyByNPliesByLogicalColour }
		| NMoves
nPlies NMoves -> NMoves -> Bool
forall a. Ord a => a -> a -> Bool
<= NMoves
0	= KillerMoves killerMove
killerMoves	-- This might occur at the start of the game, because the caller subtracts a fixed value from the current number of plies.
		| Bool
otherwise	= ByLogicalColour (Map killerMove (IntMap NMoves))
-> KillerMoves killerMove
forall killerMove.
ByLogicalColour (Map killerMove (IntMap NMoves))
-> KillerMoves killerMove
MkKillerMoves (ByLogicalColour (Map killerMove (IntMap NMoves))
 -> KillerMoves killerMove)
-> ByLogicalColour (Map killerMove (IntMap NMoves))
-> KillerMoves killerMove
forall a b. (a -> b) -> a -> b
$ (Map killerMove (IntMap NMoves) -> Map killerMove (IntMap NMoves))
-> ByLogicalColour (Map killerMove (IntMap NMoves))
-> ByLogicalColour (Map killerMove (IntMap NMoves))
forall (a :: * -> * -> *) e' e i.
(IArray a e', IArray a e, Ix i) =>
(e' -> e) -> a i e' -> a i e
Data.Array.IArray.amap (
			(IntMap NMoves -> Maybe (IntMap NMoves))
-> Map killerMove (IntMap NMoves) -> Map killerMove (IntMap NMoves)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Data.Map.mapMaybe ((IntMap NMoves -> Maybe (IntMap NMoves))
 -> Map killerMove (IntMap NMoves)
 -> Map killerMove (IntMap NMoves))
-> (IntMap NMoves -> Maybe (IntMap NMoves))
-> Map killerMove (IntMap NMoves)
-> Map killerMove (IntMap NMoves)
forall a b. (a -> b) -> a -> b
$ \IntMap NMoves
m -> let
				m' :: IntMap NMoves
m'	= (NMoves -> NMoves -> Bool) -> IntMap NMoves -> IntMap NMoves
forall a. (NMoves -> a -> Bool) -> IntMap a -> IntMap a
Data.IntMap.filterWithKey (\NMoves
nPlies' NMoves
_ -> NMoves
nPlies' NMoves -> NMoves -> Bool
forall a. Ord a => a -> a -> Bool
> NMoves
nPlies) IntMap NMoves
m
			in if IntMap NMoves -> Bool
forall a. IntMap a -> Bool
Data.IntMap.null IntMap NMoves
m'
				then Maybe (IntMap NMoves)
forall a. Maybe a
Nothing
				else IntMap NMoves -> Maybe (IntMap NMoves)
forall a. a -> Maybe a
Just IntMap NMoves
m'
		) ByLogicalColour (Map killerMove (IntMap NMoves))
nInstancesByKeyByNPliesByLogicalColour

-- | The type of a function which transforms a collection of killer-moves.
type Transformation killerMove	= KillerMoves killerMove -> KillerMoves killerMove

-- | Insert a killer-move.
insert
	:: Ord killerMove
	=> Component.Move.NPlies	-- ^ The total number of plies applied to the game.
	-> killerMove
	-> Transformation killerMove
insert :: NMoves -> killerMove -> Transformation killerMove
insert NMoves
nPlies killerMove
killerMove MkKillerMoves { deconstruct :: forall killerMove.
KillerMoves killerMove
-> ByLogicalColour (Map killerMove (IntMap NMoves))
deconstruct = ByLogicalColour (Map killerMove (IntMap NMoves))
nInstancesByKeyByNPliesByLogicalColour }	= ByLogicalColour (Map killerMove (IntMap NMoves))
-> KillerMoves killerMove
forall killerMove.
ByLogicalColour (Map killerMove (IntMap NMoves))
-> KillerMoves killerMove
MkKillerMoves (ByLogicalColour (Map killerMove (IntMap NMoves))
 -> KillerMoves killerMove)
-> ByLogicalColour (Map killerMove (IntMap NMoves))
-> KillerMoves killerMove
forall a b. (a -> b) -> a -> b
$ ByLogicalColour (Map killerMove (IntMap NMoves))
nInstancesByKeyByNPliesByLogicalColour ByLogicalColour (Map killerMove (IntMap NMoves))
-> [(LogicalColour, Map killerMove (IntMap NMoves))]
-> ByLogicalColour (Map killerMove (IntMap NMoves))
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// [
	LogicalColour -> LogicalColour
forall a. a -> a
id (LogicalColour -> LogicalColour)
-> (LogicalColour -> Map killerMove (IntMap NMoves))
-> LogicalColour
-> (LogicalColour, Map killerMove (IntMap NMoves))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (IntMap NMoves -> IntMap NMoves -> IntMap NMoves)
-> killerMove
-> IntMap NMoves
-> Map killerMove (IntMap NMoves)
-> Map killerMove (IntMap NMoves)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Data.Map.Strict.insertWith (
		(NMoves -> NMoves -> NMoves)
-> IntMap NMoves -> IntMap NMoves -> IntMap NMoves
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
Data.IntMap.unionWith NMoves -> NMoves -> NMoves
forall a. Num a => a -> a -> a
(+)
	) killerMove
killerMove (
		NMoves -> NMoves -> IntMap NMoves
forall a. NMoves -> a -> IntMap a
Data.IntMap.singleton NMoves
nPlies NMoves
1
	) (Map killerMove (IntMap NMoves) -> Map killerMove (IntMap NMoves))
-> (LogicalColour -> Map killerMove (IntMap NMoves))
-> LogicalColour
-> Map killerMove (IntMap NMoves)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByLogicalColour (Map killerMove (IntMap NMoves))
nInstancesByKeyByNPliesByLogicalColour ByLogicalColour (Map killerMove (IntMap NMoves))
-> LogicalColour -> Map killerMove (IntMap NMoves)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!) (LogicalColour -> (LogicalColour, Map killerMove (IntMap NMoves)))
-> LogicalColour -> (LogicalColour, Map killerMove (IntMap NMoves))
forall a b. (a -> b) -> a -> b
$ if NMoves -> Bool
forall a. Integral a => a -> Bool
even NMoves
nPlies
		then LogicalColour
Attribute.LogicalColour.Black
		else LogicalColour
Attribute.LogicalColour.White	-- White makes the first move.
 ] -- Singleton.

-- | Sorts an arbitrary list using the History-heuristic; <https://www.chessprogramming.org/History_Heuristic>.
sortByHistoryHeuristic
	:: Ord killerMove
	=> Attribute.LogicalColour.LogicalColour
	-> (a -> killerMove)	-- ^ Constructor.
	-> KillerMoves killerMove
	-> [a]
	-> [a]
sortByHistoryHeuristic :: LogicalColour
-> (a -> killerMove) -> KillerMoves killerMove -> [a] -> [a]
sortByHistoryHeuristic LogicalColour
logicalColour a -> killerMove
killerMoveConstructor MkKillerMoves { deconstruct :: forall killerMove.
KillerMoves killerMove
-> ByLogicalColour (Map killerMove (IntMap NMoves))
deconstruct = ByLogicalColour (Map killerMove (IntMap NMoves))
nInstancesByNPliesByKeyByLogicalColour }	= (a -> NMoves) -> [a] -> [a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn ((a -> NMoves) -> [a] -> [a]) -> (a -> NMoves) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ NMoves
-> (IntMap NMoves -> NMoves) -> Maybe (IntMap NMoves) -> NMoves
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe NMoves
0 (
	NMoves -> NMoves
forall a. Num a => a -> a
negate {-largest first-} (NMoves -> NMoves)
-> (IntMap NMoves -> NMoves) -> IntMap NMoves -> NMoves
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NMoves -> NMoves -> NMoves) -> NMoves -> IntMap NMoves -> NMoves
forall a b. (a -> b -> a) -> a -> IntMap b -> a
Data.IntMap.foldl' NMoves -> NMoves -> NMoves
forall a. Num a => a -> a -> a
(+) NMoves
0
 ) (Maybe (IntMap NMoves) -> NMoves)
-> (a -> Maybe (IntMap NMoves)) -> a -> NMoves
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	killerMove
-> Map killerMove (IntMap NMoves) -> Maybe (IntMap NMoves)
forall k a. Ord k => k -> Map k a -> Maybe a
`Data.Map.lookup` (ByLogicalColour (Map killerMove (IntMap NMoves))
nInstancesByNPliesByKeyByLogicalColour ByLogicalColour (Map killerMove (IntMap NMoves))
-> LogicalColour -> Map killerMove (IntMap NMoves)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour)
 ) (killerMove -> Maybe (IntMap NMoves))
-> (a -> killerMove) -> a -> Maybe (IntMap NMoves)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> killerMove
killerMoveConstructor