{-# LANGUAGE LambdaCase #-}
{-
	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@]

	* The instances of various moves, categorised by /logical colour/ & /rank/, are recorded from recorded games.

	* The frequency-distribution can then be used to sort the moves in the current game, to prioritise evaluation of likely candidates.
-}

module BishBosh.Model.MoveFrequency(
-- * Types
-- ** Type-synonyms
--	InstancesByMoveByRankByLogicalColour,
	GetRankAndMove,
-- ** Data-types
	MoveFrequency(),
-- * Functions
	countEntries,
	countDistinctEntries,
	insertMoves,
	sortByDescendingMoveFrequency
) where

import			Control.Arrow((&&&))
import			Data.Array.IArray((!), (//))
import qualified	BishBosh.Attribute.Rank		as Attribute.Rank
import qualified	BishBosh.Colour.LogicalColour	as Colour.LogicalColour
import qualified	BishBosh.Property.Empty		as Property.Empty
import qualified	BishBosh.Property.Null		as Property.Null
import qualified	BishBosh.Type.Count		as Type.Count
import qualified	Data.Foldable
import qualified	Data.List
import qualified	Data.List.Extra
import qualified	Data.Map.Strict			as Map
import qualified	Data.Ord

{- |
	* Records the number of instances, indexed by /move/, by /rank/, by /logical colour/.

	* CAVEAT: the /move-type/ isn't recorded.
-}
type InstancesByMoveByRankByLogicalColour move	= Colour.LogicalColour.ArrayByLogicalColour (
	Attribute.Rank.ArrayByRank (
		Map.Map move Type.Count.NPlies
	)
 )

-- | The number of recorded instances of each move.
newtype MoveFrequency move	= MkMoveFrequency {
	MoveFrequency move -> InstancesByMoveByRankByLogicalColour move
deconstruct	:: InstancesByMoveByRankByLogicalColour move
} deriving MoveFrequency move -> MoveFrequency move -> Bool
(MoveFrequency move -> MoveFrequency move -> Bool)
-> (MoveFrequency move -> MoveFrequency move -> Bool)
-> Eq (MoveFrequency move)
forall move.
Eq move =>
MoveFrequency move -> MoveFrequency move -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MoveFrequency move -> MoveFrequency move -> Bool
$c/= :: forall move.
Eq move =>
MoveFrequency move -> MoveFrequency move -> Bool
== :: MoveFrequency move -> MoveFrequency move -> Bool
$c== :: forall move.
Eq move =>
MoveFrequency move -> MoveFrequency move -> Bool
Eq

instance Property.Empty.Empty (MoveFrequency move) where
	empty :: MoveFrequency move
empty	= InstancesByMoveByRankByLogicalColour move -> MoveFrequency move
forall move.
InstancesByMoveByRankByLogicalColour move -> MoveFrequency move
MkMoveFrequency (InstancesByMoveByRankByLogicalColour move -> MoveFrequency move)
-> ([Map move NPlies] -> InstancesByMoveByRankByLogicalColour move)
-> [Map move NPlies]
-> MoveFrequency move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Array Rank (Map move NPlies)]
-> InstancesByMoveByRankByLogicalColour move
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Colour.LogicalColour.listArrayByLogicalColour ([Array Rank (Map move NPlies)]
 -> InstancesByMoveByRankByLogicalColour move)
-> ([Map move NPlies] -> [Array Rank (Map move NPlies)])
-> [Map move NPlies]
-> InstancesByMoveByRankByLogicalColour move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Rank (Map move NPlies) -> [Array Rank (Map move NPlies)]
forall a. a -> [a]
repeat (Array Rank (Map move NPlies) -> [Array Rank (Map move NPlies)])
-> ([Map move NPlies] -> Array Rank (Map move NPlies))
-> [Map move NPlies]
-> [Array Rank (Map move NPlies)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Map move NPlies] -> Array Rank (Map move NPlies)
forall (a :: * -> * -> *) e. IArray a e => [e] -> a Rank e
Attribute.Rank.listArrayByRank ([Map move NPlies] -> MoveFrequency move)
-> [Map move NPlies] -> MoveFrequency move
forall a b. (a -> b) -> a -> b
$ Map move NPlies -> [Map move NPlies]
forall a. a -> [a]
repeat Map move NPlies
forall a. Empty a => a
Property.Empty.empty

instance Property.Null.Null (MoveFrequency move) where
	isNull :: MoveFrequency move -> Bool
isNull MkMoveFrequency { deconstruct :: forall move.
MoveFrequency move -> InstancesByMoveByRankByLogicalColour move
deconstruct = InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour }	= (Array Rank (Map move NPlies) -> Bool)
-> InstancesByMoveByRankByLogicalColour move -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.Foldable.all ((Map move NPlies -> Bool) -> Array Rank (Map move NPlies) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.Foldable.all Map move NPlies -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Data.Foldable.null) InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour

-- | Count the total number of entries.
countEntries :: MoveFrequency move -> Type.Count.NPlies
countEntries :: MoveFrequency move -> NPlies
countEntries MkMoveFrequency { deconstruct :: forall move.
MoveFrequency move -> InstancesByMoveByRankByLogicalColour move
deconstruct = InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour }	= (NPlies -> Array Rank (Map move NPlies) -> NPlies)
-> NPlies -> InstancesByMoveByRankByLogicalColour move -> NPlies
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' (
	(NPlies -> Map move NPlies -> NPlies)
-> NPlies -> Array Rank (Map move NPlies) -> NPlies
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' ((NPlies -> Map move NPlies -> NPlies)
 -> NPlies -> Array Rank (Map move NPlies) -> NPlies)
-> (NPlies -> Map move NPlies -> NPlies)
-> NPlies
-> Array Rank (Map move NPlies)
-> NPlies
forall a b. (a -> b) -> a -> b
$ \NPlies
acc -> (NPlies
acc NPlies -> NPlies -> NPlies
forall a. Num a => a -> a -> a
+) (NPlies -> NPlies)
-> (Map move NPlies -> NPlies) -> Map move NPlies -> NPlies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map move NPlies -> NPlies
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Data.Foldable.sum
 ) NPlies
0 InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour

{- |
	* Count the total number of distinct entries.

	* N.B.: in this context, a distinct move is one which wasn't made in any other branch of the tree.
	E.g.: many recorded games will start with the same move, which becomes just one node in the game-tree from which this structure is derived, & so will only have a count of one in this structure.
	If this same move is also made subsequently (i.e. after a different opening), then it exists on a different branch of the tree, & increases the move's count to 2 but doesn't increase the number of distinct moves.
-}
countDistinctEntries :: MoveFrequency move -> Type.Count.NPlies
countDistinctEntries :: MoveFrequency move -> NPlies
countDistinctEntries MkMoveFrequency { deconstruct :: forall move.
MoveFrequency move -> InstancesByMoveByRankByLogicalColour move
deconstruct = InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour }	= NPlies -> NPlies
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPlies -> NPlies) -> NPlies -> NPlies
forall a b. (a -> b) -> a -> b
$ (NPlies -> Array Rank (Map move NPlies) -> NPlies)
-> NPlies -> InstancesByMoveByRankByLogicalColour move -> NPlies
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' (
	(NPlies -> Map move NPlies -> NPlies)
-> NPlies -> Array Rank (Map move NPlies) -> NPlies
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' ((NPlies -> Map move NPlies -> NPlies)
 -> NPlies -> Array Rank (Map move NPlies) -> NPlies)
-> (NPlies -> Map move NPlies -> NPlies)
-> NPlies
-> Array Rank (Map move NPlies)
-> NPlies
forall a b. (a -> b) -> a -> b
$ \NPlies
acc -> (NPlies
acc NPlies -> NPlies -> NPlies
forall a. Num a => a -> a -> a
+) (NPlies -> NPlies)
-> (Map move NPlies -> NPlies) -> Map move NPlies -> NPlies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map move NPlies -> NPlies
forall (t :: * -> *) a. Foldable t => t a -> NPlies
Data.Foldable.length
 ) NPlies
0 InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour

-- | The type of a function which can extract the /rank/ & /move/ from a datum.
type GetRankAndMove a move	= a -> (Attribute.Rank.Rank, move)

{- |
	* Inserts a list of data from which /rank/ & /move/ can be extracted, each of which were made by pieces of the same /logical colour/, i.e. by the same player.

	* If the entry already exists, then the count for that /rank/ & /move/, is increased.
-}
insertMoves
	:: Ord move
	=> Colour.LogicalColour.LogicalColour	-- ^ References the player who is required to make any one of the specified moves.
	-> GetRankAndMove a move		-- ^ How to extract the required /rank/ & /move/ from a datum.
	-> MoveFrequency move
	-> [a]					-- ^ The data from each of which, /rank/ & /move/ can be extracted.
	-> MoveFrequency move
insertMoves :: LogicalColour
-> GetRankAndMove a move
-> MoveFrequency move
-> [a]
-> MoveFrequency move
insertMoves LogicalColour
logicalColour GetRankAndMove a move
getRankAndMove MkMoveFrequency { deconstruct :: forall move.
MoveFrequency move -> InstancesByMoveByRankByLogicalColour move
deconstruct = InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour }	= InstancesByMoveByRankByLogicalColour move -> MoveFrequency move
forall move.
InstancesByMoveByRankByLogicalColour move -> MoveFrequency move
MkMoveFrequency (InstancesByMoveByRankByLogicalColour move -> MoveFrequency move)
-> ([a] -> InstancesByMoveByRankByLogicalColour move)
-> [a]
-> MoveFrequency move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour InstancesByMoveByRankByLogicalColour move
-> [(LogicalColour, ArrayByRank (Map move NPlies))]
-> InstancesByMoveByRankByLogicalColour move
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
//
 ) ([(LogicalColour, ArrayByRank (Map move NPlies))]
 -> InstancesByMoveByRankByLogicalColour move)
-> ([a] -> [(LogicalColour, ArrayByRank (Map move NPlies))])
-> [a]
-> InstancesByMoveByRankByLogicalColour move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogicalColour, ArrayByRank (Map move NPlies))
-> [(LogicalColour, ArrayByRank (Map move NPlies))]
forall (m :: * -> *) a. Monad m => a -> m a
return {-to List-monad-} ((LogicalColour, ArrayByRank (Map move NPlies))
 -> [(LogicalColour, ArrayByRank (Map move NPlies))])
-> ([a] -> (LogicalColour, ArrayByRank (Map move NPlies)))
-> [a]
-> [(LogicalColour, ArrayByRank (Map move NPlies))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) LogicalColour
logicalColour (ArrayByRank (Map move NPlies)
 -> (LogicalColour, ArrayByRank (Map move NPlies)))
-> ([a] -> ArrayByRank (Map move NPlies))
-> [a]
-> (LogicalColour, ArrayByRank (Map move NPlies))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	ArrayByRank (Map move NPlies)
instancesByMoveByRank ArrayByRank (Map move NPlies)
-> [(Rank, Map move NPlies)] -> ArrayByRank (Map move NPlies)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
//
 ) ([(Rank, Map move NPlies)] -> ArrayByRank (Map move NPlies))
-> ([a] -> [(Rank, Map move NPlies)])
-> [a]
-> ArrayByRank (Map move NPlies)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
	[a
datum]	-> let
		(Rank
rank, move
move)	= GetRankAndMove a move
getRankAndMove a
datum
	 in [Rank -> Rank
forall a. a -> a
id (Rank -> Rank)
-> (Rank -> Map move NPlies) -> Rank -> (Rank, Map move NPlies)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& move -> Map move NPlies -> Map move NPlies
incrementMoveCount move
move (Map move NPlies -> Map move NPlies)
-> (Rank -> Map move NPlies) -> Rank -> Map move NPlies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ArrayByRank (Map move NPlies)
instancesByMoveByRank ArrayByRank (Map move NPlies) -> Rank -> Map move NPlies
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!) (Rank -> (Rank, Map move NPlies))
-> Rank -> (Rank, Map move NPlies)
forall a b. (a -> b) -> a -> b
$ Rank
rank]	-- Singleton.
	[a]
l	-> [
		(
			Rank
rank,
			((Rank, move) -> Map move NPlies -> Map move NPlies)
-> Map move NPlies -> [(Rank, move)] -> Map move NPlies
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (
				move -> Map move NPlies -> Map move NPlies
incrementMoveCount (move -> Map move NPlies -> Map move NPlies)
-> ((Rank, move) -> move)
-> (Rank, move)
-> Map move NPlies
-> Map move NPlies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rank, move) -> move
forall a b. (a, b) -> b
snd {-move-}
			) (
				ArrayByRank (Map move NPlies)
instancesByMoveByRank ArrayByRank (Map move NPlies) -> Rank -> Map move NPlies
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
rank
			) [(Rank, move)]
assocs
--		) | assocs@((rank, _) : _) <- Data.List.Extra.groupSortOn fst {-rank-} $ map getRankAndMove l	-- CAVEAT: wastes space.
		) | assocs :: [(Rank, move)]
assocs@((Rank
rank, move
_) : [(Rank, move)]
_) <- ((Rank, move) -> (Rank, move) -> Ordering)
-> [(Rank, move)] -> [[(Rank, move)]]
forall a. (a -> a -> Ordering) -> [a] -> [[a]]
Data.List.Extra.groupSortBy (((Rank, move) -> Rank) -> (Rank, move) -> (Rank, move) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Data.Ord.comparing (Rank, move) -> Rank
forall a b. (a, b) -> a
fst {-rank-}) ([(Rank, move)] -> [[(Rank, move)]])
-> [(Rank, move)] -> [[(Rank, move)]]
forall a b. (a -> b) -> a -> b
$ GetRankAndMove a move -> [a] -> [(Rank, move)]
forall a b. (a -> b) -> [a] -> [b]
map GetRankAndMove a move
getRankAndMove [a]
l
	 ] -- List-comprehension.
	where
		instancesByMoveByRank :: ArrayByRank (Map move NPlies)
instancesByMoveByRank	= InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour InstancesByMoveByRankByLogicalColour move
-> LogicalColour -> ArrayByRank (Map move NPlies)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour
		incrementMoveCount :: move -> Map move NPlies -> Map move NPlies
incrementMoveCount	= (move -> NPlies -> Map move NPlies -> Map move NPlies)
-> NPlies -> move -> Map move NPlies -> Map move NPlies
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((NPlies -> NPlies -> NPlies)
-> move -> NPlies -> Map move NPlies -> Map move NPlies
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith NPlies -> NPlies -> NPlies
forall a. Num a => a -> a -> a
(+)) NPlies
1

{- |
	* Sorts an arbitrary list on the recorded frequency of the /rank/ & /move/ accessible from each list-item.

	* The /rank/ & /move/ extracted from each list-item, is assumed to have been made by the player of the specified /logical colour/.
-}
sortByDescendingMoveFrequency
	:: Ord move
	=> Colour.LogicalColour.LogicalColour	-- ^ References the player who is required to make any one of the specified moves.
	-> GetRankAndMove a move		-- ^ How to extract the required /rank/ & /move/ from a datum.
	-> MoveFrequency move
	-> [a]					-- ^ The data from each of which, /rank/ & /move/ can be extracted.
	-> [a]
{-# INLINE sortByDescendingMoveFrequency #-}
sortByDescendingMoveFrequency :: LogicalColour
-> GetRankAndMove a move -> MoveFrequency move -> [a] -> [a]
sortByDescendingMoveFrequency LogicalColour
logicalColour GetRankAndMove a move
getRankAndMove MkMoveFrequency { deconstruct :: forall move.
MoveFrequency move -> InstancesByMoveByRankByLogicalColour move
deconstruct = InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour }	= (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 -> NPlies
forall a. Num a => a -> a
negate {-most frequent first-} (NPlies -> NPlies) -> (a -> NPlies) -> a -> NPlies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	\(Rank
rank, move
move) -> NPlies -> move -> Map move NPlies -> NPlies
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault NPlies
0 move
move (Map move NPlies -> NPlies) -> Map move NPlies -> NPlies
forall a b. (a -> b) -> a -> b
$ InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour InstancesByMoveByRankByLogicalColour move
-> LogicalColour -> ArrayByRank (Map move NPlies)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour ArrayByRank (Map move NPlies) -> Rank -> Map move NPlies
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
rank
 ) ((Rank, move) -> NPlies) -> GetRankAndMove a move -> a -> NPlies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetRankAndMove a move
getRankAndMove