{-# LANGUAGE LambdaCase #-}
module BishBosh.Model.MoveFrequency(
GetRankAndMove,
MoveFrequency(),
countEntries,
insertMoves,
sortByDescendingMoveFrequency
) where
import Control.Arrow((&&&))
import Data.Array.IArray((!), (//))
import qualified BishBosh.Attribute.LogicalColour as Attribute.LogicalColour
import qualified BishBosh.Attribute.Rank as Attribute.Rank
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
import qualified Data.Ord
type InstancesByMoveByRankByLogicalColour move = Attribute.LogicalColour.ArrayByLogicalColour (
Attribute.Rank.ArrayByRank (
Data.Map.Strict.Map move Type.Count.NPlies
)
)
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
Attribute.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 k a. Map k a -> Bool
Data.Map.Strict.null) InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour
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
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 k a. Map k a -> NPlies
Data.Map.Strict.size
) NPlies
0 InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour
type GetRankAndMove a move = a -> (Attribute.Rank.Rank, move)
insertMoves
:: Ord move
=> Attribute.LogicalColour.LogicalColour
-> GetRankAndMove a move
-> MoveFrequency move
-> [a]
-> 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 ((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]
[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
) (
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, 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, 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
]
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
Data.Map.Strict.insertWith NPlies -> NPlies -> NPlies
forall a. Num a => a -> a -> a
(+)) NPlies
1
sortByDescendingMoveFrequency
:: Ord move
=> Attribute.LogicalColour.LogicalColour
-> GetRankAndMove a move
-> MoveFrequency move
-> [a]
-> [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 (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
Data.Map.Strict.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