module BishBosh.Search.KillerMoves (
Transformation,
KillerMoves(),
sortByHistoryHeuristic,
insert
) where
import Control.Arrow((&&&))
import Data.Array.IArray((!), (//))
import qualified BishBosh.Attribute.LogicalColour as Attribute.LogicalColour
import qualified BishBosh.Component.Move as Component.Move
import qualified BishBosh.Property.Empty as Property.Empty
import qualified BishBosh.Search.EphemeralData as Search.EphemeralData
import qualified Data.Array.IArray
import qualified Data.Foldable
import qualified Data.IntMap
import qualified Data.List
import qualified Data.Map
import qualified Data.Map.Strict
import qualified Data.Maybe
newtype KillerMoves killerMove = MkKillerMoves {
deconstruct :: Attribute.LogicalColour.ByLogicalColour (
Data.Map.Map killerMove (
Data.IntMap.IntMap Component.Move.NMoves
)
)
}
instance Property.Empty.Empty (KillerMoves killerMove) where
empty = MkKillerMoves . Attribute.LogicalColour.listArrayByLogicalColour $ repeat Data.Map.empty
instance Search.EphemeralData.EphemeralData (KillerMoves killerMove) where
getSize MkKillerMoves { deconstruct = nInstancesByKeyByNPliesByLogicalColour } = Data.Foldable.foldl' (
Data.Map.foldl' $ Data.IntMap.foldl' (+)
) 0 nInstancesByKeyByNPliesByLogicalColour
euthanise nPlies killerMoves@MkKillerMoves { deconstruct = nInstancesByKeyByNPliesByLogicalColour }
| nPlies <= 0 = killerMoves
| otherwise = MkKillerMoves $ Data.Array.IArray.amap (
Data.Map.mapMaybe $ \m -> let
m' = Data.IntMap.filterWithKey (\nPlies' _ -> nPlies' > nPlies) m
in if Data.IntMap.null m'
then Nothing
else Just m'
) nInstancesByKeyByNPliesByLogicalColour
type Transformation killerMove = KillerMoves killerMove -> KillerMoves killerMove
insert
:: Ord killerMove
=> Component.Move.NPlies
-> killerMove
-> Transformation killerMove
insert nPlies killerMove MkKillerMoves { deconstruct = nInstancesByKeyByNPliesByLogicalColour } = MkKillerMoves $ nInstancesByKeyByNPliesByLogicalColour // [
id &&& Data.Map.Strict.insertWith (
Data.IntMap.unionWith (+)
) killerMove (
Data.IntMap.singleton nPlies 1
) . (nInstancesByKeyByNPliesByLogicalColour !) $ if even nPlies
then Attribute.LogicalColour.Black
else Attribute.LogicalColour.White
]
sortByHistoryHeuristic
:: Ord killerMove
=> Attribute.LogicalColour.LogicalColour
-> (a -> killerMove)
-> KillerMoves killerMove
-> [a]
-> [a]
sortByHistoryHeuristic logicalColour killerMoveConstructor MkKillerMoves { deconstruct = nInstancesByNPliesByKeyByLogicalColour } = Data.List.sortOn $ Data.Maybe.maybe 0 (
negate . Data.IntMap.foldl' (+) 0
) . (
`Data.Map.lookup` (nInstancesByNPliesByKeyByLogicalColour ! logicalColour)
) . killerMoveConstructor