bishbosh 0.1.3.1 → 0.1.4.0

raw patch · 82 files changed

+1253/−784 lines, 82 filesdep +ghc-primdep ~arrayPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: ghc-prim

Dependency ranges changed: array

API changes (from Hackage documentation)

Files

• bishbosh.cabal +65/−47
• bishbosh.spec +1/−1
• changelog.markdown +15/−0
• config/CECP/bishbosh_black.xml +1/−1
• config/Raw/bishbosh_black.xml +1/−1
• config/Raw/bishbosh_black_figurine.xml +1/−1
• config/Raw/bishbosh_both.xml +1/−1
• config/Raw/bishbosh_duel_black.xml +1/−1
• config/Raw/bishbosh_duel_white.xml +1/−1
• config/Raw/bishbosh_prof.xml +1/−1
• config/Raw/bishbosh_white.xml +1/−1
• config/bishbosh.dtd +9/−7
• config/bishbosh.rng +8/−4
• config/standardOpeningOptions.xml +24/−0
• makefile +8/−10
• man/man5/bishbosh.5 +3/−2
• src-exe/BishBosh/Concurrent/Pondering.hs +1/−4
• src-exe/BishBosh/Play.hs +1/−1
• src-exe/BishBosh/State/PlayState.hs +44/−11
• src-exe/BishBosh/UI/CECP.hs +45/−16
• src-exe/BishBosh/UI/Raw.hs +50/−25
• src-exe/Main.hs +8/−9
• src-lib/BishBosh/Attribute/MoveType.hs +20/−0
• src-lib/BishBosh/Attribute/Rank.hs +5/−0
• src-lib/BishBosh/Cartesian/Abscissa.hs +3/−6
• src-lib/BishBosh/Cartesian/Coordinates.hs +54/−31
• src-lib/BishBosh/Cartesian/Ordinate.hs +18/−6
• src-lib/BishBosh/Cartesian/Vector.hs +3/−1
• src-lib/BishBosh/Colour/LogicalColour.hs +1/−13
• src-lib/BishBosh/Colour/LogicalColourOfSquare.hs +1/−1
• src-lib/BishBosh/Component/Accountant.hs +2/−2
• src-lib/BishBosh/Component/Move.hs +1/−1
• src-lib/BishBosh/Component/Piece.hs +8/−17
• src-lib/BishBosh/Component/PieceSquareByCoordinatesByRank.hs +0/−181
• src-lib/BishBosh/Component/PieceSquareValueByCoordinates.hs +94/−0
• src-lib/BishBosh/Component/PieceSquareValueByCoordinatesByRank.hs +114/−0
• src-lib/BishBosh/Component/QualifiedMove.hs +1/−1
• src-lib/BishBosh/ContextualNotation/PGN.hs +4/−6
• src-lib/BishBosh/ContextualNotation/PositionHashQualifiedMoveTree.hs +3/−3
• src-lib/BishBosh/ContextualNotation/StandardAlgebraic.hs +4/−4
• src-lib/BishBosh/Data/RoseTree.hs +1/−1
• src-lib/BishBosh/Evaluation/Fitness.hs +52/−35
• src-lib/BishBosh/Evaluation/PositionHashQuantifiedGameTree.hs +4/−4
• src-lib/BishBosh/Input/EvaluationOptions.hs +111/−50
• src-lib/BishBosh/Input/PGNOptions.hs +3/−4
• src-lib/BishBosh/Input/PieceSquareTable.hs +25/−35
• src-lib/BishBosh/Input/RankValues.hs +29/−5
• src-lib/BishBosh/Input/StandardOpeningOptions.hs +46/−27
• src-lib/BishBosh/Metric/RankValue.hs +19/−4
• src-lib/BishBosh/Metric/WeightedMeanAndCriterionValues.hs +2/−2
• src-lib/BishBosh/Model/Game.hs +3/−7
• src-lib/BishBosh/Model/GameTree.hs +1/−1
• src-lib/BishBosh/Model/PositionHashTree.hs +1/−1
• src-lib/BishBosh/Notation/PureCoordinate.hs +1/−0
• src-lib/BishBosh/Property/ShowFloat.hs +10/−0
• src-lib/BishBosh/Rule/GameTerminationReason.hs +1/−1
• src-lib/BishBosh/Rule/Result.hs +1/−1
• src-lib/BishBosh/State/Board.hs +61/−60
• src-lib/BishBosh/State/CoordinatesByRankByLogicalColour.hs +27/−19
• src-lib/BishBosh/State/MaybePieceByCoordinates.hs +78/−40
• src-lib/BishBosh/State/TurnsByLogicalColour.hs +5/−0
• src-lib/BishBosh/StateProperty/Censor.hs +8/−1
• src-lib/BishBosh/StateProperty/Mutator.hs +8/−9
• src-lib/BishBosh/Text/Poly.hs +8/−10
• src-lib/BishBosh/Type/Length.hs +1/−1
• src-lib/BishBosh/Type/Mass.hs +2/−2
• src-test/BishBosh/Test/HUnit/Cartesian/Coordinates.hs +3/−1
• src-test/BishBosh/Test/HUnit/ContextualNotation/PGN.hs +1/−1
• src-test/BishBosh/Test/HUnit/ContextualNotation/PositionHashQualifiedMoveTree.hs +1/−1
• src-test/BishBosh/Test/HUnit/ContextualNotation/StandardAlgebraic.hs +1/−0
• src-test/BishBosh/Test/HUnit/Model/PositionHashTree.hs +1/−1
• src-test/BishBosh/Test/HUnit/State/Board.hs +1/−1
• src-test/BishBosh/Test/QuickCheck/Cartesian/Coordinates.hs +27/−5
• src-test/BishBosh/Test/QuickCheck/Evaluation/PositionHashQuantifiedGameTree.hs +9/−3
• src-test/BishBosh/Test/QuickCheck/Input/EvaluationOptions.hs +9/−10
• src-test/BishBosh/Test/QuickCheck/Input/RankValues.hs +36/−3
• src-test/BishBosh/Test/QuickCheck/Input/StandardOpeningOptions.hs +7/−1
• src-test/BishBosh/Test/QuickCheck/Model/Game.hs +5/−5
• src-test/BishBosh/Test/QuickCheck/State/Board.hs +3/−1
• src-test/BishBosh/Test/QuickCheck/StateProperty/Hashable.hs +1/−1
• src-test/BishBosh/Test/QuickCheck/StateProperty/Mutator.hs +3/−9
• src-test/QuickCheck.hs +11/−3

@@ -16,7 +16,7 @@ -- along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.  Name:		bishbosh-Version:	0.1.3.1+Version:	0.1.4.0 Copyright:	(C) 2018 Dr. Alistair Ward License:	GPL-3.0-or-later License-file:	LICENSE@@ -57,46 +57,55 @@     type:	git     location:	https://github.com/functionalley/BishBosh --- Enable using: 'runhaskell Setup configure -f llvm --verbose'.-flag llvm-    Description:	Whether the 'llvm' compiler-backend has been installed and is required for code-generation.+-- Whether to use unsafe array-indexing where possible.+flag arrayunsafeat+    Description:	Use unsafe array-indexing.     Manual:		True-    Default:		False+    Default:		True  -- Automatically disabled when the required package isn't available.--- To force validation of the XML-configuration against the packaged DTD, manually disable using one of:+-- To force validation of the XML-configuration against the packaged DTD.+-- Disable using: --	runhaskell Setup configure -f -hxtrelaxng --verbose;---	stack build --flag 'bishbosh:-hxtrelaxng' --cabal-verbose;+--	stack build --flag='bishbosh:-hxtrelaxng'; flag hxtrelaxng     Description:	Link with package "hxt-relaxng" when available, for more precise specification of the XML-configuration than a traditional DTD.     Default:		True +-- Compile using LLVM; requires the 'llc' & 'opt' tools (from 'llvm') to be on one's PATH.+-- CAVEAT: build-time ~150 %, runtime ~97 % (i.e. slightly faster).+-- Enable using:+--	runhaskell Setup configure -f llvm --verbose.+--	stack build --flag='bishbosh:llvm';+flag llvm+    Description:	Whether the 'llvm' compiler-backend has been installed and is required for code-generation.+    Manual:		True+    Default:		False+ -- Whether to use narrower numerical types than machine-defaults. CAVEAT: this option increases both the space allocated & the execution-time.--- CAVEAT: incompatble with the flag 'precision'. flag narrownumbers     Description:	Use narrow numerical types.     Manual:		True     Default:		False --- Whether, to wrap common types in 'newtype' for increased type-safety. CAVEAT: there's a ~10% performance-penalty.--- CAVEAT: partly incompatible with 'narrownumbers'.+-- Whether to wrap common types in 'newtype' for increased type-safety. CAVEAT: there's a small performance-penalty. flag newtypewrappers     Description:	Wrap common types in newtype for increased type-safety.     Manual:		True     Default:		False  -- Automatically disabled when the required package isn't available.--- To access Parsec's more precise error-messages, manually disable using one of:+-- To access Parsec's more precise error-messages.+-- Disable using: --	runhaskell Setup configure -f -polyparse --verbose;---	stack build --flag 'bishbosh:-polyparse' --cabal-verbose;+--	stack build --flag='bishbosh:-polyparse'; flag polyparse     Description:	Link with package "polyparse" when available, rather than "parsec".     Default:		True --- Whether to use precise (rational) types rather than floating-point.--- CAVEAT: conceptually incompatible with 'narrownumbers'.-flag precision-    Description:	Use precise numerical types. CAVEAT: this is incompatible with either 'unboxedarrays' or 'narrownumbers'.+-- Whether to use precise (rational) numeric types rather than faster floating-point.+flag precisenumbers+    Description:	Use precise rational numeric types.     Manual:		True     Default:		False @@ -106,15 +115,14 @@     Manual:		True     Default:		True --- Whether to use unboxed arrays where possible.--- CAVEAT: incompatible with the flag 'precision', & to some extent 'newtypewrappers'.-flag unboxedarrays-    Description:	Use unboxed arrays.+-- Whether to use unboxed types where possible; e.g. in arrays or in primitive arithmetic.+flag unbox+    Description:	Use unboxed types.     Manual:		True-    Default:		False+    Default:		True  -- Automatically disabled when the required package isn't available.--- CAVEAT: on MS-Windows, it may be available but won't necessarily build, so specify "-f -unix --verbose" when configuring the package.+-- CAVEAT: on MS-Windows, it may be available but won't necessarily build; disable using 'runhaskell Setup configure -f -unix --verbose'. flag unix     Description:	Link with package "unix" when available.     Default:		True@@ -130,6 +138,9 @@      GHC-options:	-Wall -Wredundant-constraints -fno-warn-tabs +    if impl(ghc >= 7.0) && flag(llvm)+        GHC-options:	-fllvm+ common exeStanza     Hs-source-dirs:	src-exe     GHC-options:	-O2@@ -139,9 +150,6 @@         bishbosh,         hxt	^>= 9.3.1 -    if impl(ghc >= 7.0) && flag(llvm)-        GHC-options:	-fllvm- common profStanza     if impl(ghc >= 7.4.1)         GHC-prof-options:	-fprof-auto -fprof-cafs@@ -154,12 +162,16 @@ common testStanza     Hs-source-dirs:	src-test     Build-depends:-        array		^>= 0.5.1.1,+        array		>= 0.5.2.0,         bishbosh,         mtl		^>= 2.2.2,         random,         toolshed	^>= 0.18.0 +-- Hackage complains about the fragility resulting from new warnings added to ghc.+--    if impl(ghc >= 6.8)+--        GHC-options:	-Werror+     if flag(polyparse)         Build-depends:	polyparse ^>= 1.13         CPP-Options:	-DUSE_POLYPARSE='L'@@ -168,7 +180,7 @@  Library     Import:		commonStanza, profStanza-    GHC-options:	-O2 -fno-warn-unused-top-binds -Wno-all-missed-specialisations+    GHC-options:	-O2 -fno-warn-unused-top-binds     Hs-source-dirs:	src-lib      Exposed-modules:@@ -189,7 +201,8 @@         BishBosh.Component.EitherQualifiedMove         BishBosh.Component.Move         BishBosh.Component.Piece-        BishBosh.Component.PieceSquareByCoordinatesByRank+        BishBosh.Component.PieceSquareValueByCoordinates+        BishBosh.Component.PieceSquareValueByCoordinatesByRank         BishBosh.Component.QualifiedMove         BishBosh.Component.Turn         BishBosh.Component.Zobrist@@ -301,7 +314,7 @@         BishBosh.UI.SetObject      Build-depends:-        array		^>= 0.5.1.1,+        array		>= 0.5.2.0,         deepseq		>= 1.4.3,         extra		^>= 1.7.4,         factory		^>= 0.3.1,@@ -312,21 +325,26 @@         time,         toolshed	^>= 0.18.0 -    if impl(ghc >= 7.0) && flag(llvm)-        GHC-options:	-fllvm--    if flag(precision)-        CPP-Options:	-DUSE_PRECISION-    else-        if flag(narrownumbers)-            CPP-Options:	-DUSE_NARROW_NUMBERS+    if flag(arrayunsafeat)+        CPP-Options:	-DUSE_ARRAY_UNSAFEAT -        if flag(unboxedarrays)-            CPP-Options:	-DUSE_UNBOXED_ARRAYS+    if flag(precisenumbers)+        CPP-Options:	-DUSE_PRECISE_NUMBERS+    elif flag(narrownumbers)+        CPP-Options:	-DUSE_NARROW_NUMBERS      if flag(newtypewrappers)-        CPP-Options:		-DUSE_NEWTYPE_WRAPPERS+        CPP-Options:	-DUSE_NEWTYPE_WRAPPERS+    elif flag(unbox)+        CPP-Options:	-DUNBOX_TYPECOUNT_ARRAYS +        if !flag(narrownumbers)+            Build-depends:	ghc-prim+            CPP-Options:	-DUSE_PRIMITIVE++        if !flag(precisenumbers)+            CPP-Options:	-DUNBOX_TYPEMASS_ARRAYS+     if flag(polyparse)         Build-depends:		polyparse ^>= 1.13         CPP-Options:		-DUSE_POLYPARSE='L'@@ -335,8 +353,8 @@         Build-depends:		parsec ^>= 3.1.14.0      if flag(threaded)-        Build-depends:		parallel >= 3.0-        CPP-Options:		-DUSE_PARALLEL+        Build-depends:	parallel >= 3.0+        CPP-Options:	-DPARALLELISE  Executable bishbosh     Import:	commonStanza, exeStanza, profStanza@@ -354,7 +372,7 @@         Other-modules:	BishBosh.Concurrent.SignalHandlers      Build-depends:-        array		^>= 0.5.1.1,+        array		>= 0.5.2.0,         deepseq		^>= 1.4.1,         directory,         extra		^>= 1.7.4,@@ -473,13 +491,12 @@         BishBosh.Test.QuickCheck.Input.Options         BishBosh.Test.QuickCheck.Input.PGNOptions         BishBosh.Test.QuickCheck.Input.PieceSquareTable-        BishBosh.Test.QuickCheck.Input.RankValues         BishBosh.Test.QuickCheck.Input.SearchOptions+        BishBosh.Test.QuickCheck.Input.RankValues         BishBosh.Test.QuickCheck.Input.StandardOpeningOptions         BishBosh.Test.QuickCheck.Input.UIOptions         BishBosh.Test.QuickCheck.Input.Verbosity         BishBosh.Test.QuickCheck.Metric.CriterionWeight-        BishBosh.Test.QuickCheck.Metric.RankValue         BishBosh.Test.QuickCheck.Model.Game         BishBosh.Test.QuickCheck.Model.GameTree         BishBosh.Test.QuickCheck.Model.MoveFrequency@@ -520,10 +537,11 @@         QuickCheck	^>= 2.13.2      if flag(newtypewrappers)+        Other-modules:	BishBosh.Test.QuickCheck.Metric.RankValue         CPP-Options:	-DUSE_NEWTYPE_WRAPPERS -    if flag(precision)-        CPP-Options:	-DUSE_PRECISION+    if flag(precisenumbers)+        CPP-Options:	-DUSE_PRECISE_NUMBERS     elif flag(narrownumbers)         CPP-Options:	-DUSE_NARROW_NUMBERS 

@@ -24,7 +24,7 @@  Summary:	BishBosh is a chess-game. Name:		bishbosh-Version:	0.1.3.1+Version:	0.1.4.0 Release:	1 License:	GPLv3 # From '/usr/share/doc/packages/rpm/GROUPS'.

@@ -165,3 +165,18 @@ ## 0.1.3.1 * Increased minimum version for package **deepseq**, to access function **rwhnf**. +## 0.1.4.0+* Rationalised the type-signature of function **BishBosh.StateProperty.Mutator.movePiece** & refactored **BishBosh.State.{Board, CoordinatesByRankByLogicalColour, MaybePieceByCoordinates}.movePiece**.+* Created function **Cartesian.Coordinates.isBetween** to support function **Model.Game.listQualifiedMovesAvailableTo**.+* Efficiency:+	+ Implemented functions **BishBosh.Cartesian.{Coordinates.fromEnum, Ordinate.reflect}** in unboxed primitive arithmetic.+	+ Moved **Either** outwards in the data-type **BishBosh.Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank**, reducing its size, improving performance, & increasing LR symmetry.+	+ Added function **BishBosh.Attribute.MoveType.apply**, & called it from **BishBosh.Evaluation.Fitness.measurePieceSquareValueDifferenceIncrementally** to facilitate catering for *Castling* & *Promotion*.+	+ Added record-field **BishBosh.Input.StandardOpeningOptions.getMaybeMaximumPliesSinceMatch**, to limit the number of failures to match the position against a prerecorded game, before abandoning further attempts.+	+ Unboxed arrays **BishBosh.Input.RankValue.RankValues** & **BishBosh.StateProperty.Censor.NPiecesByRank** (used in record-field **BishBosh.State.Board.getNPiecesDifferenceByRank**), to improve the efficiency of function **BishBosh.Evaluation.Fitness.measureValueOfMaterial**.+	+ Added function **Cartesian.Coordinates.ixInterpolate** to support **State.MaybePieceByCoordinates.isClear**, where it can use **Data.Array.Base.unsafeAt** to bypass repeated conversion from coordinates to array-indices.+	+ Amended **BishBosh.Cartesian.Coordinates.{extrapolate, interpolate}** to also return an array-index, i.e. *(Coordinates, Int)*, thus reducing repeated calls to **Data.Array.IArray.Ix.index Coordinates**.+* Structural:+	+ Split module **BishBosh.Component.PieceSquareByCoordinatesByRank** into **BishBosh.Component.PieceSquareValueByCoordinates** & **BishBosh.Component.PieceSquareValueByCoordinatesByRank**.+	+ Migrated the **CPP**-logic to establish compatibility between environment-variables, into the Cabal-file; also renamed some environment-variables & flags for clarity.+

@@ -28,7 +28,7 @@ 	</evaluationOptions> 	<searchOptions captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3" sortOnStandardOpeningMoveFrequency="True" usePondering="True"> 		&transpositions;-		<standardOpeningOptions preferVictories="False"/>	<!-- the SCID PGN-database only contains standard-openings -->+		&standardOpeningOptions; 		<searchDepthByLogicalColour> 			<byLogicalColour logicalColour="Black" searchDepth="5"/> 		</searchDepthByLogicalColour>

@@ -28,7 +28,7 @@ 	</evaluationOptions> 	<searchOptions captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3" sortOnStandardOpeningMoveFrequency="True" usePondering="True"> 		&transpositions;-		<standardOpeningOptions preferVictories="False"/>	<!-- the SCID PGN-database only contains standard-openings -->+		&standardOpeningOptions; 		<searchDepthByLogicalColour> 			<byLogicalColour logicalColour="Black" searchDepth="4"/> 		</searchDepthByLogicalColour>

@@ -28,7 +28,7 @@ 	</evaluationOptions> 	<searchOptions captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3" sortOnStandardOpeningMoveFrequency="True" usePondering="True"> 		&transpositions;-		<standardOpeningOptions preferVictories="False"/>	<!-- the SCID PGN-database only contains standard-openings -->+		&standardOpeningOptions; 		<searchDepthByLogicalColour> 			<byLogicalColour logicalColour="Black" searchDepth="4"/> 		</searchDepthByLogicalColour>

@@ -28,7 +28,7 @@ 	</evaluationOptions> 	<searchOptions captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3" sortOnStandardOpeningMoveFrequency="True"> 		&transpositions;-		<standardOpeningOptions preferVictories="False"/>	<!-- the SCID PGN-database only contains standard-openings -->+		&standardOpeningOptions; 		<searchDepthByLogicalColour> 			<byLogicalColour logicalColour="Black" searchDepth="4"/> 			<byLogicalColour logicalColour="White" searchDepth="4"/>

@@ -33,7 +33,7 @@ 	</evaluationOptions> 	<searchOptions captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3" sortOnStandardOpeningMoveFrequency="True" usePondering="False">	<!-- CAVEAT: pondering uses time more productively used by the other instance --> 		&transpositions;-		<standardOpeningOptions preferVictories="False"/>	<!-- maximise randomness -->+		&standardOpeningOptions; 		<searchDepthByLogicalColour> 			<byLogicalColour logicalColour="Black" searchDepth="3"/> 		</searchDepthByLogicalColour>

@@ -33,7 +33,7 @@ 	</evaluationOptions> 	<searchOptions captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3" sortOnStandardOpeningMoveFrequency="True" usePondering="False">	<!-- CAVEAT: pondering uses time more productively used by the other instance --> 		&transpositions;-		<standardOpeningOptions preferVictories="False"/>	<!-- maximise randomness -->+		&standardOpeningOptions; 		<searchDepthByLogicalColour> 			<byLogicalColour logicalColour="White" searchDepth="3"/> 		</searchDepthByLogicalColour>

@@ -28,7 +28,7 @@ 	</evaluationOptions> 	<searchOptions captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3" sortOnStandardOpeningMoveFrequency="True"> 		&transpositions;-		<standardOpeningOptions preferVictories="False"/>	<!-- the SCID PGN-database only contains standard-openings -->+		&standardOpeningOptions; 		<searchDepthByLogicalColour> 			<byLogicalColour logicalColour="Black" searchDepth="4"/> 			<byLogicalColour logicalColour="White" searchDepth="4"/>

@@ -28,7 +28,7 @@ 	</evaluationOptions> 	<searchOptions captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3" sortOnStandardOpeningMoveFrequency="True" usePondering="True"> 		&transpositions;-		<standardOpeningOptions preferVictories="False"/>	<!-- the SCID PGN-database only contains standard-openings -->+		&standardOpeningOptions; 		<searchDepthByLogicalColour> 			<byLogicalColour logicalColour="White" searchDepth="4"/> 		</searchDepthByLogicalColour>

@@ -75,25 +75,27 @@ 			trapRepeatedPositions			(False | True)	#IMPLIED 			usePondering				(False | True)	#IMPLIED 		>+		<!ELEMENT transpositions EMPTY>+			<!ATTLIST transpositions+				retireTranspositionsAfter	CDATA	#REQUIRED+				minimumTranspositionSearchDepth	CDATA	#REQUIRED+			>+		<!ENTITY transpositions SYSTEM "transpositions.xml"> 		<!ELEMENT standardOpeningOptions EMPTY> 			<!ATTLIST standardOpeningOptions+				maximumPliesSinceMatch		CDATA		#IMPLIED+				preferVictories			(False | True)	#IMPLIED 				tryToMatchMoves			(False | True)	#IMPLIED 				tryToMatchViaJoiningMove	(False | True)	#IMPLIED 				tryToMatchColourFlippedPosition	(False | True)	#IMPLIED-				preferVictories			(False | True)	#IMPLIED 			>+		<!ENTITY standardOpeningOptions SYSTEM "standardOpeningOptions.xml"> 		<!ELEMENT searchDepthByLogicalColour (byLogicalColour)*> 			<!ELEMENT byLogicalColour EMPTY> 				<!ATTLIST byLogicalColour 					logicalColour	(Black | White) #REQUIRED 					searchDepth	CDATA		#REQUIRED 				>-		<!ELEMENT transpositions EMPTY>-			<!ATTLIST transpositions-				retireTranspositionsAfter	CDATA	#REQUIRED-				minimumTranspositionSearchDepth	CDATA	#REQUIRED-			>-		<!ENTITY transpositions SYSTEM "transpositions.xml"> 	<!ELEMENT ioOptions ((pgnOptions)*, (persistence)?, (uiOptions)?)> 		<!ATTLIST ioOptions 			outputConfigFilePath	CDATA	#IMPLIED

@@ -93,19 +93,23 @@ 					</optional><optional> 						<element name="standardOpeningOptions"> 							<optional>-								<attribute name="tryToMatchMoves">+								<attribute name="maximumPliesSinceMatch">+									<data type="nonNegativeInteger"/>+								</attribute>+							</optional><optional>+								<attribute name="preferVictories"> 									<ref name="Boolean"/> 								</attribute> 							</optional><optional>-								<attribute name="tryToMatchViaJoiningMove">+								<attribute name="tryToMatchMoves"> 									<ref name="Boolean"/> 								</attribute> 							</optional><optional>-								<attribute name="tryToMatchColourFlippedPosition">+								<attribute name="tryToMatchViaJoiningMove"> 									<ref name="Boolean"/> 								</attribute> 							</optional><optional>-								<attribute name="preferVictories">+								<attribute name="tryToMatchColourFlippedPosition"> 									<ref name="Boolean"/> 								</attribute> 							</optional>

@@ -0,0 +1,24 @@+<!--+	AUTHOR: Dr. Alistair Ward++	Copyright (C) 2021 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/>.+-->+<!--+	This controls standard-opening options.+-->+<standardOpeningOptions maximumPliesSinceMatch="3" preferVictories="False"/>       <!-- Permits the tightest transposition away from a prerecorded game, & back. Standard-openings don't typically describe an entire game.  -->

@@ -31,46 +31,44 @@ hlint: $(BIN_DIR)/hlint 	@$@ -j	--no-exit-code\ 		--cpp-define 'USE_NEWTYPE_WRAPPERS'\-		--cpp-define 'USE_PARALLEL'\+		--cpp-define 'PARALLELISE'\ 		--cpp-define 'USE_POLYPARSE=L'\-		--cpp-define 'USE_UNBOXED_ARRAYS'\ 		--ignore 'Use tuple-section'\ 		src-lib/ +RTS -N -RTS 	@$@ -j	--no-exit-code\ 		--cpp-define 'MOVE_NOTATION=S'\ 		--cpp-define 'USE_HXTRELAXNG'\-		--cpp-define 'USE_UNBOXED_ARRAYS'\ 		--cpp-define 'USE_UNIX'\-		--ignore 'Reduce duplication'\ 		src-exe/ +RTS -N -RTS 	@$@ -j	--cpp-define 'USE_NEWTYPE_WRAPPERS'\-		--cpp-define 'USE_POLYPARSE=L'\ 		--cpp-define 'USE_BRATKO_KOPEC'\ 		--ignore 'Use tuple-section'\ 		src-test/ +RTS -N -RTS  # Serially compile with various CPP-flags & run the test-suites. test:-	@for FLAG in -polyparse newtypewrappers narrownumbers unboxedarrays -hxtrelaxng -threaded precision; do\+	@for FLAG in -polyparse newtypewrappers unbox precisenumbers narrownumbers -hxtrelaxng -arrayunsafeat -threaded llvm; do\ 		echo $${FLAG};\ 		stack '$@' --flag="$(PACKAGE_NAME):$${FLAG}" $(GHC_OPTIONS) '$(PACKAGE_NAME):test:hunit-tests' '$(PACKAGE_NAME):test:quickcheck-tests' || break;\ 	done -# Compile with random CPP-flags & run the test-suites.+# Repeatedly compile with random CPP-flags & run the test-suites, until failure. randomTest:-	FLAGS=$$(shuf --echo -- hxtrelaxng narrownumbers newtypewrappers polyparse precision threaded unboxedarrays | head --lines=3 | sed -e '1s/^/-/' -e 's/\(.*\)/--flag=$(PACKAGE_NAME):\1/');\+	@FLAGS=$$(shuf --echo -- arrayunsafeat hxtrelaxng llvm narrownumbers newtypewrappers polyparse precisenumbers threaded unbox | head --lines=4 | sed -e '1,2s/^/-/' -e 's/\(.*\)/--flag=$(PACKAGE_NAME):\1/');\ 	echo $${FLAGS};\-	stack test $${FLAGS} $(GHC_OPTIONS) '$(PACKAGE_NAME):test:hunit-tests' '$(PACKAGE_NAME):test:quickcheck-tests'+	stack test $${FLAGS} $(GHC_OPTIONS) '$(PACKAGE_NAME):test:hunit-tests' '$(PACKAGE_NAME):test:quickcheck-tests';+	make '$@'; # Recurse.  # Profile a single-threaded build, to access entry-counts. prof: 	@stack install --profile --flag='$(PACKAGE_NAME):-threaded' $(GHC_OPTIONS) '$(PACKAGE_NAME):exe:$(PACKAGE_NAME)';-	sleep 32;	# Let the test-machine reach a quiescent state.+	sleep 60;	# Let the test-machine reach a quiescent state. 	@$(PACKAGE_NAME) -i 'config/Raw/$(PACKAGE_NAME)_$@.xml' +RTS -p -RTS  # Profile. profN2: 	@stack install --profile $(GHC_OPTIONS) '$(PACKAGE_NAME):exe:$(PACKAGE_NAME)';+	sleep 60;	# Let the test-machine reach a quiescent state. 	@$(PACKAGE_NAME) -i 'config/Raw/$(PACKAGE_NAME)_prof.xml' +RTS -p -N2 -RTS  # Install 'bishbosh'.

@@ -137,10 +137,11 @@ lb	li	lb	l	. Attribute	Type	Default	Meaning =========	====	=======	=======+maximumPliesSinceMatch	Int		the maximum number of plies since the last match with a prerecorded game, before abandoning further attempts; defaulting to \fIunlimited\fR.+preferVictories	Bool	True	whether from all matching positions extracted from the PGN-database, to prefer moves which result in a greater probability of victory, for the player who has the next move. tryToMatchMoves	Bool	True	whether to attempt to exactly match the moves already made, with a standard opening; i.e. without matching transpositions. tryToMatchViaJoiningMove	Bool	True	whether to attempt to join the current position (irrespective of the means by which it was achieved) to a standard opening that's only one move away. tryToMatchColourFlippedPosition	Bool	True	whether to attempt to match a colour-flipped (<\fBhttps://www.chessprogramming.org/Color_Flipping\fR>) version of the current position with a standard opening.-preferVictories	Bool	True	whether from all matching positions extracted from the PGN-database, to prefer moves which result in a greater probability of victory, for the player who has the next move. .TE .IP \(bu \fBsearchDepth\fR \fIInt\fR, defaulting to "\fB4\fR" (minimum "\fB1\fR"): the number of plies (half moves) to search ahead, when selecting the next move.@@ -162,7 +163,7 @@ Attribute	Type	Default	Meaning =========	====	=======	======= databaseFilePath	\fIFile-path\fR		The path in the local file-system, to a PGN-database.-decompressor	String		The optional name of an executable (available in the OS) used to decompress (to \fIstdout\fR) the specified file; the file's suffix isn't considered significant.+decompressor	\fIString\fR		The optional name of an executable (available in the OS) used to decompress (to \fIstdout\fR) the specified file; the file's suffix isn't considered significant. minimumPlies	\fIInt\fR	1	The minimum number of half moves, for an archived game to be considered valuable. maximumGames	\fIInt\fR		The optional maximum number of games to read from the database. isStrictlySequential	(\fBTrue\fR|\fBFalse\fR)	True	Whether the recorded move-numbers are accurate.

@@ -66,10 +66,7 @@ 	-> Control.Concurrent.MVar answer 	-> IO (Pondering premise) ponder putStrLn' (premiseString, premise) answer mVar	= do-	threadId	<- Control.Concurrent.forkIO $ do-		Control.Concurrent.putMVar mVar $!! answer--		putStrLn' $ showString "pondering-thread has a response based on " premiseString+	threadId	<- Control.Concurrent.forkIO . Control.Concurrent.putMVar mVar $!! answer  	putStrLn' . showString "pondering (on " . shows threadId $ showString ") a response to " premiseString 

@@ -23,7 +23,7 @@  	* Constructs the Zobrist data-type. -	* Analyses standard-opening moves in order to statically sort the move-tree.+	* Analyses standard opening moves in order to statically sort the move-tree.  	* Reads any persistent game-state from file, to initialise the play-state, which constructs the quantified move tree. 

@@ -34,7 +34,8 @@ --		getMoveFrequency, 		getSearchState, 		getOptions,-		getMaybeApplicationTerminationReason+		getMaybeApplicationTerminationReason,+		getNPliesSinceStandardOpeningMatch 	), -- * Functions 	calculateCriterionValueStatistics,@@ -46,6 +47,7 @@ -- ** Mutators 	reconstructPositionHashQuantifiedGameTree, 	resetPositionHashQuantifiedGameTree,+	rollBackPositionHashQuantifiedGameTree, --	setPositionHashQuantifiedGameTree, 	updateWithAutomaticMove, 	updateWithManualMove,@@ -71,6 +73,7 @@ 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.Count					as Type.Count import qualified	BishBosh.Type.Crypto					as Type.Crypto import qualified	BishBosh.Type.Mass					as Type.Mass import qualified	Control.Exception@@ -88,7 +91,8 @@ 	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.+	getMaybeApplicationTerminationReason	:: Maybe State.ApplicationTerminationReason.ApplicationTerminationReason,	-- ^ Whether the game has terminated.+	getNPliesSinceStandardOpeningMatch	:: Type.Count.NPlies								-- ^ The number of plies since matching the position with a standard opening. }  -- | Constructor.@@ -114,7 +118,8 @@ 		Input.Options.getEvaluationOptions &&& Input.Options.getSearchOptions $ options 	) zobrist moveFrequency game, 	getOptions				= options,-	getMaybeApplicationTerminationReason	= Nothing+	getMaybeApplicationTerminationReason	= Nothing,+	getNPliesSinceStandardOpeningMatch	= 0 }  -- | Accessor.@@ -131,7 +136,10 @@ }  -- | Reconstruct the /positionHashQuantifiedGameTree/ (in the /searchState/), with the apex set to the specified game.-reconstructPositionHashQuantifiedGameTree :: Data.Bits.Bits positionHash => Model.Game.Game -> Transformation positionHash+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,@@ -148,22 +156,43 @@ {-# SPECIALISE resetPositionHashQuantifiedGameTree :: Transformation Type.Crypto.PositionHash #-} resetPositionHashQuantifiedGameTree playState	= reconstructPositionHashQuantifiedGameTree Data.Default.def playState { 	getCriterionValues			= [],-	getMaybeApplicationTerminationReason	= Nothing+	getMaybeApplicationTerminationReason	= Nothing,+	getNPliesSinceStandardOpeningMatch	= 0 } +-- | Roll-back the state by the specified number of plies.+rollBackPositionHashQuantifiedGameTree+	:: Data.Bits.Bits positionHash+	=> Model.Game.Game+	-> Type.Count.NPlies+	-> Transformation positionHash+{-# SPECIALISE rollBackPositionHashQuantifiedGameTree :: Model.Game.Game -> Type.Count.NPlies -> Transformation Type.Crypto.PositionHash #-}+rollBackPositionHashQuantifiedGameTree game nPlies playState@MkPlayState {+	getNPliesSinceStandardOpeningMatch	= nPliesSinceStandardOpeningMatch+} = reconstructPositionHashQuantifiedGameTree game playState {+	getNPliesSinceStandardOpeningMatch	= max 0 $ nPliesSinceStandardOpeningMatch - nPlies+}+ -- | Mutator. updateWithAutomaticMove 	:: [Metric.CriterionValue.CriterionValue] 	-> Search.SearchState.SearchState positionHash 	-> Transformation positionHash-updateWithAutomaticMove criterionValues searchState playState	= playState {-	getCriterionValues	= criterionValues : getCriterionValues playState,-	getSearchState		= searchState+updateWithAutomaticMove criterionValues' searchState playState@MkPlayState {+	getCriterionValues			= criterionValues,+	getNPliesSinceStandardOpeningMatch	= nPliesSinceStandardOpeningMatch+} = playState {+	getCriterionValues			= criterionValues' : criterionValues,+	getSearchState				= searchState,+	getNPliesSinceStandardOpeningMatch	= succ nPliesSinceStandardOpeningMatch }  -- | Mutator.-updateWithManualMove :: Model.Game.Game -> Transformation positionHash-updateWithManualMove game playState@MkPlayState { getSearchState = searchState }	= setPositionHashQuantifiedGameTree (+updateWithManualMove+	:: Model.Game.Game+	-> Bool	-- ^ Whether the move matches a standard opening.+	-> Transformation positionHash+updateWithManualMove game standardOpeningMatch 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 (@@ -175,7 +204,11 @@ 			) 		) . Evaluation.QuantifiedGame.getLastTurn . Evaluation.PositionHashQuantifiedGameTree.getQuantifiedGame 	) $ Search.SearchState.getPositionHashQuantifiedGameTree searchState- ) playState+ ) $ playState {+	getNPliesSinceStandardOpeningMatch	= if standardOpeningMatch+		then 0+		else succ $ getNPliesSinceStandardOpeningMatch playState+ }  -- | Calculate the /root-mean-square/ & the /standard-deviation/, of the values of each type of /criterion/. calculateCriterionValueStatistics :: (

@@ -198,14 +198,17 @@ 	-> State.PlayState.PlayState positionHash 	-> IO (State.PlayState.PlayState positionHash) {-# SPECIALISE readMove :: ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree Type.Crypto.PositionHash -> System.Random.StdGen -> Time.StopWatch.StopWatch -> State.PlayState.PlayState Type.Crypto.PositionHash -> IO (State.PlayState.PlayState Type.Crypto.PositionHash) #-}+{-# ANN readMove "HLint: ignore Reduce duplication" #-} readMove positionHashQualifiedMoveTree randomGen	= slave where 	slave runningWatch playState	= let 		(game, options)			= State.PlayState.getGame &&& State.PlayState.getOptions $ playState 		(searchOptions, ioOptions)	= Input.Options.getSearchOptions &&& Input.Options.getIOOptions $ options -		(searchDepthByLogicalColour, tryToMatchSwitches)	= Input.SearchOptions.getSearchDepthByLogicalColour &&& Input.StandardOpeningOptions.getMatchSwitches . Input.SearchOptions.getStandardOpeningOptions $ searchOptions+		(searchDepthByLogicalColour, standardOpeningOptions)	= Input.SearchOptions.getSearchDepthByLogicalColour &&& Input.SearchOptions.getStandardOpeningOptions $ searchOptions 		fullyManual						= Data.Foldable.null searchDepthByLogicalColour +		matchSwitches	= Input.StandardOpeningOptions.getMatchSwitches standardOpeningOptions+ 		uiOptions	= Input.IOOptions.getUIOptions ioOptions  		moveNotation	= Input.UIOptions.getMoveNotation uiOptions@@ -219,7 +222,21 @@  			onCommand :: UI.Command.Command -> IO (State.PlayState.PlayState positionHash) 			onCommand UI.Command.Hint	= do-				Control.Monad.unless (Model.Game.isTerminated game) . Data.Maybe.maybe (+				Control.Monad.unless (Model.Game.isTerminated game) $ (+					let+						nPliesSinceStandardOpeningMatch	= State.PlayState.getNPliesSinceStandardOpeningMatch playState+					in if Data.Maybe.maybe True {-unlimited-} (nPliesSinceStandardOpeningMatch <=) $ Input.StandardOpeningOptions.getMaybeMaximumPliesSinceMatch standardOpeningOptions+						then do+							Control.Monad.when (verbosity > Data.Default.def) . System.IO.hPutStrLn System.IO.stderr $ Text.ShowPrefix.showsPrefixInfo "attempting to match the current position with prerecorded games."++							return {-to IO-monad-} $ ContextualNotation.PositionHashQualifiedMoveTree.maybeRandomlySelectOnymousQualifiedMove randomGen (+								Input.StandardOpeningOptions.getPreferVictories standardOpeningOptions+							 ) matchSwitches positionHashQualifiedMoveTree game+						else do+							Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixInfo $ shows nPliesSinceStandardOpeningMatch " plies since matching the position with a prerecorded game => not attempting."++							return {-to IO-monad-} Nothing	-- Don't attempt to match.+				 ) >>= Data.Maybe.maybe ( 					do 						Control.Monad.when (verbosity > Data.Default.def && not (ContextualNotation.PositionHashQualifiedMoveTree.isTerminal positionHashQualifiedMoveTree)) . System.IO.hPutStrLn System.IO.stderr $ Text.ShowPrefix.showsPrefixInfo "failed to find any suitable archived move." @@ -241,9 +258,7 @@ 					\(qualifiedMove, _) -> putStrLn . showString hintTag . showChar ' ' $ if displaySAN 						then ContextualNotation.StandardAlgebraic.showMove explicitEnpassant qualifiedMove game 						else Notation.MoveNotation.showNotation moveNotation qualifiedMove-				 ) $ ContextualNotation.PositionHashQualifiedMoveTree.maybeRandomlySelectOnymousQualifiedMove randomGen (-					Input.StandardOpeningOptions.getPreferVictories . Input.SearchOptions.getStandardOpeningOptions $ searchOptions-				 ) tryToMatchSwitches positionHashQualifiedMoveTree game+				 )  				return {-to IO-monad-} playState	-- N.B.: though one could merely call "eventLoop", a new random-generator is desirable in case an alternative hint is requested. 			onCommand (UI.Command.Print printObject)	= do@@ -301,7 +316,7 @@ 			onCommand (UI.Command.RollBack maybeNPlies)	= let 				rollBack :: Type.Count.NPlies -> IO (State.PlayState.PlayState positionHash) 				rollBack nPlies-					| (game', _) : _ <- drop (fromIntegral $ pred nPlies) $ Model.Game.rollBack game	= return {-to IO-monad-} $ State.PlayState.reconstructPositionHashQuantifiedGameTree game' playState+					| (game', _) : _ <- drop (fromIntegral $ pred nPlies) $ Model.Game.rollBack game	= return {-to IO-monad-} $ State.PlayState.rollBackPositionHashQuantifiedGameTree game' nPlies playState 					| otherwise										= onCommand UI.Command.Restart 			 in Data.Maybe.maybe ( 				let@@ -413,7 +428,7 @@ 										[(name, _result)]	-> showString ":\t" . showString name 										_			-> id 								) ""-							 ) $ ContextualNotation.PositionHashQualifiedMoveTree.findNextOnymousQualifiedMoves tryToMatchSwitches positionHashQualifiedMoveTree game+							 ) $ ContextualNotation.PositionHashQualifiedMoveTree.findNextOnymousQualifiedMoves matchSwitches positionHashQualifiedMoveTree game  							eventLoop 						"computer"	-> eventLoop	-- No action required.@@ -966,7 +981,7 @@  								let 									game'		= Model.Game.applyEitherQualifiedMove eitherQualifiedMove game-									playState'	= State.PlayState.updateWithManualMove game' playState+									playState'	= State.PlayState.updateWithManualMove game' False {-No match-} playState  								Control.Monad.when (verbosity == maxBound) $ do 									System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixInfo . showString Component.Move.tag . Text.ShowList.showsAssociation . shows (@@ -1022,6 +1037,8 @@ 		evaluationOptions	= Input.Options.getEvaluationOptions options 		searchOptions		= Input.Options.getSearchOptions options +		standardOpeningOptions	= Input.SearchOptions.getStandardOpeningOptions searchOptions+ 		(uiOptions, maybeMaximumPGNNames)	= Input.IOOptions.getUIOptions &&& Input.IOOptions.getMaybeMaximumPGNNames $ ioOptions  		moveNotation	= Input.UIOptions.getMoveNotation uiOptions@@ -1060,7 +1077,23 @@ 								else return {-to IO-monad-} 						 ) maybePondering 				 ) (-					\searchDepth' -> Data.Maybe.maybe (+					\searchDepth' -> (+						let+							nPliesSinceStandardOpeningMatch	= State.PlayState.getNPliesSinceStandardOpeningMatch playState'+						in if Data.Maybe.maybe True {-unlimited-} (nPliesSinceStandardOpeningMatch <=) $ Input.StandardOpeningOptions.getMaybeMaximumPliesSinceMatch standardOpeningOptions+							then do+								Control.Monad.when (verbosity > Data.Default.def) . System.IO.hPutStrLn System.IO.stderr $ Text.ShowPrefix.showsPrefixInfo "attempting to match the current position with prerecorded games."++								return {-to IO-monad-} $ uncurry (+									ContextualNotation.PositionHashQualifiedMoveTree.maybeRandomlySelectOnymousQualifiedMove randomGen'+								 ) (+									Input.StandardOpeningOptions.getPreferVictories &&& Input.StandardOpeningOptions.getMatchSwitches $ standardOpeningOptions+								 ) positionHashQualifiedMoveTree game'	-- Determine whether the automated player's move can be decided by a search of recorded games or we must decide ourself.+							else do+								Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixInfo $ shows nPliesSinceStandardOpeningMatch " plies since matching the position with a prerecorded game => not attempting."++								return {-to IO-monad-} Nothing	-- Don't attempt to match.+					) >>= Data.Maybe.maybe ( 						do 							Control.Monad.when ( 								verbosity > Data.Default.def && not (@@ -1157,7 +1190,7 @@ 							Data.Maybe.maybe ( 								return {-to IO-monad-} () 							 ) (-								Concurrent.Pondering.abort mVar >=> Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixInfo . showString "pondering pre-empted by standard-opening match => "+								Concurrent.Pondering.abort mVar >=> Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixInfo . showString "pondering pre-empted by a match with a prerecorded game => " 							 ) maybePondering  							let selectedGame	= Model.Game.applyQualifiedMove qualifiedMove game'@@ -1174,12 +1207,8 @@  							putStrLn . showString moveTag . showChar ' ' $ Notation.MoveNotation.showNotation moveNotation qualifiedMove	-- Send the move to the GUI. -							return {-to IO-monad-} (State.PlayState.updateWithManualMove selectedGame playState', Nothing)	-- N.B.: one could ponder, but would have to construct a game-tree, & the chance of a subsequent standard-opening move is high.-					 ) $ uncurry (-						ContextualNotation.PositionHashQualifiedMoveTree.maybeRandomlySelectOnymousQualifiedMove randomGen'-					 ) (-						Input.StandardOpeningOptions.getPreferVictories &&& Input.StandardOpeningOptions.getMatchSwitches $ Input.SearchOptions.getStandardOpeningOptions searchOptions-					 ) positionHashQualifiedMoveTree game'	-- Determine whether the automated player's move can be decided by a search of recorded games or we must decide ourself.+							return {-to IO-monad-} (State.PlayState.updateWithManualMove selectedGame True {-match-} playState', Nothing)	-- N.B.: one could ponder, but would have to construct a game-tree, & the chance of a subsequent standard opening move is high.+					 ) 				 ) ( 					if Input.UIOptions.isCECPManualMode uiOptions' 						then Nothing

@@ -64,7 +64,6 @@ import qualified	BishBosh.State.PlayState					as State.PlayState import qualified	BishBosh.Text.ShowColouredPrefix				as Text.ShowColouredPrefix import qualified	BishBosh.Text.ShowList						as Text.ShowList-import qualified	BishBosh.Text.ShowPrefix					as Text.ShowPrefix import qualified	BishBosh.Time.StopWatch						as Time.StopWatch import qualified	BishBosh.Type.Count						as Type.Count import qualified	BishBosh.Type.Crypto						as Type.Crypto@@ -103,13 +102,15 @@ 	-> State.PlayState.PlayState positionHash 	-> IO (State.PlayState.PlayState positionHash) {-# SPECIALISE readMove :: ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree Type.Crypto.PositionHash -> System.Random.StdGen -> Time.StopWatch.StopWatch -> State.PlayState.PlayState Type.Crypto.PositionHash -> IO (State.PlayState.PlayState Type.Crypto.PositionHash) #-}+{-# ANN readMove "HLint: ignore Reduce duplication" #-} readMove positionHashQualifiedMoveTree randomGen runningWatch playState	= let 	(game, options)			= State.PlayState.getGame &&& State.PlayState.getOptions $ playState 	(searchOptions, ioOptions)	= Input.Options.getSearchOptions &&& Input.Options.getIOOptions $ options -	searchDepthByLogicalColour	= Input.SearchOptions.getSearchDepthByLogicalColour searchOptions-	fullyManual			= Data.Foldable.null searchDepthByLogicalColour+	(searchDepthByLogicalColour, standardOpeningOptions)	= Input.SearchOptions.getSearchDepthByLogicalColour &&& Input.SearchOptions.getStandardOpeningOptions $ searchOptions +	fullyManual	= Data.Foldable.null searchDepthByLogicalColour+ 	(uiOptions, maybeMaximumPGNNames)	= Input.IOOptions.getUIOptions &&& Input.IOOptions.getMaybeMaximumPGNNames $ ioOptions  	moveNotation	= Input.UIOptions.getMoveNotation uiOptions@@ -132,7 +133,23 @@  		onCommand :: UI.Command.Command -> IO (State.PlayState.PlayState positionHash) 		onCommand UI.Command.Hint	= do-			Control.Monad.unless (Model.Game.isTerminated game) . Data.Maybe.maybe (+			Control.Monad.unless (Model.Game.isTerminated game) $ (+				let+					nPliesSinceStandardOpeningMatch	= State.PlayState.getNPliesSinceStandardOpeningMatch playState+				in if Data.Maybe.maybe True {-unlimited-} (nPliesSinceStandardOpeningMatch <=) $ Input.StandardOpeningOptions.getMaybeMaximumPliesSinceMatch standardOpeningOptions+					then do+						Control.Monad.when (verbosity > Data.Default.def) . System.IO.hPutStrLn System.IO.stderr $ Text.ShowColouredPrefix.showsPrefixInfo "attempting to match the current position with prerecorded games."++						return {-to IO-monad-} $ uncurry (+							ContextualNotation.PositionHashQualifiedMoveTree.maybeRandomlySelectOnymousQualifiedMove randomGen+						 ) (+							Input.StandardOpeningOptions.getPreferVictories &&& Input.StandardOpeningOptions.getMatchSwitches $ standardOpeningOptions+						 ) positionHashQualifiedMoveTree game+					else do+						Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixInfo $ shows nPliesSinceStandardOpeningMatch " plies since matching the position with a prerecorded game => not attempting."++						return {-to IO-monad-} Nothing	-- Don't attempt to match.+			 ) >>= Data.Maybe.maybe ( 				do 					Control.Monad.when (verbosity > Data.Default.def && not (ContextualNotation.PositionHashQualifiedMoveTree.isTerminal positionHashQualifiedMoveTree)) . System.IO.hPutStrLn System.IO.stderr $ Text.ShowColouredPrefix.showsPrefixInfo "failed to find any suitable archived move." @@ -152,11 +169,7 @@ 						_		-> Control.Exception.throwIO . Data.Exception.mkRequestFailure . showString "BishBosh.UI.Raw.readMove.onCommand:\tunexpectedly failed to find any moves; " $ shows game "."	-- CAVEAT: the game should have terminated. 			 ) ( 				\(qualifiedMove, names) -> putStrLn . Text.ShowColouredPrefix.showsPrefixInfo . showString "Try \"" . Notation.MoveNotation.showsNotation moveNotation qualifiedMove . showString "\" from:" $ ContextualNotation.QualifiedMoveForest.showsNames maybeMaximumPGNNames names ""-			 ) $ uncurry (-				ContextualNotation.PositionHashQualifiedMoveTree.maybeRandomlySelectOnymousQualifiedMove randomGen-			 ) (-				Input.StandardOpeningOptions.getPreferVictories &&& Input.StandardOpeningOptions.getMatchSwitches $ Input.SearchOptions.getStandardOpeningOptions searchOptions-			 ) positionHashQualifiedMoveTree game+			 )  			return {-to IO-monad-} playState	-- N.B.: though one could merely call "eventLoop", a new random-generator is desirable in case an alternative hint is requested. 		onCommand (UI.Command.Print printObject)	= do@@ -192,8 +205,6 @@ 		onCommand UI.Command.Restart	= do 			Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr $ Text.ShowColouredPrefix.showsPrefixInfo "restarting game." -			Input.IOOptions.persist ioOptions (verbosity == maxBound) (Data.Default.def :: Model.Game.Game)- 			return {-to IO-monad-} $ State.PlayState.resetPositionHashQuantifiedGameTree playState 		onCommand (UI.Command.RollBack maybeNPlies)	= let 			rollBack :: Type.Count.NPlies -> IO (State.PlayState.PlayState positionHash)@@ -201,7 +212,7 @@ 				| (game', _) : _ <- drop (fromIntegral $ pred nPlies) $ Model.Game.rollBack game	= do 					Control.Monad.when (verbosity == maxBound) . putStrLn $ show2D game' -					return {-to IO-monad-} $ State.PlayState.reconstructPositionHashQuantifiedGameTree game' playState+					return {-to IO-monad-} $ State.PlayState.rollBackPositionHashQuantifiedGameTree game' nPlies playState 				| otherwise	= onCommand UI.Command.Restart 		 in Data.Maybe.maybe ( 			let@@ -301,7 +312,7 @@  						let 							game'		= Model.Game.applyEitherQualifiedMove eitherQualifiedMove game-							playState'	= State.PlayState.updateWithManualMove game' playState+							playState'	= State.PlayState.updateWithManualMove game' False {-No match-} playState  						Control.Monad.when (verbosity == maxBound) $ do 							System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixInfo . showString Component.Move.tag . Text.ShowList.showsAssociation . shows (@@ -354,6 +365,8 @@  	(searchOptions, ioOptions)	= Input.Options.getSearchOptions &&& Input.Options.getIOOptions $ options +	standardOpeningOptions	= Input.SearchOptions.getStandardOpeningOptions searchOptions+ 	uiOptions	= Input.IOOptions.getUIOptions ioOptions  	moveNotation	= Input.UIOptions.getMoveNotation uiOptions@@ -398,13 +411,29 @@ 									then {-rolled-back-} Data.Maybe.maybe ( 										return {-to IO-monad-} Nothing 									) $ \pondering -> do-										Concurrent.Pondering.abort mVar pondering >>= Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixInfo . showString "pondering invalidated by roll-back => "+										Concurrent.Pondering.abort mVar pondering >>= Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixInfo . showString "pondering invalidated by roll-back => "  										return {-to IO-monad-} Nothing	-- Pondering has been terminated. 									else return {-to IO-monad-} 							 ) maybePondering 					 ) (-						\searchDepth' -> Data.Maybe.maybe (+						\searchDepth' -> (+							let+								nPliesSinceStandardOpeningMatch	= State.PlayState.getNPliesSinceStandardOpeningMatch playState'+							in if Data.Maybe.maybe True {-unlimited-} (nPliesSinceStandardOpeningMatch <=) $ Input.StandardOpeningOptions.getMaybeMaximumPliesSinceMatch standardOpeningOptions+								then do+									Control.Monad.when (verbosity > Data.Default.def) . System.IO.hPutStrLn System.IO.stderr $ Text.ShowColouredPrefix.showsPrefixInfo "attempting to match the current position with prerecorded games."++									return {-to IO-monad-} $ uncurry (+										ContextualNotation.PositionHashQualifiedMoveTree.maybeRandomlySelectOnymousQualifiedMove randomGen'+									 ) (+										Input.StandardOpeningOptions.getPreferVictories &&& Input.StandardOpeningOptions.getMatchSwitches $ standardOpeningOptions+									 ) positionHashQualifiedMoveTree game'	-- Determine whether the automated player's move can be decided by a search of recorded games or we must decide ourself.+								else do+									Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixInfo $ shows nPliesSinceStandardOpeningMatch " plies since matching the position with a prerecorded game => not attempting."++									return {-to IO-monad-} Nothing	-- Don't attempt to match.+						) >>= Data.Maybe.maybe ( 							do 								Control.Monad.when ( 									verbosity > Data.Default.def && not (@@ -426,11 +455,11 @@ 										(== Concurrent.Pondering.getPremise pondering) . Component.QualifiedMove.getMove . Component.Turn.getQualifiedMove 									) $ Model.Game.maybeLastTurn game'	-- Confirm whether the pondering initiated at the start of the opponent's turn, was founded on the move they eventually made. 										then do-											Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr $ Text.ShowPrefix.showsPrefixInfo "move-premise validated => waiting."+											Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr $ Text.ShowColouredPrefix.showsPrefixInfo "move-premise validated => waiting."  											Control.Concurrent.takeMVar mVar	-- Blocking read, while the pondering terminates. 										else do-											Concurrent.Pondering.abort mVar pondering >>= Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixInfo . showString "pondering invalidated by incorrect move-premise => "+											Concurrent.Pondering.abort mVar pondering >>= Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixInfo . showString "pondering invalidated by incorrect move-premise => "  											return {-to IO-monad-} searchResult	-- Pondering wasn't well-founded, so the search must be evaluated. 								 ) maybePondering >>= (@@ -468,7 +497,7 @@ 												then case continuation of 													quantifiedGame' {-1st move after ours in optimal move-sequence-} : _	-> fmap Just . ( 														\positionHashQuantifiedGameTree'' -> Concurrent.Pondering.ponder (-															Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixInfo+															Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixInfo 														) ( 															showString "move-premise" . Text.ShowList.showsAssociation . ($ ".") . Notation.MoveNotation.showsNotation moveNotation &&& Component.QualifiedMove.getMove . Component.Turn.getQualifiedMove $ Evaluation.QuantifiedGame.getLastTurn quantifiedGame' 														) (@@ -490,7 +519,7 @@ 								Data.Maybe.maybe ( 									return {-to IO-monad-} () 								 ) (-									Concurrent.Pondering.abort mVar >=> Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixInfo . showString "pondering pre-empted by standard-opening match => "+									Concurrent.Pondering.abort mVar >=> Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixInfo . showString "pondering pre-empted by match with a prerecorded game => " 								 ) maybePondering  								let selectedGame	= Model.Game.applyQualifiedMove qualifiedMove game'@@ -505,12 +534,8 @@  										putStrLn $ show2D selectedGame -								return {-to IO-monad-} (State.PlayState.updateWithManualMove selectedGame playState', Nothing)	-- N.B.: one could ponder, but would have to construct a game-tree, & the chance of a subsequent standard-opening move is high.-						 ) $ uncurry (-							ContextualNotation.PositionHashQualifiedMoveTree.maybeRandomlySelectOnymousQualifiedMove randomGen'-						 ) (-							Input.StandardOpeningOptions.getPreferVictories &&& Input.StandardOpeningOptions.getMatchSwitches $ Input.SearchOptions.getStandardOpeningOptions searchOptions-						 ) positionHashQualifiedMoveTree game'	-- Determine whether the automated player's move can be decided by a search of recorded games or we must decide ourself.+								return {-to IO-monad-} (State.PlayState.updateWithManualMove selectedGame True {-match-} playState', Nothing)	-- N.B.: one could ponder, but would have to construct a game-tree, & the chance of a subsequent standard opening move is high.+						 ) 					 ) ( 						Model.Game.getNextLogicalColour game' `Map.lookup` Input.SearchOptions.getSearchDepthByLogicalColour searchOptions'	-- Determinate whether the next player is manual. 					 ) >>= (

@@ -31,8 +31,7 @@  import			Control.Arrow((&&&), (***), (|||)) import			Control.Category((>>>))-import			Data.Array.IArray((!))-import qualified	BishBosh.Component.PieceSquareByCoordinatesByRank	as Component.PieceSquareByCoordinatesByRank+import qualified	BishBosh.Component.PieceSquareValueByCoordinatesByRank	as Component.PieceSquareValueByCoordinatesByRank import qualified	BishBosh.ContextualNotation.PGN				as ContextualNotation.PGN import qualified	BishBosh.ContextualNotation.PGNDatabase			as ContextualNotation.PGNDatabase import qualified	BishBosh.ContextualNotation.QualifiedMoveForest		as ContextualNotation.QualifiedMoveForest@@ -42,8 +41,8 @@ import qualified	BishBosh.Input.EvaluationOptions			as Input.EvaluationOptions import qualified	BishBosh.Input.IOOptions				as Input.IOOptions import qualified	BishBosh.Input.Options					as Input.Options-import qualified	BishBosh.Input.PieceSquareTable				as Input.PieceSquareTable import qualified	BishBosh.Input.PGNOptions				as Input.PGNOptions+import qualified	BishBosh.Input.PieceSquareTable				as Input.PieceSquareTable import qualified	BishBosh.Input.UIOptions				as Input.UIOptions import qualified	BishBosh.Input.Verbosity				as Input.Verbosity import qualified	BishBosh.Model.Game					as Model.Game@@ -267,24 +266,24 @@ 			formatPieceSquareTableForGNUPlot options	= Data.Maybe.maybe ( 				Control.Exception.throwIO $ Data.Exception.mkNullDatum "the piece-square table is undefined." 			 ) (-				\pieceSquareByCoordinatesByRank	-> putStr . foldr ($) "" . zipWith (.) (+				\pieceSquareValueByCoordinatesByRank	-> putStr . foldr ($) "" . zipWith (.) ( 					map (-						\gamePhase	-> showChar Component.PieceSquareByCoordinatesByRank.gnuPlotComment . showString gamePhase . showString "-game:\n"+						\gamePhase	-> showChar Component.PieceSquareValueByCoordinatesByRank.gnuPlotComment . showString gamePhase . showString "-game:\n" 					) ["Opening", "End"] 				) $ map (-					\selector	-> Component.PieceSquareByCoordinatesByRank.formatForGNUPlot pieceSquareByCoordinatesByRank (+					\selector	-> Component.PieceSquareValueByCoordinatesByRank.formatForGNUPlot pieceSquareValueByCoordinatesByRank ( 						Property.ShowFloat.showsFloatToN' (-							Input.UIOptions.getNDecimalDigits . Input.IOOptions.getUIOptions $ Input.Options.getIOOptions options	-- PieceSquareValue formatter.+							Input.UIOptions.getNDecimalDigits . Input.IOOptions.getUIOptions $ Input.Options.getIOOptions options	-- PieceSquareValue-formatter. 						) . ( 							realToFrac	:: Type.Mass.PieceSquareValue -> Input.PieceSquareTable.IOFormat 						) 					) ( 						showChar '\t'	-- Column-delimiter. 					) (-						! selector Component.PieceSquareByCoordinatesByRank.nPiecesBounds	-- Select from interpolated values.+						selector Input.EvaluationOptions.nPiecesBounds	-- Select from interpolated values. 					) 				) [snd, fst]-			 ) . Input.EvaluationOptions.getMaybePieceSquareByCoordinatesByRank $ Input.Options.getEvaluationOptions options+			 ) . Input.EvaluationOptions.getMaybePieceSquareValueByCoordinatesByRank $ Input.Options.getEvaluationOptions options  #ifdef USE_UNIX 	Concurrent.SignalHandlers.handleSignals

@@ -39,6 +39,7 @@ 	enPassant, -- * Functions 	nPiecesMutator,+	apply, -- ** Constructors 	mkMaybeNormalMoveType, 	mkNormalMoveType,@@ -265,4 +266,23 @@ nPiecesMutator moveType 	| isCapture moveType	= pred 	| otherwise		= id++-- | Permit the caller to react in an arbitrary way, according to a specific move-type.+apply+	:: (+		IsShort -> a,	-- Castle.+		a,		-- En-passant+		(+			Maybe Attribute.Rank.Rank {-captured-},+			Maybe Attribute.Rank.Rank {-promotion-}+		) -> a+	)		-- ^ The handlers for each move-type; Castle, En-passant & Normal.+	-> MoveType+	-> a+apply (onCastle, _, _) (Castle isShort)	= onCastle isShort+apply (_, onEnPassant, _) EnPassant	= onEnPassant+apply (_, _, onNormal) Normal {+	getMaybeTakenRank	= maybeTakenRank,+	getMaybePromotionRank	= maybePromotionRank+}					= onNormal (maybeTakenRank, maybePromotionRank) 

@@ -31,6 +31,7 @@ -- ** Type-synonyms 	EvaluateRank, 	ArrayByRank,+	UArrayByRank, -- ** Data-types 	Rank(..), -- * Constants@@ -63,6 +64,7 @@ import qualified	Control.DeepSeq import qualified	Control.Exception import qualified	Data.Array.IArray+import qualified	Data.Array.Unboxed import qualified	Data.Char import qualified	Data.List import qualified	Data.Ord@@ -206,6 +208,9 @@  -- | A boxed array indexed by /rank/, of arbitrary values. type ArrayByRank	= Data.Array.IArray.Array Rank++-- | An unboxed array indexed by /rank/, of fixed-size elements.+type UArrayByRank	= Data.Array.Unboxed.UArray Rank  -- | Array-constructor from an ordered list of elements. listArrayByRank :: Data.Array.IArray.IArray a e => [e] -> a Rank e

@@ -52,6 +52,7 @@ 	inBounds ) where +import			Control.Arrow((&&&)) import			Data.Array.IArray((!)) import qualified	BishBosh.Type.Length	as Type.Length import qualified	Control.Exception@@ -80,24 +81,20 @@  -- | Convert to an array-index. toIx :: Type.Length.X -> Int-{-# INLINE toIx #-} toIx	= fromIntegral . subtract xMin  -- | Convert from an array-index. fromIx :: Int -> Type.Length.X-{-# INLINE fromIx #-} fromIx	= (+ xMin) . fromIntegral  -- | Reflects about the mid-point of the axis. reflect :: Type.Length.X -> Type.Length.X-reflect	= (-	+ (2 * xMin + pred xLength)- ) . negate+reflect	= (2 * xMin + xMax -)  -- | Predicate. inBounds :: Type.Length.X -> Bool {-# INLINE inBounds #-}-inBounds x	= x >= xMin && x <= xMax+inBounds	= uncurry (&&) . ((>= xMin) &&& (<= xMax))  -- | Translate the specified ordinate. translate :: (Type.Length.X -> Type.Length.X) -> Type.Length.X -> Type.Length.X

@@ -1,4 +1,9 @@ {-# LANGUAGE CPP #-}++#ifdef USE_PRIMITIVE+{-# LANGUAGE MagicHash #-}+#endif+ {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -32,11 +37,10 @@ 		getY 	), -- ** Type-synonyms+	QualifiedStraightLine, --	Transformation, 	ArrayByCoordinates,-#ifdef USE_UNBOXED_ARRAYS 	UArrayByCoordinates,-#endif -- * Constants 	tag, 	topLeft,@@ -72,6 +76,7 @@ 	arrayByCoordinates, -- ** Predicates --	inBounds,+	isBetween, 	isPawnsFirstRank, 	isEnPassantRank, 	areSquaresIsochromatic@@ -95,17 +100,15 @@ import qualified	Control.DeepSeq import qualified	Control.Exception import qualified	Data.Array.IArray+import qualified	Data.Array.Unboxed import qualified	Data.Foldable import qualified	Data.List import qualified	Data.Map				as Map import qualified	Data.Maybe -#ifdef USE_PARALLEL-import qualified	Control.Parallel.Strategies-#endif--#ifdef USE_UNBOXED_ARRAYS-import qualified	Data.Array.Unboxed+#ifdef USE_PRIMITIVE+import			GHC.Exts(Int(I#))+import			GHC.Prim((+#), (*#)) #endif  -- | Used to qualify XML.@@ -129,7 +132,8 @@ 	} -- Top Right.  instance Control.DeepSeq.NFData Coordinates where-	rnf MkCoordinates { getX = x, getY = y }	= Control.DeepSeq.rnf (x, y)+--	rnf MkCoordinates { getX = x, getY = y }	= Control.DeepSeq.rnf (x, y)+	rnf _	= ()	-- N.B.: it's already strict.  instance Data.Array.IArray.Ix Coordinates where 	range (lower, upper)			= Control.Exception.assert (lower == minBound && upper == maxBound) Property.FixedMembership.members@@ -145,12 +149,18 @@ 	 ) . (`divMod` fromIntegral Cartesian.Abscissa.xLength)  	fromEnum MkCoordinates {+#ifdef USE_PRIMITIVE+		getX	= I# x,+		getY	= I# y+	} = I# (8# *# y +# x)	-- CAVEAT: bypasses modules 'Cartesian.{Abscissa, Ordinate}'.+#else 		getX	= x, 		getY	= y 	} = fromIntegral Cartesian.Abscissa.xLength * Cartesian.Ordinate.toIx y + Cartesian.Abscissa.toIx x+#endif  instance Ord Coordinates where-	MkCoordinates { getX = x, getY = y } `compare` MkCoordinates { getX = x', getY = y' }	= (y, x) `compare` (y', x')	-- N.B.: x is less significant than y, as required by the implementation of 'Data.Array.IArray.Ix.inRange'.+	MkCoordinates { getX = x, getY = y } `compare` MkCoordinates { getX = x', getY = y' }	= (y, x) `compare` (y', x')	-- N.B.: x is less significant than y.  instance Show Coordinates where 	showsPrec precedence MkCoordinates { getX = x, getY = y }	= showsPrec precedence (x, y)@@ -184,7 +194,9 @@ 		getX	= fromIntegral $! Cartesian.Ordinate.reflect y, 		getY	= fromIntegral x 	} -- +90 degrees, i.e. anti-clockwise.+ 	rotate180	= Property.Opposable.getOpposite+ 	rotate270 MkCoordinates { 		getX	= x, 		getY	= y@@ -382,6 +394,17 @@ 			| direction == Direction.Direction.nw	= (xDecreasing,	yIncreasing) 			| otherwise {-NE-}			= (xIncreasing,	yIncreasing) +-- | A line of /coordinates/, qualified by an array-index into any 'ArrayByCoordinates'.+type QualifiedStraightLine	= [(Coordinates, Int)]++-- | The constant lists of (/coordinates/, array-index), extrapolated from every /coordinate/ in the /board/, in every /direction/.+extrapolationsByDirectionByCoordinates :: ArrayByCoordinates (Direction.Direction.ArrayByDirection QualifiedStraightLine)+extrapolationsByDirectionByCoordinates	= listArrayByCoordinates $ map (+	\coordinates	-> Direction.Direction.listArrayByDirection $ map (+		map (id &&& fromEnum) . extrapolate' coordinates+	) Property.FixedMembership.members {-direction-}+ ) Property.FixedMembership.members {-coordinates-}+ {- | 	* Generates a line of /coordinates/, starting just after the specified source & proceeding in the specified /direction/ to the edge of the board. @@ -391,22 +414,12 @@ extrapolate 	:: Coordinates				-- ^ The point from which to start. 	-> Direction.Direction.Direction	-- ^ The direction in which to proceed.-	-> [Coordinates]+	-> QualifiedStraightLine extrapolate coordinates	direction	= extrapolationsByDirectionByCoordinates ! coordinates ! direction --- | The constant lists of /coordinates/, extrapolated from every /coordinate/ in the /board/, in every /direction/.-extrapolationsByDirectionByCoordinates :: ArrayByCoordinates (Direction.Direction.ArrayByDirection [Coordinates])-extrapolationsByDirectionByCoordinates	= listArrayByCoordinates-#ifdef USE_PARALLEL-	. Control.Parallel.Strategies.withStrategy (Control.Parallel.Strategies.parList Control.Parallel.Strategies.rdeepseq)-#endif-	$ map (-		\coordinates	-> Direction.Direction.listArrayByDirection $ extrapolate' coordinates `map` Property.FixedMembership.members {-direction-}-	) Property.FixedMembership.members {-coordinates-}---- | Apply the specified function to each line of /coordinates/ extrapolated from the specified central hub, in each of the specified /direction/s.+-- | Apply the specified function to each 'QualifiedStraightLine' extrapolated from the specified central hub, in each of the specified /direction/s. applyAlongDirectionsFrom-	:: ([Coordinates] -> [a])			-- ^ Individually map each straight line of coordinates extrapolated from the central hub.+	:: (QualifiedStraightLine -> [a])		-- ^ Individually map each 'QualifiedCoordinatesLine' extrapolated from the central hub. 	-> Coordinates					-- ^ The central hub from which to extrapolate. 	-> Maybe [Direction.Direction.Direction]	-- ^ The directions in which to extrapolate; 'Nothing' implies omnidirectional. 	-> [a]@@ -416,28 +429,28 @@ 	concatMap $ f . (extrapolationsByDirectionByCoordinates ! from !)  ) --- | The constant lists of /coordinates/, between every permutation of source & valid destination on the /board/.-interpolationsByDestinationBySource :: ArrayByCoordinates (Map.Map Coordinates [Coordinates])+-- | The constant 'QualifiedStraightLine', between every permutation of source & valid destination on the /board/.+interpolationsByDestinationBySource :: ArrayByCoordinates (Map.Map Coordinates QualifiedStraightLine) interpolationsByDestinationBySource	= Data.Array.IArray.amap ( 	Map.fromList . map (-		last {-destination-} &&& id {-interpolation-}+		fst {-coordinates-} . last {-destination-} &&& id {-interpolation-} 	) . concatMap ( 		tail {-remove null list-} . Data.List.inits	-- Generate all possible interpolations from this extrapolation. 	) . Data.Foldable.toList  ) extrapolationsByDirectionByCoordinates	-- Derive from extrapolations.  {- |-	* Generates a line of /coordinates/ covering the half open interval @(source, destination]@.+	* Generates a 'QualifiedStraightLine' covering the half open interval @(source, destination]@.  	* CAVEAT: the destination-/coordinates/ must be a valid @Queen@'s /move/ from the source; so that all intermediate points lie on a square of the board. -}-interpolate :: Coordinates -> Coordinates -> [Coordinates]+interpolate :: Coordinates -> Coordinates -> QualifiedStraightLine interpolate coordinatesSource coordinatesDestination	= interpolationsByDestinationBySource ! coordinatesSource Map.! coordinatesDestination  {- | 	* Measures the signed distance between source & destination /coordinates/. -	* N.B.: this isn't the /irrational/ distance a rational crow would fly, but rather the integral /x/ & /y/ components of that path.+	* N.B.: this isn't the typically /irrational/ distance a rational crow would fly, but rather the integral /x/ & /y/ components of that path.  	* CAVEAT: beware the potential fence-post error. -}@@ -465,6 +478,18 @@ areSquaresIsochromatic :: [Coordinates] -> Bool areSquaresIsochromatic	= uncurry (||) . (all (== minBound) &&& all (== maxBound)) . map getLogicalColourOfSquare +{- |+	* Whether the specified coordinates lie within the open interval (source, destination); neither source nor destination lies in this interval.++	* CAVEAT: the source & destination must form a straight line of non-zero length (i.e. a valid Queen's move).+-}+isBetween+	:: Coordinates	-- ^ Source.+	-> Coordinates	-- ^ Destination.+	-> Coordinates	-- ^ Potential intermediary.+	-> Bool+isBetween source destination intermediary	= Data.Maybe.isJust . Data.List.find ((== intermediary) . fst {-coordinates-}) . init {-drop the destination-} $ interpolate source destination+ -- | The conventional starting /coordinates/ for the @King@ of the specified /logical colour/. kingsStartingCoordinates :: Colour.LogicalColour.LogicalColour -> Coordinates kingsStartingCoordinates logicalColour	= MkCoordinates {@@ -488,10 +513,8 @@ -- | A boxed array indexed by /coordinates/, of arbitrary elements. type ArrayByCoordinates	= Data.Array.IArray.Array Coordinates -#ifdef USE_UNBOXED_ARRAYS -- | An unboxed array indexed by /coordinates/, of fixed-size elements. type UArrayByCoordinates	= Data.Array.Unboxed.UArray Coordinates-#endif  -- | Array-constructor from an ordered list of elements. listArrayByCoordinates :: Data.Array.IArray.IArray a e => [e] -> a Coordinates e

@@ -1,3 +1,9 @@+{-# LANGUAGE CPP #-}++#ifdef USE_PRIMITIVE+{-# LANGUAGE MagicHash #-}+#endif+ {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -49,12 +55,18 @@ 	inBounds ) where +import			Control.Arrow((&&&)) import qualified	BishBosh.Cartesian.Abscissa	as Cartesian.Abscissa import qualified	BishBosh.Colour.LogicalColour	as Colour.LogicalColour import qualified	BishBosh.Property.Opposable	as Property.Opposable import qualified	BishBosh.Type.Length		as Type.Length import qualified	Control.Exception +#ifdef USE_PRIMITIVE+import			GHC.Exts(Int(I#))+import			GHC.Prim((-#))+#endif+ -- | The constant length of the /y/-axis. yLength :: Type.Length.Y yLength	= fromIntegral Cartesian.Abscissa.xLength	-- I.E.: the board is square.@@ -70,12 +82,10 @@  -- | Convert to an array-index. toIx :: Type.Length.Y -> Int-{-# INLINE toIx #-} toIx	= fromIntegral . subtract yMin  -- | Convert from an array-index. fromIx :: Int -> Type.Length.Y-{-# INLINE fromIx #-} fromIx	= (+ yMin) . fromIntegral  -- | The /rank/ from which /piece/s conventionally start.@@ -101,14 +111,16 @@  -- | Reflects about the mid-point of the axis. reflect :: Type.Length.Y -> Type.Length.Y-reflect	= (-	+ (2 * yMin + pred yLength)- ) . negate+#ifdef USE_PRIMITIVE+reflect (I# y)	= I# (7# -# y)	-- CAVEAT: hard-coded bounds.+#else+reflect	= (2 * yMin + yMax -)+#endif  -- | Predicate. inBounds :: Type.Length.Y -> Bool {-# INLINE inBounds #-}-inBounds y	= y >= yMin && y <= yMax+inBounds	= uncurry (&&) . ((>= yMin) &&& (<= yMax))  -- | Translate the specified ordinate. translate :: (Type.Length.Y -> Type.Length.Y) -> Type.Length.Y -> Type.Length.Y

@@ -66,10 +66,13 @@ } deriving (Eq, Show)  instance Control.DeepSeq.NFData Vector where+{- 	rnf MkVector { 		getXDistance	= xDistance, 		getYDistance	= yDistance 	} = Control.DeepSeq.rnf (xDistance, yDistance)+-}+	rnf _	= ()	-- N.B.: it's already strict.  instance Property.Opposable.Opposable Vector where 	getOpposite MkVector {@@ -157,7 +160,6 @@  -- | Whether the specified /vector/ represents a move a @Knight@ could make. isKnightsMove :: Vector -> Bool-{-# INLINE isKnightsMove #-} isKnightsMove MkVector { 	getXDistance	= xDistance, 	getYDistance	= yDistance

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, LambdaCase #-}+{-# LANGUAGE LambdaCase #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -31,9 +31,6 @@ -- * Types -- ** Type-synonyms 	ArrayByLogicalColour,-#ifdef USE_UNBOXED_ARRAYS-	UArrayByLogicalColour,-#endif -- ** Data-types 	LogicalColour(..), -- * Constants@@ -61,10 +58,6 @@ import qualified	Text.XML.HXT.Arrow.Pickle			as HXT import qualified	Text.XML.HXT.Arrow.Pickle.Schema -#ifdef USE_UNBOXED_ARRAYS-import qualified	Data.Array.Unboxed-#endif- -- | Used to qualify XML. tag :: String tag	= "logicalColour"@@ -135,11 +128,6 @@  -- | A boxed array indexed by /logical colour/, of arbitrary elements. type ArrayByLogicalColour	= Data.Array.IArray.Array LogicalColour--#ifdef USE_UNBOXED_ARRAYS--- | An unboxed array indexed by /logical colour/, of fixed-size values.-type UArrayByLogicalColour	= Data.Array.Unboxed.UArray LogicalColour-#endif  -- | Array-constructor from an ordered list of elements. listArrayByLogicalColour :: Data.Array.IArray.IArray a e => [e] -> a LogicalColour e

@@ -34,7 +34,7 @@ 	black, 	white, -- * Functions--- ** Predicate+-- ** Predicates 	isBlack ) where 

@@ -27,7 +27,7 @@ 	Accountant(..) ) where -import qualified	BishBosh.Component.PieceSquareByCoordinatesByRank	as Component.PieceSquareByCoordinatesByRank+import qualified	BishBosh.Component.PieceSquareValueByCoordinatesByRank	as Component.PieceSquareValueByCoordinatesByRank import qualified	BishBosh.Type.Count					as Type.Count import qualified	BishBosh.Type.Mass					as Type.Mass @@ -35,7 +35,7 @@ class Accountant accountant where 	-- | Calculate the total value of the /coordinates/ occupied by the /piece/s of either side. 	sumPieceSquareValueByLogicalColour-		:: Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank+		:: Component.PieceSquareValueByCoordinatesByRank.PieceSquareValueByCoordinatesByRank 		-> accountant 		-> Type.Count.NPieces	-- ^ The number of pieces (of any logical colour or rank) remaining on the board; used to gauge progress through the game. 		-> [Type.Mass.Base]	-- CAVEAT: can't return '[Type.Mass.PieceSquareValue]' because it's bounded.

@@ -156,7 +156,7 @@ } = Cartesian.Vector.measureDistance source destination  -- | Generates a line of /coordinates/ covering the half open interval @(source, destination]@.-interpolate :: Move -> [Cartesian.Coordinates.Coordinates]+interpolate :: Move -> Cartesian.Coordinates.QualifiedStraightLine interpolate move@MkMove { 	getSource	= source, 	getDestination	= destination

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, LambdaCase #-}+{-# LANGUAGE LambdaCase #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -103,10 +103,6 @@ import qualified	Text.XML.HXT.Arrow.Pickle			as HXT import qualified	Text.XML.HXT.Arrow.Pickle.Schema -#ifdef USE_PARALLEL-import qualified	Control.Parallel.Strategies-#endif- -- | Used to qualify XML. tag :: String tag	= "piece"@@ -234,18 +230,13 @@ type ByRankByLogicalColour element	= Colour.LogicalColour.ArrayByLogicalColour (Map.Map Attribute.Rank.Rank element)  -- | Constructor of a certain shape of container, but with arbitrary contents.-mkByRankByLogicalColour ::-#ifdef USE_PARALLEL-	Control.DeepSeq.NFData	element =>-#endif-	[Attribute.Rank.Rank] -> (Colour.LogicalColour.LogicalColour -> Attribute.Rank.Rank -> element) -> ByRankByLogicalColour element-mkByRankByLogicalColour ranks mkElement	= Colour.LogicalColour.listArrayByLogicalColour-#ifdef USE_PARALLEL-	. Control.Parallel.Strategies.withStrategy (Control.Parallel.Strategies.parList Control.Parallel.Strategies.rdeepseq)-#endif-	$ map (-		\logicalColour	-> Map.fromList $ map (id &&& mkElement logicalColour) ranks-	) Property.FixedMembership.members+mkByRankByLogicalColour+	:: [Attribute.Rank.Rank]+	-> (Colour.LogicalColour.LogicalColour -> Attribute.Rank.Rank -> element)+	-> ByRankByLogicalColour element+mkByRankByLogicalColour ranks mkElement	= Colour.LogicalColour.listArrayByLogicalColour $ map (+	\logicalColour	-> Map.fromList $ map (id &&& mkElement logicalColour) ranks+ ) Property.FixedMembership.members  {- | 	* The constant /vector/s over which the specified type of /piece/ can attack.

@@ -1,181 +0,0 @@-{-# LANGUAGE CPP #-}-{--	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@]	Defines the relative value of a specific /rank/ of piece, occupying a specific /coordinate/ on the board, at a specific stage in the game.--}--module BishBosh.Component.PieceSquareByCoordinatesByRank(--- * Types--- ** Type-synonyms---	PieceSquareValueByNPieces,---	EitherPieceSquareValueByNPiecesByCoordinates,--- ** Data-types-	PieceSquareByCoordinatesByRank(---		MkPieceSquareByCoordinatesByRank,---		deconstruct-	),--- * Constants-	nPiecesBounds,-	gnuPlotComment,--- * Functions-	findPieceSquareValue,-	interpolatePieceSquareValues,-	formatForGNUPlot,--- ** Constructor-	mkPieceSquareByCoordinatesByRank-) where--import			Control.Arrow((&&&), (|||))-import			Data.Array.IArray((!))-import qualified	BishBosh.Attribute.Rank			as Attribute.Rank-import qualified	BishBosh.Cartesian.Abscissa		as Cartesian.Abscissa-import qualified	BishBosh.Cartesian.Coordinates		as Cartesian.Coordinates-import qualified	BishBosh.Colour.LogicalColour		as Colour.LogicalColour-import qualified	BishBosh.Component.Piece		as Component.Piece-import qualified	BishBosh.Property.FixedMembership	as Property.FixedMembership-import qualified	BishBosh.Property.Reflectable		as Property.Reflectable-import qualified	BishBosh.Text.ShowList			as Text.ShowList-import qualified	BishBosh.Type.Count			as Type.Count-import qualified	BishBosh.Type.Mass			as Type.Mass-import qualified	Control.DeepSeq-import qualified	Data.Array.IArray-import qualified	Data.Foldable-import qualified	Data.List--#if defined(USE_UNBOXED_ARRAYS) && !(defined(USE_NEWTYPE_WRAPPERS) || defined(USE_PRECISION))-#define UNBOX-import qualified	Data.Array.Unboxed-#endif---- | The piece-square value may vary as the game progresses.-type PieceSquareValueByNPieces =-#ifdef UNBOX-	Data.Array.Unboxed.UArray-#else-	Data.Array.IArray.Array-#endif-		Type.Count.NPieces Type.Mass.PieceSquareValue---- | The bounds of the number of pieces on the board, at the end-game & opening-game respectively.-nPiecesBounds :: (Type.Count.NPieces, Type.Count.NPieces)-nPiecesBounds	= (-	3 {-minimum sufficient material-},-	fromIntegral Colour.LogicalColour.nDistinctLogicalColours * Component.Piece.nPiecesPerSide- )---- | Self-documentation.-type EitherPieceSquareValueByNPiecesByCoordinates	= Either (-#ifdef UNBOX-	Cartesian.Coordinates.UArrayByCoordinates-#else-	Cartesian.Coordinates.ArrayByCoordinates-#endif-		Type.Mass.PieceSquareValue	-- Uninterpolated.- ) (-	Cartesian.Coordinates.ArrayByCoordinates PieceSquareValueByNPieces	-- Interpolated.- )---- | The value for each type of /piece/ of occupying each coordinate, at each stage in the lifetime of the game.-newtype PieceSquareByCoordinatesByRank	= MkPieceSquareByCoordinatesByRank {-	deconstruct	:: Attribute.Rank.ArrayByRank EitherPieceSquareValueByNPiecesByCoordinates-} deriving (Eq, Show)--instance Control.DeepSeq.NFData PieceSquareByCoordinatesByRank where-	rnf-#ifdef UNBOX-		_								= ()-#else-		MkPieceSquareByCoordinatesByRank { deconstruct = byRank }	= Control.DeepSeq.rnf byRank-#endif---- | Constructor.-mkPieceSquareByCoordinatesByRank-	:: (Attribute.Rank.Rank -> EitherPieceSquareValueByNPiecesByCoordinates)	-- ^ Convert a /rank/ into either (a /pieceSquareValue/ or a /pieceSquareValue/ which linearly varies with the number of /piece/s remaining) by /coordinates/.-	-> PieceSquareByCoordinatesByRank-mkPieceSquareByCoordinatesByRank	= MkPieceSquareByCoordinatesByRank . Attribute.Rank.listArrayByRank . (`map` Property.FixedMembership.members)---- | Find the piece-square value, at a stage in the game's lifetime defined by the total number of pieces remaining, for the specified /rank/ & /coordinates/.-findPieceSquareValue-	:: PieceSquareByCoordinatesByRank-	-> Type.Count.NPieces			-- ^ The progress through the game.-	-> Colour.LogicalColour.LogicalColour	-- ^ The /piece/'s /logical colour/.-	-> Attribute.Rank.Rank			-- ^ The /piece/'s /rank/.-	-> Cartesian.Coordinates.Coordinates	-- ^ The /piece/'s location.-	-> Type.Mass.PieceSquareValue-findPieceSquareValue MkPieceSquareByCoordinatesByRank { deconstruct = byRank } nPieces logicalColour rank	= (-	(!) ||| (-		\byNPiecesByCoordinates	-> (! nPieces) . (byNPiecesByCoordinates !)-	) $ byRank ! rank- ) . if Colour.LogicalColour.isBlack logicalColour-	then Property.Reflectable.reflectOnX-	else id---- | Given the bounds over which two piece-square values vary as the game progresses from opening to end, return linearly interpolated values for all stages.-interpolatePieceSquareValues-	:: Type.Mass.PieceSquareValue	-- ^ Opening-game.-	-> Type.Mass.PieceSquareValue	-- ^ End-game.-	-> PieceSquareValueByNPieces-interpolatePieceSquareValues openingGame endGame	= Data.Array.IArray.listArray nPiecesBounds . map (-	fromRational . uncurry (+) . (-		(* toRational openingGame) &&& (* toRational endGame) . (1 -)-	) . (-		/ fromIntegral (-			uncurry subtract nPiecesBounds	-- N.B.: this can't reasonably be zero.-		) -- map into the closed unit-interval [0,1].-	) . fromIntegral . subtract (-		fst {-minimum-} nPiecesBounds-	)- ) $ uncurry enumFromTo nPiecesBounds---- | The character used in __GNUPlot__ to denote a comment.-gnuPlotComment :: Char-gnuPlotComment	= '#'---- | Format the data for input to __GNUPlot__.-formatForGNUPlot-	:: PieceSquareByCoordinatesByRank-	-> (Type.Mass.PieceSquareValue -> ShowS)			-- ^ Format a /pieceSquareValue/.-	-> ShowS							-- ^ The column-delimiter.-	-> (PieceSquareValueByNPieces -> Type.Mass.PieceSquareValue)	-- ^ Select one /PieceSquareValue/ from interpolated values.-	-> ShowS-formatForGNUPlot MkPieceSquareByCoordinatesByRank { deconstruct = byRank } pieceSquareValueFormatter columnDelimiter selector	= (-	showsRow (-		showChar gnuPlotComment . showChar 'x' : showChar 'y' : map shows Attribute.Rank.range	-- Header comment.-	) .- ) . foldr (-	\(coordinates, byRank') showS	-> let-		(x, y)	= Cartesian.Coordinates.getX &&& Cartesian.Coordinates.getY $ coordinates-	in showsRow (-		shows x : shows y : map pieceSquareValueFormatter byRank'-	) . (-		if x == Cartesian.Abscissa.xMax-			then terminateRow	-- Separate isolines.-			else id-	) . showS- ) id . zip (-	Property.FixedMembership.members	:: [Cartesian.Coordinates.Coordinates]- ) . Data.List.transpose . map (-	Data.Array.IArray.elems ||| map selector {-select one PieceSquareValue from interpolated values-} . Data.Foldable.toList {-ByCoordinates-}- ) $ Data.Foldable.toList {-ByRank-} byRank where-	terminateRow	= showChar '\n'-	showsRow	= Text.ShowList.showsDelimitedList columnDelimiter id terminateRow-

@@ -0,0 +1,94 @@+{-# LANGUAGE CPP #-}+{-+	Copyright (C) 2021 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@]	Defines the values of a single unspecified piece, of occupying various coordinates.+-}++module BishBosh.Component.PieceSquareValueByCoordinates(+-- * Types+-- ** Type-synonyms+--	ByCoordinates,+-- ** Data-types+	PieceSquareValueByCoordinates(),+-- * Functions+-- ** Accessors+	dereference,+	getPieceSquareValue,+	toList,+-- ** Constructors+	fromList+) where++import			Data.Array.IArray((!))+import qualified	BishBosh.Cartesian.Coordinates	as Cartesian.Coordinates+import qualified	BishBosh.Colour.LogicalColour	as Colour.LogicalColour+import qualified	BishBosh.Property.Reflectable	as Property.Reflectable+import qualified	BishBosh.Type.Mass		as Type.Mass+import qualified	Control.DeepSeq+import qualified	Data.Array.IArray++type ByCoordinates	=+#ifdef UNBOX_TYPEMASS_ARRAYS+	Cartesian.Coordinates.UArrayByCoordinates+#else+	Cartesian.Coordinates.ArrayByCoordinates+#endif+		Type.Mass.PieceSquareValue++-- | The piece-square value varies with coordinates at which the unspecified piece is located.+newtype PieceSquareValueByCoordinates	= MkPieceSquareValueByCoordinates ByCoordinates deriving (Eq, Show)++instance Control.DeepSeq.NFData PieceSquareValueByCoordinates where+	rnf (MkPieceSquareValueByCoordinates pieceSquareValueByCoordinates)	=+#ifdef UNBOX_TYPEMASS_ARRAYS+		Control.DeepSeq.rwhnf+#else+		Control.DeepSeq.rnf+#endif+			pieceSquareValueByCoordinates++-- | Constructor from a list ordered by /coordinates/.+fromList :: [Type.Mass.PieceSquareValue] -> PieceSquareValueByCoordinates+fromList	= MkPieceSquareValueByCoordinates . Cartesian.Coordinates.listArrayByCoordinates++-- | Deconstruct, returning the ordered list from which it was constructed.+toList :: PieceSquareValueByCoordinates -> [Type.Mass.PieceSquareValue]+toList (MkPieceSquareValueByCoordinates pieceSquareValueByCoordinates)	= Data.Array.IArray.elems pieceSquareValueByCoordinates++-- | Extract the value for the specified /coordinates/ (from @White@'s perspective).+dereference :: PieceSquareValueByCoordinates -> Cartesian.Coordinates.Coordinates -> Type.Mass.PieceSquareValue+dereference (MkPieceSquareValueByCoordinates pieceSquareValueByCoordinates)	= (pieceSquareValueByCoordinates !)++{- |+	* Get the piece-square value, for the specified /coordinates/.++	* Utilises symmetry to infer values for @Black@, by reflecting the specified /coordinates/ into @White@'s domain.+-}+getPieceSquareValue+	:: PieceSquareValueByCoordinates+	-> Colour.LogicalColour.LogicalColour	-- ^ The /piece/'s /logical colour/.+	-> Cartesian.Coordinates.Coordinates	-- ^ The /piece/'s location.+	-> Type.Mass.PieceSquareValue+getPieceSquareValue (MkPieceSquareValueByCoordinates pieceSquareValueByCoordinates) logicalColour	= (pieceSquareValueByCoordinates !) . if Colour.LogicalColour.isBlack logicalColour+	then Property.Reflectable.reflectOnX+	else id+

@@ -0,0 +1,114 @@+{-+	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@]	Defines the relative value of a specific /rank/ of piece, occupying a specific square, at a each stage in the game's life-cycle.+-}++module BishBosh.Component.PieceSquareValueByCoordinatesByRank(+-- * Types+-- ** Type-synonyms+--	PieceSquareValueByCoordinatesByEitherNPieces,+-- ** Data-types+	PieceSquareValueByCoordinatesByRank(),+-- * Constants+	gnuPlotComment,+-- * Functions+--	unify,+	formatForGNUPlot,+-- ** Accessors+	getPieceSquareValueByCoordinates,+-- ** Constructor+	mkPieceSquareValueByCoordinatesByRank+) where++import			Control.Arrow((&&&), (|||))+import			Data.Array.IArray((!))+import qualified	BishBosh.Attribute.Rank					as Attribute.Rank+import qualified	BishBosh.Cartesian.Abscissa				as Cartesian.Abscissa+import qualified	BishBosh.Cartesian.Coordinates				as Cartesian.Coordinates+import qualified	BishBosh.Component.PieceSquareValueByCoordinates	as Component.PieceSquareValueByCoordinates+import qualified	BishBosh.Property.FixedMembership			as Property.FixedMembership+import qualified	BishBosh.Text.ShowList					as Text.ShowList+import qualified	BishBosh.Type.Count					as Type.Count+import qualified	BishBosh.Type.Mass					as Type.Mass+import qualified	Control.DeepSeq+import qualified	Data.Array.IArray+import qualified	Data.Foldable+import qualified	Data.List++-- | The piece-square value may vary with /coordinates/ & optionally also the number of pieces remaining.+type PieceSquareValueByCoordinatesByEitherNPieces	= Either Component.PieceSquareValueByCoordinates.PieceSquareValueByCoordinates (+	Data.Array.IArray.Array Type.Count.NPieces Component.PieceSquareValueByCoordinates.PieceSquareValueByCoordinates+ )++-- | The piece-square value for various /coordinates/, optionally the number of pieces remaining, & /rank/.+newtype PieceSquareValueByCoordinatesByRank	= MkPieceSquareValueByCoordinatesByRank (Attribute.Rank.ArrayByRank PieceSquareValueByCoordinatesByEitherNPieces)++instance Control.DeepSeq.NFData PieceSquareValueByCoordinatesByRank where+	rnf (MkPieceSquareValueByCoordinatesByRank pieceSquareValueByCoordinatesByEitherNPiecesByRank)	= Control.DeepSeq.rnf pieceSquareValueByCoordinatesByEitherNPiecesByRank	-- Forward.++-- | Constructor.+mkPieceSquareValueByCoordinatesByRank :: (Attribute.Rank.Rank -> PieceSquareValueByCoordinatesByEitherNPieces) -> PieceSquareValueByCoordinatesByRank+mkPieceSquareValueByCoordinatesByRank	= MkPieceSquareValueByCoordinatesByRank . Attribute.Rank.listArrayByRank . (`map` Property.FixedMembership.members)++-- | Unify the /Left/ & /Right/ sides of 'PieceSquareValueByCoordinatesByEitherNPieces'.+unify :: Type.Count.NPieces -> PieceSquareValueByCoordinatesByEitherNPieces -> Component.PieceSquareValueByCoordinates.PieceSquareValueByCoordinates+unify nPieces	= id ||| (! nPieces)++-- | Retrieve the appropriate /PieceSquareValueByCoordinates/ for the specified /rank/, @ the current stage of the game's life-cycle.+getPieceSquareValueByCoordinates+	:: PieceSquareValueByCoordinatesByRank+	-> Type.Count.NPieces	-- ^ An inverse proxy for the age of the game.+	-> Attribute.Rank.Rank	-- ^ The /piece/'s /rank/.+	-> Component.PieceSquareValueByCoordinates.PieceSquareValueByCoordinates+getPieceSquareValueByCoordinates (MkPieceSquareValueByCoordinatesByRank pieceSquareValueByCoordinatesByEitherNPiecesByRank) nPieces rank	= unify nPieces $ pieceSquareValueByCoordinatesByEitherNPiecesByRank ! rank++-- | The character used in __GNUPlot__ to denote a comment.+gnuPlotComment :: Char+gnuPlotComment	= '#'++-- | Format the data for input to __GNUPlot__.+formatForGNUPlot+	:: PieceSquareValueByCoordinatesByRank+	-> (Type.Mass.PieceSquareValue -> ShowS)	-- ^ Format a /pieceSquareValue/.+	-> ShowS					-- ^ The column-delimiter.+	-> Type.Count.NPieces				-- ^ Select from interpolated values.+	-> ShowS+formatForGNUPlot (MkPieceSquareValueByCoordinatesByRank pieceSquareValueByCoordinatesByEitherNPiecesByRank) pieceSquareValueFormatter columnDelimiter nPieces	= (+	showsRow (+		showChar gnuPlotComment . showChar 'x' : showChar 'y' : map shows Attribute.Rank.range	-- Header comment.+	) .+ ) . foldr (+	\(coordinates, byRank') showS	-> let+		(x, y)	= Cartesian.Coordinates.getX &&& Cartesian.Coordinates.getY $ coordinates+	in showsRow (+		shows x : shows y : map pieceSquareValueFormatter byRank'+	) . (+		if x == Cartesian.Abscissa.xMax+			then terminateRow	-- Separate isolines.+			else id+	) . showS+ ) id . zip Property.FixedMembership.members . Data.List.transpose . map (+	Component.PieceSquareValueByCoordinates.toList . unify nPieces+ ) $ Data.Foldable.toList {-ByRank-} pieceSquareValueByCoordinatesByEitherNPiecesByRank where+	terminateRow	= showChar '\n'+	showsRow	= Text.ShowList.showsDelimitedList columnDelimiter id terminateRow+

@@ -24,7 +24,7 @@  module BishBosh.Component.QualifiedMove( -- * Types--- * Type-synonyms+-- ** Type-synonyms 	QualifiedMoveSequence, -- ** Data-types 	QualifiedMove(

@@ -464,15 +464,15 @@  -- | Parses a /game/ from PGN move-text. moveTextParser-#ifdef USE_POLYPARSE 	:: IsStrictlySequential 	-> ContextualNotation.StandardAlgebraic.ValidateMoves+#ifdef USE_POLYPARSE 	-> Text.Poly.TextParser Model.Game.Game moveTextParser isStrictlySequential validateMoves	= let 	elementSequenceParser :: Model.Game.Game -> Text.Poly.TextParser Model.Game.Game 	elementSequenceParser game	= let 		expectedMoveNumber :: Type.Count.NMoves-		expectedMoveNumber	= fromIntegral . succ . (`div` 2) . State.TurnsByLogicalColour.getNPlies $ Model.Game.getTurnsByLogicalColour game+		expectedMoveNumber	= State.TurnsByLogicalColour.deriveMoveNumber $ Model.Game.getTurnsByLogicalColour game 	 in do 		moveNumber	<- ( 			if Colour.LogicalColour.isBlack $ Model.Game.getNextLogicalColour game@@ -504,14 +504,12 @@  in do 	game	<- fmap (Data.Maybe.fromMaybe Data.Default.def {-game-}) . Control.Applicative.optional $ elementSequenceParser Data.Default.def {-game-} #else /* Parsec */-	:: IsStrictlySequential-	-> ContextualNotation.StandardAlgebraic.ValidateMoves 	-> Parsec.Parser Model.Game.Game moveTextParser isStrictlySequential validateMoves	= let 	elementSequenceParser :: Model.Game.Game -> Parsec.Parser Model.Game.Game 	elementSequenceParser game	= let 		expectedMoveNumber :: Type.Count.NMoves-		expectedMoveNumber	= fromIntegral . succ . (`div` 2) . State.TurnsByLogicalColour.getNPlies $ Model.Game.getTurnsByLogicalColour game+		expectedMoveNumber	= State.TurnsByLogicalColour.deriveMoveNumber $ Model.Game.getTurnsByLogicalColour game 	 in do 		moveNumber	<- ( 			if Colour.LogicalColour.isBlack $ Model.Game.getNextLogicalColour game@@ -540,7 +538,7 @@  in do 	game	<- Parsec.option Data.Default.def {-game-} . Parsec.try $ elementSequenceParser Data.Default.def {-game-} #endif-	Data.Maybe.maybe game (`Model.Game.updateTerminationReasonWith` game) `fmap` maybeResultParser+	Data.Maybe.maybe game (`Model.Game.updateTerminationReasonWith` game) <$> maybeResultParser  {- | 	* Parses /PGN/.

@@ -82,7 +82,7 @@ import qualified	System.Random import qualified	ToolShed.System.Random -#ifdef USE_PARALLEL+#ifdef PARALLELISE import qualified	Control.Parallel.Strategies #endif @@ -100,7 +100,7 @@ 	getZobrist		:: Component.Zobrist.Zobrist positionHash,	-- ^ Used to hash each position in the tree. 	getTree			:: Tree positionHash, 	getMinimumPieces	:: ! Type.Count.NPieces,			-- ^ The minimum number of /piece/s remaining after the last /move/ in any game defined in the tree.-	getHasAnyVictories	:: Bool						-- ^ Whether a victory has been recorded for any game in the tree; which won't be the case if it was constructed from a PGN-database containing standard-openings.+	getHasAnyVictories	:: Bool						-- ^ Whether a victory has been recorded for any game in the tree; which won't be the case if it was constructed from a PGN-database containing standard openings. }  -- | Constructor: augment the specified /qualified-move forest/ with a /Zobrist-hash/ of the /position/ & include the default initial game at the apex.@@ -246,7 +246,7 @@ 	| otherwise			= [ 		Control.Arrow.second (concatMap snd {-[OnymousResult]-}) movePair |	-- Discard the opponent's matching move, but cite the names of archived games it reached. 			movePair@(_, _ : _)	<--#ifdef USE_PARALLEL+#ifdef PARALLELISE 				Control.Parallel.Strategies.withStrategy ( 					Control.Parallel.Strategies.parList $ Control.Parallel.Strategies.evalTuple2 Control.Parallel.Strategies.r0 {-pre-match move-} Control.Parallel.Strategies.rdeepseq {-matching moves-} 				) .

@@ -501,7 +501,7 @@ 				else {-not a Pawn-} let 					mkNormalMoveType destination	= Attribute.MoveType.mkNormalMoveType (getMaybeRank destination) Nothing {-promotion-} -					resolveQualifiedMove destination candidates	= case candidates of+					resolveQualifiedMove destination	= \case 						[]			-> fail . showString "Failed to locate any " . shows piece . showString " able to move to " $ shows destination "." 						[source]		-> return {-to ParsecT-monad-} . Component.QualifiedMove.mkQualifiedMove (Component.Move.mkMove source destination) $ mkNormalMoveType destination 						sourceCandidates	-> Parsec.choice [@@ -514,7 +514,7 @@ 					Parsec.try $ do -- N.B. this scenario occurs when there are identical pieces on both the same row & the same column, as the intended attacker; i.e. after a promotion. 						source		<- Notation.PureCoordinate.coordinatesParser	<?> "Source" -						Parsec.optional captureParser		<?> "Optional capture"+						Parsec.optional captureParser	<?> "Optional capture"  						destination	<- Notation.PureCoordinate.coordinatesParser	<?> "Destination" @@ -530,13 +530,13 @@ 							) <$> Notation.PureCoordinate.ordinateParser 						 ) -- Build a filter from the source-qualifier. -						Parsec.optional captureParser		<?> "Optional capture"+						Parsec.optional captureParser	<?> "Optional capture"  						destination	<- Notation.PureCoordinate.coordinatesParser	<?> "Destination"  						resolveQualifiedMove destination . sourceFilter $ findAttacksBy destination, 					do	-- The most likely scenario, where the intended attacker is unambiguous.-						Parsec.optional captureParser		<?> "Optional capture"+						Parsec.optional captureParser	<?> "Optional capture"  						destination	<- Notation.PureCoordinate.coordinatesParser	<?> "Unqualified destination" 

@@ -27,7 +27,7 @@ -- ** Type-synonyms --	Transformation, 	IsMatch,--- * Function+-- * Functions 	countTerminalNodes, 	drawTree, 	drawForest,

@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -46,16 +47,19 @@ ) where  import			Control.Applicative((<|>))-import			Control.Arrow((&&&))+import			Control.Arrow((&&&), (***)) import			Data.Array.IArray((!)) import qualified	BishBosh.Attribute.MoveType				as Attribute.MoveType+import qualified	BishBosh.Attribute.Rank					as Attribute.Rank import qualified	BishBosh.Cartesian.Abscissa				as Cartesian.Abscissa import qualified	BishBosh.Cartesian.Coordinates				as Cartesian.Coordinates import qualified	BishBosh.Cartesian.Ordinate				as Cartesian.Ordinate import qualified	BishBosh.Colour.LogicalColour				as Colour.LogicalColour+import qualified	BishBosh.Component.CastlingMove				as Component.CastlingMove import qualified	BishBosh.Component.Move					as Component.Move import qualified	BishBosh.Component.Piece				as Component.Piece-import qualified	BishBosh.Component.PieceSquareByCoordinatesByRank	as Component.PieceSquareByCoordinatesByRank+import qualified	BishBosh.Component.PieceSquareValueByCoordinates	as Component.PieceSquareValueByCoordinates+import qualified	BishBosh.Component.PieceSquareValueByCoordinatesByRank	as Component.PieceSquareValueByCoordinatesByRank import qualified	BishBosh.Component.QualifiedMove			as Component.QualifiedMove import qualified	BishBosh.Component.Turn					as Component.Turn import qualified	BishBosh.Input.CriteriaWeights				as Input.CriteriaWeights@@ -77,48 +81,61 @@ import qualified	Data.Map.Strict						as Map import qualified	Data.Maybe --- | Measures the difference in piece-square value between players, from the perspective of the last player to move.+-- | Measures the difference in /piece-square value/ between players, from the perspective of the last player to move. measurePieceSquareValueDifference-	:: Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank+	:: Component.PieceSquareValueByCoordinatesByRank.PieceSquareValueByCoordinatesByRank 	-> Model.Game.Game-	-> Type.Mass.Base-measurePieceSquareValueDifference pieceSquareByCoordinatesByRank game	= (+	-> Type.Mass.Base	-- ^ Unbounded difference.+measurePieceSquareValueDifference pieceSquareValueByCoordinatesByRank game	= Data.List.foldl1' ( 	if Colour.LogicalColour.isBlack $! Model.Game.getNextLogicalColour game-		then id-		else negate	-- Represent the piece-square value difference from Black's perspective.- ) $! whitesPieceSquareValue - blacksPieceSquareValue where-	[blacksPieceSquareValue, whitesPieceSquareValue]	= Data.Array.IArray.elems . State.Board.sumPieceSquareValueByLogicalColour pieceSquareByCoordinatesByRank $ Model.Game.getBoard game+		then subtract+		else (-)	-- Represent the piece-square value difference from Black's perspective; i.e. the last player to move.+ ) . State.Board.sumPieceSquareValueByLogicalColour pieceSquareValueByCoordinatesByRank $ Model.Game.getBoard game  {- |-	* Measures the difference in piece-square value between players, from the perspective of the last player to move.+	* Measures the difference in /piece-square value/ between players, from the perspective of the last player to move.  	* The previous value is provided, to enable calculation by difference. -	* N.B.: because of diminishing returns, the piece-square value for everything but simple moves is calculated from scratch.+	* CAVEAT: after a capture, the value is recounted from scratch, because there's one fewer pieces remaining & the piece-square value may depend on NPieces, so all pieces are potentially impacted. -} measurePieceSquareValueDifferenceIncrementally 	:: Type.Mass.Base	-- ^ The difference between players in the piece-square value, before the last move was applied & therefore also from the perspective of the previous player.-	-> Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank+	-> Component.PieceSquareValueByCoordinatesByRank.PieceSquareValueByCoordinatesByRank 	-> Model.Game.Game-	-> Type.Mass.Base-measurePieceSquareValueDifferenceIncrementally previousPieceSquareValueDifference pieceSquareByCoordinatesByRank game-	| Attribute.MoveType.isSimple $! Component.QualifiedMove.getMoveType qualifiedMove	= let-		findPieceSquareValue :: Cartesian.Coordinates.Coordinates -> Type.Mass.Base-		findPieceSquareValue	= realToFrac . uncurry (-			Component.PieceSquareByCoordinatesByRank.findPieceSquareValue pieceSquareByCoordinatesByRank-		 ) (-			State.Board.getNPieces {- N.B.: no capture occurred-} . Model.Game.getBoard &&& Property.Opposable.getOpposite . Model.Game.getNextLogicalColour $ game	{-the last player to move-}-		 ) (-			Component.Turn.getRank turn	-- N.B.: no promotion occurred.-		 )-	in uncurry (-) (-		findPieceSquareValue . Component.Move.getDestination &&& findPieceSquareValue . Component.Move.getSource $ Component.QualifiedMove.getMove qualifiedMove-	) - previousPieceSquareValueDifference {-from the previous player's perspective-}-	| otherwise	= measurePieceSquareValueDifference pieceSquareByCoordinatesByRank game	-- N.B.: though non-simple (Castling, En-passant, promotion) can be calculated, the returns don't justify the effort.-	where-		Just turn	= Model.Game.maybeLastTurn game-		qualifiedMove	= Component.Turn.getQualifiedMove turn+	-> Type.Mass.Base	-- ^ Unbounded difference.+measurePieceSquareValueDifferenceIncrementally previousPieceSquareValueDifference pieceSquareValueByCoordinatesByRank game	= Data.Maybe.maybe (+	measurePieceSquareValueDifference pieceSquareValueByCoordinatesByRank game	-- Recalculate.+ ) (+	subtract previousPieceSquareValueDifference+ ) . Attribute.MoveType.apply (+	\isShort	-> Just . (+ quietMovePieceSquareDifference) . uncurry subtract . uncurry (***) (+		getPieceSquareValue &&& getPieceSquareValue $! getPieceSquareValueByCoordinates Attribute.Rank.Rook+	) . (+		Component.Move.getSource &&& Component.Move.getDestination+	) . Component.CastlingMove.getRooksMove . (+		if isShort then snd else fst+	) $ Component.CastlingMove.getLongAndShortMoves previousLogicalColour,+	Nothing,	-- En-passant.+	\case+		(Nothing, maybePromotionRank)	-> Just $! Data.Maybe.maybe quietMovePieceSquareDifference (+			uncurry subtract . uncurry (***) getMovePieceSquareValues . (,) (getPieceSquareValueByCoordinates rank) . getPieceSquareValueByCoordinates+		 ) maybePromotionRank+		_				-> Nothing	-- Capture.+ ) $! Component.QualifiedMove.getMoveType qualifiedMove where+	(previousLogicalColour, (qualifiedMove, rank))	= Property.Opposable.getOpposite . Model.Game.getNextLogicalColour &&& (Component.Turn.getQualifiedMove &&& Component.Turn.getRank) . Data.Maybe.fromJust . Model.Game.maybeLastTurn $ game	-- Deconstruct. +	getPieceSquareValueByCoordinates :: Attribute.Rank.Rank -> Component.PieceSquareValueByCoordinates.PieceSquareValueByCoordinates+	getPieceSquareValueByCoordinates	= Component.PieceSquareValueByCoordinatesByRank.getPieceSquareValueByCoordinates pieceSquareValueByCoordinatesByRank . State.Board.getNPieces $ Model.Game.getBoard game++	getPieceSquareValue :: Component.PieceSquareValueByCoordinates.PieceSquareValueByCoordinates -> Cartesian.Coordinates.Coordinates -> Type.Mass.Base+	getPieceSquareValue pieceSquareByCoordinates	= realToFrac . Component.PieceSquareValueByCoordinates.getPieceSquareValue pieceSquareByCoordinates previousLogicalColour++	getMovePieceSquareValues :: (Component.PieceSquareValueByCoordinates.PieceSquareValueByCoordinates -> Type.Mass.Base, Component.PieceSquareValueByCoordinates.PieceSquareValueByCoordinates -> Type.Mass.Base)+	getMovePieceSquareValues	= uncurry (***) (id &&& id $ flip getPieceSquareValue) . (Component.Move.getSource &&& Component.Move.getDestination) $ Component.QualifiedMove.getMove qualifiedMove++	quietMovePieceSquareDifference	= uncurry subtract . uncurry (&&&) getMovePieceSquareValues $! getPieceSquareValueByCoordinates rank+ -- | Measure the arithmetic difference between the total /rank-value/ of the /piece/s currently held by either side; <https://www.chessprogramming.org/Material>. measureValueOfMaterial 	:: Input.RankValues.RankValues@@ -293,9 +310,9 @@ 			else 0	-- A draw. 	) [] 	| otherwise	= do-		criteriaWeights				<- Control.Monad.Reader.asks Input.EvaluationOptions.getCriteriaWeights-		rankValuePair				<- Control.Monad.Reader.asks $ Input.EvaluationOptions.getRankValues &&& Input.EvaluationOptions.getMaximumTotalRankValue-		maybePieceSquareByCoordinatesByRank	<- Control.Monad.Reader.asks Input.EvaluationOptions.getMaybePieceSquareByCoordinatesByRank+		criteriaWeights					<- Control.Monad.Reader.asks Input.EvaluationOptions.getCriteriaWeights+		rankValuePair					<- Control.Monad.Reader.asks $ Input.EvaluationOptions.getRankValues &&& Input.EvaluationOptions.getMaximumTotalRankValue+		maybePieceSquareValueByCoordinatesByRank	<- Control.Monad.Reader.asks Input.EvaluationOptions.getMaybePieceSquareValueByCoordinatesByRank  		return {-to Reader-monad-} $! Input.CriteriaWeights.calculateWeightedMean criteriaWeights ( 			uncurry measureValueOfMaterial rankValuePair game@@ -304,7 +321,7 @@ 		 ) ( 			Data.Maybe.maybe 0 ( 				realToFrac . (/ fromIntegral Component.Piece.nPiecesPerSide)	-- Normalise.-			) $ maybePieceSquareValueDifference <|> fmap (`measurePieceSquareValueDifference` game) maybePieceSquareByCoordinatesByRank+			) $ maybePieceSquareValueDifference <|> fmap (`measurePieceSquareValueDifference` game) maybePieceSquareValueByCoordinatesByRank 		 ) ( 			measureValueOfCastlingPotential game 		 ) (

@@ -177,7 +177,7 @@ 							positionHash'	= Model.Game.updateIncrementalPositionHash game positionHash game' zobrist 					in slave 				) (-					\pieceSquareByCoordinatesByRank -> let+					\pieceSquareValueByCoordinatesByRank -> let 						slave pieceSquareValueDifference positionHash game Data.Tree.Node { 							Data.Tree.rootLabel	= game', 							Data.Tree.subForest	= gameForest'@@ -187,11 +187,11 @@ 							) evaluationOptions, 							Data.Tree.subForest	= map (slave pieceSquareValueDifference' positionHash' game') gameForest'	-- Recurse. 						} where-							pieceSquareValueDifference'	= Evaluation.Fitness.measurePieceSquareValueDifferenceIncrementally pieceSquareValueDifference pieceSquareByCoordinatesByRank game'+							pieceSquareValueDifference'	= Evaluation.Fitness.measurePieceSquareValueDifferenceIncrementally pieceSquareValueDifference pieceSquareValueByCoordinatesByRank game' 							positionHash'			= Model.Game.updateIncrementalPositionHash game positionHash game' zobrist-					in slave $ Evaluation.Fitness.measurePieceSquareValueDifference pieceSquareByCoordinatesByRank seedGame+					in slave $ Evaluation.Fitness.measurePieceSquareValueDifference pieceSquareValueByCoordinatesByRank seedGame 				) (-					Input.EvaluationOptions.getMaybePieceSquareByCoordinatesByRank evaluationOptions+					Input.EvaluationOptions.getMaybePieceSquareValueByCoordinatesByRank evaluationOptions 				) apexPositionHash seedGame 			) $ Data.Tree.subForest bareGameTree 		}

@@ -42,29 +42,35 @@ 		getCriteriaWeights, 		getIncrementalEvaluation, --		getMaybePieceSquareTablePair,-		getMaybePieceSquareByCoordinatesByRank+		getMaybePieceSquareValueByCoordinatesByRank 	), -- * Constants 	tag, --	incrementalEvaluationTag, --	pieceSquareTablesTag, --	pieceSquareTableEndGameTag,+	nPiecesBounds, -- * Functions+--	interpolatePieceSquareValues, --	fromPieceSquareTablePair, -- ** Constructor 	mkEvaluationOptions ) where  import			BishBosh.Data.Bool()-import			Control.Arrow((***))-import qualified	BishBosh.Cartesian.Coordinates				as Cartesian.Coordinates-import qualified	BishBosh.Component.PieceSquareByCoordinatesByRank	as Component.PieceSquareByCoordinatesByRank+import			Control.Arrow((&&&), (***))+import qualified	BishBosh.Colour.LogicalColour				as Colour.LogicalColour+import qualified	BishBosh.Component.Piece				as Component.Piece+import qualified	BishBosh.Component.PieceSquareValueByCoordinates	as Component.PieceSquareValueByCoordinates+import qualified	BishBosh.Component.PieceSquareValueByCoordinatesByRank	as Component.PieceSquareValueByCoordinatesByRank import qualified	BishBosh.Data.Exception					as Data.Exception import qualified	BishBosh.Input.CriteriaWeights				as Input.CriteriaWeights import qualified	BishBosh.Input.PieceSquareTable				as Input.PieceSquareTable import qualified	BishBosh.Input.RankValues				as Input.RankValues+import qualified	BishBosh.Property.FixedMembership			as Property.FixedMembership import qualified	BishBosh.Property.ShowFloat				as Property.ShowFloat import qualified	BishBosh.Text.ShowList					as Text.ShowList+import qualified	BishBosh.Type.Count					as Type.Count import qualified	BishBosh.Type.Mass					as Type.Mass import qualified	Control.DeepSeq import qualified	Control.Exception@@ -99,32 +105,32 @@  -- | Defines the options related to the automatic selection of /move/s. data EvaluationOptions	= MkEvaluationOptions {-	getRankValues				:: Input.RankValues.RankValues,								-- ^ The static value associated with each /piece/'s /rank/.-	getMaximumTotalRankValue		:: Type.Mass.RankValue,									-- ^ Used to normalise the total value of pieces. Derived from 'getRankValues'.-	getCriteriaWeights			:: Input.CriteriaWeights.CriteriaWeights,						-- ^ The weights applied to each of the heterogeneous criterion-values used to select a /move/.-	getIncrementalEvaluation		:: IncrementalEvaluation,								-- ^ Whether to generate position-hashes & evaluate the piece-square value, from the previous value or from scratch.-	getMaybePieceSquareTablePair		:: Maybe PieceSquareTablePair,								-- ^ A optional pair of piece-square tables representing the opening & end-games respectively.-	getMaybePieceSquareByCoordinatesByRank	:: Maybe Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank	-- ^ The optional value for each rank of /piece/, when occupying each coordinate, at each phase of the game.-} deriving (Eq, Show)+	getRankValues					:: Input.RankValues.RankValues,									-- ^ The static value associated with each /piece/'s /rank/.+	getMaximumTotalRankValue			:: Type.Mass.RankValue,										-- ^ Used to normalise the total value of pieces. Derived from 'getRankValues'.+	getCriteriaWeights				:: Input.CriteriaWeights.CriteriaWeights,							-- ^ The weights applied to each of the heterogeneous criterion-values used to select a /move/.+	getIncrementalEvaluation			:: IncrementalEvaluation,									-- ^ Whether to generate position-hashes & evaluate the piece-square value, from the previous value or from scratch.+	getMaybePieceSquareTablePair			:: Maybe PieceSquareTablePair,									-- ^ A optional pair of piece-square tables representing the opening & end-games respectively.+	getMaybePieceSquareValueByCoordinatesByRank	:: Maybe Component.PieceSquareValueByCoordinatesByRank.PieceSquareValueByCoordinatesByRank	-- ^ The optional value for each rank of /piece/, when occupying each coordinate, at each phase of the game.+}  instance Control.DeepSeq.NFData EvaluationOptions where 	rnf MkEvaluationOptions {---		getRankValues				= rankValues,-		getMaximumTotalRankValue		= maximumTotalValue,-		getCriteriaWeights			= criteriaWeights,-		getIncrementalEvaluation		= incrementalEvaluation,---		getMaybePieceSquareTablePair		= maybePieceSquareTablePair,-		getMaybePieceSquareByCoordinatesByRank	= maybePieceSquareByCoordinatesByRank-	} = Control.DeepSeq.rnf (maximumTotalValue, criteriaWeights, incrementalEvaluation, maybePieceSquareByCoordinatesByRank)+--		getRankValues					= rankValues,+		getMaximumTotalRankValue			= maximumTotalValue,+		getCriteriaWeights				= criteriaWeights,+		getIncrementalEvaluation			= incrementalEvaluation,+--		getMaybePieceSquareTablePair			= maybePieceSquareTablePair,+		getMaybePieceSquareValueByCoordinatesByRank	= maybePieceSquareValueByCoordinatesByRank+	} = Control.DeepSeq.rnf (maximumTotalValue, criteriaWeights, incrementalEvaluation, maybePieceSquareValueByCoordinatesByRank)  instance Property.ShowFloat.ShowFloat EvaluationOptions where 	showsFloat fromDouble MkEvaluationOptions {-		getRankValues				= rankValues,---		getMaximumTotalRankValue		= maximumTotalValue,-		getCriteriaWeights			= criteriaWeights,-		getIncrementalEvaluation		= incrementalEvaluation,-		getMaybePieceSquareTablePair		= maybePieceSquareTablePair---		getMaybePieceSquareByCoordinatesByRank	= maybePieceSquareByCoordinatesByRank+		getRankValues					= rankValues,+--		getMaximumTotalRankValue			= maximumTotalValue,+		getCriteriaWeights				= criteriaWeights,+		getIncrementalEvaluation			= incrementalEvaluation,+		getMaybePieceSquareTablePair			= maybePieceSquareTablePair+--		getMaybePieceSquareValueByCoordinatesByRank	= maybePieceSquareValueByCoordinatesByRank 	} = Text.ShowList.showsAssociationList' $ [ 		( 			Input.RankValues.tag,		Property.ShowFloat.showsFloat fromDouble rankValues@@ -147,25 +153,42 @@  instance Data.Default.Default EvaluationOptions where 	def = MkEvaluationOptions {-		getRankValues				= rankValues,-		getMaximumTotalRankValue		= Input.RankValues.calculateMaximumTotalValue rankValues,-		getCriteriaWeights			= Data.Default.def,-		getIncrementalEvaluation		= True,-		getMaybePieceSquareTablePair		= Nothing,-		getMaybePieceSquareByCoordinatesByRank	= Nothing+		getRankValues					= rankValues,+		getMaximumTotalRankValue			= Input.RankValues.calculateMaximumTotalValue rankValues,+		getCriteriaWeights				= Data.Default.def,+		getIncrementalEvaluation			= True,+		getMaybePieceSquareTablePair			= Nothing,+		getMaybePieceSquareValueByCoordinatesByRank	= Nothing 	} where 		rankValues	= Data.Default.def +instance Eq EvaluationOptions where+	MkEvaluationOptions {+		getRankValues					= rankValues,+--		getMaximumTotalRankValue			= maximumTotalValue,+		getCriteriaWeights				= criteriaWeights,+		getIncrementalEvaluation			= incrementalEvaluation,+		getMaybePieceSquareTablePair			= maybePieceSquareTablePair+--		getMaybePieceSquareValueByCoordinatesByRank	= maybePieceSquareValueByCoordinatesByRank+	} == MkEvaluationOptions {+		getRankValues					= rankValues',+--		getMaximumTotalRankValue			= maximumTotalValue',+		getCriteriaWeights				= criteriaWeights',+		getIncrementalEvaluation			= incrementalEvaluation',+		getMaybePieceSquareTablePair			= maybePieceSquareTablePair'+--		getMaybePieceSquareValueByCoordinatesByRank	= maybePieceSquareValueByCoordinatesByRank'+	} = rankValues == rankValues' && criteriaWeights == criteriaWeights' && incrementalEvaluation == incrementalEvaluation' && maybePieceSquareTablePair == maybePieceSquareTablePair'+ instance HXT.XmlPickler EvaluationOptions where 	xpickle	= HXT.xpDefault def . HXT.xpElem tag . HXT.xpWrap ( 		\(a, b, c, d) -> mkEvaluationOptions a b c d,	-- Construct. 		\MkEvaluationOptions {-			getRankValues				= rankValues,---			getMaximumTotalRankValue		= maximumTotalRankValue,-			getCriteriaWeights			= criteriaWeights,-			getIncrementalEvaluation		= incrementalEvaluation,-			getMaybePieceSquareTablePair		= maybePieceSquareTablePair---			getMaybePieceSquareByCoordinatesByRank	= maybePieceSquareByCoordinatesByRank+			getRankValues					= rankValues,+--			getMaximumTotalRankValue			= maximumTotalRankValue,+			getCriteriaWeights				= criteriaWeights,+			getIncrementalEvaluation			= incrementalEvaluation,+			getMaybePieceSquareTablePair			= maybePieceSquareTablePair+--			getMaybePieceSquareValueByCoordinatesByRank	= maybePieceSquareValueByCoordinatesByRank 		} -> ( 			rankValues, 			criteriaWeights,@@ -177,18 +200,56 @@ 	 ) . HXT.xpOption . HXT.xpElem pieceSquareTablesTag $ HXT.xpElem Input.PieceSquareTable.tag HXT.xpickle `HXT.xpPair` HXT.xpElem pieceSquareTableEndGameTag HXT.xpickle where 		def	= Data.Default.def --- | Convert a /PieceSquareTablePair/ to a single linearly interpolated array.-fromPieceSquareTablePair :: PieceSquareTablePair -> Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank-fromPieceSquareTablePair pieceSquareTablePair	= Component.PieceSquareByCoordinatesByRank.mkPieceSquareByCoordinatesByRank $ \rank -> (+instance Show EvaluationOptions where+	showsPrec precedence MkEvaluationOptions {+		getRankValues					= rankValues,+--		getMaximumTotalRankValue			= maximumTotalRankValue,+		getCriteriaWeights				= criteriaWeights,+		getIncrementalEvaluation			= incrementalEvaluation,+		getMaybePieceSquareTablePair			= maybePieceSquareTablePair+--		getMaybePieceSquareValueByCoordinatesByRank	= maybePieceSquareValueByCoordinatesByRank+	} = showsPrec precedence (rankValues, criteriaWeights, incrementalEvaluation, maybePieceSquareTablePair)++-- | The constant bounds of the number of pieces on the board, at the end-game & opening-game respectively.+nPiecesBounds :: (Type.Count.NPieces, Type.Count.NPieces)+nPiecesBounds	= (+	3 {-minimum sufficient material-},+	fromIntegral Colour.LogicalColour.nDistinctLogicalColours * Component.Piece.nPiecesPerSide+ )++-- | Given the bounds over which a piece-square value varies, as the game progresses from opening to end, return the linearly interpolated value for the specified stage.+interpolatePieceSquareValues+	:: Type.Count.NPieces						-- ^ The value to interpolate.+	-> (Type.Mass.PieceSquareValue, Type.Mass.PieceSquareValue)	-- ^ (Opening-game, End-game) values.+	-> Type.Mass.PieceSquareValue+interpolatePieceSquareValues nPieces (openingGame, endGame)	= realToFrac . uncurry (+) . (+	(* toRational openingGame) &&& (* toRational endGame) . (1 -)	-- N.B.: arithmetic must be conducted in an unbounded type, instead of 'PieceSquareValue'.+ ) $ fromIntegral (+	nPieces - fst {-minimum-} nPiecesBounds+ ) / fromIntegral (+	uncurry subtract nPiecesBounds	-- N.B.: this can't reasonably be zero.+ )++-- | Derive 'PieceSquareValueByCoordinatesByRank'.+fromPieceSquareTablePair :: PieceSquareTablePair -> Component.PieceSquareValueByCoordinatesByRank.PieceSquareValueByCoordinatesByRank+fromPieceSquareTablePair pieceSquareTablePair	= Component.PieceSquareValueByCoordinatesByRank.mkPieceSquareValueByCoordinatesByRank $ \rank -> ( 	\(openingGamePieceSquareValueByCoordinates, maybeEndGamePieceSquareValueByCoordinates) -> Data.Maybe.maybe (-		Left openingGamePieceSquareValueByCoordinates+		Left openingGamePieceSquareValueByCoordinates	-- There's only one value for this rank, so no interpolation is required. 	) (-		Right . Cartesian.Coordinates.listArrayByCoordinates . zipWith Component.PieceSquareByCoordinatesByRank.interpolatePieceSquareValues (-			Data.Array.IArray.elems openingGamePieceSquareValueByCoordinates-		) . Data.Array.IArray.elems+		\endGamePieceSquareValueByCoordinates -> Right $ Data.Array.IArray.listArray nPiecesBounds (+			map (+				\nPieces -> Component.PieceSquareValueByCoordinates.fromList $ map (+					interpolatePieceSquareValues nPieces . uncurry (&&&) (+						($ openingGamePieceSquareValueByCoordinates) &&& ($ endGamePieceSquareValueByCoordinates) $ Component.PieceSquareValueByCoordinates.dereference+					)+				) Property.FixedMembership.members	-- Coordinates.+			) $ uncurry enumFromTo nPiecesBounds+		 ) 	) maybeEndGamePieceSquareValueByCoordinates  ) $ (-	 Data.Maybe.fromJust {-values for the openingGame must be specified-} . Input.PieceSquareTable.dereference rank *** Input.PieceSquareTable.dereference rank+	uncurry (***) . (+		(.) Data.Maybe.fromJust {-all ranks must be defined for the openingGame-} &&& id+	) $ Input.PieceSquareTable.findPieceSquareValueByCoordinates rank  ) pieceSquareTablePair  -- | Smart constructor.@@ -208,12 +269,12 @@ 	= Control.Exception.throw . Data.Exception.mkIncompatibleData . showString "BishBosh.Input.EvaluationOptions.mkEvaluationOptions:\tweight of " . shows Input.CriteriaWeights.weightOfPieceSquareValueTag . showString " is defined but " $ shows Input.PieceSquareTable.tag " isn't." 	| maximumTotalRankValue == 0 && Input.CriteriaWeights.getWeightOfMaterial criteriaWeights /= 0	= Control.Exception.throw . Data.Exception.mkIncompatibleData . showString "BishBosh.Input.EvaluationOptions.mkEvaluationOptions:\tweight of " . shows Input.CriteriaWeights.weightOfMaterialTag . showString " is non-zero, but the maximum total rank-value is " $ shows rankValues "." 	| otherwise		= MkEvaluationOptions {-		getRankValues				= rankValues,-		getMaximumTotalRankValue		= maximumTotalRankValue,-		getCriteriaWeights			= criteriaWeights,-		getIncrementalEvaluation		= incrementalEvaluation,-		getMaybePieceSquareTablePair		= maybePieceSquareTablePair,-		getMaybePieceSquareByCoordinatesByRank	= fromPieceSquareTablePair <$> maybePieceSquareTablePair	-- Infer.+		getRankValues					= rankValues,+		getMaximumTotalRankValue			= maximumTotalRankValue,+		getCriteriaWeights				= criteriaWeights,+		getIncrementalEvaluation			= incrementalEvaluation,+		getMaybePieceSquareTablePair			= maybePieceSquareTablePair,+		getMaybePieceSquareValueByCoordinatesByRank	= fromPieceSquareTablePair <$> maybePieceSquareTablePair	-- Infer. 	} where 		maximumTotalRankValue	= Input.RankValues.calculateMaximumTotalValue rankValues 

@@ -134,13 +134,12 @@ 		getIdentificationTags	= identificationTags, 		getMinimumPlies		= minimumPlies, 		getMaybeMaximumGames	= maybeMaximumGames-	} = Text.ShowList.showsAssociationList' [+	} = Text.ShowList.showsAssociationList' $ Data.Maybe.maybe id (+		(:) . (,) decompressorTag . shows+	 ) maybeDecompressor [ 		( 			databaseFilePathTag, 			shows databaseFilePath-		), (-			decompressorTag,-			shows maybeDecompressor 		), ( 			isStrictlySequentialTag, 			shows isStrictlySequential

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -41,7 +40,6 @@ -- ** Type-synonyms --	Normalise, --	ReflectOnY,---	PieceSquareValueByCoordinates, 	IOFormat, 	Assocs, -- ** Data-types@@ -58,8 +56,9 @@ 	normaliseToUnitInterval, 	mirror, 	unmirror,+-- ** Accessors 	findUndefinedRanks,-	dereference,+	findPieceSquareValueByCoordinates, -- ** Constructors 	mkPieceSquareTable, -- ** Predicates@@ -68,25 +67,25 @@  import			BishBosh.Data.Bool()	-- HXT.XmlPickler. import			Control.Arrow((&&&), (***))-import qualified	BishBosh.Attribute.Rank			as Attribute.Rank-import qualified	BishBosh.Cartesian.Abscissa		as Cartesian.Abscissa-import qualified	BishBosh.Cartesian.Coordinates		as Cartesian.Coordinates-import qualified	BishBosh.Data.Exception			as Data.Exception-import qualified	BishBosh.Data.Foldable			as Data.Foldable-import qualified	BishBosh.Data.Num			as Data.Num-import qualified	BishBosh.Property.Empty			as Property.Empty-import qualified	BishBosh.Property.FixedMembership	as Property.FixedMembership-import qualified	BishBosh.Property.ShowFloat		as Property.ShowFloat-import qualified	BishBosh.Text.Case			as Text.Case-import qualified	BishBosh.Text.ShowList			as Text.ShowList-import qualified	BishBosh.Type.Mass			as Type.Mass+import qualified	BishBosh.Attribute.Rank					as Attribute.Rank+import qualified	BishBosh.Cartesian.Abscissa				as Cartesian.Abscissa+import qualified	BishBosh.Cartesian.Coordinates				as Cartesian.Coordinates+import qualified	BishBosh.Component.PieceSquareValueByCoordinates	as Component.PieceSquareValueByCoordinates+import qualified	BishBosh.Data.Exception					as Data.Exception+import qualified	BishBosh.Data.Foldable					as Data.Foldable+import qualified	BishBosh.Data.Num					as Data.Num+import qualified	BishBosh.Property.Empty					as Property.Empty+import qualified	BishBosh.Property.FixedMembership			as Property.FixedMembership+import qualified	BishBosh.Property.ShowFloat				as Property.ShowFloat+import qualified	BishBosh.Text.Case					as Text.Case+import qualified	BishBosh.Text.ShowList					as Text.ShowList+import qualified	BishBosh.Type.Mass					as Type.Mass import qualified	Control.Arrow import qualified	Control.Exception-import qualified	Data.Array.IArray import qualified	Data.Default-import qualified	Data.Map.Strict				as Map+import qualified	Data.Map.Strict						as Map import qualified	Data.Set-import qualified	Text.XML.HXT.Arrow.Pickle		as HXT+import qualified	Text.XML.HXT.Arrow.Pickle				as HXT  -- | Used to qualify XML. tag :: String@@ -106,20 +105,11 @@ -- | Type-synonym. type ReflectOnY	= Bool --- | Self-documentation.-type PieceSquareValueByCoordinates	=-#if defined(USE_UNBOXED_ARRAYS) && !(defined(USE_NEWTYPE_WRAPPERS) || defined(USE_PRECISION))-	Cartesian.Coordinates.UArrayByCoordinates-#else-	Cartesian.Coordinates.ArrayByCoordinates-#endif-		Type.Mass.PieceSquareValue- -- | Defines the value for each type of piece, of occupying each square. data PieceSquareTable	= MkPieceSquareTable {-	getNormalise				:: Normalise,							-- ^ Whether to map the specified values into the closed unit-interval.	CAVEAT: incompatible with RelaxNG, the specification for which already constrains values to the unit-interval.-	getReflectOnY				:: ReflectOnY,							-- ^ Whether values for the RHS of the board should be inferred by reflection about the y-axis.-	getPieceSquareValueByCoordinatesByRank	:: Map.Map Attribute.Rank.Rank PieceSquareValueByCoordinates	-- ^ N.B.: on the assumption that the values for Black pieces are the reflection of those for White, merely the /rank/ of each /piece/ need be defined.+	getNormalise				:: Normalise,												-- ^ Whether to map the specified values into the closed unit-interval.	CAVEAT: incompatible with RelaxNG, the specification for which already constrains values to the unit-interval.+	getReflectOnY				:: ReflectOnY,												-- ^ Whether values for the RHS of the board should be inferred by reflection about the y-axis.+	getPieceSquareValueByCoordinatesByRank	:: Map.Map Attribute.Rank.Rank Component.PieceSquareValueByCoordinates.PieceSquareValueByCoordinates	-- ^ N.B.: on the assumption that the values for Black pieces are the reflection of those for White, merely the /rank/ of each /piece/ need be defined. } deriving (Eq, Show)  instance Property.ShowFloat.ShowFloat PieceSquareTable where@@ -140,7 +130,7 @@ 			if reflectOnY 				then unmirror 				else id-		) . Data.Array.IArray.elems+		) . Component.PieceSquareValueByCoordinates.toList 	 ) ( 		Map.toList pieceSquareValueByCoordinatesByRank 	 )@@ -170,7 +160,7 @@ 					if reflectOnY 						then unmirror 						else id-				) . Data.Array.IArray.elems+				) . Component.PieceSquareValueByCoordinates.toList 			) pieceSquareValueByCoordinatesByRank 		) -- Deconstruct to tuple. 	 ) . HXT.xpTriple (@@ -241,7 +231,7 @@ 		getNormalise				= normalise, 		getReflectOnY				= reflectOnY, 		getPieceSquareValueByCoordinatesByRank	= Map.fromList . map (-			Control.Arrow.second Cartesian.Coordinates.listArrayByCoordinates+			Control.Arrow.second Component.PieceSquareValueByCoordinates.fromList 		) . ( 			if reflectOnY 				then map $ Control.Arrow.second mirror@@ -266,6 +256,6 @@ findUndefinedRanks MkPieceSquareTable { getPieceSquareValueByCoordinatesByRank = pieceSquareValueByCoordinatesByRank }	= Data.Set.fromAscList Property.FixedMembership.members `Data.Set.difference` Map.keysSet pieceSquareValueByCoordinatesByRank  -- | Lookup the values for all /coordinates/, corresponding to the specified /rank/.-dereference :: Attribute.Rank.Rank -> PieceSquareTable -> Maybe PieceSquareValueByCoordinates-dereference rank MkPieceSquareTable { getPieceSquareValueByCoordinatesByRank = pieceSquareValueByCoordinatesByRank }	= Map.lookup rank pieceSquareValueByCoordinatesByRank+findPieceSquareValueByCoordinates :: Attribute.Rank.Rank -> PieceSquareTable -> Maybe Component.PieceSquareValueByCoordinates.PieceSquareValueByCoordinates+findPieceSquareValueByCoordinates rank MkPieceSquareTable { getPieceSquareValueByCoordinatesByRank = pieceSquareValueByCoordinatesByRank }	= Map.lookup rank pieceSquareValueByCoordinatesByRank 

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -51,6 +52,7 @@ import qualified	BishBosh.Property.ShowFloat	as Property.ShowFloat import qualified	BishBosh.Text.ShowList		as Text.ShowList import qualified	BishBosh.Type.Mass		as Type.Mass+import qualified	Control.Arrow import qualified	Control.DeepSeq import qualified	Control.Exception import qualified	Data.Array.IArray@@ -70,9 +72,21 @@ 	* CAVEAT: a @King@ can never be taken, but assigning the value /infinity/ creates problems, so typically it has the value @0@. -} newtype RankValues	= MkRankValues {-	deconstruct	:: Attribute.Rank.ArrayByRank Metric.RankValue.RankValue-} deriving (Eq, Read, Show)+	deconstruct	::+#ifdef UNBOX_TYPEMASS_ARRAYS+		Attribute.Rank.UArrayByRank+#else+		Attribute.Rank.ArrayByRank+#endif+			Metric.RankValue.RankValue+} deriving Eq +instance Read RankValues where+	readsPrec precedence	= map (Control.Arrow.first fromAssocs) . readsPrec precedence++instance Show RankValues where+	showsPrec precedence MkRankValues { deconstruct = byRank }	= showsPrec precedence $ Data.Array.IArray.assocs byRank+ instance Property.ShowFloat.ShowFloat RankValues where 	showsFloat fromDouble	= Text.ShowList.showsAssociationList' . map (show *** Property.ShowFloat.showsFloat fromDouble) . Data.Array.IArray.assocs . deconstruct @@ -85,17 +99,27 @@ 		3, 		3, 		9,-		0	-- N.B.: move-selection is independent of the King's value (since it can't be taken), so it can be defined arbitrarily.+		0	-- N.B.: the King's value is immaterial (since it can't be taken), so it can be defined arbitrarily. 	 ]  instance Control.DeepSeq.NFData RankValues where-	rnf (MkRankValues byRank)	= Control.DeepSeq.rnf byRank+	rnf (MkRankValues byRank)	=+#ifdef UNBOX_TYPEMASS_ARRAYS+		Control.DeepSeq.rwhnf+#else+		Control.DeepSeq.rnf+#endif+			byRank  instance HXT.XmlPickler RankValues where 	xpickle	= HXT.xpDefault Data.Default.def . HXT.xpWrap ( 		fromAssocs,				-- Construct from an association-list. 		Data.Array.IArray.assocs . deconstruct	-- Deconstruct to an association-list.-	 ) . HXT.xpList1 . HXT.xpElem tag $ HXT.xpickle {-Rank-} `HXT.xpPair` HXT.xpickle {-RankValue-}+	 ) . HXT.xpList1 . HXT.xpElem tag $ HXT.xpickle {-Rank-} `HXT.xpPair`+#ifndef USE_NEWTYPE_WRAPPERS+		HXT.xpAttr Metric.RankValue.tag+#endif+		HXT.xpickle  -- | Smart constructor. fromAssocs :: [(Attribute.Rank.Rank, Metric.RankValue.RankValue)] -> RankValues

@@ -19,7 +19,7 @@ {- |  [@AUTHOR@]	Dr. Alistair Ward - [@DESCRIPTION@]	Defines configurable options related to the process of searching standard-openings.+ [@DESCRIPTION@]	Defines configurable options related to the process of searching standard openings. -}  module BishBosh.Input.StandardOpeningOptions(@@ -30,7 +30,8 @@ --		getTryToMatchMoves, --		getTryToMatchViaJoiningMove, --		getTryToMatchColourFlippedPosition,-		getPreferVictories+		getPreferVictories,+		getMaybeMaximumPliesSinceMatch 	), -- * Constants 	tag,@@ -38,6 +39,7 @@ --	tryToMatchViaJoiningMoveTag, --	tryToMatchColourFlippedPositionTag, --	preferVictoriesTag,+--	maximumPliesSinceMatchTag, -- * Functions -- ** Constructor 	mkStandardOpeningOptions,@@ -47,8 +49,10 @@  import			BishBosh.Data.Bool()	-- For 'HXT.xpickle'. import qualified	BishBosh.Text.ShowList						as Text.ShowList+import qualified	BishBosh.Type.Count						as Type.Count import qualified	Control.DeepSeq import qualified	Data.Default+import qualified	Data.Maybe import qualified	BishBosh.ContextualNotation.PositionHashQualifiedMoveTree	as ContextualNotation.PositionHashQualifiedMoveTree import qualified	Text.XML.HXT.Arrow.Pickle					as HXT @@ -72,30 +76,42 @@ preferVictoriesTag :: String preferVictoriesTag			= "preferVictories" +-- | Used to qualify XML.+maximumPliesSinceMatchTag :: String+maximumPliesSinceMatchTag		= "maximumPliesSinceMatch"+ -- | Defines options related to searching for a move. data StandardOpeningOptions	= MkStandardOpeningOptions {+	getMaybeMaximumPliesSinceMatch		:: Maybe Type.Count.NPlies,								-- ^ The optional maximum number of plies, after the last match with a prerecorded game, before abandoning further attempts. If unspecified then there's no limit.+	getPreferVictories			:: ContextualNotation.PositionHashQualifiedMoveTree.PreferVictories,			-- ^ Whether from all matching positions extracted from PGN-Databases, to prefer moves which result in a greater probability of victory, for the player who has the next move. 	getTryToMatchMoves			:: ContextualNotation.PositionHashQualifiedMoveTree.TryToMatchMoves,			-- ^ Whether to attempt to exactly match moves with a standard opening; transpositions won't be matched. 	getTryToMatchViaJoiningMove		:: ContextualNotation.PositionHashQualifiedMoveTree.TryToMatchViaJoiningMove,		-- ^ Whether to attempt to join the current position to a standard opening that's only one ply away.-	getTryToMatchColourFlippedPosition	:: ContextualNotation.PositionHashQualifiedMoveTree.TryToMatchColourFlippedPosition,	-- ^ Whether to attempt to match a colour-flipped version of the current position with a standard opening.-	getPreferVictories			:: ContextualNotation.PositionHashQualifiedMoveTree.PreferVictories			-- ^ Whether from all matching positions extracted from PGN-Databases, to prefer moves which result in a greater probability of victory, for the player who has the next move.+	getTryToMatchColourFlippedPosition	:: ContextualNotation.PositionHashQualifiedMoveTree.TryToMatchColourFlippedPosition	-- ^ Whether to attempt to match a colour-flipped version of the current position with a standard opening. } deriving Eq  instance Control.DeepSeq.NFData StandardOpeningOptions where 	rnf MkStandardOpeningOptions {+		getMaybeMaximumPliesSinceMatch		= maybeMaximumPliesSinceMatch,+		getPreferVictories			= preferVictories, 		getTryToMatchMoves			= tryToMatchMoves, 		getTryToMatchViaJoiningMove		= tryToMatchViaJoiningMove,-		getTryToMatchColourFlippedPosition	= tryToMatchColourFlippedPosition,-		getPreferVictories			= preferVictories-	} = Control.DeepSeq.rnf (tryToMatchMoves, tryToMatchViaJoiningMove, tryToMatchColourFlippedPosition, preferVictories)+		getTryToMatchColourFlippedPosition	= tryToMatchColourFlippedPosition+	} = Control.DeepSeq.rnf (maybeMaximumPliesSinceMatch, preferVictories, tryToMatchMoves, tryToMatchViaJoiningMove, tryToMatchColourFlippedPosition)  instance Show StandardOpeningOptions where 	showsPrec _ MkStandardOpeningOptions {+		getMaybeMaximumPliesSinceMatch		= maybeMaximumPliesSinceMatch,+		getPreferVictories			= preferVictories, 		getTryToMatchMoves			= tryToMatchMoves, 		getTryToMatchViaJoiningMove		= tryToMatchViaJoiningMove,-		getTryToMatchColourFlippedPosition	= tryToMatchColourFlippedPosition,-		getPreferVictories			= preferVictories-	} = Text.ShowList.showsAssociationList' [+		getTryToMatchColourFlippedPosition	= tryToMatchColourFlippedPosition+	} = Text.ShowList.showsAssociationList' $ Data.Maybe.maybe id (+		(:) . (,) maximumPliesSinceMatchTag . shows+	 ) maybeMaximumPliesSinceMatch [ 		(+			preferVictoriesTag,+			shows preferVictories+		), ( 			tryToMatchMovesTag, 			shows tryToMatchMoves 		), (@@ -104,52 +120,55 @@ 		), ( 			tryToMatchColourFlippedPositionTag, 			shows tryToMatchColourFlippedPosition-		), (-			preferVictoriesTag,-			shows preferVictories 		) 	 ]  instance Data.Default.Default StandardOpeningOptions where 	def = MkStandardOpeningOptions {+		getMaybeMaximumPliesSinceMatch		= Nothing,	-- Unlimited.+		getPreferVictories			= True, 		getTryToMatchMoves			= True, 		getTryToMatchViaJoiningMove		= True,-		getTryToMatchColourFlippedPosition	= True,-		getPreferVictories			= True+		getTryToMatchColourFlippedPosition	= True 	}  instance HXT.XmlPickler StandardOpeningOptions where 	xpickle	= HXT.xpDefault Data.Default.def . HXT.xpElem tag . HXT.xpWrap (-		\(a, b, c, d) -> mkStandardOpeningOptions a b c d,	-- Construct.+		\(a, b, c, d, e) -> mkStandardOpeningOptions a b c d e,	-- Construct. 		\MkStandardOpeningOptions {+			getMaybeMaximumPliesSinceMatch		= maybeMaximumPliesSinceMatch,+			getPreferVictories			= preferVictories, 			getTryToMatchMoves			= tryToMatchMoves, 			getTryToMatchViaJoiningMove		= tryToMatchViaJoiningMove,-			getTryToMatchColourFlippedPosition	= tryToMatchColourFlippedPosition,-			getPreferVictories			= preferVictories-		} -> (tryToMatchMoves, tryToMatchViaJoiningMove, tryToMatchColourFlippedPosition, preferVictories) -- Deconstruct.-	 ) $ HXT.xp4Tuple (+			getTryToMatchColourFlippedPosition	= tryToMatchColourFlippedPosition+		} -> (maybeMaximumPliesSinceMatch, preferVictories, tryToMatchMoves, tryToMatchViaJoiningMove, tryToMatchColourFlippedPosition) -- Deconstruct.+	 ) $ HXT.xp5Tuple (+		HXT.xpOption $ HXT.xpAttr maximumPliesSinceMatchTag HXT.xpickle+	 ) (+		getPreferVictories def `HXT.xpDefault` HXT.xpAttr preferVictoriesTag HXT.xpickle+	 ) ( 		getTryToMatchMoves def `HXT.xpDefault` HXT.xpAttr tryToMatchMovesTag HXT.xpickle 	 ) ( 		getTryToMatchViaJoiningMove def `HXT.xpDefault` HXT.xpAttr tryToMatchViaJoiningMoveTag HXT.xpickle 	 ) ( 		getTryToMatchColourFlippedPosition def `HXT.xpDefault` HXT.xpAttr tryToMatchColourFlippedPositionTag HXT.xpickle-	 ) (-		getPreferVictories def `HXT.xpDefault` HXT.xpAttr preferVictoriesTag HXT.xpickle 	 ) where 		def	= Data.Default.def  -- | Smart constructor. mkStandardOpeningOptions-	:: ContextualNotation.PositionHashQualifiedMoveTree.TryToMatchMoves+	:: Maybe Type.Count.NPlies	-- ^ The optional maximum number of plies, after the last position matched against a standard opening, to abandon further match-attempts.+	-> ContextualNotation.PositionHashQualifiedMoveTree.PreferVictories+	-> ContextualNotation.PositionHashQualifiedMoveTree.TryToMatchMoves 	-> ContextualNotation.PositionHashQualifiedMoveTree.TryToMatchViaJoiningMove 	-> ContextualNotation.PositionHashQualifiedMoveTree.TryToMatchColourFlippedPosition-	-> ContextualNotation.PositionHashQualifiedMoveTree.PreferVictories 	-> StandardOpeningOptions-mkStandardOpeningOptions tryToMatchMoves tryToMatchViaJoiningMove tryToMatchColourFlippedPosition preferVictories	= MkStandardOpeningOptions {+mkStandardOpeningOptions maybeNPlies preferVictories tryToMatchMoves tryToMatchViaJoiningMove tryToMatchColourFlippedPosition	= MkStandardOpeningOptions {+	getMaybeMaximumPliesSinceMatch		= maybeNPlies,+	getPreferVictories			= preferVictories, 	getTryToMatchMoves			= tryToMatchMoves, 	getTryToMatchViaJoiningMove		= tryToMatchViaJoiningMove,-	getTryToMatchColourFlippedPosition	= tryToMatchColourFlippedPosition,-	getPreferVictories			= preferVictories+	getTryToMatchColourFlippedPosition	= tryToMatchColourFlippedPosition }  -- | Accessor.

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {- 	Copyright (C) 2021 Dr. Alistair Ward @@ -24,37 +25,48 @@ 	* The relative value of a /rank/ of chess-piece.  	* <https://en.wikipedia.org/wiki/Chess_piece_relative_value#Hans_Berliner.27s_system%20Chess-piece%20relative%20values>++	* CAVEAT: this isn't measured in conventional centi-pawns units; values are constrained to the closed unit interval, & there's no requirement /Pawn/'s value to be @1@. -}  module BishBosh.Metric.RankValue( -- * Types+#ifdef USE_NEWTYPE_WRAPPERS -- ** Data-types 	RankValue( --		MkRankValue, --		deconstruct 	),--- * Constants---	tag, -- * Functions -- ** Constructor---	mkRankValue+--	mkRankValue,+#else+-- ** Type-synonyms+	RankValue,+#endif+-- * Constants+	tag ) where +import qualified	BishBosh.Type.Mass		as Type.Mass++#ifdef USE_NEWTYPE_WRAPPERS import qualified	BishBosh.Data.Exception		as Data.Exception import qualified	BishBosh.Data.Num		as Data.Num import qualified	BishBosh.Property.ShowFloat	as Property.ShowFloat-import qualified	BishBosh.Type.Mass		as Type.Mass import qualified	Control.Arrow import qualified	Control.DeepSeq import qualified	Control.Exception import qualified	Data.List.Extra import qualified	Text.XML.HXT.Arrow.Pickle	as HXT+#endif  -- | Used to qualify XML. tag :: String tag	= "rankValue"  -- | The constant value associated with a /rank/; the higher, the more valuable it is considered to be.+#ifdef USE_NEWTYPE_WRAPPERS newtype RankValue = MkRankValue { 	deconstruct	:: Type.Mass.RankValue } deriving (Eq, Ord)@@ -94,4 +106,7 @@ mkRankValue rankValue 	| Data.Num.inClosedUnitInterval rankValue	= MkRankValue rankValue 	| otherwise					= Control.Exception.throw . Data.Exception.mkOutOfBounds . showString "BishBosh.Metric.RankValue.mkRankValue:\t" $ shows rankValue " must be within the closed unit-interval [0,1]."+#else+type RankValue	 = Type.Mass.Base+#endif 

@@ -50,7 +50,7 @@ import qualified	Control.DeepSeq import qualified	Factory.Math.Statistics -#ifdef USE_PARALLEL+#ifdef PARALLELISE import qualified	Control.Parallel.Strategies #endif @@ -108,7 +108,7 @@ calculateWeightedMean	= uncurry mkWeightedMeanAndCriterionValues . ( 	Factory.Math.Statistics.getWeightedMean &&& map (realToFrac . fst)  )-#ifdef USE_PARALLEL+#ifdef PARALLELISE 	. Control.Parallel.Strategies.withStrategy ( 		Control.Parallel.Strategies.parList $ Control.Parallel.Strategies.evalTuple2 Control.Parallel.Strategies.rdeepseq Control.Parallel.Strategies.r0 	)

@@ -500,9 +500,7 @@ 				Cartesian.Coordinates.kingsStartingCoordinates logicalColour 			) castlingRooksSource, 			let castlingKingsMove	= Component.CastlingMove.getKingsMove castlingMove,-			all (-				null . State.Board.findAttackersOf board logicalColour-			) $ Component.Move.interpolate castlingKingsMove	-- The King mustn't be checked anywhere alongs its route.+			not $ State.Board.passesThroughCheck board logicalColour castlingKingsMove 	] {-list-comprehension-} 	| otherwise	= [] {-have already Castled-} @@ -920,9 +918,7 @@ 								maybeChecked == Just sourceLogicalColour, 								"it can't castle out of check" 							), (-								not . all (-									null . State.Board.findAttackersOf board sourceLogicalColour-								) $ Component.Move.interpolate move,	-- The King mustn't pass through check when moving from source to destination (inclusive); a long castle still permits the square right of the Rook to be checked.+								State.Board.passesThroughCheck board sourceLogicalColour move,	-- The King mustn't pass through check when moving from source to destination (inclusive); a long castle still permits the square right of the Rook to be checked. 								"it can't castle through check" 							) 						] -- Tests which are independent of the implied Rook.@@ -1108,7 +1104,7 @@ 				let piece	= Component.Piece.mkPiece logicalColour rank, 				source			<- State.CoordinatesByRankByLogicalColour.dereference coordinatesByRankByLogicalColour logicalColour rank,	-- Find the source of a potential blocking move. 				(destination, Nothing)	<- State.MaybePieceByCoordinates.listDestinationsFor maybePieceByCoordinates source piece,	-- The blocker must move to an empty square, otherwise the checker was already blocked.-				Control.Exception.assert (checkedFrom /= kingsCoordinates) . elem destination . init {-drop King's location-} $ Cartesian.Coordinates.interpolate checkedFrom kingsCoordinates,+				Control.Exception.assert (checkedFrom /= kingsCoordinates) $ Cartesian.Coordinates.isBetween kingsCoordinates checkedFrom destination, 				maybePromotionRank	<- listMaybePromotionRanks destination piece 		 ] -- List-comprehension. 		attackers		-> Control.Exception.assert (

@@ -38,7 +38,7 @@ --		MkGameTree, 		deconstruct 	),--- * Function+-- * Functions --	compareByMVVLVA, --	getLastMove, --	staticExchangeEvaluation,

@@ -28,7 +28,7 @@ --	BarePositionHashTree, -- ** Data-types 	PositionHashTree(),--- * Function+-- * Functions 	countDistinctPositions, -- ** Constructors 	mkPositionHashTree

@@ -106,6 +106,7 @@  -- | Parse a pair of /coordinates/. coordinatesParser :: Text.Poly.TextParser Cartesian.Coordinates.Coordinates+{-# ANN coordinatesParser "HLint: ignore Use <$>" #-} coordinatesParser	= do 	x	<- abscissaParser 	y	<- ordinateParser

@@ -31,6 +31,7 @@ ) where  import qualified	BishBosh.Type.Count	as Type.Count+import qualified	Data.Ratio import qualified	Numeric  -- | Render the specified data to the specified number of decimal digits.@@ -40,6 +41,15 @@ -- | An alternative to 'Show', for floating-point data. class ShowFloat a where 	showsFloat	:: (Double -> ShowS) -> a -> ShowS++instance ShowFloat Double where+	showsFloat	= id++instance ShowFloat Float where+	showsFloat fromDouble	= fromDouble . realToFrac++instance Integral r => ShowFloat (Data.Ratio.Ratio r) where+	showsFloat fromDouble	= fromDouble . realToFrac  -- | Render the specified data to the specified number of decimal digits. showsFloatToN :: ShowFloat a => Type.Count.NDecimalDigits -> a -> ShowS

@@ -31,7 +31,7 @@ -- * Types -- ** Data-types 	GameTerminationReason(),--- * Function+-- * Functions 	toResult, -- ** Constructors 	mkCheckMate,

@@ -30,7 +30,7 @@ --		VictoryBy, --		Draw 	),--- * Function+-- * Functions 	findMaybeVictor, -- ** Constructor 	mkResult,

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP, LambdaCase #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -61,11 +61,12 @@ -- ** Mutators 	movePiece, -- ** Predicates+	passesThroughCheck, 	isKingChecked, 	exposesKing ) where -import			Control.Arrow((&&&), (***), (|||))+import			Control.Arrow((&&&), (***)) import			Data.Array.IArray((!), (//)) import qualified	BishBosh.Attribute.MoveType				as Attribute.MoveType import qualified	BishBosh.Attribute.Rank					as Attribute.Rank@@ -75,7 +76,7 @@ import qualified	BishBosh.Component.Accountant				as Component.Accountant import qualified	BishBosh.Component.Move					as Component.Move import qualified	BishBosh.Component.Piece				as Component.Piece-import qualified	BishBosh.Component.PieceSquareByCoordinatesByRank	as Component.PieceSquareByCoordinatesByRank+import qualified	BishBosh.Component.PieceSquareValueByCoordinatesByRank	as Component.PieceSquareValueByCoordinatesByRank import qualified	BishBosh.Data.Exception					as Data.Exception import qualified	BishBosh.Direction.Direction				as Direction.Direction import qualified	BishBosh.Property.Empty					as Property.Empty@@ -133,7 +134,9 @@ 		getMaybePieceByCoordinates			= maybePieceByCoordinates, 		getCoordinatesByRankByLogicalColour		= coordinatesByRankByLogicalColour, 		getNDefendersByCoordinatesByLogicalColour	= nDefendersByCoordinatesByLogicalColour,+#ifndef UNBOX_TYPECOUNT_ARRAYS 		getNPiecesDifferenceByRank			= nPiecesDifferenceByRank,+#endif 		getNPawnsByFileByLogicalColour			= nPawnsByFileByLogicalColour, 		getNPieces					= nPieces, 		getPassedPawnCoordinatesByLogicalColour		= passedPawnCoordinatesByLogicalColour@@ -141,7 +144,9 @@ 		maybePieceByCoordinates, 		coordinatesByRankByLogicalColour, 		nDefendersByCoordinatesByLogicalColour,+#ifndef UNBOX_TYPECOUNT_ARRAYS 		nPiecesDifferenceByRank,+#endif 		nPawnsByFileByLogicalColour, 		nPieces, 		passedPawnCoordinatesByLogicalColour@@ -180,13 +185,8 @@ 	listRandoms zobrist MkBoard { getCoordinatesByRankByLogicalColour = coordinatesByRankByLogicalColour }	= StateProperty.Hashable.listRandoms zobrist coordinatesByRankByLogicalColour	-- Forward.  instance StateProperty.Mutator.Mutator Board where-	defineCoordinates maybePiece coordinates MkBoard {-		getMaybePieceByCoordinates	= maybePieceByCoordinates-	} = fromMaybePieceByCoordinates $ StateProperty.Mutator.defineCoordinates maybePiece coordinates maybePieceByCoordinates--	movePiece move sourcePiece maybePromotionRank eitherPassingPawnsDestinationOrMaybeTakenRank MkBoard {-		getMaybePieceByCoordinates	= maybePieceByCoordinates-	} = fromMaybePieceByCoordinates $ StateProperty.Mutator.movePiece move sourcePiece maybePromotionRank eitherPassingPawnsDestinationOrMaybeTakenRank maybePieceByCoordinates+	defineCoordinates maybePiece coordinates MkBoard { getMaybePieceByCoordinates = maybePieceByCoordinates }	= fromMaybePieceByCoordinates $ StateProperty.Mutator.defineCoordinates maybePiece coordinates maybePieceByCoordinates+	movePiece move moveType sourcePiece MkBoard { getMaybePieceByCoordinates = maybePieceByCoordinates }		= fromMaybePieceByCoordinates $ StateProperty.Mutator.movePiece move moveType sourcePiece maybePieceByCoordinates  instance StateProperty.Seeker.Seeker Board where 	findProximateKnights MkBoard {@@ -236,9 +236,9 @@ 	getNPieces					= nPieces } 	| Just sourcePiece <- State.MaybePieceByCoordinates.dereference maybePieceByCoordinates source	= let-		oppositePiece				= Property.Opposable.getOpposite sourcePiece-		(logicalColour, opponentsLogicalColour)	= ($! sourcePiece) &&& ($! oppositePiece) $ Component.Piece.getLogicalColour+		(logicalColour, (opponentsLogicalColour, oppositePiece))	= Component.Piece.getLogicalColour &&& ((Component.Piece.getLogicalColour &&& id) . Property.Opposable.getOpposite) $ sourcePiece +-- CAVEAT: this is an incomplete implementation, since Castling isn't represented, but rather implemented via two sequential calls to 'movePiece'. 		moveType :: Attribute.MoveType.MoveType 		moveType -- CAVEAT: one can't call 'State.MaybePieceByCoordinates.inferMoveType', since that performs some move-validation, & therefore exceeds the remit of this module. 			| Just explicitMoveType	<- maybeMoveType					= explicitMoveType@@ -250,21 +250,14 @@ 				else Nothing  -- Derive the required values from moveType.-		(maybePromotionRank, maybeExplicitlyTakenRank)	= Attribute.Rank.getMaybePromotionRank &&& Attribute.MoveType.getMaybeExplicitlyTakenRank $! moveType	-- Deconstruct.-		destinationPiece				= Data.Maybe.maybe id Component.Piece.promote maybePromotionRank sourcePiece-		wasPawnTakenExplicitly				= maybeExplicitlyTakenRank == Just Attribute.Rank.Pawn--		eitherPassingPawnsDestinationOrMaybeTakenRank :: Either Cartesian.Coordinates.Coordinates (Maybe Attribute.Rank.Rank)-		eitherPassingPawnsDestinationOrMaybeTakenRank-			| Attribute.MoveType.isEnPassant moveType	= Left $ Cartesian.Coordinates.retreat logicalColour destination-			| otherwise					= Right maybeExplicitlyTakenRank--		eitherPassingPawnsDestinationOrMaybeTakenPiece :: Either Cartesian.Coordinates.Coordinates (Maybe Component.Piece.Piece)-		eitherPassingPawnsDestinationOrMaybeTakenPiece	= fmap (Component.Piece.mkPiece opponentsLogicalColour) <$> eitherPassingPawnsDestinationOrMaybeTakenRank+		(destinationPiece, (maybeExplicitlyTakenPiece, wasPawnTakenExplicitly))	= ($ sourcePiece) . Data.Maybe.maybe id Component.Piece.promote . Attribute.Rank.getMaybePromotionRank &&& (fmap (Component.Piece.mkPiece opponentsLogicalColour) &&& (== Just Attribute.Rank.Pawn)) . Attribute.MoveType.getMaybeExplicitlyTakenRank $! moveType  		movePiece' :: StateProperty.Mutator.Mutator mutator => mutator -> mutator-		movePiece'	= StateProperty.Mutator.movePiece move sourcePiece maybePromotionRank eitherPassingPawnsDestinationOrMaybeTakenRank+		movePiece'	= StateProperty.Mutator.movePiece move moveType sourcePiece +		enpassantCaptureCoordinates :: Cartesian.Coordinates.Coordinates+		enpassantCaptureCoordinates	= Cartesian.Coordinates.retreat logicalColour destination	-- CAVEAT: only valid when the move-type is En-passant.+ 		board'@MkBoard { getMaybePieceByCoordinates = maybePieceByCoordinates' }	= MkBoard { 			getMaybePieceByCoordinates			= movePiece' maybePieceByCoordinates, 			getCoordinatesByRankByLogicalColour		= movePiece' coordinatesByRankByLogicalColour,@@ -286,14 +279,13 @@ 				(! Colour.LogicalColour.Black) &&& (! Colour.LogicalColour.White) $ nDefendersByCoordinatesByLogicalColour // ( 					let 						nDefendersByCoordinates	= nDefendersByCoordinatesByLogicalColour ! opponentsLogicalColour-					in (:) . (,) opponentsLogicalColour . (`Map.delete` nDefendersByCoordinates) {-Pawn has been taken-} ||| (-						\maybeExplicitlyTakenRank' -> if Data.Maybe.isJust maybeExplicitlyTakenRank'-							then (:) (-								opponentsLogicalColour,-								Map.delete destination nDefendersByCoordinates	-- This piece has been taken.-							)-							else id-					) $ eitherPassingPawnsDestinationOrMaybeTakenRank+					in Attribute.MoveType.apply (+						const id,	-- Castle.+						(:) . (,) opponentsLogicalColour $ Map.delete enpassantCaptureCoordinates nDefendersByCoordinates,	-- Pawn taken En-passant.+						\case+							(Just _, _)	-> (:) . (,) opponentsLogicalColour $ Map.delete destination nDefendersByCoordinates	-- Piece has been taken.+							_		-> id+					) moveType 				 ) [ 					id &&& Map.delete source . (nDefendersByCoordinatesByLogicalColour !) $ logicalColour	-- This piece has been moved. 				 ] -- Singleton.@@ -301,14 +293,16 @@ 				\l r -> fst l == fst r	-- Compare coordinates. 			) $ [ 				(affectedCoordinates, affectedPiece) |-					(knightsCoordinates, knight)	<- (source, sourcePiece) : (,) destination `map` (destinationPiece : (const [] ||| Data.Maybe.maybeToList) eitherPassingPawnsDestinationOrMaybeTakenPiece),+					(knightsCoordinates, knight)	<- (source, sourcePiece) : (,) destination `map` (+						destinationPiece : Data.Maybe.maybeToList maybeExplicitlyTakenPiece+					), 					Component.Piece.isKnight knight, 					affectedCoordinates		<- Data.Maybe.mapMaybe (`Cartesian.Vector.maybeTranslate` knightsCoordinates) Cartesian.Vector.attackVectorsForKnight, 					affectedPiece			<- Data.Maybe.maybeToList $! State.MaybePieceByCoordinates.dereference maybePieceByCoordinates' affectedCoordinates, 					Component.Piece.isFriend knight affectedPiece 			] {-list-comprehension-} ++ [ 				(blockingCoordinates, blockingPiece) |-					passingPawnsDestination			<- return {-to List-monad-} ||| const [] $ eitherPassingPawnsDestinationOrMaybeTakenRank,+					passingPawnsDestination			<- [enpassantCaptureCoordinates | Attribute.MoveType.isEnPassant moveType], 					(direction, antiParallelDirection)	<- Direction.Direction.opposites, 					(blockingCoordinates, blockingPiece)	<- case State.MaybePieceByCoordinates.findBlockingPieces maybePieceByCoordinates' passingPawnsDestination $ Just [direction, antiParallelDirection] of 						[cp, cp'] -> [@@ -331,7 +325,6 @@ 						 ) locatedPieces 			] {-list-comprehension-} ++ (destination, destinationPiece) : [ 				(blockingCoordinates, blockingPiece) |-					let maybeExplicitlyTakenPiece	= const Nothing ||| id $ eitherPassingPawnsDestinationOrMaybeTakenPiece, 					(direction, antiParallelDirection)	<- Direction.Direction.opposites, 					(coordinates, piece)			<- [(source, sourcePiece), (destination, destinationPiece)], 					(blockingCoordinates, blockingPiece)	<- case State.MaybePieceByCoordinates.findBlockingPieces maybePieceByCoordinates' coordinates $ Just [direction, antiParallelDirection] of@@ -354,21 +347,25 @@ 				if Colour.LogicalColour.isBlack logicalColour 					then (-)	-- Since White pieces are arbitrarily counted as positive, negate the adjustment if the current player is Black. 					else (+)-			) nPiecesDifferenceByRank $ if Attribute.MoveType.isEnPassant moveType-				then [(Attribute.Rank.Pawn, 1)]	-- Increment relative number of Pawns.-				else Data.Maybe.maybe id (-					(:) . flip (,) 1	-- Increment.-				) maybeExplicitlyTakenRank $ Data.Maybe.maybe [] (-					\promotionRank -> [-						(-							promotionRank,-							1	-- Increment.-						), (-							Attribute.Rank.Pawn,-							negate 1	-- Decrement relative number of Pawns.-						)-					]-				) maybePromotionRank,+			) nPiecesDifferenceByRank $ Attribute.MoveType.apply (+				const [],			-- Castle.+				[(Attribute.Rank.Pawn, 1)],	-- Enpassant => increment relative number of Pawns.+				uncurry ($) . (+					Data.Maybe.maybe id (+						(:) . flip (,) 1	-- Capture => Increment.+					) *** Data.Maybe.maybe [] (+						\promotionRank -> [+							(+								promotionRank,+								1		-- Increment.+							), (+								Attribute.Rank.Pawn,+								negate 1	-- Decrement relative number of Pawns.+							)+						]+					)+				) -- Normal.+			) moveType, 			getNPawnsByFileByLogicalColour		= if Component.Piece.isPawn sourcePiece && not (Attribute.MoveType.isQuiet moveType) || wasPawnTakenExplicitly 				then StateProperty.Seeker.countPawnsByFileByLogicalColour coordinatesByRankByLogicalColour'	-- Recalculate. 				else getNPawnsByFileByLogicalColour board,@@ -386,19 +383,13 @@  -- | Calculate the total value of the /coordinates/ occupied by the /piece/s of either side, at a stage in the game's life-span defined by the total number of pieces remaining. sumPieceSquareValueByLogicalColour-	:: Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank+	:: Component.PieceSquareValueByCoordinatesByRank.PieceSquareValueByCoordinatesByRank 	-> Board-	->-#if defined(USE_UNBOXED_ARRAYS) && !defined(USE_PRECISION)-	Colour.LogicalColour.UArrayByLogicalColour-#else-	Colour.LogicalColour.ArrayByLogicalColour-#endif-		Type.Mass.Base	-- ^ Sum of PieceSquareValues.-sumPieceSquareValueByLogicalColour pieceSquareByCoordinatesByRank MkBoard {+	-> [Type.Mass.Base]	-- ^ Individual sums for each logical colours, of the PieceSquareValues.+sumPieceSquareValueByLogicalColour pieceSquareValueByCoordinatesByRank MkBoard { 	getCoordinatesByRankByLogicalColour	= coordinatesByRankByLogicalColour, 	getNPieces				= nPieces-} = Colour.LogicalColour.listArrayByLogicalColour $ Component.Accountant.sumPieceSquareValueByLogicalColour pieceSquareByCoordinatesByRank coordinatesByRankByLogicalColour nPieces+} = Component.Accountant.sumPieceSquareValueByLogicalColour pieceSquareValueByCoordinatesByRank coordinatesByRankByLogicalColour nPieces	-- Forward the request.  {- | 	* Lists the source-/coordinates/ from which the referenced destination can be attacked.@@ -455,6 +446,16 @@ isKingChecked board@MkBoard { getCoordinatesByRankByLogicalColour = coordinatesByRankByLogicalColour }	= not . null . uncurry ($!) . ( 	findAttackersOf board &&& State.CoordinatesByRankByLogicalColour.getKingsCoordinates coordinatesByRankByLogicalColour  )++-- | Confirm whether the specified move passes through check.+passesThroughCheck+	:: Board+	-> Colour.LogicalColour.LogicalColour	-- ^ The mover's /logical colour/.+	-> Component.Move.Move+	-> Bool+passesThroughCheck board logicalColour	= not . all (+	null . findAttackersOf board logicalColour . fst {-coordinates-}+ ) . Component.Move.interpolate  {- | 	* Whether one's own @King@ has become exposed in the proposed /board/.

@@ -54,8 +54,9 @@ 	sortCoordinates ) where -import			Control.Arrow((&&&), (|||))+import			Control.Arrow((&&&)) import			Data.Array.IArray((!), (//))+import qualified	BishBosh.Attribute.MoveType				as Attribute.MoveType import qualified	BishBosh.Attribute.Rank					as Attribute.Rank import qualified	BishBosh.Cartesian.Abscissa				as Cartesian.Abscissa import qualified	BishBosh.Cartesian.Coordinates				as Cartesian.Coordinates@@ -64,7 +65,8 @@ import qualified	BishBosh.Component.Accountant				as Component.Accountant import qualified	BishBosh.Component.Move					as Component.Move import qualified	BishBosh.Component.Piece				as Component.Piece-import qualified	BishBosh.Component.PieceSquareByCoordinatesByRank	as Component.PieceSquareByCoordinatesByRank+import qualified	BishBosh.Component.PieceSquareValueByCoordinates	as Component.PieceSquareValueByCoordinates+import qualified	BishBosh.Component.PieceSquareValueByCoordinatesByRank	as Component.PieceSquareValueByCoordinatesByRank import qualified	BishBosh.Component.Zobrist				as Component.Zobrist import qualified	BishBosh.Property.Empty					as Property.Empty import qualified	BishBosh.Property.FixedMembership			as Property.FixedMembership@@ -159,32 +161,36 @@ 		) maybePiece 	 ) . deconstruct . purgeCoordinates coordinates -	movePiece move sourcePiece maybePromotionRank eitherPassingPawnsDestinationOrMaybeTakenRank MkCoordinatesByRankByLogicalColour {-		deconstruct	= byLogicalColour-	} = MkCoordinatesByRankByLogicalColour $ byLogicalColour // (-		(:) . (`deleteOpponentsCoordinates` Attribute.Rank.Pawn) ||| Data.Maybe.maybe id {-quiet move-} (-			(:) . deleteOpponentsCoordinates destination-		) $ eitherPassingPawnsDestinationOrMaybeTakenRank+	movePiece move moveType sourcePiece MkCoordinatesByRankByLogicalColour { deconstruct = byLogicalColour }	= MkCoordinatesByRankByLogicalColour $ byLogicalColour // (+		let+			deleteOpponentsCoordinates coordinates rank	= id &&& deleteCoordinatesFromRank coordinates rank . (byLogicalColour !) $ Property.Opposable.getOpposite logicalColour+		in Attribute.MoveType.apply (+			const id,	-- Castle.+			(Cartesian.Coordinates.retreat logicalColour destination `deleteOpponentsCoordinates` Attribute.Rank.Pawn :),	-- En-passant.+			Data.Maybe.maybe id (+				(:) . deleteOpponentsCoordinates destination+			) . fst {-taken Rank-}+		) moveType 	 ) [ 		let 			byRank	= byLogicalColour ! logicalColour 		in ( 			logicalColour, 			byRank // Data.Maybe.maybe (-				return {-to List-monad-} . Control.Arrow.second (destination :)	-- Add the destination to the mover.+				return {-to List-monad-} . Control.Arrow.second (destination :)	-- Add the destination to the mover's unpromoted rank. 			) ( 				\promotionRank -> (:) (-					promotionRank,-					destination : byRank ! promotionRank	-- Add the destination to the mover's promoted rank.+					id &&& (destination :) . (byRank !) $ promotionRank	-- Add the destination to the mover's promoted rank. 				) . return {-to List-monad-}-			) maybePromotionRank (-				id &&& Data.List.delete (Component.Move.getSource move) . (byRank !) $ Component.Piece.getRank sourcePiece+			) (+				Attribute.MoveType.getMaybePromotedRank moveType+			) (+				id &&& Data.List.delete (Component.Move.getSource move) . (byRank !) $ Component.Piece.getRank sourcePiece	-- Remove the piece from the source. 			) 		) -- Pair. 	 ] where-		destination					= Component.Move.getDestination move-		logicalColour					= Component.Piece.getLogicalColour sourcePiece-		deleteOpponentsCoordinates coordinates rank	= id &&& deleteCoordinatesFromRank coordinates rank . (byLogicalColour !) $ Property.Opposable.getOpposite logicalColour+		destination	= Component.Move.getDestination move+		logicalColour	= Component.Piece.getLogicalColour sourcePiece  {- | 	* Find any @Knight@s of the specified /logical colour/, in attack-range around the specified /coordinates/.@@ -225,10 +231,12 @@ 	 )  instance Component.Accountant.Accountant CoordinatesByRankByLogicalColour where-	sumPieceSquareValueByLogicalColour pieceSquareByCoordinatesByRank MkCoordinatesByRankByLogicalColour { deconstruct = byLogicalColour } nPieces	= map (+	sumPieceSquareValueByLogicalColour pieceSquareValueByCoordinatesByRank MkCoordinatesByRankByLogicalColour { deconstruct = byLogicalColour } nPieces	= map ( 		\(logicalColour, byRank) -> Data.List.foldl' (-			\acc (rank, coordinatesList) -> Data.List.foldl' (-				\acc' -> (+ acc') . realToFrac . Component.PieceSquareByCoordinatesByRank.findPieceSquareValue pieceSquareByCoordinatesByRank nPieces logicalColour rank+			\acc (rank, coordinatesList) -> let+				pieceSquareValueByCoordinates	= Component.PieceSquareValueByCoordinatesByRank.getPieceSquareValueByCoordinates pieceSquareValueByCoordinatesByRank nPieces rank+			in pieceSquareValueByCoordinates `seq` Data.List.foldl' (+				\acc' coordinates -> acc' + (realToFrac $! Component.PieceSquareValueByCoordinates.getPieceSquareValue pieceSquareValueByCoordinates logicalColour coordinates) 			) acc coordinatesList 		) 0 $ Data.Array.IArray.assocs byRank 	 ) $ Data.Array.IArray.assocs byLogicalColour

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -55,7 +56,7 @@ ) where  import			Control.Applicative((<|>))-import			Control.Arrow((&&&), (***), (|||))+import			Control.Arrow((&&&), (***)) import			Control.Category((>>>)) import			Data.Array.IArray((!), (//)) import qualified	BishBosh.Attribute.MoveType				as Attribute.MoveType@@ -72,7 +73,8 @@ import qualified	BishBosh.Component.CastlingMove				as Component.CastlingMove import qualified	BishBosh.Component.Move					as Component.Move import qualified	BishBosh.Component.Piece				as Component.Piece-import qualified	BishBosh.Component.PieceSquareByCoordinatesByRank	as Component.PieceSquareByCoordinatesByRank+import qualified	BishBosh.Component.PieceSquareValueByCoordinates	as Component.PieceSquareValueByCoordinates+import qualified	BishBosh.Component.PieceSquareValueByCoordinatesByRank	as Component.PieceSquareValueByCoordinatesByRank import qualified	BishBosh.Component.Zobrist				as Component.Zobrist import qualified	BishBosh.Data.Exception					as Data.Exception import qualified	BishBosh.Direction.Direction				as Direction.Direction@@ -82,7 +84,6 @@ import qualified	BishBosh.Property.FixedMembership			as Property.FixedMembership import qualified	BishBosh.Property.ForsythEdwards			as Property.ForsythEdwards import qualified	BishBosh.Property.Opposable				as Property.Opposable-import qualified	BishBosh.Property.Orientated				as Property.Orientated import qualified	BishBosh.Property.Reflectable				as Property.Reflectable import qualified	BishBosh.Property.SelfValidating			as Property.SelfValidating import qualified	BishBosh.StateProperty.Censor				as StateProperty.Censor@@ -104,6 +105,12 @@ import qualified	Data.Maybe import qualified	ToolShed.Data.List.Runlength +#ifdef USE_ARRAY_UNSAFEAT+import qualified	Data.Array.Base+#else+import qualified	BishBosh.Property.Orientated				as Property.Orientated+#endif+ {- | 	* This structure allows one to determine what /piece/ (if any) is located at specific /coordinates/. @@ -247,23 +254,24 @@ 	 ] -- List-comprehension.  instance StateProperty.Mutator.Mutator MaybePieceByCoordinates where-	defineCoordinates maybePiece coordinates MkMaybePieceByCoordinates {-		deconstruct	= byCoordinates-	} = Control.Exception.assert (+	defineCoordinates maybePiece coordinates MkMaybePieceByCoordinates { deconstruct = byCoordinates }	= Control.Exception.assert ( 		Data.Maybe.isJust maybePiece || Data.Maybe.isJust (byCoordinates ! coordinates) 	 ) . MkMaybePieceByCoordinates $ byCoordinates // [(coordinates, maybePiece)] -	movePiece move sourcePiece maybePromotionRank eitherPassingPawnsDestinationOrMaybeTakenRank MkMaybePieceByCoordinates {-		deconstruct	= byCoordinates-	} = MkMaybePieceByCoordinates $ byCoordinates // (-		(:) . flip (,) Nothing {-take en-passant-} ||| const id $ eitherPassingPawnsDestinationOrMaybeTakenRank+	movePiece move moveType sourcePiece MkMaybePieceByCoordinates { deconstruct = byCoordinates }	= MkMaybePieceByCoordinates $ byCoordinates // (+		if Attribute.MoveType.isEnPassant moveType+			then (:) (+				Cartesian.Coordinates.retreat (Component.Piece.getLogicalColour sourcePiece) $ Component.Move.getDestination move,+				Nothing+			)+			else id 	 ) [ 		( 			Component.Move.getSource move, 			Nothing	-- Remove the piece from the source. 		), ( 			Component.Move.getDestination move,-			Just $ Data.Maybe.maybe id Component.Piece.promote maybePromotionRank sourcePiece	-- Place the piece at the destination, removing any opposing incumbent as a side-effect.+			Just $ Data.Maybe.maybe id Component.Piece.promote (Attribute.MoveType.getMaybePromotedRank moveType) sourcePiece	-- Place the piece at the destination, removing any opposing incumbent as a side-effect. 		) 	 ] @@ -290,16 +298,17 @@ 	fromAssocs	= MkMaybePieceByCoordinates . Data.Array.IArray.accumArray (flip const) Nothing {-default-} (minBound, maxBound) . map (Control.Arrow.second Just)  instance Component.Accountant.Accountant MaybePieceByCoordinates where-	sumPieceSquareValueByLogicalColour pieceSquareByCoordinatesByRank maybePieceByCoordinates nPieces = (+	sumPieceSquareValueByLogicalColour pieceSquareValueByCoordinatesByRank maybePieceByCoordinates nPieces = ( 		\(b, w) -> [b, w] 	 ) . Data.List.foldl' ( 		\(b, w) (coordinates, piece) -> let 			logicalColour		= Component.Piece.getLogicalColour piece-			pieceSquareValue	= realToFrac $! Component.PieceSquareByCoordinatesByRank.findPieceSquareValue pieceSquareByCoordinatesByRank nPieces logicalColour (Component.Piece.getRank piece) coordinates+			pieceSquareValue	= realToFrac $! Component.PieceSquareValueByCoordinates.getPieceSquareValue (getPieceSquareValueByCoordinates $ Component.Piece.getRank piece) logicalColour coordinates 		in if Colour.LogicalColour.isBlack logicalColour 			then let b' = b + pieceSquareValue in b' `seq` (b', w) 			else let w' = w + pieceSquareValue in w' `seq` (b, w')-	 ) (0, 0) $ StateProperty.Seeker.findAllPieces maybePieceByCoordinates+	 ) (0, 0) $ StateProperty.Seeker.findAllPieces maybePieceByCoordinates where+		getPieceSquareValueByCoordinates	= Component.PieceSquareValueByCoordinatesByRank.getPieceSquareValueByCoordinates pieceSquareValueByCoordinatesByRank nPieces  instance Property.SelfValidating.SelfValidating MaybePieceByCoordinates where 	findInvalidity	= uncurry (++) . (StateProperty.Censor.findInvalidity &&& StateProperty.Seeker.findInvalidity)@@ -382,16 +391,22 @@ 			else []	-- The path immediately ahead is blocked. 		else {-N,K-} findAttackDestinations . Data.Maybe.maybe True {-unoccupied-} $ (/= logicalColour) . Component.Piece.getLogicalColour 	else {-R,B,Q-} let-		takeUntil :: [Cartesian.Coordinates.Coordinates] -> [(Cartesian.Coordinates.Coordinates, Maybe Attribute.Rank.Rank)]-		takeUntil (destination : remainder)-			| Just blockingPiece	<- byCoordinates ! destination	= [+		takeUntil :: Cartesian.Coordinates.QualifiedStraightLine -> [(Cartesian.Coordinates.Coordinates, Maybe Attribute.Rank.Rank)]+#ifdef USE_ARRAY_UNSAFEAT+		takeUntil ((destination, ix) : remainder)+			| Just blockingPiece	<- Data.Array.Base.unsafeAt byCoordinates ix+#else+		takeUntil ((destination, _) : remainder)+			| Just blockingPiece	<- byCoordinates ! destination+#endif+			= [ 				( 					destination, 					Just $ Component.Piece.getRank blockingPiece 				) | Component.Piece.getLogicalColour blockingPiece /= logicalColour 			] -- List-comprehension.-			| otherwise						= (destination, Nothing) : takeUntil remainder	-- Recurse.-		takeUntil _							= []+			| otherwise	= (destination, Nothing) : takeUntil remainder	-- Recurse.+		takeUntil _		= [] 	in Cartesian.Coordinates.applyAlongDirectionsFrom takeUntil source $ if Component.Piece.isQueen piece 		then Nothing	-- i.e. all directions. 		else Just $ Component.Piece.getAttackDirections piece@@ -472,11 +487,17 @@ 	-> Direction.Direction.Direction	-- ^ The direction in which to search. 	-> Maybe Component.Piece.LocatedPiece	-- ^ Any blocking piece. findBlockingPiece MkMaybePieceByCoordinates { deconstruct = byCoordinates } source	= slave . Cartesian.Coordinates.extrapolate source where-	slave :: [Cartesian.Coordinates.Coordinates] -> Maybe Component.Piece.LocatedPiece-	slave (coordinates : remainder)-		| Just blockingPiece	<- byCoordinates ! coordinates	= Just (coordinates, blockingPiece)	-- Terminate with success.-		| otherwise						= slave remainder			-- Recurse.-	slave _								= Nothing				-- Terminate with failure.+	slave :: Cartesian.Coordinates.QualifiedStraightLine -> Maybe Component.Piece.LocatedPiece+#ifdef USE_ARRAY_UNSAFEAT+	slave ((coordinates, ix) : remainder)+		| Just blockingPiece	<- Data.Array.Base.unsafeAt byCoordinates ix+#else+	slave ((coordinates, _) : remainder)+		| Just blockingPiece	<- byCoordinates ! coordinates+#endif+				= Just (coordinates, blockingPiece)	-- Terminate with success.+		| otherwise	= slave remainder			-- Recurse.+	slave _			= Nothing				-- Terminate with failure.  {- | 	* Find the first /piece/ of either /logical colour/, encountered in each of the specified /direction/s, from just after the specified /coordinates/.@@ -489,16 +510,22 @@ 	-> Maybe [Direction.Direction.Direction]	-- ^ The directions in which to search; 'Nothing' implies omni-directional. 	-> [Component.Piece.LocatedPiece]		-- ^ Blocking pieces in non-specific directions. findBlockingPieces MkMaybePieceByCoordinates { deconstruct = byCoordinates }	= Cartesian.Coordinates.applyAlongDirectionsFrom slave where-	slave :: [Cartesian.Coordinates.Coordinates] -> [Component.Piece.LocatedPiece]-	slave (coordinates : remainder)-		| Just blockingPiece	<- byCoordinates ! coordinates	= [(coordinates, blockingPiece)]	-- Terminate with success.-		| otherwise						= slave remainder			-- Recurse.-	slave _								= []					-- Terminate with failure.+	slave :: Cartesian.Coordinates.QualifiedStraightLine -> [Component.Piece.LocatedPiece]+#ifdef USE_ARRAY_UNSAFEAT+	slave ((coordinates, ix) : remainder)+		| Just blockingPiece	<- Data.Array.Base.unsafeAt byCoordinates ix+#else+	slave ((coordinates, _) : remainder)+		| Just blockingPiece	<- byCoordinates ! coordinates+#endif+				= [(coordinates, blockingPiece)]	-- Terminate with success.+		| otherwise	= slave remainder			-- Recurse.+	slave _			= []					-- Terminate with failure.  {- | 	* Find the /coordinates/ of any attacker who can strike the specified /coordinates/, from the specified /direction/ (as seen by the target). -	* N.B.: there no requirement for there to actually be a /piece/ to attack at the specified target.+	* N.B.: there's no requirement for there to actually be a /piece/ to attack at the specified target. -} findAttackerInDirection 	:: MaybePieceByCoordinates@@ -550,9 +577,19 @@ 	-> Cartesian.Coordinates.Coordinates	-- ^ Source. 	-> Cartesian.Coordinates.Coordinates	-- ^ Destination. 	-> Bool-isClear maybePieceByCoordinates source destination	= Control.Exception.assert (-	source /= destination && Property.Orientated.isStraight (Component.Move.mkMove source destination)- ) . all (isVacant maybePieceByCoordinates) . init {-discard the destination-} $ Cartesian.Coordinates.interpolate source destination+isClear+#ifdef USE_ARRAY_UNSAFEAT+	MkMaybePieceByCoordinates { deconstruct = byCoordinates } source destination	= all (+		Data.Maybe.isNothing . Data.Array.Base.unsafeAt byCoordinates . snd {-ix-}+	)+#else+	maybePieceByCoordinates source destination	= Control.Exception.assert (+		source /= destination && Property.Orientated.isStraight (Component.Move.mkMove source destination)+	) . all (+		isVacant maybePieceByCoordinates . fst {-coordinates-}+	)+#endif+	. init {-discard the destination-} $ Cartesian.Coordinates.interpolate source destination  -- | Whether there's a blockage between a /piece/ presumed to exist at the specified source, & a /piece/ presumed to exist @ the specified destination. isObstructed@@ -569,11 +606,12 @@ 	otherwise one would also need to confirm that the opponent's @Pawn@ had just double-advanced into the appropriate position. -} isEnPassantMove :: MaybePieceByCoordinates -> Component.Move.Move -> Bool-isEnPassantMove maybePieceByCoordinates@MkMaybePieceByCoordinates { deconstruct = byCoordinates } move-	| Just piece	<- byCoordinates ! source-	, let logicalColour	= Component.Piece.getLogicalColour piece-	= Cartesian.Coordinates.isEnPassantRank source logicalColour && Component.Piece.isPawn piece && destination `elem` Component.Piece.findAttackDestinations piece source && isVacant maybePieceByCoordinates destination	-- The move is either En-passant or invalid.-	| otherwise	= False	-- No piece.-	where-		(source, destination)	= Component.Move.getSource &&& Component.Move.getDestination $ move+isEnPassantMove maybePieceByCoordinates@MkMaybePieceByCoordinates { deconstruct = byCoordinates } move	= Data.Maybe.maybe False {-No piece-} (+	\piece -> uncurry (&&) (+		Cartesian.Coordinates.isEnPassantRank source . Component.Piece.getLogicalColour &&& Component.Piece.isPawn $ piece+	) && uncurry (&&) (+		(`elem` Component.Piece.findAttackDestinations piece source) &&& isVacant maybePieceByCoordinates $ Component.Move.getDestination move	-- The move is either En-passant or invalid.+	)+ ) $ byCoordinates ! source where+	source	= Component.Move.getSource move 

@@ -35,6 +35,7 @@ -- * Functions 	inferNextLogicalColour, 	countPlies,+	deriveMoveNumber, 	dereference, -- ** Constructors 	fromAssocs,@@ -133,6 +134,10 @@ -} countPlies :: TurnsByLogicalColour turn -> Type.Count.NPlies countPlies MkTurnsByLogicalColour { getTurnsByLogicalColour = byLogicalColour }	= fromIntegral $ Data.Foldable.foldl' (\acc -> (+ acc) . length) 0 byLogicalColour++-- | Derive the move-number, as used in PGN.+deriveMoveNumber :: TurnsByLogicalColour turn -> Type.Count.NMoves+deriveMoveNumber MkTurnsByLogicalColour { getNPlies = nPlies }	= succ {-index from 1-} $! fromIntegral nPlies `div` 2  -- | Dereference. dereference :: TurnsByLogicalColour turn -> Colour.LogicalColour.LogicalColour -> [turn]

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -39,7 +40,13 @@ import qualified	BishBosh.Type.Count			as Type.Count  -- | The difference in the number of /piece/s of each /rank/ held by either side.-type NPiecesByRank	= Attribute.Rank.ArrayByRank Type.Count.NPieces+type NPiecesByRank	=+#ifdef UNBOX_TYPECOUNT_ARRAYS+	Attribute.Rank.UArrayByRank+#else+	Attribute.Rank.ArrayByRank+#endif+		Type.Count.NPieces  -- | An interface which may be implemented by data which can perform a census of the /piece/s on the /board/. class Censor censor where

@@ -34,11 +34,11 @@ 	removePiece ) where -import qualified	BishBosh.Attribute.Rank		as Attribute.Rank-import qualified	BishBosh.Cartesian.Coordinates	as Cartesian.Coordinates-import qualified	BishBosh.Component.Move		as Component.Move-import qualified	BishBosh.Component.Piece	as Component.Piece-import qualified	BishBosh.Property.Empty		as Property.Empty+import qualified	BishBosh.Attribute.MoveType		as Attribute.MoveType+import qualified	BishBosh.Cartesian.Coordinates		as Cartesian.Coordinates+import qualified	BishBosh.Component.Move			as Component.Move+import qualified	BishBosh.Component.Piece		as Component.Piece+import qualified	BishBosh.Property.Empty			as Property.Empty  {- | 	* An interface which may be implemented by data which can mutate the board.@@ -61,10 +61,9 @@  	-- | Move the specified piece, accounting for promotions & casualties. 	movePiece-		:: Component.Move.Move							-- ^ The source & destination /coordinates/.-		-> Component.Piece.Piece						-- ^ The /piece/ which moved.-		-> Maybe Attribute.Rank.Rank						-- ^ The (possibly promoted) /rank/ to place at the destination.-		-> Either Cartesian.Coordinates.Coordinates (Maybe Attribute.Rank.Rank)	-- ^ Either the /coordinates/ of any @Pawn@ which was just captured en-passant, or the /rank/ of any /piece/ taken.+		:: Component.Move.Move+		-> Attribute.MoveType.MoveType+		-> Component.Piece.Piece	-- ^ The /piece/ which moved, rather than the (ptentially promoted) one that arrived. 		-> mutator 		-> mutator 

@@ -31,13 +31,15 @@ 	char, 	string, 	spaces,-	unsignedDecimal,+	unsignedDecimal ) where  import qualified	BishBosh.Data.Integral			as Data.Integral import qualified	Data.Char -#if USE_POLYPARSE == 'L'+#ifndef USE_POLYPARSE+#	error "USE_POLYPARSE undefined"+#elif USE_POLYPARSE == 'L' import qualified	Text.ParserCombinators.Poly.Lazy	as Poly #elif USE_POLYPARSE == 'P' import qualified	Text.ParserCombinators.Poly.Plain	as Poly@@ -50,10 +52,8 @@  -- | Matches the specified char. char :: Char -> TextParser ()-char c	= do-	_	<- Poly.satisfyMsg (== c) [c]--	return {-to Parser-monad-} ()+{-# ANN char "HLint: ignore Use void" #-}+char c	= Poly.satisfyMsg (== c) [c] >> return {-to Parser-monad-} ()  {- | 	* Matches the specified string.@@ -70,10 +70,8 @@ -} spaces :: TextParser () -- spaces	= Control.Monad.void . Poly.many $ Poly.satisfy Data.Char.isSpace	-- CAVEAT: poor performance ?!-spaces	= do-	_	<- Poly.many $ Poly.satisfy Data.Char.isSpace--	return {-to Parser-monad-} ()+{-# ANN spaces "HLint: ignore Use void" #-}+spaces	= Poly.many (Poly.satisfy Data.Char.isSpace) >> return {-to Parser-monad-} ()  -- | Parses an unsigned base-10 integer. unsignedDecimal :: Num i => TextParser i

@@ -41,7 +41,7 @@ 	Column ) where -#if defined(USE_NARROW_NUMBERS) || defined(USE_NEWTYPE_WRAPPERS)+#if defined USE_NARROW_NUMBERS || defined USE_NEWTYPE_WRAPPERS #	ifdef USE_NARROW_NUMBERS import qualified	Data.Int #	endif

@@ -49,7 +49,7 @@ import qualified	Control.Exception #endif -#ifdef USE_PRECISION+#ifdef USE_PRECISE_NUMBERS import			BishBosh.Data.Ratio() #else import qualified	Text.XML.HXT.Arrow.Pickle	as HXT@@ -57,7 +57,7 @@  -- | The underling type. type Base	=-#ifdef USE_PRECISION+#ifdef USE_PRECISE_NUMBERS 	Rational #else /* Floating-point */ #	ifdef USE_NARROW_NUMBERS

@@ -38,7 +38,9 @@ -- | Check the sanity of the implementation, by validating a list of static test-cases. testCases :: Test.HUnit.Test testCases	= Test.HUnit.test [-	all (Colour.LogicalColourOfSquare.isBlack . Cartesian.Coordinates.getLogicalColourOfSquare) (+	all (+		Colour.LogicalColourOfSquare.isBlack . Cartesian.Coordinates.getLogicalColourOfSquare . fst {-Coordinates-}+	) ( 		Cartesian.Coordinates.extrapolate (minBound :: Cartesian.Coordinates.Coordinates) maxBound {-direction-} 	) ~? "'BishBosh.Cartesian.Coordinates.getLogicalColourOfSquare' failed to find black squares on the main diagonal.", 	"'BishBosh.Cartesian.Coordinates.getLogicalColourOfSquare' failed to count equal numbers of black & white squares." ~: (

@@ -48,7 +48,7 @@ import qualified	Text.ParserCombinators.Parsec		as Parsec #endif -#if !defined(USE_POLYPARSE) || USE_POLYPARSE != 'L'+#if !defined USE_POLYPARSE || USE_POLYPARSE != 'L' import qualified	BishBosh.Data.Exception			as Data.Exception import qualified	Control.Exception #endif

@@ -78,7 +78,7 @@ -- | Check the sanity of the implementation, by validating a list of static test-cases. testCases :: Test.HUnit.Test testCases	= Test.HUnit.test [-	"ContextualNotation.PositionHashQualifiedMoveTree.findNextOnymousQualifiedMoves" ~: checkMatch (True, False, False) game2 (init moveStrings2) finalMove2,	-- Exact match for standard-opening.+	"ContextualNotation.PositionHashQualifiedMoveTree.findNextOnymousQualifiedMoves" ~: checkMatch (True, False, False) game2 (init moveStrings2) finalMove2,	-- Exact match for standard opening. 	"ContextualNotation.PositionHashQualifiedMoveTree.findNextOnymousQualifiedMoves/transposition" ~: checkMatch (False, False, False) game1 (words "e2e4 c7c5 d2d4 c5d4p g1f3 d7d6 f3d4p g8f6 b1c3") finalMove1,	-- White's 2nd & 3rd moves have been transposed & Black's 2nd & 3rd move also have been transposed. 	"ContextualNotation.PositionHashQualifiedMoveTree.findNextOnymousQualifiedMoves/transposition" ~: checkMatch (False, False, False) game2 (words "g1f3 d7d6 e2e4 c7c5 d2d4 c5d4p f3d4p g8f6 b1c3 a7a6 c1g5 e7e6 f2f4 d8b6 d1d2 b6b2p a1b1 b2a3 f4f5 b8c6 f5e6p f7e6p d4c6n b7c6n e4e5 d6e5p g5f6n g7f6b c3e4 f8e7 f1e2 h7h5 b1b3 a3a4") finalMove2,	-- White & also Black's 1st & 2nd moves have been transposed. 	"ContextualNotation.PositionHashQualifiedMoveTree.findNextOnymousQualifiedMoves/join" ~: checkMatch (False, True {-TryToMatchViaJoiningMove-}, False) game1 (words "e2e4 c7c5 g1f3 d7d6 d2d4 c5d4p b1c3 g8f6") (

@@ -57,6 +57,7 @@ import			Control.Arrow((|||)) import			Test.HUnit((~?=), (~?)) import qualified	Text.ParserCombinators.Parsec+{-# ANN module "HLint: ignore Use fewer imports" #-} #endif  -- | Check the sanity of the implementation, by validating a list of static test-cases.

@@ -39,7 +39,7 @@ testCases :: Test.HUnit.Test testCases	= Test.HUnit.test [ 	let-		maxDepth	= 4+		maxDepth	= 4	-- CAVEAT: 5 requires to much RAM. 	in "'BishBosh.Model.PositionhashTree.countDistinctPositions' failed" ~: map ( 		\i -> Model.PositionHashTree.countDistinctPositions i (Data.Default.def :: Model.PositionHashTree.PositionHashTree Type.Crypto.PositionHash) 	) [0 .. maxDepth] ~?= take (succ maxDepth) [1, 20, 400, 5362, 72078, 822518, 9417681, 96400068, 988187354, 9183421888, 85375278064, 726155461002]	-- <https://oeis.org/A083276>. CAVEAT: the point at which this test fails, depends on the square-root of the bits in 'Crypto.PositionHash'.

@@ -64,7 +64,7 @@ 	let 		kingsColour		= minBound 		destination		= Cartesian.Coordinates.mkRelativeCoordinates ((+ 3) *** (+ 3))-		directionToCoordinates	= last . Cartesian.Coordinates.extrapolate destination+		directionToCoordinates	= fst {-Coordinates-} . last . Cartesian.Coordinates.extrapolate destination 		mkPiece			= Component.Piece.mkPiece $ Property.Opposable.getOpposite kingsColour 		maybeShift		= (`Cartesian.Vector.maybeTranslate` destination) 	in all (

@@ -119,14 +119,20 @@ 					| null extrapolation	= source 					| otherwise		= last extrapolation 			 in source == destination || source : extrapolation == reverse (-				destination : Cartesian.Coordinates.interpolate destination source+				destination : map fst {-Coordinates-} (+					Cartesian.Coordinates.interpolate destination source+				) 			 )-		 ) $ Cartesian.Coordinates.extrapolate source direction+		 ) . map fst {-Coordinates-} $ Cartesian.Coordinates.extrapolate source direction 	in Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 64 } f, 	let 		f :: Cartesian.Coordinates.Coordinates -> Cartesian.Coordinates.Coordinates -> Test.QuickCheck.Property-		f source destination	= isValidMove source destination ==> Test.QuickCheck.label "Coordinates.prop_interpolate" $ source : Cartesian.Coordinates.interpolate source destination == reverse (-			destination : Cartesian.Coordinates.interpolate destination source+		f source destination	= isValidMove source destination ==> Test.QuickCheck.label "Coordinates.prop_interpolate" $ source : map fst {-Coordinates-} (+			Cartesian.Coordinates.interpolate source destination+		 ) == reverse (+			destination : map fst {-Coordinates-} (+				Cartesian.Coordinates.interpolate destination source+			) 		 ) 	in Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 64 } f, 	let@@ -142,6 +148,22 @@ 		f	= Test.QuickCheck.label "Coordinates.prop_applyAlongDirectionsFrom" . uncurry (==) . ( 			flip (Cartesian.Coordinates.applyAlongDirectionsFrom id) Nothing &&& flip (Cartesian.Coordinates.applyAlongDirectionsFrom id) (Just Property.FixedMembership.members) 		 )-	in Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 16 } f+	in Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 16 } f,+	let+		f :: Cartesian.Coordinates.Coordinates -> Direction.Direction.Direction -> Test.QuickCheck.Property+		f source direction	= not (null qualifiedStraightLine) ==> let+			destination	= fst {-coordinates-} $ last qualifiedStraightLine+		 in Test.QuickCheck.label "Coordinates.prop_isBetween(terminals)" . not $ any (Cartesian.Coordinates.isBetween source destination) [source, destination] where+			qualifiedStraightLine	= Cartesian.Coordinates.extrapolate source direction+	in Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 32 } f,+	let+		f :: Cartesian.Coordinates.Coordinates -> Direction.Direction.Direction -> Cartesian.Coordinates.Coordinates -> Test.QuickCheck.Property+		f source direction intermediary	= not (null qualifiedStraightLine) ==> let+			destination	= fst {-coordinates-} $ last qualifiedStraightLine+		 in Test.QuickCheck.label "Coordinates.prop_isBetween(symmetrical)" . uncurry (==) $ (+			Cartesian.Coordinates.isBetween source destination &&& Cartesian.Coordinates.isBetween destination source+		 ) intermediary where+			qualifiedStraightLine	= Cartesian.Coordinates.extrapolate source direction+	in Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 64 } f  ] 

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -36,19 +37,23 @@ import qualified	BishBosh.Input.SearchOptions				as Input.SearchOptions import qualified	BishBosh.Model.Game					as Model.Game import qualified	BishBosh.Property.Empty					as Property.Empty-import qualified	BishBosh.State.Position					as State.Position import qualified	BishBosh.Test.QuickCheck.Component.Zobrist		as Test.QuickCheck.Component.Zobrist import qualified	BishBosh.Type.Crypto					as Type.Crypto import qualified	BishBosh.Type.Mass					as Type.Mass-import qualified	Data.List.Extra-import qualified	Data.Ord import qualified	Data.Tree import qualified	Test.QuickCheck++#ifndef USE_NARROW_NUMBERS+import qualified	BishBosh.State.Position					as State.Position+import qualified	Data.List.Extra+import qualified	Data.Ord import			Test.QuickCheck((==>))+#endif  -- | The constant test-results for this data-type. results :: IO [Test.QuickCheck.Result] results	= sequence [+#ifndef USE_NARROW_NUMBERS 	let 		f 			:: Input.EvaluationOptions.EvaluationOptions@@ -67,6 +72,7 @@ 				Data.Ord.comparing Evaluation.PositionHashQuantifiedGameTree.getPositionHash 			 ) . take 10000 . Data.Tree.flatten . Evaluation.PositionHashQuantifiedGameTree.deconstruct $ Evaluation.PositionHashQuantifiedGameTree.mkPositionHashQuantifiedGameTree evaluationOptions searchOptions zobrist Property.Empty.empty {-MoveFrequency-} game 	in Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 32 } f,+#endif 	let 		f 			:: Input.EvaluationOptions.EvaluationOptions

@@ -40,14 +40,13 @@ import qualified	BishBosh.Input.RankValues		as Input.RankValues import qualified	BishBosh.Property.Reflectable		as Property.Reflectable import qualified	BishBosh.State.Board			as State.Board-import qualified	Data.Array.IArray import qualified	Data.List import qualified	Data.Map.Strict				as Map import qualified	Data.Maybe import qualified	Test.QuickCheck import			Test.QuickCheck((==>)) -#ifdef USE_PRECISION+#ifdef USE_PRECISE_NUMBERS import qualified	BishBosh.Component.Accountant		as Component.Accountant import qualified	BishBosh.Type.Mass			as Type.Mass #endif@@ -72,25 +71,25 @@ -- | The constant test-results for this data-type. results :: IO [Test.QuickCheck.Result] results	= sequence [-#ifdef USE_PRECISION+#ifdef USE_PRECISE_NUMBERS 	let 		f :: Input.EvaluationOptions.EvaluationOptions -> State.Board.Board -> Test.QuickCheck.Property-		f evaluationOptions board	= Data.Maybe.isJust maybePieceSquareByCoordinatesByRank ==> Test.QuickCheck.label "EvaluationOptions.prop_sumPieceSquareValueByLogicalColour" . uncurry (==) $ (+		f evaluationOptions board	= Data.Maybe.isJust maybePieceSquareValueByCoordinatesByRank ==> Test.QuickCheck.label "EvaluationOptions.prop_sumPieceSquareValueByLogicalColour" . uncurry (==) $ ( 			sumPieceSquareValueByLogicalColour' . State.Board.getCoordinatesByRankByLogicalColour &&& sumPieceSquareValueByLogicalColour' . State.Board.getMaybePieceByCoordinates 		 ) board where-			maybePieceSquareByCoordinatesByRank	= Input.EvaluationOptions.getMaybePieceSquareByCoordinatesByRank evaluationOptions+			maybePieceSquareValueByCoordinatesByRank	= Input.EvaluationOptions.getMaybePieceSquareValueByCoordinatesByRank evaluationOptions  			sumPieceSquareValueByLogicalColour' :: Component.Accountant.Accountant accountant => accountant -> [Type.Mass.Base]-			sumPieceSquareValueByLogicalColour'	= flip (Component.Accountant.sumPieceSquareValueByLogicalColour $ Data.Maybe.fromJust maybePieceSquareByCoordinatesByRank) $ State.Board.getNPieces board+			sumPieceSquareValueByLogicalColour'	= flip (Component.Accountant.sumPieceSquareValueByLogicalColour $ Data.Maybe.fromJust maybePieceSquareValueByCoordinatesByRank) $ State.Board.getNPieces board 	in Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 64 } f, #endif 	let 		f :: Input.EvaluationOptions.EvaluationOptions -> State.Board.Board -> Test.QuickCheck.Property-		f evaluationOptions board	= Data.Maybe.isJust maybePieceSquareByCoordinatesByRank ==> Test.QuickCheck.label "EvaluationOptions.prop_sumPieceSquareValueByLogicalColour/reflectOnX" . uncurry (==) $ (-			Data.Array.IArray.elems . sumPieceSquareValueByLogicalColour &&& reverse . Data.Array.IArray.elems . sumPieceSquareValueByLogicalColour . Property.Reflectable.reflectOnX+		f evaluationOptions board	= Data.Maybe.isJust maybePieceSquareValueByCoordinatesByRank ==> Test.QuickCheck.label "EvaluationOptions.prop_sumPieceSquareValueByLogicalColour/reflectOnX" . uncurry (==) $ (+			sumPieceSquareValueByLogicalColour &&& reverse . sumPieceSquareValueByLogicalColour . Property.Reflectable.reflectOnX 		 ) board where-			maybePieceSquareByCoordinatesByRank	= Input.EvaluationOptions.getMaybePieceSquareByCoordinatesByRank evaluationOptions-			sumPieceSquareValueByLogicalColour	= State.Board.sumPieceSquareValueByLogicalColour $ Data.Maybe.fromJust maybePieceSquareByCoordinatesByRank+			maybePieceSquareValueByCoordinatesByRank	= Input.EvaluationOptions.getMaybePieceSquareValueByCoordinatesByRank evaluationOptions+			sumPieceSquareValueByLogicalColour		= State.Board.sumPieceSquareValueByLogicalColour $ Data.Maybe.fromJust maybePieceSquareValueByCoordinatesByRank 	in Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 32 } f  ] 

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {- 	Copyright (C) 2018 Dr. Alistair Ward@@ -23,15 +24,47 @@  [@DESCRIPTION@]	Implements 'Test.QuickCheck.Arbitrary'. -} -module BishBosh.Test.QuickCheck.Input.RankValues() where+module BishBosh.Test.QuickCheck.Input.RankValues(+-- * Constants+	results+) where -import			BishBosh.Test.QuickCheck.Metric.RankValue() import qualified	BishBosh.Attribute.Rank			as Attribute.Rank import qualified	BishBosh.Input.RankValues		as Input.RankValues import qualified	BishBosh.Property.FixedMembership	as Property.FixedMembership import qualified	Data.List import qualified	Test.QuickCheck+import qualified	ToolShed.Test.ReversibleIO +#ifdef USE_NEWTYPE_WRAPPERS+import			BishBosh.Test.QuickCheck.Metric.RankValue()+#endif+ instance Test.QuickCheck.Arbitrary Input.RankValues.RankValues where-	arbitrary	= Input.RankValues.fromAssocs . zip Property.FixedMembership.members . Data.List.sort {-ensures Q is most valuable (except K)-} <$> Test.QuickCheck.vector (fromIntegral Attribute.Rank.nDistinctRanks)+	arbitrary	= Input.RankValues.fromAssocs . zip Property.FixedMembership.members . Data.List.sort {-ensures Q is most valuable (except K)-} +#ifndef USE_NEWTYPE_WRAPPERS+		. map (recip . fromInteger . succ . abs)	-- Map into the closed unit interval.+#endif+		<$> Test.QuickCheck.suchThat (+			Test.QuickCheck.vector $ fromIntegral Attribute.Rank.nDistinctRanks+		) (any (/= 0))++-- | The constant test-results for this data-type.+results :: IO [Test.QuickCheck.Result]+results	= sequence [+	let+		f :: Input.RankValues.RankValues -> Test.QuickCheck.Property+		f	= Test.QuickCheck.label "RankValues.prop_readPrependedWhiteSpace" . ToolShed.Test.ReversibleIO.readPrependedWhiteSpace+	in Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 32 } f,+	let+		f :: String -> Test.QuickCheck.Property+		f garbage	= Test.QuickCheck.label "RankValues.prop_read" $ case (reads garbage :: [(Input.RankValues.RankValues, String)]) of+			[_]	-> True+			_	-> True	-- Unless the read-implementation throws an exception.+	in Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 256 } f,+	let+		f :: Input.RankValues.RankValues -> String -> Test.QuickCheck.Property+		f rankValue	= Test.QuickCheck.label "RankValues.prop_readTrailingGarbage" . ToolShed.Test.ReversibleIO.readTrailingGarbage (const True) rankValue+	in Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 256 } f+ ] 

@@ -25,9 +25,15 @@  module BishBosh.Test.QuickCheck.Input.StandardOpeningOptions() where +import			BishBosh.Test.QuickCheck.Type.Count() import qualified	BishBosh.Input.StandardOpeningOptions	as Input.StandardOpeningOptions import qualified	Test.QuickCheck  instance Test.QuickCheck.Arbitrary Input.StandardOpeningOptions.StandardOpeningOptions where-	arbitrary	= Input.StandardOpeningOptions.mkStandardOpeningOptions <$> Test.QuickCheck.arbitrary <*> Test.QuickCheck.arbitrary <*> Test.QuickCheck.arbitrary <*> Test.QuickCheck.arbitrary+	arbitrary	= Input.StandardOpeningOptions.mkStandardOpeningOptions+		<$> Test.QuickCheck.arbitrary+		<*> Test.QuickCheck.arbitrary+		<*> Test.QuickCheck.arbitrary+		<*> Test.QuickCheck.arbitrary+		<*> Test.QuickCheck.arbitrary 

@@ -293,11 +293,11 @@ 	let 		f :: Input.EvaluationOptions.EvaluationOptions -> Model.Game.Game -> Test.QuickCheck.Property 		f evaluationOptions game	= Data.Maybe.isJust (-			Input.EvaluationOptions.getMaybePieceSquareByCoordinatesByRank evaluationOptions+			Input.EvaluationOptions.getMaybePieceSquareValueByCoordinatesByRank evaluationOptions 		 ) && not ( 			Property.Null.isNull game 		 ) ==> Test.QuickCheck.label "Game.prop_measurePieceSquareValueIncrementally" .-#ifdef USE_PRECISION+#ifdef USE_PRECISE_NUMBERS 		 uncurry (==) #else 		 (@@ -310,10 +310,10 @@ 		 ) . abs . uncurry (-)	-- Tolerance for floating-point errors. #endif 		 $ (-			measurePieceSquareValueDifference' &&& Evaluation.Fitness.measurePieceSquareValueDifferenceIncrementally (measurePieceSquareValueDifference' oldGame) pieceSquareByCoordinatesByRank+			measurePieceSquareValueDifference' &&& Evaluation.Fitness.measurePieceSquareValueDifferenceIncrementally (measurePieceSquareValueDifference' oldGame) pieceSquareValueByCoordinatesByRank 		 ) game where-			pieceSquareByCoordinatesByRank		= Data.Maybe.fromJust $ Input.EvaluationOptions.getMaybePieceSquareByCoordinatesByRank evaluationOptions-			measurePieceSquareValueDifference'	= Evaluation.Fitness.measurePieceSquareValueDifference pieceSquareByCoordinatesByRank+			pieceSquareValueByCoordinatesByRank	= Data.Maybe.fromJust $ Input.EvaluationOptions.getMaybePieceSquareValueByCoordinatesByRank evaluationOptions+			measurePieceSquareValueDifference'	= Evaluation.Fitness.measurePieceSquareValueDifference pieceSquareValueByCoordinatesByRank 			(oldGame, _) : _			= Model.Game.rollBack game 	in Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 2048 } f, 	let

@@ -157,7 +157,9 @@ 				isClear	= State.MaybePieceByCoordinates.isClear maybePieceByCoordinates source 			in all ( 				\direction -> Data.Maybe.maybe (-					Data.Maybe.maybe True isClear . Data.Maybe.listToMaybe . reverse $ Cartesian.Coordinates.extrapolate source direction+					Data.Maybe.maybe True (+						isClear . fst {-Coordinates-}+					) .  Data.Maybe.listToMaybe . reverse $ Cartesian.Coordinates.extrapolate source direction 				) ( 					isClear . fst {-destination-} 				) $ State.MaybePieceByCoordinates.findBlockingPiece maybePieceByCoordinates source direction

@@ -23,7 +23,7 @@ -}  module BishBosh.Test.QuickCheck.StateProperty.Hashable(--- * Constants,+-- * Constants 	results ) where 

@@ -33,12 +33,10 @@ import			BishBosh.Test.QuickCheck.Model.Game() import			Control.Arrow((&&&)) import			Test.QuickCheck ((==>))-import qualified	BishBosh.Attribute.MoveType			as Attribute.MoveType import qualified	BishBosh.Cartesian.Coordinates			as Cartesian.Coordinates import qualified	BishBosh.Component.Move				as Component.Move import qualified	BishBosh.Component.QualifiedMove		as Component.QualifiedMove import qualified	BishBosh.Component.Piece			as Component.Piece-import qualified	BishBosh.Component.Turn				as Component.Turn import qualified	BishBosh.Model.Game				as Model.Game import qualified	BishBosh.Property.Null				as Property.Null import qualified	BishBosh.State.Board				as State.Board@@ -74,13 +72,9 @@ 				board			= Model.Game.getBoard game  				movePiece :: StateProperty.Mutator.Mutator mutator => mutator -> mutator-				movePiece	= StateProperty.Mutator.movePiece move (-					Data.Maybe.fromJust . State.MaybePieceByCoordinates.dereference (State.Board.getMaybePieceByCoordinates board) $ Component.Move.getSource move-				 ) (-					Attribute.MoveType.getMaybePromotedRank moveType-				 ) $ if Attribute.MoveType.isEnPassant moveType-					then Left . Component.Move.getDestination . Component.QualifiedMove.getMove . Component.Turn.getQualifiedMove . Data.Maybe.fromJust $ Model.Game.maybeLastTurn game-					else Right $ Attribute.MoveType.getMaybeExplicitlyTakenRank moveType+				movePiece	= StateProperty.Mutator.movePiece move moveType (+					Data.Maybe.fromJust . State.MaybePieceByCoordinates.dereference (State.Board.getMaybePieceByCoordinates board) . Component.Move.getSource $ Component.QualifiedMove.getMove qualifiedMove+				 ) 			in uncurry (==) $ ( 				normalise . StateProperty.View.translate . movePiece . State.Board.getMaybePieceByCoordinates &&& normalise . movePiece . State.Board.getCoordinatesByRankByLogicalColour 			) board

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -46,7 +47,7 @@ import qualified	BishBosh.Test.QuickCheck.Input.EvaluationOptions				as Test.QuickCheck.Input.EvaluationOptions import qualified	BishBosh.Test.QuickCheck.Input.Options						as Test.QuickCheck.Input.Options import qualified	BishBosh.Test.QuickCheck.Input.PieceSquareTable					as Test.QuickCheck.Input.PieceSquareTable-import qualified	BishBosh.Test.QuickCheck.Metric.RankValue					as Test.QuickCheck.Metric.RankValue+import qualified	BishBosh.Test.QuickCheck.Input.RankValues					as Test.QuickCheck.Input.RankValues import qualified	BishBosh.Test.QuickCheck.Model.Game						as Test.QuickCheck.Model.Game import qualified	BishBosh.Test.QuickCheck.Model.GameTree						as Test.QuickCheck.Model.GameTree import qualified	BishBosh.Test.QuickCheck.Model.MoveFrequency					as Test.QuickCheck.Model.MoveFrequency@@ -77,6 +78,10 @@ import qualified	System.Exit import qualified	ToolShed.Test.QuickCheck.Result +#ifdef USE_NEWTYPE_WRAPPERS+import qualified	BishBosh.Test.QuickCheck.Metric.RankValue					as Test.QuickCheck.Metric.RankValue+#endif+ -- | Entry-point to the test-suite. main :: IO () main	= mapM_ (@@ -89,9 +94,14 @@ 	Test.QuickCheck.Attribute.Rank.results, 	Test.QuickCheck.Attribute.MoveType.results, 	Test.QuickCheck.Direction.Direction.results,+#ifdef USE_NEWTYPE_WRAPPERS+	Test.QuickCheck.Metric.RankValue.results,+#endif+	Test.QuickCheck.Input.CriteriaWeights.results, 	Test.QuickCheck.Input.EvaluationOptions.results, 	Test.QuickCheck.Input.Options.results, 	Test.QuickCheck.Input.PieceSquareTable.results,+	Test.QuickCheck.Input.RankValues.results, 	Test.QuickCheck.Cartesian.Coordinates.results, 	Test.QuickCheck.Cartesian.Vector.results, 	Test.QuickCheck.Component.Piece.results,@@ -123,8 +133,6 @@ 	Test.QuickCheck.ContextualNotation.PGNComment.results, 	Test.QuickCheck.ContextualNotation.PGN.results, 	Test.QuickCheck.ContextualNotation.QualifiedMoveForest.results,-	Test.QuickCheck.Input.CriteriaWeights.results,-	Test.QuickCheck.Metric.RankValue.results, 	Test.QuickCheck.Evaluation.PositionHashQuantifiedGameTree.results, 	Test.QuickCheck.Search.KillerMoves.results, 	Test.QuickCheck.UI.PrintObject.results,