module BishBosh.Search.Search(
Result (
getSearchState,
getQuantifiedGames,
getNMovesEvaluated
),
showsSeparator,
search,
calculateBranchingFactor
) where
import Control.Arrow((&&&))
import qualified BishBosh.Component.Move as Component.Move
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Evaluation.PositionHashQuantifiedGameTree as Evaluation.PositionHashQuantifiedGameTree
import qualified BishBosh.Evaluation.QuantifiedGame as Evaluation.QuantifiedGame
import qualified BishBosh.Input.SearchOptions as Input.SearchOptions
import qualified BishBosh.Model.Game as Model.Game
import qualified BishBosh.Notation.MoveNotation as Notation.MoveNotation
import qualified BishBosh.Search.AlphaBeta as Search.AlphaBeta
import qualified BishBosh.Search.SearchState as Search.SearchState
import qualified BishBosh.State.TurnsByLogicalColour as State.TurnsByLogicalColour
import qualified BishBosh.Text.ShowList as Text.ShowList
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Control.Monad.Reader
import qualified Data.Maybe
data Result x y positionHash criterionValue weightedMean = MkResult {
getSearchState :: Search.SearchState.SearchState x y positionHash criterionValue weightedMean,
getQuantifiedGames :: [Evaluation.QuantifiedGame.QuantifiedGame x y criterionValue weightedMean],
getNMovesEvaluated :: Component.Move.NMoves
}
instance Control.DeepSeq.NFData weightedMean => Control.DeepSeq.NFData (Result x y positionHash criterionValue weightedMean) where
rnf MkResult { getQuantifiedGames = quantifiedGames } = Control.DeepSeq.rnf quantifiedGames
showsSeparator :: ShowS
showsSeparator = showString " -> "
instance (Enum x, Enum y, Real criterionValue, Real weightedMean) => Notation.MoveNotation.ShowNotationFloat (Result x y positionHash criterionValue weightedMean) where
showsNotationFloat moveNotation showsDouble result@MkResult {
getQuantifiedGames = quantifiedGames,
getNMovesEvaluated = nMovesEvaluated
} = Text.ShowList.showsFormattedList showsSeparator (
Notation.MoveNotation.showsNotationFloat moveNotation showsDouble
) quantifiedGames . showString "; selected after analysing " . shows nMovesEvaluated . showString " moves (branching-factor" . Text.ShowList.showsAssociation . showsDouble (
calculateBranchingFactor result
) . showChar ')'
search :: (
Enum x,
Enum y,
Eq criterionValue,
Num weightedMean,
Ord weightedMean,
Ord positionHash,
Ord x,
Ord y
)
=> Input.SearchOptions.SearchDepth
-> Search.SearchState.SearchState x y positionHash criterionValue weightedMean
-> Input.SearchOptions.Reader (Result x y positionHash criterionValue weightedMean)
search 0 _ = Control.Exception.throw . Data.Exception.mkOutOfBounds . showString "BishBosh.Search.Search.search:\t" . shows Input.SearchOptions.searchDepthTag . showString " must be at least " $ shows Input.SearchOptions.minimumSearchDepth "."
search searchDepth searchState
| Just terminationReason <- Model.Game.getMaybeTerminationReason game = Control.Exception.throw . Data.Exception.mkInvalidDatum . showString "BishBosh.Search.Search.search:\tthe game has already terminated; " $ shows terminationReason "."
| otherwise = do
(maybeRetireKillerMovesAfter, maybeRetireTranspositionsAfter) <- Control.Monad.Reader.asks $ Input.SearchOptions.getMaybeRetireKillerMovesAfter &&& Input.SearchOptions.maybeRetireTranspositionsAfter
let nPlies = State.TurnsByLogicalColour.getNPlies $ Model.Game.getTurnsByLogicalColour game
searchResult <- Search.AlphaBeta.negaMax searchDepth $ Search.SearchState.euthanise nPlies maybeRetireKillerMovesAfter maybeRetireTranspositionsAfter searchState
case Search.AlphaBeta.extractSelectedTurns nPlies searchResult of
(dynamicMoveData, turns@(turn : _), nMovesEvaluated) -> let
isMatch turn' = (== turn') . Evaluation.QuantifiedGame.getLastTurn . Evaluation.PositionHashQuantifiedGameTree.getQuantifiedGame
in return MkResult {
getSearchState = Search.SearchState.mkSearchState (
Data.Maybe.fromMaybe (
Control.Exception.throw $ Data.Exception.mkIncompatibleData "BishBosh.Search.Search.search:\tBishBosh.Data.RoseTree.reduce failed."
) $ Evaluation.PositionHashQuantifiedGameTree.reduce (isMatch turn) positionHashQuantifiedGameTree
) dynamicMoveData,
getQuantifiedGames = map Evaluation.PositionHashQuantifiedGameTree.getQuantifiedGame . Data.Maybe.fromMaybe (
Control.Exception.throw $ Data.Exception.mkSearchFailure "BishBosh.Search.Search.search:\tBishBosh.Data.RoseTree.traceRoute failed."
) $ Evaluation.PositionHashQuantifiedGameTree.traceRoute isMatch positionHashQuantifiedGameTree turns,
getNMovesEvaluated = nMovesEvaluated
}
_ -> Control.Exception.throw $ Data.Exception.mkNullDatum "BishBosh.Search.Search.search:\tzero turns selected."
where
positionHashQuantifiedGameTree = Search.SearchState.getPositionHashQuantifiedGameTree searchState
game = Evaluation.QuantifiedGame.getGame $ Evaluation.PositionHashQuantifiedGameTree.getRootQuantifiedGame positionHashQuantifiedGameTree
calculateBranchingFactor :: Floating branchingFactor => Result x y positionHash criterionValue weightedMean -> branchingFactor
calculateBranchingFactor MkResult {
getQuantifiedGames = quantifiedGames,
getNMovesEvaluated = nMovesEvaluated
}
| null quantifiedGames = Control.Exception.throw $ Data.Exception.mkNullDatum "BishBosh.Search.Search.calculateBranchingFactor:\tnull quantifiedGames."
| nMovesEvaluated == 0 = Control.Exception.throw $ Data.Exception.mkInsufficientData "BishBosh.Search.Search.calculateBranchingFactor:\tzero moves analysed."
| otherwise = fromIntegral nMovesEvaluated ** recip (
fromIntegral $ length quantifiedGames
)