module BishBosh.Model.MoveFrequency(
GetRankAndMove,
MoveFrequency(),
countEntries,
insertMoves,
sortByDescendingMoveFrequency
) where
import Data.Array.IArray((!), (//))
import qualified BishBosh.Attribute.LogicalColour as Attribute.LogicalColour
import qualified BishBosh.Attribute.Rank as Attribute.Rank
import qualified BishBosh.Component.Move as Component.Move
import qualified BishBosh.Property.Empty as Property.Empty
import qualified BishBosh.Property.Null as Property.Null
import qualified Data.Foldable
import qualified Data.List
import qualified Data.List.Extra
import qualified Data.Map
import qualified Data.Ord
type InstancesByMoveByRankByLogicalColour move = Attribute.LogicalColour.ByLogicalColour (Attribute.Rank.ByRank (Data.Map.Map move Component.Move.NMoves))
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 NMoves] -> InstancesByMoveByRankByLogicalColour move)
-> [Map move NMoves]
-> MoveFrequency move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Array Rank (Map move NMoves)]
-> InstancesByMoveByRankByLogicalColour move
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Attribute.LogicalColour.listArrayByLogicalColour ([Array Rank (Map move NMoves)]
-> InstancesByMoveByRankByLogicalColour move)
-> ([Map move NMoves] -> [Array Rank (Map move NMoves)])
-> [Map move NMoves]
-> InstancesByMoveByRankByLogicalColour move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Rank (Map move NMoves) -> [Array Rank (Map move NMoves)]
forall a. a -> [a]
repeat (Array Rank (Map move NMoves) -> [Array Rank (Map move NMoves)])
-> ([Map move NMoves] -> Array Rank (Map move NMoves))
-> [Map move NMoves]
-> [Array Rank (Map move NMoves)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Map move NMoves] -> Array Rank (Map move NMoves)
forall (a :: * -> * -> *) e. IArray a e => [e] -> a Rank e
Attribute.Rank.listArrayByRank ([Map move NMoves] -> MoveFrequency move)
-> [Map move NMoves] -> MoveFrequency move
forall a b. (a -> b) -> a -> b
$ Map move NMoves -> [Map move NMoves]
forall a. a -> [a]
repeat Map move NMoves
forall k a. Map k a
Data.Map.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 NMoves) -> Bool)
-> InstancesByMoveByRankByLogicalColour move -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.Foldable.all ((Map move NMoves -> Bool) -> Array Rank (Map move NMoves) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.Foldable.all Map move NMoves -> Bool
forall k a. Map k a -> Bool
Data.Map.null) InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour
countEntries :: MoveFrequency move -> Component.Move.NMoves
countEntries :: MoveFrequency move -> NMoves
countEntries MkMoveFrequency { deconstruct :: forall move.
MoveFrequency move -> InstancesByMoveByRankByLogicalColour move
deconstruct = InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour } = (NMoves -> Array Rank (Map move NMoves) -> NMoves)
-> NMoves -> InstancesByMoveByRankByLogicalColour move -> NMoves
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' (
(NMoves -> Map move NMoves -> NMoves)
-> NMoves -> Array Rank (Map move NMoves) -> NMoves
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' ((NMoves -> Map move NMoves -> NMoves)
-> NMoves -> Array Rank (Map move NMoves) -> NMoves)
-> (NMoves -> Map move NMoves -> NMoves)
-> NMoves
-> Array Rank (Map move NMoves)
-> NMoves
forall a b. (a -> b) -> a -> b
$ \NMoves
acc -> (NMoves
acc NMoves -> NMoves -> NMoves
forall a. Num a => a -> a -> a
+) (NMoves -> NMoves)
-> (Map move NMoves -> NMoves) -> Map move NMoves -> NMoves
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map move NMoves -> NMoves
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Data.Foldable.sum
) NMoves
0 InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour
countDistinctEntries :: MoveFrequency move -> Component.Move.NMoves
countDistinctEntries :: MoveFrequency move -> NMoves
countDistinctEntries MkMoveFrequency { deconstruct :: forall move.
MoveFrequency move -> InstancesByMoveByRankByLogicalColour move
deconstruct = InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour } = (NMoves -> Array Rank (Map move NMoves) -> NMoves)
-> NMoves -> InstancesByMoveByRankByLogicalColour move -> NMoves
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' (
(NMoves -> Map move NMoves -> NMoves)
-> NMoves -> Array Rank (Map move NMoves) -> NMoves
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' ((NMoves -> Map move NMoves -> NMoves)
-> NMoves -> Array Rank (Map move NMoves) -> NMoves)
-> (NMoves -> Map move NMoves -> NMoves)
-> NMoves
-> Array Rank (Map move NMoves)
-> NMoves
forall a b. (a -> b) -> a -> b
$ \NMoves
acc -> (NMoves
acc NMoves -> NMoves -> NMoves
forall a. Num a => a -> a -> a
+) (NMoves -> NMoves)
-> (Map move NMoves -> NMoves) -> Map move NMoves -> NMoves
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map move NMoves -> NMoves
forall k a. Map k a -> NMoves
Data.Map.size
) NMoves
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 } [a]
l = InstancesByMoveByRankByLogicalColour move -> MoveFrequency move
forall move.
InstancesByMoveByRankByLogicalColour move -> MoveFrequency move
MkMoveFrequency (InstancesByMoveByRankByLogicalColour move -> MoveFrequency move)
-> InstancesByMoveByRankByLogicalColour move -> MoveFrequency move
forall a b. (a -> b) -> a -> b
$ case [a]
l of
[] -> InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour
[a
datum] -> let
(Rank
rank, move
move) = GetRankAndMove a move
getRankAndMove a
datum
instancesByMove :: Map move NMoves
instancesByMove = ByRank (Map move NMoves)
instancesByMoveByRank ByRank (Map move NMoves) -> Rank -> Map move NMoves
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
rank
in InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour InstancesByMoveByRankByLogicalColour move
-> [(LogicalColour, ByRank (Map move NMoves))]
-> InstancesByMoveByRankByLogicalColour move
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// [
(
LogicalColour
logicalColour,
ByRank (Map move NMoves)
instancesByMoveByRank ByRank (Map move NMoves)
-> [(Rank, Map move NMoves)] -> ByRank (Map move NMoves)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// [
(
Rank
rank,
(NMoves -> NMoves -> NMoves)
-> move -> NMoves -> Map move NMoves -> Map move NMoves
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Data.Map.insertWith NMoves -> NMoves -> NMoves
forall a. Num a => a -> a -> a
(+) move
move NMoves
1 Map move NMoves
instancesByMove
)
]
)
]
[a]
_ -> InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour InstancesByMoveByRankByLogicalColour move
-> [(LogicalColour, ByRank (Map move NMoves))]
-> InstancesByMoveByRankByLogicalColour move
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// [
(
LogicalColour
logicalColour,
ByRank (Map move NMoves)
instancesByMoveByRank ByRank (Map move NMoves)
-> [(Rank, Map move NMoves)] -> ByRank (Map move NMoves)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// [
(
Rank
rank,
((Rank, move) -> Map move NMoves -> Map move NMoves)
-> Map move NMoves -> [(Rank, move)] -> Map move NMoves
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (
\(Rank
_, move
move) -> (NMoves -> NMoves -> NMoves)
-> move -> NMoves -> Map move NMoves -> Map move NMoves
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Data.Map.insertWith NMoves -> NMoves -> NMoves
forall a. Num a => a -> a -> a
(+) move
move NMoves
1
) (
ByRank (Map move NMoves)
instancesByMoveByRank ByRank (Map move NMoves) -> Rank -> Map move NMoves
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 :: ByRank (Map move NMoves)
instancesByMoveByRank = InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour InstancesByMoveByRankByLogicalColour move
-> LogicalColour -> ByRank (Map move NMoves)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour
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 -> 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 -> NMoves
forall a. Num a => a -> a
negate (NMoves -> NMoves) -> (a -> NMoves) -> a -> NMoves
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
\(Rank
rank, move
move) -> NMoves -> move -> Map move NMoves -> NMoves
forall k a. Ord k => a -> k -> Map k a -> a
Data.Map.findWithDefault NMoves
0 move
move (Map move NMoves -> NMoves) -> Map move NMoves -> NMoves
forall a b. (a -> b) -> a -> b
$ InstancesByMoveByRankByLogicalColour move
instancesByMoveByRankByLogicalColour InstancesByMoveByRankByLogicalColour move
-> LogicalColour -> ByRank (Map move NMoves)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour ByRank (Map move NMoves) -> Rank -> Map move NMoves
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
rank
) ((Rank, move) -> NMoves) -> GetRankAndMove a move -> a -> NMoves
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetRankAndMove a move
getRankAndMove