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 {
deconstruct :: InstancesByMoveByRankByLogicalColour move
} deriving Eq
instance Property.Empty.Empty (MoveFrequency move) where
empty = MkMoveFrequency . Attribute.LogicalColour.listArrayByLogicalColour . repeat . Attribute.Rank.listArrayByRank $ repeat Data.Map.empty
instance Property.Null.Null (MoveFrequency move) where
isNull MkMoveFrequency { deconstruct = instancesByMoveByRankByLogicalColour } = Data.Foldable.all (Data.Foldable.all Data.Map.null) instancesByMoveByRankByLogicalColour
countEntries :: MoveFrequency move -> Component.Move.NMoves
countEntries MkMoveFrequency { deconstruct = instancesByMoveByRankByLogicalColour } = Data.Foldable.foldl' (
Data.Foldable.foldl' $ \acc -> (acc +) . Data.Foldable.sum
) 0 instancesByMoveByRankByLogicalColour
countDistinctEntries :: MoveFrequency move -> Component.Move.NMoves
countDistinctEntries MkMoveFrequency { deconstruct = instancesByMoveByRankByLogicalColour } = Data.Foldable.foldl' (
Data.Foldable.foldl' $ \acc -> (acc +) . Data.Map.size
) 0 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 MkMoveFrequency { deconstruct = instancesByMoveByRankByLogicalColour } l = MkMoveFrequency $ case l of
[] -> instancesByMoveByRankByLogicalColour
[datum] -> let
(rank, move) = getRankAndMove datum
instancesByMove = instancesByMoveByRank ! rank
in instancesByMoveByRankByLogicalColour // [
(
logicalColour,
instancesByMoveByRank // [
(
rank,
Data.Map.insertWith (+) move 1 instancesByMove
)
]
)
]
_ -> instancesByMoveByRankByLogicalColour // [
(
logicalColour,
instancesByMoveByRank // [
(
rank,
foldr (
\(_, move) -> Data.Map.insertWith (+) move 1
) (
instancesByMoveByRank ! rank
) assocs
) | assocs@((rank, _) : _) <- Data.List.Extra.groupSortBy (Data.Ord.comparing fst ) $ map getRankAndMove l
]
)
]
where
instancesByMoveByRank = instancesByMoveByRankByLogicalColour ! logicalColour
sortByDescendingMoveFrequency
:: Ord move
=> Attribute.LogicalColour.LogicalColour
-> GetRankAndMove a move
-> MoveFrequency move
-> [a]
-> [a]
{-# INLINE sortByDescendingMoveFrequency #-}
sortByDescendingMoveFrequency logicalColour getRankAndMove MkMoveFrequency { deconstruct = instancesByMoveByRankByLogicalColour } = Data.List.sortOn $ negate . (
\(rank, move) -> Data.Map.findWithDefault 0 move $ instancesByMoveByRankByLogicalColour ! logicalColour ! rank
) . getRankAndMove