module BishBosh.Search.KillerMoves (
Transformation,
KillerMoves(),
sortByHistoryHeuristic,
insert
) where
import Control.Arrow((&&&))
import Data.Array.IArray((!), (//))
import qualified BishBosh.Colour.LogicalColour as Colour.LogicalColour
import qualified BishBosh.Property.Empty as Property.Empty
import qualified BishBosh.Search.EphemeralData as Search.EphemeralData
import qualified BishBosh.Type.Count as Type.Count
import qualified Data.Array.IArray
import qualified Data.Foldable
import qualified Data.IntMap.Strict as IntMap
import qualified Data.List
import qualified Data.Map as Map
import qualified Data.Maybe
type NInstancesByNPliesByKeyByLogicalColour killerMoveKey = Colour.LogicalColour.ArrayByLogicalColour (
Map.Map killerMoveKey (
IntMap.IntMap Type.Count.NPlies
)
)
newtype KillerMoves killerMoveKey = MkKillerMoves {
KillerMoves killerMoveKey
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
deconstruct :: NInstancesByNPliesByKeyByLogicalColour killerMoveKey
}
instance Property.Empty.Empty (KillerMoves killerMoveKey) where
empty :: KillerMoves killerMoveKey
empty = NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> KillerMoves killerMoveKey
forall killerMoveKey.
NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> KillerMoves killerMoveKey
MkKillerMoves (NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> KillerMoves killerMoveKey)
-> ([Map killerMoveKey (IntMap NPlies)]
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey)
-> [Map killerMoveKey (IntMap NPlies)]
-> KillerMoves killerMoveKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Map killerMoveKey (IntMap NPlies)]
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Colour.LogicalColour.listArrayByLogicalColour ([Map killerMoveKey (IntMap NPlies)] -> KillerMoves killerMoveKey)
-> [Map killerMoveKey (IntMap NPlies)] -> KillerMoves killerMoveKey
forall a b. (a -> b) -> a -> b
$ Map killerMoveKey (IntMap NPlies)
-> [Map killerMoveKey (IntMap NPlies)]
forall a. a -> [a]
repeat Map killerMoveKey (IntMap NPlies)
forall a. Empty a => a
Property.Empty.empty
instance Search.EphemeralData.EphemeralData (KillerMoves killerMoveKey) where
getSize :: KillerMoves killerMoveKey -> NPlies
getSize MkKillerMoves { deconstruct :: forall killerMoveKey.
KillerMoves killerMoveKey
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
deconstruct = NInstancesByNPliesByKeyByLogicalColour killerMoveKey
nInstancesByNPliesByKeyByLogicalColour } = NPlies -> NPlies
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPlies -> NPlies) -> NPlies -> NPlies
forall a b. (a -> b) -> a -> b
$ (NPlies -> Map killerMoveKey (IntMap NPlies) -> NPlies)
-> NPlies
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> NPlies
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' (
(NPlies -> IntMap NPlies -> NPlies)
-> NPlies -> Map killerMoveKey (IntMap NPlies) -> NPlies
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' ((NPlies -> IntMap NPlies -> NPlies)
-> NPlies -> Map killerMoveKey (IntMap NPlies) -> NPlies)
-> (NPlies -> IntMap NPlies -> NPlies)
-> NPlies
-> Map killerMoveKey (IntMap NPlies)
-> NPlies
forall a b. (a -> b) -> a -> b
$ (NPlies -> NPlies -> NPlies) -> NPlies -> IntMap NPlies -> NPlies
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' NPlies -> NPlies -> NPlies
forall a. Num a => a -> a -> a
(+)
) NPlies
0 NInstancesByNPliesByKeyByLogicalColour killerMoveKey
nInstancesByNPliesByKeyByLogicalColour
euthanise :: NPlies -> KillerMoves killerMoveKey -> KillerMoves killerMoveKey
euthanise NPlies
nPlies killerMoves :: KillerMoves killerMoveKey
killerMoves@MkKillerMoves { deconstruct :: forall killerMoveKey.
KillerMoves killerMoveKey
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
deconstruct = NInstancesByNPliesByKeyByLogicalColour killerMoveKey
nInstancesByNPliesByKeyByLogicalColour }
| NPlies
nPlies NPlies -> NPlies -> Bool
forall a. Ord a => a -> a -> Bool
<= NPlies
0 = KillerMoves killerMoveKey
killerMoves
| Bool
otherwise = NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> KillerMoves killerMoveKey
forall killerMoveKey.
NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> KillerMoves killerMoveKey
MkKillerMoves (NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> KillerMoves killerMoveKey)
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> KillerMoves killerMoveKey
forall a b. (a -> b) -> a -> b
$ (Map killerMoveKey (IntMap NPlies)
-> Map killerMoveKey (IntMap NPlies))
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
forall (a :: * -> * -> *) e' e i.
(IArray a e', IArray a e, Ix i) =>
(e' -> e) -> a i e' -> a i e
Data.Array.IArray.amap (
(IntMap NPlies -> Maybe (IntMap NPlies))
-> Map killerMoveKey (IntMap NPlies)
-> Map killerMoveKey (IntMap NPlies)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe ((IntMap NPlies -> Maybe (IntMap NPlies))
-> Map killerMoveKey (IntMap NPlies)
-> Map killerMoveKey (IntMap NPlies))
-> (IntMap NPlies -> Maybe (IntMap NPlies))
-> Map killerMoveKey (IntMap NPlies)
-> Map killerMoveKey (IntMap NPlies)
forall a b. (a -> b) -> a -> b
$ \IntMap NPlies
m -> let
m' :: IntMap NPlies
m' = (NPlies -> NPlies -> Bool) -> IntMap NPlies -> IntMap NPlies
forall a. (NPlies -> a -> Bool) -> IntMap a -> IntMap a
IntMap.filterWithKey (\NPlies
nPlies' NPlies
_ -> NPlies
nPlies' NPlies -> NPlies -> Bool
forall a. Ord a => a -> a -> Bool
> NPlies -> NPlies
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPlies
nPlies) IntMap NPlies
m
in if IntMap NPlies -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Data.Foldable.null IntMap NPlies
m'
then Maybe (IntMap NPlies)
forall a. Maybe a
Nothing
else IntMap NPlies -> Maybe (IntMap NPlies)
forall a. a -> Maybe a
Just IntMap NPlies
m'
) NInstancesByNPliesByKeyByLogicalColour killerMoveKey
nInstancesByNPliesByKeyByLogicalColour
type Transformation killerMoveKey = KillerMoves killerMoveKey -> KillerMoves killerMoveKey
insert
:: Ord killerMoveKey
=> Type.Count.NPlies
-> killerMoveKey
-> Transformation killerMoveKey
insert :: NPlies -> killerMoveKey -> Transformation killerMoveKey
insert NPlies
nPlies killerMoveKey
killerMoveKey MkKillerMoves { deconstruct :: forall killerMoveKey.
KillerMoves killerMoveKey
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
deconstruct = NInstancesByNPliesByKeyByLogicalColour killerMoveKey
nInstancesByNPliesByKeyByLogicalColour } = NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> KillerMoves killerMoveKey
forall killerMoveKey.
NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> KillerMoves killerMoveKey
MkKillerMoves (NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> KillerMoves killerMoveKey)
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> KillerMoves killerMoveKey
forall a b. (a -> b) -> a -> b
$ NInstancesByNPliesByKeyByLogicalColour killerMoveKey
nInstancesByNPliesByKeyByLogicalColour NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> [(LogicalColour, Map killerMoveKey (IntMap NPlies))]
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// [
LogicalColour -> LogicalColour
forall a. a -> a
id (LogicalColour -> LogicalColour)
-> (LogicalColour -> Map killerMoveKey (IntMap NPlies))
-> LogicalColour
-> (LogicalColour, Map killerMoveKey (IntMap NPlies))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (IntMap NPlies -> IntMap NPlies -> IntMap NPlies)
-> killerMoveKey
-> IntMap NPlies
-> Map killerMoveKey (IntMap NPlies)
-> Map killerMoveKey (IntMap NPlies)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (
(NPlies -> NPlies -> NPlies)
-> IntMap NPlies -> IntMap NPlies -> IntMap NPlies
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith NPlies -> NPlies -> NPlies
forall a. Num a => a -> a -> a
(+)
) killerMoveKey
killerMoveKey (
NPlies -> NPlies -> IntMap NPlies
forall a. NPlies -> a -> IntMap a
IntMap.singleton (NPlies -> NPlies
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPlies
nPlies) NPlies
1
) (Map killerMoveKey (IntMap NPlies)
-> Map killerMoveKey (IntMap NPlies))
-> (LogicalColour -> Map killerMoveKey (IntMap NPlies))
-> LogicalColour
-> Map killerMoveKey (IntMap NPlies)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
NInstancesByNPliesByKeyByLogicalColour killerMoveKey
nInstancesByNPliesByKeyByLogicalColour NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> LogicalColour -> Map killerMoveKey (IntMap NPlies)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!
) (LogicalColour
-> (LogicalColour, Map killerMoveKey (IntMap NPlies)))
-> LogicalColour
-> (LogicalColour, Map killerMoveKey (IntMap NPlies))
forall a b. (a -> b) -> a -> b
$ if NPlies -> Bool
forall a. Integral a => a -> Bool
even NPlies
nPlies
then LogicalColour
Colour.LogicalColour.Black
else LogicalColour
Colour.LogicalColour.White
]
sortByHistoryHeuristic
:: Ord killerMoveKey
=> Colour.LogicalColour.LogicalColour
-> (a -> killerMoveKey)
-> KillerMoves killerMoveKey
-> [a]
-> [a]
{-# INLINABLE sortByHistoryHeuristic #-}
sortByHistoryHeuristic :: LogicalColour
-> (a -> killerMoveKey) -> KillerMoves killerMoveKey -> [a] -> [a]
sortByHistoryHeuristic LogicalColour
logicalColour a -> killerMoveKey
killerMoveKeyConstructor MkKillerMoves { deconstruct :: forall killerMoveKey.
KillerMoves killerMoveKey
-> NInstancesByNPliesByKeyByLogicalColour killerMoveKey
deconstruct = NInstancesByNPliesByKeyByLogicalColour killerMoveKey
nInstancesByNPliesByKeyByLogicalColour } = (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
-> (IntMap NPlies -> NPlies) -> Maybe (IntMap NPlies) -> NPlies
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe NPlies
0 (
NPlies -> NPlies
forall a. Num a => a -> a
negate (NPlies -> NPlies)
-> (IntMap NPlies -> NPlies) -> IntMap NPlies -> NPlies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NPlies -> NPlies -> NPlies) -> NPlies -> IntMap NPlies -> NPlies
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' NPlies -> NPlies -> NPlies
forall a. Num a => a -> a -> a
(+) NPlies
0
) (Maybe (IntMap NPlies) -> NPlies)
-> (a -> Maybe (IntMap NPlies)) -> a -> NPlies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
killerMoveKey
-> Map killerMoveKey (IntMap NPlies) -> Maybe (IntMap NPlies)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` (NInstancesByNPliesByKeyByLogicalColour killerMoveKey
nInstancesByNPliesByKeyByLogicalColour NInstancesByNPliesByKeyByLogicalColour killerMoveKey
-> LogicalColour -> Map killerMoveKey (IntMap NPlies)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour)
) (killerMoveKey -> Maybe (IntMap NPlies))
-> (a -> killerMoveKey) -> a -> Maybe (IntMap NPlies)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> killerMoveKey
killerMoveKeyConstructor