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 {
KillerMoves killerMove
-> ByLogicalColour (Map killerMove (IntMap NMoves))
deconstruct :: Attribute.LogicalColour.ByLogicalColour (
Data.Map.Map killerMove (
Data.IntMap.IntMap Component.Move.NMoves
)
)
}
instance Property.Empty.Empty (KillerMoves killerMove) where
empty :: KillerMoves killerMove
empty = ByLogicalColour (Map killerMove (IntMap NMoves))
-> KillerMoves killerMove
forall killerMove.
ByLogicalColour (Map killerMove (IntMap NMoves))
-> KillerMoves killerMove
MkKillerMoves (ByLogicalColour (Map killerMove (IntMap NMoves))
-> KillerMoves killerMove)
-> ([Map killerMove (IntMap NMoves)]
-> ByLogicalColour (Map killerMove (IntMap NMoves)))
-> [Map killerMove (IntMap NMoves)]
-> KillerMoves killerMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Map killerMove (IntMap NMoves)]
-> ByLogicalColour (Map killerMove (IntMap NMoves))
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Attribute.LogicalColour.listArrayByLogicalColour ([Map killerMove (IntMap NMoves)] -> KillerMoves killerMove)
-> [Map killerMove (IntMap NMoves)] -> KillerMoves killerMove
forall a b. (a -> b) -> a -> b
$ Map killerMove (IntMap NMoves) -> [Map killerMove (IntMap NMoves)]
forall a. a -> [a]
repeat Map killerMove (IntMap NMoves)
forall k a. Map k a
Data.Map.empty
instance Search.EphemeralData.EphemeralData (KillerMoves killerMove) where
getSize :: KillerMoves killerMove -> NMoves
getSize MkKillerMoves { deconstruct :: forall killerMove.
KillerMoves killerMove
-> ByLogicalColour (Map killerMove (IntMap NMoves))
deconstruct = ByLogicalColour (Map killerMove (IntMap NMoves))
nInstancesByKeyByNPliesByLogicalColour } = (NMoves -> Map killerMove (IntMap NMoves) -> NMoves)
-> NMoves
-> ByLogicalColour (Map killerMove (IntMap NMoves))
-> NMoves
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' (
(NMoves -> IntMap NMoves -> NMoves)
-> NMoves -> Map killerMove (IntMap NMoves) -> NMoves
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Data.Map.foldl' ((NMoves -> IntMap NMoves -> NMoves)
-> NMoves -> Map killerMove (IntMap NMoves) -> NMoves)
-> (NMoves -> IntMap NMoves -> NMoves)
-> NMoves
-> Map killerMove (IntMap NMoves)
-> NMoves
forall a b. (a -> b) -> a -> b
$ (NMoves -> NMoves -> NMoves) -> NMoves -> IntMap NMoves -> NMoves
forall a b. (a -> b -> a) -> a -> IntMap b -> a
Data.IntMap.foldl' NMoves -> NMoves -> NMoves
forall a. Num a => a -> a -> a
(+)
) NMoves
0 ByLogicalColour (Map killerMove (IntMap NMoves))
nInstancesByKeyByNPliesByLogicalColour
euthanise :: NMoves -> KillerMoves killerMove -> KillerMoves killerMove
euthanise NMoves
nPlies killerMoves :: KillerMoves killerMove
killerMoves@MkKillerMoves { deconstruct :: forall killerMove.
KillerMoves killerMove
-> ByLogicalColour (Map killerMove (IntMap NMoves))
deconstruct = ByLogicalColour (Map killerMove (IntMap NMoves))
nInstancesByKeyByNPliesByLogicalColour }
| NMoves
nPlies NMoves -> NMoves -> Bool
forall a. Ord a => a -> a -> Bool
<= NMoves
0 = KillerMoves killerMove
killerMoves
| Bool
otherwise = ByLogicalColour (Map killerMove (IntMap NMoves))
-> KillerMoves killerMove
forall killerMove.
ByLogicalColour (Map killerMove (IntMap NMoves))
-> KillerMoves killerMove
MkKillerMoves (ByLogicalColour (Map killerMove (IntMap NMoves))
-> KillerMoves killerMove)
-> ByLogicalColour (Map killerMove (IntMap NMoves))
-> KillerMoves killerMove
forall a b. (a -> b) -> a -> b
$ (Map killerMove (IntMap NMoves) -> Map killerMove (IntMap NMoves))
-> ByLogicalColour (Map killerMove (IntMap NMoves))
-> ByLogicalColour (Map killerMove (IntMap NMoves))
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 NMoves -> Maybe (IntMap NMoves))
-> Map killerMove (IntMap NMoves) -> Map killerMove (IntMap NMoves)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Data.Map.mapMaybe ((IntMap NMoves -> Maybe (IntMap NMoves))
-> Map killerMove (IntMap NMoves)
-> Map killerMove (IntMap NMoves))
-> (IntMap NMoves -> Maybe (IntMap NMoves))
-> Map killerMove (IntMap NMoves)
-> Map killerMove (IntMap NMoves)
forall a b. (a -> b) -> a -> b
$ \IntMap NMoves
m -> let
m' :: IntMap NMoves
m' = (NMoves -> NMoves -> Bool) -> IntMap NMoves -> IntMap NMoves
forall a. (NMoves -> a -> Bool) -> IntMap a -> IntMap a
Data.IntMap.filterWithKey (\NMoves
nPlies' NMoves
_ -> NMoves
nPlies' NMoves -> NMoves -> Bool
forall a. Ord a => a -> a -> Bool
> NMoves
nPlies) IntMap NMoves
m
in if IntMap NMoves -> Bool
forall a. IntMap a -> Bool
Data.IntMap.null IntMap NMoves
m'
then Maybe (IntMap NMoves)
forall a. Maybe a
Nothing
else IntMap NMoves -> Maybe (IntMap NMoves)
forall a. a -> Maybe a
Just IntMap NMoves
m'
) ByLogicalColour (Map killerMove (IntMap NMoves))
nInstancesByKeyByNPliesByLogicalColour
type Transformation killerMove = KillerMoves killerMove -> KillerMoves killerMove
insert
:: Ord killerMove
=> Component.Move.NPlies
-> killerMove
-> Transformation killerMove
insert :: NMoves -> killerMove -> Transformation killerMove
insert NMoves
nPlies killerMove
killerMove MkKillerMoves { deconstruct :: forall killerMove.
KillerMoves killerMove
-> ByLogicalColour (Map killerMove (IntMap NMoves))
deconstruct = ByLogicalColour (Map killerMove (IntMap NMoves))
nInstancesByKeyByNPliesByLogicalColour } = ByLogicalColour (Map killerMove (IntMap NMoves))
-> KillerMoves killerMove
forall killerMove.
ByLogicalColour (Map killerMove (IntMap NMoves))
-> KillerMoves killerMove
MkKillerMoves (ByLogicalColour (Map killerMove (IntMap NMoves))
-> KillerMoves killerMove)
-> ByLogicalColour (Map killerMove (IntMap NMoves))
-> KillerMoves killerMove
forall a b. (a -> b) -> a -> b
$ ByLogicalColour (Map killerMove (IntMap NMoves))
nInstancesByKeyByNPliesByLogicalColour ByLogicalColour (Map killerMove (IntMap NMoves))
-> [(LogicalColour, Map killerMove (IntMap NMoves))]
-> ByLogicalColour (Map killerMove (IntMap NMoves))
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 killerMove (IntMap NMoves))
-> LogicalColour
-> (LogicalColour, Map killerMove (IntMap NMoves))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (IntMap NMoves -> IntMap NMoves -> IntMap NMoves)
-> killerMove
-> IntMap NMoves
-> Map killerMove (IntMap NMoves)
-> Map killerMove (IntMap NMoves)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Data.Map.Strict.insertWith (
(NMoves -> NMoves -> NMoves)
-> IntMap NMoves -> IntMap NMoves -> IntMap NMoves
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
Data.IntMap.unionWith NMoves -> NMoves -> NMoves
forall a. Num a => a -> a -> a
(+)
) killerMove
killerMove (
NMoves -> NMoves -> IntMap NMoves
forall a. NMoves -> a -> IntMap a
Data.IntMap.singleton NMoves
nPlies NMoves
1
) (Map killerMove (IntMap NMoves) -> Map killerMove (IntMap NMoves))
-> (LogicalColour -> Map killerMove (IntMap NMoves))
-> LogicalColour
-> Map killerMove (IntMap NMoves)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByLogicalColour (Map killerMove (IntMap NMoves))
nInstancesByKeyByNPliesByLogicalColour ByLogicalColour (Map killerMove (IntMap NMoves))
-> LogicalColour -> Map killerMove (IntMap NMoves)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!) (LogicalColour -> (LogicalColour, Map killerMove (IntMap NMoves)))
-> LogicalColour -> (LogicalColour, Map killerMove (IntMap NMoves))
forall a b. (a -> b) -> a -> b
$ if NMoves -> Bool
forall a. Integral a => a -> Bool
even NMoves
nPlies
then LogicalColour
Attribute.LogicalColour.Black
else LogicalColour
Attribute.LogicalColour.White
]
sortByHistoryHeuristic
:: Ord killerMove
=> Attribute.LogicalColour.LogicalColour
-> (a -> killerMove)
-> KillerMoves killerMove
-> [a]
-> [a]
sortByHistoryHeuristic :: LogicalColour
-> (a -> killerMove) -> KillerMoves killerMove -> [a] -> [a]
sortByHistoryHeuristic LogicalColour
logicalColour a -> killerMove
killerMoveConstructor MkKillerMoves { deconstruct :: forall killerMove.
KillerMoves killerMove
-> ByLogicalColour (Map killerMove (IntMap NMoves))
deconstruct = ByLogicalColour (Map killerMove (IntMap NMoves))
nInstancesByNPliesByKeyByLogicalColour } = (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
-> (IntMap NMoves -> NMoves) -> Maybe (IntMap NMoves) -> NMoves
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe NMoves
0 (
NMoves -> NMoves
forall a. Num a => a -> a
negate (NMoves -> NMoves)
-> (IntMap NMoves -> NMoves) -> IntMap NMoves -> NMoves
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NMoves -> NMoves -> NMoves) -> NMoves -> IntMap NMoves -> NMoves
forall a b. (a -> b -> a) -> a -> IntMap b -> a
Data.IntMap.foldl' NMoves -> NMoves -> NMoves
forall a. Num a => a -> a -> a
(+) NMoves
0
) (Maybe (IntMap NMoves) -> NMoves)
-> (a -> Maybe (IntMap NMoves)) -> a -> NMoves
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
killerMove
-> Map killerMove (IntMap NMoves) -> Maybe (IntMap NMoves)
forall k a. Ord k => k -> Map k a -> Maybe a
`Data.Map.lookup` (ByLogicalColour (Map killerMove (IntMap NMoves))
nInstancesByNPliesByKeyByLogicalColour ByLogicalColour (Map killerMove (IntMap NMoves))
-> LogicalColour -> Map killerMove (IntMap NMoves)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour)
) (killerMove -> Maybe (IntMap NMoves))
-> (a -> killerMove) -> a -> Maybe (IntMap NMoves)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> killerMove
killerMoveConstructor