packages feed

weekdaze-0.0.0.1: src-lib/WeekDaze/ExecutionConfiguration/ExecutionOptions.hs

{-# LANGUAGE CPP, FlexibleContexts #-}
{-
	Copyright (C) 2013-2015 Dr. Alistair Ward

	This file is part of WeekDaze.

	WeekDaze 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.

	WeekDaze 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 WeekDaze.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]	Defines the data which drives the solution-mechanism, as opposed to that which either defines the problem or describes the presentation of the solution.
-}

module WeekDaze.ExecutionConfiguration.ExecutionOptions(
-- * Types
-- ** Type-synonyms
--	Hint,
--	Mutator,
	RandomSeed,
	PermitTemporaryStudentBodyMerger,
	ReduceStudentBodyRegister,
	RemoveRedundantCourses,
-- ** Data-types
	ExecutionOptions(..),
-- * Constants
--	tag,
--	filePathTag,
	inputStudentViewTimetableTag,
	permitTemporaryStudentBodyMergerTag,
	randomSeedTag,
	reduceStudentBodyRegisterTag,
	removeRedundantCoursesTag,
	removePointlessGroupsTag,
	removeUnsubscribedGroupsTag,
	zeroInappropriateOptionsTag,
-- * Functions
-- ** Mutators
	setPermitTemporaryStudentBodyMerger,
	setSynchronisedCourseMutationFecundity,
	setSynchronisedCourseByDayMutationFecundity,
	setExcessRunlengthMutationFecundity,
	setFecundityDecayRatio,
	setHomogeneousStudentViewLessonMutationFecundity,
	setIncompleteCourseMutationFecundity,
	setMinimumPopulationDiversityRatio,
	setMaybeNInitialScouts,
	setSingletonStudentClassMutationFecundity,
	setSplitSessionMutationFecundity,
	setStudentBodyCombinationMutationFecundity,
	setStudentViewTimetableForDayMutationFecundity,
	setStudentViewTimetableForWeekMutationFecundity,
	setSynchronousLessonMutationFecundity,
-- ** Predicates
	hintWasSpecified
) where

import qualified	Control.DeepSeq
import qualified	Data.Default
import qualified	Data.Maybe
import qualified	System.FilePath
import qualified	Text.XML.HXT.Arrow.Pickle					as HXT
import qualified	ToolShed.SelfValidate
import qualified	WeekDaze.Configuration						as Configuration
import qualified	WeekDaze.Enhanced.EnhancedEither				as Enhanced.EnhancedEither
import qualified	WeekDaze.ExecutionConfiguration.CriterionWeight			as ExecutionConfiguration.CriterionWeight
import qualified	WeekDaze.ExecutionConfiguration.EvolutionStrategies		as ExecutionConfiguration.EvolutionStrategies
import qualified	WeekDaze.ExecutionConfiguration.LessonCriteriaWeights		as ExecutionConfiguration.LessonCriteriaWeights
import qualified	WeekDaze.ExecutionConfiguration.OptimiseLessonCriteriaWeights	as ExecutionConfiguration.OptimiseLessonCriteriaWeights
import qualified	WeekDaze.ExecutionConfiguration.TimetableBreederFecundity	as ExecutionConfiguration.TimetableBreederFecundity
import qualified	WeekDaze.ExecutionConfiguration.TimetableCriteriaWeights	as ExecutionConfiguration.TimetableCriteriaWeights
import qualified	WeekDaze.Model.TimetableAxisTriple				as Model.TimetableAxisTriple
import qualified	WeekDaze.Size							as Size
import			WeekDaze.Enhanced.EnhancedBool()

#ifdef USE_HDBC
import qualified	Database.HDBC
import qualified	Data.Convertible
import qualified	Data.Typeable
import qualified	WeekDaze.Database.Selector					as Database.Selector
import qualified	WeekDaze.Model.TimetableAxis					as Model.TimetableAxis
import qualified	WeekDaze.Model.TimetableAxisTraversal				as Model.TimetableAxisTraversal

instance (
	Control.DeepSeq.NFData		criterionWeight,
	Control.DeepSeq.NFData		fecundityDecayRatio,
	Control.DeepSeq.NFData		populationDiversityRatio,
	Data.Convertible.Convertible	Database.HDBC.SqlValue criterionWeight,			-- Flexible context.
	Data.Convertible.Convertible	Database.HDBC.SqlValue fecundityDecayRatio,		-- Flexible context.
	Data.Convertible.Convertible	Database.HDBC.SqlValue populationDiversityRatio,	-- Flexible context.
	Data.Typeable.Typeable		criterionWeight,
	Data.Typeable.Typeable		fecundityDecayRatio,
	Data.Typeable.Typeable		populationDiversityRatio,
	RealFrac			criterionWeight,
	RealFrac			fecundityDecayRatio,
	RealFrac			populationDiversityRatio
 ) => Database.Selector.Selector (ExecutionOptions criterionWeight fecundityDecayRatio populationDiversityRatio) where
	fromDatabase connection	projectIdSql	= let
		executionOptionsTableName, traversalOrderTableName :: Database.Selector.TableName
		executionOptionsTableName	= showString Database.Selector.tablePrefix tag
		traversalOrderTableName		= showString Database.Selector.tablePrefix Model.TimetableAxisTriple.tag
	 in do
		(evolutionStrategies, optimiseLessonCriteriaWeights, lessonCriteriaWeights, timetableCriteriaWeights)
#ifdef QUERY_DB_CONCURRENTLY
			<- Database.Selector.fromDatabaseConcurrently connection projectIdSql
#else
			<- Database.Selector.fromDatabase connection projectIdSql
#endif
		traversalOrderRows	<- Database.Selector.select connection [
			Model.TimetableAxisTraversal.senseTag,
			Model.TimetableAxis.tag
		 ] [traversalOrderTableName] [(Database.Selector.projectIdColumnName, projectIdSql)]

		executionOptionsRows	<- Database.Selector.select connection [
			randomSeedTag,
			permitTemporaryStudentBodyMergerTag,
			reduceStudentBodyRegisterTag,
			removeRedundantCoursesTag,
			removePointlessGroupsTag,
			removeUnsubscribedGroupsTag,
			zeroInappropriateOptionsTag
		 ] [executionOptionsTableName] [(Database.Selector.projectIdColumnName, projectIdSql)]

		return {-to IO-Monad-} . (
			if null traversalOrderRows
				then id
				else case traversalOrderRows of
					[row1, row2, row3]	-> let
						mkAxisTraversal :: [Database.HDBC.SqlValue] -> Model.TimetableAxisTraversal.AxisTraversal
						mkAxisTraversal row	= case row of
							[senseSql, axisSql]	-> let
								axisTraversal	= Data.Maybe.fromMaybe "" (Database.HDBC.fromSql senseSql) ++ Database.HDBC.fromSql axisSql
							 in case reads axisTraversal of
								[(x, "")]	-> x
								_		-> error . showString "WeekDaze.ExecutionConfiguration.ExecutionOptions.fromDatabase.mkAxisTraversal:\tfailed to parse " $ shows axisTraversal "."
							_			-> error . showString "WeekDaze.ExecutionConfiguration.ExecutionOptions.fromDatabase.mkAxisTraversal:\tunexpected number of columns=" . shows (length row) . showString " in row of table " $ shows traversalOrderTableName "; two are expected."
					 in \executionOptions -> executionOptions {
						getMaybeHint	= Just . Left $ Model.TimetableAxisTriple.mkAxes (mkAxisTraversal row1, mkAxisTraversal row2, mkAxisTraversal row3) -- Triple.
					 }
					_			-> error . showString "WeekDaze.ExecutionConfiguration.ExecutionOptions.fromDatabase:\tunexpected number of rows=" . shows (length traversalOrderRows) . showString " selected from table " $ shows traversalOrderTableName "; three are expected."
		 ) . (
			case executionOptionsRows of
				[]			-> id
				[executionOptionsRow]	-> case executionOptionsRow of
					[
						randomSeedSql,
						permitTemporaryStudentBodyMergerSql,
						reduceStudentBodyRegisterSql,
						removeRedundantCoursesSql,
						removePointlessGroupsSql,
						removeUnsubscribedGroupsSql,
						zeroInappropriateOptionsSql
					 ] -> (
						\executionOptions -> executionOptions {
							getMaybeRandomSeed	= either (
								error . showString "WeekDaze.ExecutionConfiguration.ExecutionOptions.fromDatabase:\tfailed to parse the value for " . shows randomSeedTag . showString " read from the database; " . show
							) id $ Database.HDBC.safeFromSql randomSeedSql
						}
					 ) . (
						\executionOptions -> Data.Maybe.maybe executionOptions (
							\value -> executionOptions { getPermitTemporaryStudentBodyMerger = value }
						) . either (
							error . showString "WeekDaze.ExecutionConfiguration.ExecutionOptions.fromDatabase:\tfailed to parse the value for " . shows permitTemporaryStudentBodyMergerTag . showString " read from the database; " . show
						) id $ Database.HDBC.safeFromSql permitTemporaryStudentBodyMergerSql
					 ) . (
						\executionOptions -> Data.Maybe.maybe executionOptions (
							\value -> executionOptions { getReduceStudentBodyRegister = value }
						) . either (
							error . showString "WeekDaze.ExecutionConfiguration.ExecutionOptions.fromDatabase:\tfailed to parse the value for " . shows reduceStudentBodyRegisterTag . showString " read from the database; " . show
						) id $ Database.HDBC.safeFromSql reduceStudentBodyRegisterSql
					 ) . (
						\executionOptions -> Data.Maybe.maybe executionOptions (
							\value -> executionOptions { getRemoveRedundantCourses = value }
						) . either (
							error . showString "WeekDaze.ExecutionConfiguration.ExecutionOptions.fromDatabase:\tfailed to parse the value for " . shows removeRedundantCoursesTag . showString " read from the database; " . show
						) id $ Database.HDBC.safeFromSql removeRedundantCoursesSql
					 ) . (
						\executionOptions -> Data.Maybe.maybe executionOptions (
							\value -> executionOptions { getRemovePointlessGroups = value }
						) . either (
							error . showString "WeekDaze.ExecutionConfiguration.ExecutionOptions.fromDatabase:\tfailed to parse the value for " . shows removePointlessGroupsTag . showString " read from the database; " . show
						) id $ Database.HDBC.safeFromSql removePointlessGroupsSql
					 ) . (
						\executionOptions -> Data.Maybe.maybe executionOptions (
							\value -> executionOptions { getRemoveUnsubscribedGroups = value }
						) . either (
							error . showString "WeekDaze.ExecutionConfiguration.ExecutionOptions.fromDatabase:\tfailed to parse the value for " . shows removeUnsubscribedGroupsTag . showString " read from the database; " . show
						) id $ Database.HDBC.safeFromSql removeUnsubscribedGroupsSql
					 ) . (
						\executionOptions -> Data.Maybe.maybe executionOptions (
							\value -> executionOptions { getZeroInappropriateOptions = value }
						) . either (
							error . showString "WeekDaze.ExecutionConfiguration.ExecutionOptions.fromDatabase:\tfailed to parse the value for " . shows zeroInappropriateOptionsTag . showString " read from the database; " . show
						) id $ Database.HDBC.safeFromSql zeroInappropriateOptionsSql
					 )
					_ -> error . showString "WeekDaze.ExecutionConfiguration.ExecutionOptions.fromDatabase:\tunexpected number of columns=" . shows (length executionOptionsRow) . showString " in row of table " $ shows executionOptionsTableName "."
				_			-> error . showString "WeekDaze.ExecutionConfiguration.ExecutionOptions.fromDatabase:\tunexpected number of rows=" . shows (length executionOptionsRows) . showString " selected from table " $ shows executionOptionsTableName "."
		 ) $ (
			Data.Default.def	:: ExecutionOptions Rational Rational Rational	-- Arbitrarily.
		 ) {
			getEvolutionStrategies			= evolutionStrategies,
			getOptimiseLessonCriteriaWeights	= optimiseLessonCriteriaWeights,
			getLessonCriteriaWeights		= lessonCriteriaWeights,
			getTimetableCriteriaWeights		= timetableCriteriaWeights
		}
#endif /* USE_HDBC */

-- | Used to qualify XML.
tag :: String
tag					= "executionOptions"

-- | Used to qualify XML.
filePathTag :: String
filePathTag				= "filePath"

-- | Used to qualify XML.
inputStudentViewTimetableTag :: String
inputStudentViewTimetableTag		= "inputStudentViewTimetable"

-- | Used to qualify SQL & XML.
permitTemporaryStudentBodyMergerTag :: String
permitTemporaryStudentBodyMergerTag	= "permitTemporaryStudentBodyMerger"

-- | Used to qualify SQL & XML.
randomSeedTag :: String
randomSeedTag				= "randomSeed"

-- | Used to qualify SQL & XML.
reduceStudentBodyRegisterTag :: String
reduceStudentBodyRegisterTag		= "reduceStudentBodyRegister"

-- | Used to qualify SQL & XML.
removeRedundantCoursesTag :: String
removeRedundantCoursesTag		= "removeRedundantCourses"

-- | Used to qualify SQL & XML.
removePointlessGroupsTag :: String
removePointlessGroupsTag		= "removePointlessGroups"

-- | Used to qualify SQL & XML.
removeUnsubscribedGroupsTag :: String
removeUnsubscribedGroupsTag		= "removeUnsubscribedGroups"

-- | Used to qualify SQL & XML.
zeroInappropriateOptionsTag :: String
zeroInappropriateOptionsTag		= "zeroInappropriateOptions"

-- | One can either define the raster-scan by which the initial solution is constructed, or specify an XML-file containing the initial solution.
type Hint				= Either Model.TimetableAxisTriple.Axes System.FilePath.FilePath

-- | A seed from which to construct a pseudo-random number-generator.
type RandomSeed				= Int

-- | Whether to permit /student-bodies/ to be temporarily merged for a /lesson/.
type PermitTemporaryStudentBodyMerger	= Bool

-- | Whether to automatically merge /student-bodies/ with identical profiles.
type ReduceStudentBodyRegister		= Bool

-- | Whether to remove /course/s for which there's zero demand.
type RemoveRedundantCourses		= Bool

-- | Encapsulates the data which drives the implementation.
data ExecutionOptions criterionWeight fecundityDecayRatio populationDiversityRatio	= MkExecutionOptions {
	getEvolutionStrategies			:: ExecutionConfiguration.EvolutionStrategies.EvolutionStrategies fecundityDecayRatio populationDiversityRatio,	-- ^ The extent to which various strategies are applied, in an attempt to evolve the /timetable/.
	getMaybeHint				:: Maybe Hint,													-- ^ Optionally define either the order in which a /timetable/'s axes are traversed during construction of the initial deterministic solution or a path to a file from which the initial /StudentView.Timetable.Timetable/ can be read; the default is to perform all traverses, & select the best.
	getMaybeRandomSeed			:: Maybe RandomSeed,												-- ^ Optionally seed the pseudo-random number-generator to produce a repeatable sequence.
	getOptimiseLessonCriteriaWeights	:: ExecutionConfiguration.OptimiseLessonCriteriaWeights.OptimiseLessonCriteriaWeights criterionWeight,		-- ^ Whether & how to optimise the weights of lesson-criteria by maximising the weighted mean of timetable-criteria for the initial deterministic timetable.
	getLessonCriteriaWeights		:: ExecutionConfiguration.LessonCriteriaWeights.LessonCriteriaWeights criterionWeight,				-- ^ The weight associated with criteria used to select a /lesson/, at a specific time-coordinate in the /timetable/.
	getPermitTemporaryStudentBodyMerger	:: PermitTemporaryStudentBodyMerger,										-- ^ Whether to permit a temporary merger between /student-bodies/, to permit a /teacher/ & /location/ to be shared for the duration of a /course/.
	getReduceStudentBodyRegister		:: ReduceStudentBodyRegister,											-- ^ Whether to permanently merge /student-bodies/ with identical profiles, thus reducing the number of independently schedulable entities.
	getRemoveRedundantCourses		:: RemoveRedundantCourses,											-- ^ Whether to remove any /courses/ offered, which aren't required by any /student/.
	getRemovePointlessGroups		:: Bool,													-- ^ Whether to remove /groups/ from the /group-catalogue/, for which zero /meetings/ have been timetable.
	getRemoveUnsubscribedGroups		:: Bool,													-- ^ Whether to remove /groups/ from the /group-catalogue/, to which neither /student-bodies/ nor /teachers/ have subscribed.
	getTimetableCriteriaWeights		:: ExecutionConfiguration.TimetableCriteriaWeights.TimetableCriteriaWeights criterionWeight,			-- ^ The weight associated with criteria used to evaluate a /timetable/, during optimisation.
	getZeroInappropriateOptions		:: Bool														-- ^ Whether to zero the weight of each /lesson-criterion/ & /timetable-criterion/, & the /fecundity/ of each /evolution-strategy/, which is either inappropriate for, or irrelevant to, the specified /problem-parameters/.
} deriving (Eq, Show)

instance (
	Fractional	criterionWeight,
	Fractional	fecundityDecayRatio,
	Fractional	populationDiversityRatio
 ) => Data.Default.Default (ExecutionOptions criterionWeight fecundityDecayRatio populationDiversityRatio) where
	def = MkExecutionOptions {
		getEvolutionStrategies			= Data.Default.def,
		getMaybeHint				= Nothing,
		getMaybeRandomSeed			= Nothing,
		getOptimiseLessonCriteriaWeights	= Data.Default.def,
		getLessonCriteriaWeights		= Data.Default.def,
		getPermitTemporaryStudentBodyMerger	= True,
		getReduceStudentBodyRegister		= True,
		getRemoveRedundantCourses		= True,
		getRemovePointlessGroups		= True,
		getRemoveUnsubscribedGroups		= True,
		getTimetableCriteriaWeights		= Data.Default.def,
		getZeroInappropriateOptions		= True
	}

instance (
	Num	fecundityDecayRatio,
	Num	populationDiversityRatio,
	Ord	fecundityDecayRatio,
	Ord	populationDiversityRatio,
	Real	criterionWeight,
	Show	criterionWeight,
	Show	fecundityDecayRatio,
	Show	populationDiversityRatio
 ) => ToolShed.SelfValidate.SelfValidator (ExecutionOptions criterionWeight fecundityDecayRatio populationDiversityRatio) where
	getErrors MkExecutionOptions {
		getEvolutionStrategies			= evolutionStrategies,
		getMaybeHint				= maybeHint,
		getOptimiseLessonCriteriaWeights	= optimiseLessonCriteriaWeights,
		getLessonCriteriaWeights		= lessonCriteriaWeights,
		getPermitTemporaryStudentBodyMerger	= permitTemporaryStudentBodyMerger,
		getTimetableCriteriaWeights		= timetableCriteriaWeights
	}
		| not $ ToolShed.SelfValidate.isValid evolutionStrategies		= ToolShed.SelfValidate.getErrors evolutionStrategies
		| not $ ToolShed.SelfValidate.isValid optimiseLessonCriteriaWeights	= ToolShed.SelfValidate.getErrors optimiseLessonCriteriaWeights
		| not $ ToolShed.SelfValidate.isValid lessonCriteriaWeights		= ToolShed.SelfValidate.getErrors lessonCriteriaWeights
		| not $ ToolShed.SelfValidate.isValid timetableCriteriaWeights		= ToolShed.SelfValidate.getErrors timetableCriteriaWeights
		| otherwise	= ToolShed.SelfValidate.extractErrors [
			(
				Data.Maybe.maybe False (const False `either` (not . System.FilePath.isValid)) maybeHint,
				"invalid file-path; " ++ show maybeHint
			), (
				permitTemporaryStudentBodyMerger && any (/= minBound) [
					ExecutionConfiguration.LessonCriteriaWeights.getWeightOfMaximiseStudentClassSizeOverLocationCapacity lessonCriteriaWeights,
					ExecutionConfiguration.LessonCriteriaWeights.getWeightOfMaximiseStudentClassSizeOverCourseClassSize lessonCriteriaWeights
				],
				"when " ++ permitTemporaryStudentBodyMergerTag ++ "=" ++ show permitTemporaryStudentBodyMerger ++ ", " ++ ExecutionConfiguration.LessonCriteriaWeights.tag ++ "={" ++ show ExecutionConfiguration.LessonCriteriaWeights.weightOfMaximiseStudentClassSizeOverLocationCapacityTag ++ ", " ++ show ExecutionConfiguration.LessonCriteriaWeights.weightOfMaximiseStudentClassSizeOverCourseClassSizeTag ++ "} should be zero"
			), (
				not permitTemporaryStudentBodyMerger && any (/= minBound) [
					ExecutionConfiguration.LessonCriteriaWeights.getWeightOfMinimiseStudentBodyCombinations lessonCriteriaWeights,
					ExecutionConfiguration.LessonCriteriaWeights.getWeightOfAreResourcesReused lessonCriteriaWeights,
					ExecutionConfiguration.TimetableCriteriaWeights.getWeightOfMinimiseMeanStudentBodyCombinationsPerLesson timetableCriteriaWeights
				],
				"when " ++ permitTemporaryStudentBodyMergerTag ++ "=" ++ show permitTemporaryStudentBodyMerger ++ ", " ++ ExecutionConfiguration.LessonCriteriaWeights.tag ++ "={" ++ show ExecutionConfiguration.LessonCriteriaWeights.weightOfMinimiseStudentBodyCombinationsTag ++ ", " ++ show ExecutionConfiguration.LessonCriteriaWeights.weightOfAreResourcesReusedTag ++ "} & " ++ ExecutionConfiguration.TimetableCriteriaWeights.tag ++ "={" ++ show ExecutionConfiguration.TimetableCriteriaWeights.weightOfMinimiseMeanStudentBodyCombinationsPerLessonTag ++ "} should be zero"
			)
		]

instance (
	Fractional	criterionWeight,
	Fractional	fecundityDecayRatio,
	Fractional	populationDiversityRatio,
	HXT.XmlPickler	criterionWeight,
	HXT.XmlPickler	fecundityDecayRatio,
	HXT.XmlPickler	populationDiversityRatio,
	Ord		fecundityDecayRatio,
	Ord		populationDiversityRatio,
	Real		criterionWeight,
	Show		criterionWeight,
	Show		fecundityDecayRatio,
	Show		populationDiversityRatio
 ) => HXT.XmlPickler (ExecutionOptions criterionWeight fecundityDecayRatio populationDiversityRatio) where
	xpickle	= HXT.xpElem tag . HXT.xpWrap (
		\(a, b, c, d, e, f, g, h, i, j, k, l)	-> MkExecutionOptions a b c d e f g h i j k l,	-- Construct from a tuple.
		\MkExecutionOptions {
			getEvolutionStrategies			= evolutionStrategies,
			getMaybeHint				= maybeHint,
			getMaybeRandomSeed			= maybeRandomSeed,
			getOptimiseLessonCriteriaWeights	= optimiseLessonCriteriaWeights,
			getLessonCriteriaWeights		= lessonCriteriaWeights,
			getPermitTemporaryStudentBodyMerger	= permitTemporaryStudentBodyMerger,
			getReduceStudentBodyRegister		= reduceStudentBodyRegister,
			getRemoveRedundantCourses		= removeRedundantCourses,
			getRemovePointlessGroups		= removePointlessGroups,
			getRemoveUnsubscribedGroups		= removeUnsubscribedGroups,
			getTimetableCriteriaWeights		= timetableCriteriaWeights,
			getZeroInappropriateOptions		= zeroInappropriateOptions
		} -> (
			evolutionStrategies,
			maybeHint,
			maybeRandomSeed,
			optimiseLessonCriteriaWeights,
			lessonCriteriaWeights,
			permitTemporaryStudentBodyMerger,
			reduceStudentBodyRegister,
			removeRedundantCourses,
			removePointlessGroups,
			removeUnsubscribedGroups,
			timetableCriteriaWeights,
			zeroInappropriateOptions
		) -- Deconstruct to a tuple.
	 ) $ HXT.xp12Tuple HXT.xpickle {-evolutionStrategies-} (
		HXT.xpOption . Enhanced.EnhancedEither.xpickle HXT.xpickle {-traversalOrder-} . HXT.xpElem inputStudentViewTimetableTag $ HXT.xpTextAttr filePathTag
	 ) (
		HXT.xpAttrImplied randomSeedTag HXT.xpInt
	 ) HXT.xpickle {-optimiseLessonCriteriaWeights-} HXT.xpickle {-lessonCriteriaWeights-} (
		getPermitTemporaryStudentBodyMerger defaultExecutionOptions `HXT.xpDefault` HXT.xpAttr permitTemporaryStudentBodyMergerTag HXT.xpickle {-Bool-}
	 ) (
		getReduceStudentBodyRegister defaultExecutionOptions `HXT.xpDefault` HXT.xpAttr reduceStudentBodyRegisterTag HXT.xpickle {-Bool-}
	 ) (
		getRemoveRedundantCourses defaultExecutionOptions `HXT.xpDefault` HXT.xpAttr removeRedundantCoursesTag HXT.xpickle {-Bool-}
	 ) (
		getRemovePointlessGroups defaultExecutionOptions `HXT.xpDefault` HXT.xpAttr removePointlessGroupsTag HXT.xpickle {-Bool-}
	 ) (
		getRemoveUnsubscribedGroups defaultExecutionOptions `HXT.xpDefault` HXT.xpAttr removeUnsubscribedGroupsTag HXT.xpickle {-Bool-}
	 ) HXT.xpickle {-timetableCriteriaWeights-} (
		getZeroInappropriateOptions defaultExecutionOptions `HXT.xpDefault` HXT.xpAttr zeroInappropriateOptionsTag HXT.xpickle {-Bool-}
	 ) where
		defaultExecutionOptions :: ExecutionOptions Rational Rational Rational	-- The type-parameters are irrelevant & are therefore largely arbitrarily.
		defaultExecutionOptions	= Data.Default.def

instance (
	Control.DeepSeq.NFData	criterionWeight,
	Control.DeepSeq.NFData	fecundityDecayRatio,
	Control.DeepSeq.NFData	populationDiversityRatio
 ) => Control.DeepSeq.NFData (ExecutionOptions criterionWeight fecundityDecayRatio populationDiversityRatio) where
	rnf MkExecutionOptions {
		getEvolutionStrategies			= evolutionStrategies,
		getMaybeHint				= maybeHint,
		getMaybeRandomSeed			= maybeRandomSeed,
		getOptimiseLessonCriteriaWeights	= optimiseLessonCriteriaWeights,
		getLessonCriteriaWeights		= lessonCriteriaWeights,
		getPermitTemporaryStudentBodyMerger	= permitTemporaryStudentBodyMerger,
		getReduceStudentBodyRegister		= reduceStudentBodyRegister,
		getRemoveRedundantCourses		= removeRedundantCourses,
		getRemovePointlessGroups		= removePointlessGroups,
		getRemoveUnsubscribedGroups		= removeUnsubscribedGroups,
		getTimetableCriteriaWeights		= timetableCriteriaWeights,
		getZeroInappropriateOptions		= zeroInappropriateOptions
	} = Control.DeepSeq.rnf (
		evolutionStrategies,
		maybeHint,
		maybeRandomSeed,
		optimiseLessonCriteriaWeights,
		lessonCriteriaWeights,
		[
			permitTemporaryStudentBodyMerger,
			reduceStudentBodyRegister,
			removeRedundantCourses,
			removePointlessGroups,
			removeUnsubscribedGroups
		],
		timetableCriteriaWeights,
		zeroInappropriateOptions
	 )

-- | The type of a function used to transform 'ExecutionOptions'.
type Mutator criterionWeight fecundityDecayRatio populationDiversityRatio	= ExecutionOptions criterionWeight fecundityDecayRatio populationDiversityRatio -> ExecutionOptions criterionWeight fecundityDecayRatio populationDiversityRatio

{- |
	* Mutator.

	* If /student-bodies/ can be temporarily merged, allowing the size of /student-class/es to grow,
	then there's no obvious advantage to fitting this transient class-size to either the capacity of the /location/ or to any maximum class-size defined for the /course/;
	so 'ExecutionConfiguration.LessonCriteriaWeights.getWeightOfMaximiseStudentClassSizeOverLocationCapacity' & 'ExecutionConfiguration.LessonCriteriaWeights.getWeightOfMaximiseStudentClassSizeOverCourseClassSize' aren't relevant,
	equally if student-bodies can't be merged, then synchronous identical /lesson/s are permissible, so there's no point trying to promote them via 'ExecutionConfiguration.LessonCriteriaWeights.getWeightOfAreResourcesReused'.

	* Alternatively, if /student-bodies/ can't be temporarily merged into a variety of /student-classes/,
	then there's no concept of either 'ExecutionConfiguration.LessonCriteriaWeights.getWeightOfMinimiseStudentBodyCombinations' or 'ExecutionConfiguration.TimetableCriteriaWeights.getWeightOfMinimiseMeanStudentBodyCombinationsPerLesson'.
-}
setPermitTemporaryStudentBodyMerger :: Num criterionWeight => PermitTemporaryStudentBodyMerger -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setPermitTemporaryStudentBodyMerger permitTemporaryStudentBodyMerger executionOptions@MkExecutionOptions {
	getLessonCriteriaWeights	= lessonCriteriaWeights,
	getTimetableCriteriaWeights	= timetableCriteriaWeights
}
	| permitTemporaryStudentBodyMerger = executionOptions' {
		getLessonCriteriaWeights	= lessonCriteriaWeights {
			ExecutionConfiguration.LessonCriteriaWeights.getWeightOfMaximiseStudentClassSizeOverLocationCapacity	= minBound,	-- The student-class needs space for growth.
			ExecutionConfiguration.LessonCriteriaWeights.getWeightOfMaximiseStudentClassSizeOverCourseClassSize	= minBound	-- The student-class needs space for growth.
		} -- Turn off.
	}
	| otherwise = executionOptions' {
		getLessonCriteriaWeights	= lessonCriteriaWeights {
			ExecutionConfiguration.LessonCriteriaWeights.getWeightOfMinimiseStudentBodyCombinations	= minBound,	-- Each student-class, has a single constant member.
			ExecutionConfiguration.LessonCriteriaWeights.getWeightOfAreResourcesReused		= minBound	-- Resources can only be reused by merging student-classes.
		}, -- Turn off.
		getTimetableCriteriaWeights	= timetableCriteriaWeights {
			ExecutionConfiguration.TimetableCriteriaWeights.getWeightOfMinimiseMeanStudentBodyCombinationsPerLesson	= minBound,	-- The mean is constant (one) for all timetable.
			ExecutionConfiguration.TimetableCriteriaWeights.getWeightOfMaximiseMeanStudentClassSize			= minBound	-- The size of the student-class equals the size its single student-body.
		} -- Turn off.
	}
	where
		executionOptions'	= executionOptions { getPermitTemporaryStudentBodyMerger = permitTemporaryStudentBodyMerger }	-- Mutate the original request.

-- | Mutator.
setSynchronisedCourseMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setSynchronisedCourseMutationFecundity timetableBreederFecundity executionOptions	= executionOptions {
	getEvolutionStrategies	= (getEvolutionStrategies executionOptions) {
		ExecutionConfiguration.EvolutionStrategies.getSynchronisedCourseMutationFecundity	= timetableBreederFecundity
	}
}

-- | Mutator.
setSynchronisedCourseByDayMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setSynchronisedCourseByDayMutationFecundity timetableBreederFecundity executionOptions	= executionOptions {
	getEvolutionStrategies	= (getEvolutionStrategies executionOptions) {
		ExecutionConfiguration.EvolutionStrategies.getSynchronisedCourseByDayMutationFecundity	= timetableBreederFecundity
	}
}

-- | Mutator.
setExcessRunlengthMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setExcessRunlengthMutationFecundity timetableBreederFecundity executionOptions	= executionOptions {
	getEvolutionStrategies	= (getEvolutionStrategies executionOptions) {
		ExecutionConfiguration.EvolutionStrategies.getExcessRunlengthMutationFecundity	= timetableBreederFecundity
	}
}

-- | Mutator.
setFecundityDecayRatio :: fecundityDecayRatio -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setFecundityDecayRatio fecundityDecayRatio executionOptions	= executionOptions {
	getEvolutionStrategies	= (getEvolutionStrategies executionOptions) {
		ExecutionConfiguration.EvolutionStrategies.getFecundityDecayRatio	= fecundityDecayRatio
	}
}

-- | Mutator.
setHomogeneousStudentViewLessonMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setHomogeneousStudentViewLessonMutationFecundity timetableBreederFecundity executionOptions	= executionOptions {
	getEvolutionStrategies	= (getEvolutionStrategies executionOptions) {
		ExecutionConfiguration.EvolutionStrategies.getHomogeneousStudentViewLessonMutationFecundity	= timetableBreederFecundity
	}
}

-- | Mutator.
setIncompleteCourseMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setIncompleteCourseMutationFecundity timetableBreederFecundity executionOptions	= executionOptions {
	getEvolutionStrategies	= (getEvolutionStrategies executionOptions) {
		ExecutionConfiguration.EvolutionStrategies.getIncompleteCourseMutationFecundity	= timetableBreederFecundity
	}
}

-- | Mutator.
setMinimumPopulationDiversityRatio :: populationDiversityRatio -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setMinimumPopulationDiversityRatio populationDiversityRatio executionOptions	= executionOptions {
	getEvolutionStrategies	= (getEvolutionStrategies executionOptions) {
		ExecutionConfiguration.EvolutionStrategies.getMinimumPopulationDiversityRatio	= populationDiversityRatio
	}
}

-- | Mutator.
setMaybeNInitialScouts :: Maybe Size.NTimetables -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setMaybeNInitialScouts maybeNInitialScouts executionOptions	= executionOptions {
	getEvolutionStrategies	= (getEvolutionStrategies executionOptions) {
		ExecutionConfiguration.EvolutionStrategies.getMaybeNInitialScouts	= maybeNInitialScouts
	}
}

-- | Mutator.
setSingletonStudentClassMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setSingletonStudentClassMutationFecundity timetableBreederFecundity executionOptions	= executionOptions {
	getEvolutionStrategies	= (getEvolutionStrategies executionOptions) {
		ExecutionConfiguration.EvolutionStrategies.getSingletonStudentClassMutationFecundity	= timetableBreederFecundity
	}
}

-- | Mutator.
setSplitSessionMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setSplitSessionMutationFecundity timetableBreederFecundity executionOptions	= executionOptions {
	getEvolutionStrategies	= (getEvolutionStrategies executionOptions) {
		ExecutionConfiguration.EvolutionStrategies.getSplitSessionMutationFecundity	= timetableBreederFecundity
	}
}

-- | Mutator.
setStudentBodyCombinationMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setStudentBodyCombinationMutationFecundity timetableBreederFecundity executionOptions	= executionOptions {
	getEvolutionStrategies	= (getEvolutionStrategies executionOptions) {
		ExecutionConfiguration.EvolutionStrategies.getStudentBodyCombinationMutationFecundity	= timetableBreederFecundity
	}
}

-- | Mutator.
setStudentViewTimetableForDayMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setStudentViewTimetableForDayMutationFecundity timetableBreederFecundity executionOptions	= executionOptions {
	getEvolutionStrategies	= (getEvolutionStrategies executionOptions) {
		ExecutionConfiguration.EvolutionStrategies.getStudentViewTimetableForDayMutationFecundity	= timetableBreederFecundity
	}
}

-- | Mutator.
setStudentViewTimetableForWeekMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setStudentViewTimetableForWeekMutationFecundity timetableBreederFecundity executionOptions	= executionOptions {
	getEvolutionStrategies	= (getEvolutionStrategies executionOptions) {
		ExecutionConfiguration.EvolutionStrategies.getStudentViewTimetableForWeekMutationFecundity	= timetableBreederFecundity
	}
}

-- | Mutator.
setSynchronousLessonMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setSynchronousLessonMutationFecundity timetableBreederFecundity executionOptions	= executionOptions {
	getEvolutionStrategies	= (getEvolutionStrategies executionOptions) {
		ExecutionConfiguration.EvolutionStrategies.getSynchronousLessonMutationFecundity	= timetableBreederFecundity
	}
}

-- | True if a (/traversalOrder/, /input file-path/) was specified.
hintWasSpecified :: ExecutionOptions criterionWeight fecundityDecayRatio populationDiversityRatio -> (Bool, Bool)
hintWasSpecified	= Data.Maybe.maybe (False, False) (const (True, False) `either` const (False, True)) . getMaybeHint

instance (
	Eq	criterionWeight,
	Num	criterionWeight
 ) => Configuration.Configuration (ExecutionOptions criterionWeight fecundityDecayRatio populationDiversityRatio) where
	issueWarnings executionOptions	= [
		msg | (True, msg) <- [
			(
				ExecutionConfiguration.CriterionWeight.areAllZero $ getTimetableCriteriaWeights executionOptions, {-lazy evaluation-}
				"the weights of all timetable-criteria are zero; the relative fitness of timetables cannot be measured"
			), (
				ExecutionConfiguration.EvolutionStrategies.areAllZero $ getEvolutionStrategies executionOptions,
				"the fecundities of all evolution-strategies are zero; evolution cannot occur"
			)
		 ]
	 ]