{-
	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
--	NInstancesByNPliesByKeyByLogicalColour,
	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.Property.Empty			as Property.Empty
import qualified	BishBosh.Search.EphemeralData		as Search.EphemeralData
import qualified	BishBosh.Type.Count			as Type.Count
import qualified	Data.Array.IArray
import qualified	Data.Foldable
import qualified	Data.IntMap.Strict
import qualified	Data.List
import qualified	Data.Map
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 number of plies into the game, at which it occurred,
	a key containing the killer-move,
	& the logical colour of the player making the move.
-}
type NInstancesByNPliesByKeyByLogicalColour killerMoveKey	= Attribute.LogicalColour.ArrayByLogicalColour (
	Data.Map.Map killerMoveKey (
		Data.IntMap.Strict.IntMap Type.Count.NPlies {-NInstances-}	-- CAVEAT: 'Int' is used to represent the number of plies into the game (in order to utilise 'IntMap') though it ought to be NPlies also.
	)
 )

-- | Data which can be used to advance the evaluation of identical sibling moves, in the hope of achieving beta-cutoff sooner.
newtype KillerMoves killerMoveKey	= MkKillerMoves {
	KillerMoves killerMoveKey
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
deconstruct	:: NInstancesByNPliesByKeyByLogicalColour killerMoveKey
}

instance Property.Empty.Empty (KillerMoves killerMoveKey) where
	empty :: KillerMoves killerMoveKey
empty	= NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> KillerMoves killerMoveKey
forall killerMoveKey.
NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> KillerMoves killerMoveKey
MkKillerMoves (NInstancesByNPliesByKeyByLogicalColour killerMoveKey
 -> KillerMoves killerMoveKey)
-> ([Map killerMoveKey (IntMap NPlies)]
    -> NInstancesByNPliesByKeyByLogicalColour killerMoveKey)
-> [Map killerMoveKey (IntMap NPlies)]
-> KillerMoves killerMoveKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Map killerMoveKey (IntMap NPlies)]
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Attribute.LogicalColour.listArrayByLogicalColour ([Map killerMoveKey (IntMap NPlies)] -> KillerMoves killerMoveKey)
-> [Map killerMoveKey (IntMap NPlies)] -> KillerMoves killerMoveKey
forall a b. (a -> b) -> a -> b
$ Map killerMoveKey (IntMap NPlies)
-> [Map killerMoveKey (IntMap NPlies)]
forall a. a -> [a]
repeat Map killerMoveKey (IntMap NPlies)
forall a. Empty a => a
Property.Empty.empty

instance Search.EphemeralData.EphemeralData (KillerMoves killerMoveKey) where
	getSize :: KillerMoves killerMoveKey -> NPlies
getSize MkKillerMoves { deconstruct :: forall killerMoveKey.
KillerMoves killerMoveKey
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
deconstruct = NInstancesByNPliesByKeyByLogicalColour killerMoveKey
nInstancesByNPliesByKeyByLogicalColour }	= NPlies -> NPlies
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPlies -> NPlies) -> NPlies -> NPlies
forall a b. (a -> b) -> a -> b
$ (NPlies -> Map killerMoveKey (IntMap NPlies) -> NPlies)
-> NPlies
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> NPlies
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' (
		(NPlies -> IntMap NPlies -> NPlies)
-> NPlies -> Map killerMoveKey (IntMap NPlies) -> NPlies
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Data.Map.foldl' ((NPlies -> IntMap NPlies -> NPlies)
 -> NPlies -> Map killerMoveKey (IntMap NPlies) -> NPlies)
-> (NPlies -> IntMap NPlies -> NPlies)
-> NPlies
-> Map killerMoveKey (IntMap NPlies)
-> NPlies
forall a b. (a -> b) -> a -> b
$ (NPlies -> NPlies -> NPlies) -> NPlies -> IntMap NPlies -> NPlies
forall a b. (a -> b -> a) -> a -> IntMap b -> a
Data.IntMap.Strict.foldl' NPlies -> NPlies -> NPlies
forall a. Num a => a -> a -> a
(+)
	 ) NPlies
0 NInstancesByNPliesByKeyByLogicalColour killerMoveKey
nInstancesByNPliesByKeyByLogicalColour

	euthanise :: NPlies -> KillerMoves killerMoveKey -> KillerMoves killerMoveKey
euthanise NPlies
nPlies killerMoves :: KillerMoves killerMoveKey
killerMoves@MkKillerMoves { deconstruct :: forall killerMoveKey.
KillerMoves killerMoveKey
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
deconstruct = NInstancesByNPliesByKeyByLogicalColour killerMoveKey
nInstancesByNPliesByKeyByLogicalColour }
		| NPlies
nPlies NPlies -> NPlies -> Bool
forall a. Ord a => a -> a -> Bool
<= NPlies
0	= KillerMoves killerMoveKey
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	= NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> KillerMoves killerMoveKey
forall killerMoveKey.
NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> KillerMoves killerMoveKey
MkKillerMoves (NInstancesByNPliesByKeyByLogicalColour killerMoveKey
 -> KillerMoves killerMoveKey)
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> KillerMoves killerMoveKey
forall a b. (a -> b) -> a -> b
$ (Map killerMoveKey (IntMap NPlies)
 -> Map killerMoveKey (IntMap NPlies))
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
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 NPlies -> Maybe (IntMap NPlies))
-> Map killerMoveKey (IntMap NPlies)
-> Map killerMoveKey (IntMap NPlies)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Data.Map.mapMaybe ((IntMap NPlies -> Maybe (IntMap NPlies))
 -> Map killerMoveKey (IntMap NPlies)
 -> Map killerMoveKey (IntMap NPlies))
-> (IntMap NPlies -> Maybe (IntMap NPlies))
-> Map killerMoveKey (IntMap NPlies)
-> Map killerMoveKey (IntMap NPlies)
forall a b. (a -> b) -> a -> b
$ \IntMap NPlies
m -> let
				m' :: IntMap NPlies
m'	= (NPlies -> NPlies -> Bool) -> IntMap NPlies -> IntMap NPlies
forall a. (NPlies -> a -> Bool) -> IntMap a -> IntMap a
Data.IntMap.Strict.filterWithKey (\NPlies
nPlies' NPlies
_ -> NPlies
nPlies' NPlies -> NPlies -> Bool
forall a. Ord a => a -> a -> Bool
> NPlies -> NPlies
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPlies
nPlies) IntMap NPlies
m
			in if IntMap NPlies -> Bool
forall a. IntMap a -> Bool
Data.IntMap.Strict.null IntMap NPlies
m'
				then Maybe (IntMap NPlies)
forall a. Maybe a
Nothing
				else IntMap NPlies -> Maybe (IntMap NPlies)
forall a. a -> Maybe a
Just IntMap NPlies
m'
		) NInstancesByNPliesByKeyByLogicalColour killerMoveKey
nInstancesByNPliesByKeyByLogicalColour

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

-- | Insert a killer-move.
insert
	:: Ord killerMoveKey
	=> Type.Count.NPlies	-- ^ The total number of plies applied to the game.
	-> killerMoveKey
	-> Transformation killerMoveKey
insert :: NPlies -> killerMoveKey -> Transformation killerMoveKey
insert NPlies
nPlies killerMoveKey
killerMoveKey MkKillerMoves { deconstruct :: forall killerMoveKey.
KillerMoves killerMoveKey
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
deconstruct = NInstancesByNPliesByKeyByLogicalColour killerMoveKey
nInstancesByNPliesByKeyByLogicalColour }	= NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> KillerMoves killerMoveKey
forall killerMoveKey.
NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> KillerMoves killerMoveKey
MkKillerMoves (NInstancesByNPliesByKeyByLogicalColour killerMoveKey
 -> KillerMoves killerMoveKey)
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> KillerMoves killerMoveKey
forall a b. (a -> b) -> a -> b
$ NInstancesByNPliesByKeyByLogicalColour killerMoveKey
nInstancesByNPliesByKeyByLogicalColour NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> [(LogicalColour, Map killerMoveKey (IntMap NPlies))]
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
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 killerMoveKey (IntMap NPlies))
-> LogicalColour
-> (LogicalColour, Map killerMoveKey (IntMap NPlies))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (IntMap NPlies -> IntMap NPlies -> IntMap NPlies)
-> killerMoveKey
-> IntMap NPlies
-> Map killerMoveKey (IntMap NPlies)
-> Map killerMoveKey (IntMap NPlies)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Data.Map.insertWith (
		(NPlies -> NPlies -> NPlies)
-> IntMap NPlies -> IntMap NPlies -> IntMap NPlies
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
Data.IntMap.Strict.unionWith NPlies -> NPlies -> NPlies
forall a. Num a => a -> a -> a
(+)
	) killerMoveKey
killerMoveKey (
		NPlies -> NPlies -> IntMap NPlies
forall a. NPlies -> a -> IntMap a
Data.IntMap.Strict.singleton (NPlies -> NPlies
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPlies
nPlies) NPlies
1
	) (Map killerMoveKey (IntMap NPlies)
 -> Map killerMoveKey (IntMap NPlies))
-> (LogicalColour -> Map killerMoveKey (IntMap NPlies))
-> LogicalColour
-> Map killerMoveKey (IntMap NPlies)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
		NInstancesByNPliesByKeyByLogicalColour killerMoveKey
nInstancesByNPliesByKeyByLogicalColour NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> LogicalColour -> Map killerMoveKey (IntMap NPlies)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!
	) (LogicalColour
 -> (LogicalColour, Map killerMoveKey (IntMap NPlies)))
-> LogicalColour
-> (LogicalColour, Map killerMoveKey (IntMap NPlies))
forall a b. (a -> b) -> a -> b
$ if NPlies -> Bool
forall a. Integral a => a -> Bool
even NPlies
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 killerMoveKey
	=> Attribute.LogicalColour.LogicalColour
	-> (a -> killerMoveKey)	-- ^ Key-constructor.
	-> KillerMoves killerMoveKey
	-> [a]
	-> [a]
{-# INLINABLE sortByHistoryHeuristic #-}
sortByHistoryHeuristic :: LogicalColour
-> (a -> killerMoveKey) -> KillerMoves killerMoveKey -> [a] -> [a]
sortByHistoryHeuristic LogicalColour
logicalColour a -> killerMoveKey
killerMoveKeyConstructor MkKillerMoves { deconstruct :: forall killerMoveKey.
KillerMoves killerMoveKey
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
deconstruct = NInstancesByNPliesByKeyByLogicalColour killerMoveKey
nInstancesByNPliesByKeyByLogicalColour }	= (a -> NPlies) -> [a] -> [a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn ((a -> NPlies) -> [a] -> [a]) -> (a -> NPlies) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ NPlies
-> (IntMap NPlies -> NPlies) -> Maybe (IntMap NPlies) -> NPlies
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe NPlies
0 (
	NPlies -> NPlies
forall a. Num a => a -> a
negate {-largest first-} (NPlies -> NPlies)
-> (IntMap NPlies -> NPlies) -> IntMap NPlies -> NPlies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NPlies -> NPlies -> NPlies) -> NPlies -> IntMap NPlies -> NPlies
forall a b. (a -> b -> a) -> a -> IntMap b -> a
Data.IntMap.Strict.foldl' NPlies -> NPlies -> NPlies
forall a. Num a => a -> a -> a
(+) NPlies
0
 ) (Maybe (IntMap NPlies) -> NPlies)
-> (a -> Maybe (IntMap NPlies)) -> a -> NPlies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	killerMoveKey
-> Map killerMoveKey (IntMap NPlies) -> Maybe (IntMap NPlies)
forall k a. Ord k => k -> Map k a -> Maybe a
`Data.Map.lookup` (NInstancesByNPliesByKeyByLogicalColour killerMoveKey
nInstancesByNPliesByKeyByLogicalColour NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> LogicalColour -> Map killerMoveKey (IntMap NPlies)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour)
 ) (killerMoveKey -> Maybe (IntMap NPlies))
-> (a -> killerMoveKey) -> a -> Maybe (IntMap NPlies)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> killerMoveKey
killerMoveKeyConstructor