PlayState.hs

{-
	Copyright (C) 2018 Dr. Alistair Ward

	This file is part of BishBosh.

	BishBosh is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	BishBosh is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]	The data-type threaded through the moves of the game, transporting the changing /game/-state & configuration.
-}

module BishBosh.State.PlayState(
-- * Types
-- ** Type-synonyms
--	Transformation,
-- ** Data-types
	PlayState(
--		MkPlayState,
--		getCriterionValues,
--		getZobrist,
--		getMoveFrequency,
		getSearchState,
		getOptions,
		getMaybeApplicationTerminationReason
	),
-- * Functions
	calculateCriterionValueStatistics,
	suggestCorrections,
-- ** Constructor
	initialise,
-- ** Accessors
	getGame,
-- ** Mutators
	reconstructPositionHashQuantifiedGameTree,
	resetPositionHashQuantifiedGameTree,
--	setPositionHashQuantifiedGameTree,
	updateWithAutomaticMove,
	updateWithManualMove,
	resign,
-- ** Predicates
	hasMorePlies,
	hasApplicationTerminationBeenRequested
 ) where

import			Control.Arrow((&&&))
import qualified	BishBosh.Component.Zobrist				as Component.Zobrist
import qualified	BishBosh.Data.Exception					as Data.Exception
import qualified	BishBosh.Data.List
import qualified	BishBosh.Evaluation.PositionHashQuantifiedGameTree	as Evaluation.PositionHashQuantifiedGameTree
import qualified	BishBosh.Evaluation.QuantifiedGame			as Evaluation.QuantifiedGame
import qualified	BishBosh.Input.IOOptions				as Input.IOOptions
import qualified	BishBosh.Input.Options					as Input.Options
import qualified	BishBosh.Input.UIOptions				as Input.UIOptions
import qualified	BishBosh.Metric.CriterionValue				as Metric.CriterionValue
import qualified	BishBosh.Model.Game					as Model.Game
import qualified	BishBosh.Model.GameTree					as Model.GameTree
import qualified	BishBosh.Notation.MoveNotation				as Notation.MoveNotation
import qualified	BishBosh.Search.SearchState				as Search.SearchState
import qualified	BishBosh.State.ApplicationTerminationReason		as State.ApplicationTerminationReason
import qualified	BishBosh.State.TurnsByLogicalColour			as State.TurnsByLogicalColour
import qualified	BishBosh.Type.Crypto					as Type.Crypto
import qualified	BishBosh.Type.Mass					as Type.Mass
import qualified	Control.Exception
import qualified	Data.Bits
import qualified	Data.Default
import qualified	Data.List
import qualified	Data.Maybe
import qualified	Data.Ord
import qualified	Factory.Math.Statistics

-- | The type threaded through the sequence of /game/s during play.
data PlayState positionHash	= MkPlayState {
	getCriterionValues			:: [[Metric.CriterionValue.CriterionValue]],					-- ^ The /criterion-value/s accumulated during the game.
	getZobrist				:: Component.Zobrist.Zobrist positionHash,					-- ^ The constant hash-codes used to construct position-hashes.
	getMoveFrequency			:: Model.GameTree.MoveFrequency,						-- ^ The constant frequency of moves extracted from file.
	getSearchState				:: Search.SearchState.SearchState positionHash,
	getOptions				:: Input.Options.Options,							-- ^ The constant options by which the game is configured.
	getMaybeApplicationTerminationReason	:: Maybe State.ApplicationTerminationReason.ApplicationTerminationReason	-- ^ Whether the game has terminated.
}

-- | Constructor.
initialise
	:: Data.Bits.Bits positionHash
	=> Input.Options.Options
	-> Component.Zobrist.Zobrist positionHash
	-> Model.GameTree.MoveFrequency
	-> Model.Game.Game
	-> PlayState positionHash
{-# SPECIALISE initialise
	:: Input.Options.Options
	-> Component.Zobrist.Zobrist Type.Crypto.PositionHash
	-> Model.GameTree.MoveFrequency
	-> Model.Game.Game
	-> PlayState Type.Crypto.PositionHash
 #-}
initialise options zobrist moveFrequency game	= MkPlayState {
	getCriterionValues			= [],
	getZobrist				= zobrist,
	getMoveFrequency			= moveFrequency,
	getSearchState				= Search.SearchState.initialise $ uncurry Evaluation.PositionHashQuantifiedGameTree.mkPositionHashQuantifiedGameTree (
		Input.Options.getEvaluationOptions &&& Input.Options.getSearchOptions $ options
	) zobrist moveFrequency game,
	getOptions				= options,
	getMaybeApplicationTerminationReason	= Nothing
}

-- | Accessor.
getGame :: PlayState positionHash -> Model.Game.Game
getGame MkPlayState { getSearchState = searchState }	= Evaluation.QuantifiedGame.getGame . Evaluation.PositionHashQuantifiedGameTree.getRootQuantifiedGame $ Search.SearchState.getPositionHashQuantifiedGameTree searchState

-- | The type of a function used to transform a 'PlayState'.
type Transformation positionHash	= PlayState positionHash -> PlayState positionHash

-- | Mutator.
setPositionHashQuantifiedGameTree :: Evaluation.PositionHashQuantifiedGameTree.PositionHashQuantifiedGameTree positionHash -> Transformation positionHash
setPositionHashQuantifiedGameTree positionHashQuantifiedGameTree playState@MkPlayState { getSearchState = searchState }	= playState {
	getSearchState	= searchState { Search.SearchState.getPositionHashQuantifiedGameTree = positionHashQuantifiedGameTree }
}

-- | Reconstruct the /positionHashQuantifiedGameTree/ (in the /searchState/), with the apex set to the specified game.
reconstructPositionHashQuantifiedGameTree :: Data.Bits.Bits positionHash => Model.Game.Game -> Transformation positionHash
{-# SPECIALISE reconstructPositionHashQuantifiedGameTree :: Model.Game.Game -> Transformation Type.Crypto.PositionHash #-}
reconstructPositionHashQuantifiedGameTree game playState@MkPlayState {
	getZobrist		= zobrist,
	getMoveFrequency	= moveFrequency,
	getOptions		= options
} = setPositionHashQuantifiedGameTree (
	uncurry Evaluation.PositionHashQuantifiedGameTree.mkPositionHashQuantifiedGameTree (
		Input.Options.getEvaluationOptions &&& Input.Options.getSearchOptions $ options
	) zobrist moveFrequency game
 ) playState

-- | Reset to the initial state.
resetPositionHashQuantifiedGameTree :: Data.Bits.Bits positionHash => Transformation positionHash
{-# SPECIALISE resetPositionHashQuantifiedGameTree :: Transformation Type.Crypto.PositionHash #-}
resetPositionHashQuantifiedGameTree playState	= reconstructPositionHashQuantifiedGameTree Data.Default.def playState {
	getCriterionValues			= [],
	getMaybeApplicationTerminationReason	= Nothing
}

-- | Mutator.
updateWithAutomaticMove
	:: [Metric.CriterionValue.CriterionValue]
	-> Search.SearchState.SearchState positionHash
	-> Transformation positionHash
updateWithAutomaticMove criterionValues searchState playState	= playState {
	getCriterionValues	= criterionValues : getCriterionValues playState,
	getSearchState		= searchState
}

-- | Mutator.
updateWithManualMove :: Model.Game.Game -> Transformation positionHash
updateWithManualMove game playState@MkPlayState { getSearchState = searchState }	= setPositionHashQuantifiedGameTree (
	Data.Maybe.fromMaybe (
		Control.Exception.throw $ Data.Exception.mkIncompatibleData "BishBosh.State.PlayState.updateWithManualMove:\tEvaluation.PositionHashQuantifiedGameTree.reduce failed."
	) . Evaluation.PositionHashQuantifiedGameTree.reduce (
		(
			== Data.Maybe.fromMaybe (
				Control.Exception.throw $ Data.Exception.mkResultUndefined "BishBosh.State.PlayState.updateWithManualMove:\tModel.Game.maybeLastTurn failed."
			) (
				Model.Game.maybeLastTurn game
			)
		) . Evaluation.QuantifiedGame.getLastTurn . Evaluation.PositionHashQuantifiedGameTree.getQuantifiedGame
	) $ Search.SearchState.getPositionHashQuantifiedGameTree searchState
 ) playState

-- | Calculate the /root-mean-square/ & the /standard-deviation/, of the values of each type of /criterion/.
calculateCriterionValueStatistics :: (
	Floating	standardDeviation,
	Fractional	mean
 )
	=> PlayState positionHash
	-> [(mean, standardDeviation)]
calculateCriterionValueStatistics MkPlayState { getCriterionValues = criterionValues }	= map (
	(
		Factory.Math.Statistics.getMean &&& Factory.Math.Statistics.getStandardDeviation
	) . map (
		\criterionValue -> realToFrac criterionValue	:: Type.Mass.CriterionValue
	)
 ) $ Data.List.transpose criterionValues

-- | Resignation by the player who currently holds the choice of move.
resign :: Transformation positionHash
resign playState@MkPlayState { getSearchState = searchState }	= setPositionHashQuantifiedGameTree (
	Evaluation.PositionHashQuantifiedGameTree.resign $ Search.SearchState.getPositionHashQuantifiedGameTree searchState
 ) playState

-- | Given a string from which either a /move/ can't be parsed or the one that can is illegal, returns the closest matches amongst the currently available /move/s.
suggestCorrections
	:: String	-- ^ Move-string.
	-> PlayState positionHash
	-> [String]	-- ^ Suggested corrections.
suggestCorrections moveString playState@MkPlayState { getOptions = options }
	| Model.Game.isTerminated game	= []
	| otherwise			= BishBosh.Data.List.findClosest moveString . map (
		Notation.MoveNotation.showNotation . Input.UIOptions.getMoveNotation . Input.IOOptions.getUIOptions $ Input.Options.getIOOptions options
	) $ Model.Game.findQualifiedMovesAvailableToNextPlayer game
	where
		game	= getGame playState

-- | Whether the game in the first /play-state/ has more plies than that in the second.
hasMorePlies
	:: PlayState positionHash
	-> PlayState positionHash
	-> Bool
hasMorePlies playState playState'	= Data.Ord.comparing (State.TurnsByLogicalColour.getNPlies . Model.Game.getTurnsByLogicalColour . getGame) playState playState' == GT

-- | Whether the user has requested application-termination, or the configured maximum number of turns has been reached.
hasApplicationTerminationBeenRequested :: PlayState positionHash -> Bool
hasApplicationTerminationBeenRequested MkPlayState { getMaybeApplicationTerminationReason = maybeApplicationTerminationReason }	= Data.Maybe.isJust maybeApplicationTerminationReason