{-# LANGUAGE CPP, FlexibleContexts #-}
module WeekDaze.ExecutionConfiguration.EvolutionStrategies(
EvolutionStrategies(..),
synchronisedCourseMutationTag,
synchronisedCourseByDayMutationTag,
excessRunlengthMutationTag,
homogeneousStudentViewLessonMutationTag,
incompleteCourseMutationTag,
randomLessonMutationTag,
singletonStudentClassMutationTag,
splitSessionMutationTag,
studentBodyCombinationMutationTag,
studentViewTimetableForDayMutationTag,
studentViewTimetableForWeekMutationTag,
synchronousLessonMutationTag,
fecundityDecayRatioTag,
minimumPopulationDiversityRatioTag,
nInitialScoutsTag,
zeroSynchronisedCourseMutationFecundity,
zeroSynchronisedCourseByDayMutationFecundity,
zeroExcessRunlengthMutationFecundity,
zeroSingletonStudentClassMutationFecundity,
zeroSplitSessionMutationFecundity,
zeroStudentBodyCombinationMutationFecundity,
areAllZero
) where
import qualified Control.DeepSeq
import qualified Data.Default
import qualified Data.Maybe
import qualified Text.XML.HXT.Arrow.Pickle as HXT
import qualified ToolShed.SelfValidate
import qualified WeekDaze.ExecutionConfiguration.TimetableBreederFecundity as ExecutionConfiguration.TimetableBreederFecundity
import qualified WeekDaze.Size as Size
import qualified WeekDaze.Temporal.Day as Temporal.Day
#ifdef USE_HDBC
import Control.Arrow((&&&))
import qualified Database.HDBC
import qualified Data.Convertible
import qualified Data.Typeable
import qualified WeekDaze.Database.Selector as Database.Selector
instance (
Data.Convertible.Convertible Database.HDBC.SqlValue fecundityDecayRatio,
Data.Convertible.Convertible Database.HDBC.SqlValue populationDiversityRatio,
Data.Typeable.Typeable fecundityDecayRatio,
Data.Typeable.Typeable populationDiversityRatio,
RealFrac fecundityDecayRatio,
RealFrac populationDiversityRatio
) => Database.Selector.Selector (EvolutionStrategies fecundityDecayRatio populationDiversityRatio) where
fromDatabase connection projectIdSql = let
tableName :: Database.Selector.TableName
tableName = Database.Selector.tablePrefix ++ tag
in do
strategiesRows <- Database.Selector.select connection [
"synchronisedCourseMutationDeterministicCTor",
"synchronisedCourseMutationRandomCTor",
"synchronisedCourseByDayMutationDeterministicCTor",
"synchronisedCourseByDayMutationRandomCTor",
"excessRunlengthMutationDeterministicCTor",
"excessRunlengthMutationRandomCTor",
"homogeneousStudentViewLessonMutationDeterministicCTor",
"homogeneousStudentViewLessonMutationRandomCTor",
"incompleteCourseMutationDeterministicCTor",
"incompleteCourseMutationRandomCTor",
"randomLessonMutationDeterministicCTor",
"randomLessonMutationRandomCTor",
"singletonStudentClassMutationDeterministicCTor",
"singletonStudentClassMutationRandomCTor",
"splitSessionMutationDeterministicCTor",
"splitSessionMutationRandomCTor",
"studentBodyCombinationMutationDeterministicCTor",
"studentBodyCombinationMutationRandomCTor",
"studentViewTimetableForDayMutationDeterministicCTor",
"studentViewTimetableForDayMutationRandomCTor",
"studentViewTimetableForWeekMutationDeterministicCTor",
"studentViewTimetableForWeekMutationRandomCTor",
"synchronousLessonMutationDeterministicCTor",
"synchronousLessonMutationRandomCTor",
randomLessonMutationNTrialsTag,
randomLessonMutationNTimeslotsTag,
studentViewTimetableForDayMutationNDaysTag,
studentViewTimetableForWeekMutationNTrialsTag,
studentViewTimetableForWeekMutationNTimeslotsTag,
fecundityDecayRatioTag,
minimumPopulationDiversityRatioTag,
nInitialScoutsTag
] [tableName] [(Database.Selector.projectIdColumnName, projectIdSql)]
return $ case strategiesRows of
[] -> Data.Default.def
[strategiesRow] -> case strategiesRow of
[
synchronisedCourseMutationDeterministicConstructorFecunditySql,
synchronisedCourseMutationRandomConstructorFecunditySql,
synchronisedCourseByDayMutationDeterministicConstructorFecunditySql,
synchronisedCourseByDayMutationRandomConstructorFecunditySql,
excessRunlengthMutationDeterministicConstructorFecunditySql,
excessRunlengthMutationRandomConstructorFecunditySql,
homogeneousStudentViewLessonMutationDeterministicConstructorFecunditySql,
homogeneousStudentViewLessonMutationRandomConstructorFecunditySql,
incompleteCourseMutationDeterministicConstructorFecunditySql,
incompleteCourseMutationRandomConstructorFecunditySql,
randomLessonMutationDeterministicConstructorFecunditySql,
randomLessonMutationRandomConstructorFecunditySql,
singletonStudentClassMutationDeterministicConstructorFecunditySql,
singletonStudentClassMutationRandomConstructorFecunditySql,
splitSessionMutationDeterministicConstructorFecunditySql,
splitSessionMutationRandomConstructorFecunditySql,
studentBodyCombinationMutationDeterministicConstructorFecunditySql,
studentBodyCombinationMutationRandomConstructorFecunditySql,
studentViewTimetableForDayMutationDeterministicConstructorFecunditySql,
studentViewTimetableForDayMutationRandomConstructorFecunditySql,
studentViewTimetableForWeekMutationDeterministicConstructorFecunditySql,
studentViewTimetableForWeekMutationRandomConstructorFecunditySql,
synchronousLessonMutationDeterministicConstructorFecunditySql,
synchronousLessonMutationRandomConstructorFecunditySql,
randomLessonMutationNTrialsSql,
randomLessonMutationNTimeslotsSql,
studentViewTimetableForDayMutationNDaysSql,
studentViewTimetableForWeekMutationNTrialsSql,
studentViewTimetableForWeekMutationNTimeslotsSql,
fecundityDecayRatioSql,
minimumPopulationDiversityRatioSql,
nInitialScoutsSql
] -> let
mkTimetableBreederFecundity x y = ExecutionConfiguration.TimetableBreederFecundity.mkTimetableBreederFecundity (
Data.Maybe.fromMaybe defaultDeterministicFecundity . either (
error . showString "WeekDaze.ExecutionConfiguration.EvolutionStrategies.fromDatabase.mkTimetableBreederFecundity:\tfailed to parse the value for the 'deterministic fecundity' read from the database; " . show
) id $ Database.HDBC.safeFromSql x
) (
Data.Maybe.fromMaybe defaultRandomFecundity . either (
error . showString "WeekDaze.ExecutionConfiguration.EvolutionStrategies.fromDatabase.mkTimetableBreederFecundity:\tfailed to parse the value for the 'random fecundity' read from the database; " . show
) id $ Database.HDBC.safeFromSql y
) where
(defaultDeterministicFecundity, defaultRandomFecundity) = ExecutionConfiguration.TimetableBreederFecundity.getDeterministicConstructorFecundity &&& ExecutionConfiguration.TimetableBreederFecundity.getRandomConstructorFecundity $ Data.Default.def
def = Data.Default.def
in MkEvolutionStrategies {
getSynchronisedCourseMutationFecundity = mkTimetableBreederFecundity synchronisedCourseMutationDeterministicConstructorFecunditySql synchronisedCourseMutationRandomConstructorFecunditySql,
getSynchronisedCourseByDayMutationFecundity = mkTimetableBreederFecundity synchronisedCourseByDayMutationDeterministicConstructorFecunditySql synchronisedCourseByDayMutationRandomConstructorFecunditySql,
getExcessRunlengthMutationFecundity = mkTimetableBreederFecundity excessRunlengthMutationDeterministicConstructorFecunditySql excessRunlengthMutationRandomConstructorFecunditySql,
getHomogeneousStudentViewLessonMutationFecundity = mkTimetableBreederFecundity homogeneousStudentViewLessonMutationDeterministicConstructorFecunditySql homogeneousStudentViewLessonMutationRandomConstructorFecunditySql,
getIncompleteCourseMutationFecundity = mkTimetableBreederFecundity incompleteCourseMutationDeterministicConstructorFecunditySql incompleteCourseMutationRandomConstructorFecunditySql,
getRandomLessonMutationFecundity = mkTimetableBreederFecundity randomLessonMutationDeterministicConstructorFecunditySql randomLessonMutationRandomConstructorFecunditySql,
getSingletonStudentClassMutationFecundity = mkTimetableBreederFecundity singletonStudentClassMutationDeterministicConstructorFecunditySql singletonStudentClassMutationRandomConstructorFecunditySql,
getSplitSessionMutationFecundity = mkTimetableBreederFecundity splitSessionMutationDeterministicConstructorFecunditySql splitSessionMutationRandomConstructorFecunditySql,
getStudentBodyCombinationMutationFecundity = mkTimetableBreederFecundity studentBodyCombinationMutationDeterministicConstructorFecunditySql studentBodyCombinationMutationRandomConstructorFecunditySql,
getStudentViewTimetableForDayMutationFecundity = mkTimetableBreederFecundity studentViewTimetableForDayMutationDeterministicConstructorFecunditySql studentViewTimetableForDayMutationRandomConstructorFecunditySql,
getStudentViewTimetableForWeekMutationFecundity = mkTimetableBreederFecundity studentViewTimetableForWeekMutationDeterministicConstructorFecunditySql studentViewTimetableForWeekMutationRandomConstructorFecunditySql,
getSynchronousLessonMutationFecundity = mkTimetableBreederFecundity synchronousLessonMutationDeterministicConstructorFecunditySql synchronousLessonMutationRandomConstructorFecunditySql,
getRandomLessonMutationNTrials = Data.Maybe.fromMaybe (getRandomLessonMutationNTrials def) . either (
error . showString "WeekDaze.ExecutionConfiguration.EvolutionStrategies.fromDatabase:\tfailed to parse the value for " . shows randomLessonMutationNTrialsTag . showString " read from the database; " . show
) id $ Database.HDBC.safeFromSql randomLessonMutationNTrialsSql,
getRandomLessonMutationNTimeslots = Data.Maybe.fromMaybe (getRandomLessonMutationNTimeslots def) . either (
error . showString "WeekDaze.ExecutionConfiguration.EvolutionStrategies.fromDatabase:\tfailed to parse the value for " . shows randomLessonMutationNTimeslotsTag . showString " read from the database; " . show
) id $ Database.HDBC.safeFromSql randomLessonMutationNTimeslotsSql,
getStudentViewTimetableForDayMutationMaybeNDays = either (
error . showString "WeekDaze.ExecutionConfiguration.EvolutionStrategies.fromDatabase:\tfailed to parse the value for " . shows studentViewTimetableForDayMutationNDaysTag . showString " read from the database; " . show
) id $ Database.HDBC.safeFromSql studentViewTimetableForDayMutationNDaysSql,
getStudentViewTimetableForWeekMutationNTrials = Data.Maybe.fromMaybe (getStudentViewTimetableForWeekMutationNTrials def) . either (
error . showString "WeekDaze.ExecutionConfiguration.EvolutionStrategies.fromDatabase:\tfailed to parse the value for " . shows studentViewTimetableForWeekMutationNTrialsTag . showString " read from the database; " . show
) id $ Database.HDBC.safeFromSql studentViewTimetableForWeekMutationNTrialsSql,
getStudentViewTimetableForWeekMutationNTimeslots = Data.Maybe.fromMaybe (getStudentViewTimetableForWeekMutationNTimeslots def) . either (
error . showString "WeekDaze.ExecutionConfiguration.EvolutionStrategies.fromDatabase:\tfailed to parse the value for " . shows studentViewTimetableForWeekMutationNTimeslotsTag . showString " read from the database; " . show
) id $ Database.HDBC.safeFromSql studentViewTimetableForWeekMutationNTimeslotsSql,
getFecundityDecayRatio = Database.Selector.fromSqlFractional (getFecundityDecayRatio def) fecundityDecayRatioSql,
getMinimumPopulationDiversityRatio = Database.Selector.fromSqlFractional (getMinimumPopulationDiversityRatio def) minimumPopulationDiversityRatioSql,
getMaybeNInitialScouts = either (
error . showString "WeekDaze.ExecutionConfiguration.EvolutionStrategies.fromDatabase:\tfailed to parse the value for " . shows nInitialScoutsTag . showString " read from the database; " . show
) id $ Database.HDBC.safeFromSql nInitialScoutsSql
}
_ -> error $ "WeekDaze.ExecutionConfiguration.EvolutionStrategies.fromDatabase:\tunexpected number of columns=" ++ show (length strategiesRow) ++ " in row of table " ++ show tableName ++ "."
_ -> error $ "WeekDaze.ExecutionConfiguration.EvolutionStrategies.fromDatabase:\tunexpected number of rows=" ++ show (length strategiesRows) ++ " selected from table " ++ show tableName ++ "."
#endif /* USE_HDBC */
tag :: String
tag = "evolutionStrategies"
synchronisedCourseMutationTag :: String
synchronisedCourseMutationTag = "synchronisedCourseMutation"
synchronisedCourseByDayMutationTag :: String
synchronisedCourseByDayMutationTag = "synchronisedCourseByDayMutation"
excessRunlengthMutationTag :: String
excessRunlengthMutationTag = "excessRunlengthMutation"
homogeneousStudentViewLessonMutationTag :: String
homogeneousStudentViewLessonMutationTag = "homogeneousStudentViewLessonMutation"
incompleteCourseMutationTag :: String
incompleteCourseMutationTag = "incompleteCourseMutation"
randomLessonMutationTag :: String
randomLessonMutationTag = "randomLessonMutation"
singletonStudentClassMutationTag :: String
singletonStudentClassMutationTag = "singletonStudentClassMutation"
splitSessionMutationTag :: String
splitSessionMutationTag = "splitSessionMutation"
studentBodyCombinationMutationTag :: String
studentBodyCombinationMutationTag = "studentBodyCombinationMutation"
studentViewTimetableForDayMutationTag :: String
studentViewTimetableForDayMutationTag = "studentViewTimetableForDayMutation"
studentViewTimetableForWeekMutationTag :: String
studentViewTimetableForWeekMutationTag = "studentViewTimetableForWeekMutation"
synchronousLessonMutationTag :: String
synchronousLessonMutationTag = "synchronousLessonMutation"
randomLessonMutationNTrialsTag :: String
randomLessonMutationNTrialsTag = "randomLessonMutationNTrials"
randomLessonMutationNTimeslotsTag :: String
randomLessonMutationNTimeslotsTag = "randomLessonMutationNTimeslots"
studentViewTimetableForDayMutationNDaysTag :: String
studentViewTimetableForDayMutationNDaysTag = "studentViewTimetableForDayMutationNDays"
studentViewTimetableForWeekMutationNTrialsTag :: String
studentViewTimetableForWeekMutationNTrialsTag = "studentViewTimetableForWeekMutationNTrials"
studentViewTimetableForWeekMutationNTimeslotsTag :: String
studentViewTimetableForWeekMutationNTimeslotsTag = "studentViewTimetableForWeekMutationNTimeslots"
fecundityDecayRatioTag :: String
fecundityDecayRatioTag = "fecundityDecayRatio"
minimumPopulationDiversityRatioTag :: String
minimumPopulationDiversityRatioTag = "minimumPopulationDiversityRatio"
nInitialScoutsTag :: String
nInitialScoutsTag = "nInitialScouts"
data EvolutionStrategies fecundityDecayRatio populationDiversityRatio = MkEvolutionStrategies {
getSynchronisedCourseMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity,
getSynchronisedCourseByDayMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity,
getExcessRunlengthMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity,
getHomogeneousStudentViewLessonMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity,
getIncompleteCourseMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity,
getRandomLessonMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity,
getSingletonStudentClassMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity,
getSplitSessionMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity,
getStudentBodyCombinationMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity,
getStudentViewTimetableForDayMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity,
getStudentViewTimetableForWeekMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity,
getSynchronousLessonMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity,
getRandomLessonMutationNTrials :: Int,
getRandomLessonMutationNTimeslots :: Size.NTimeslots,
getStudentViewTimetableForDayMutationMaybeNDays :: Maybe Size.NDays,
getStudentViewTimetableForWeekMutationNTrials :: Int,
getStudentViewTimetableForWeekMutationNTimeslots :: Size.NTimeslots,
getFecundityDecayRatio :: fecundityDecayRatio,
getMinimumPopulationDiversityRatio :: populationDiversityRatio,
getMaybeNInitialScouts :: Maybe Size.NTimetables
} deriving (Eq, Show)
instance (Fractional fecundityDecayRatio, Fractional populationDiversityRatio) => Data.Default.Default (EvolutionStrategies fecundityDecayRatio populationDiversityRatio) where
def = MkEvolutionStrategies {
getSynchronisedCourseMutationFecundity = Data.Default.def,
getSynchronisedCourseByDayMutationFecundity = Data.Default.def,
getExcessRunlengthMutationFecundity = Data.Default.def,
getHomogeneousStudentViewLessonMutationFecundity = Data.Default.def,
getIncompleteCourseMutationFecundity = Data.Default.def,
getRandomLessonMutationFecundity = Data.Default.def,
getSingletonStudentClassMutationFecundity = Data.Default.def,
getSplitSessionMutationFecundity = Data.Default.def,
getStudentBodyCombinationMutationFecundity = Data.Default.def,
getStudentViewTimetableForDayMutationFecundity = Data.Default.def,
getStudentViewTimetableForWeekMutationFecundity = Data.Default.def,
getSynchronousLessonMutationFecundity = Data.Default.def,
getRandomLessonMutationNTrials = 256,
getRandomLessonMutationNTimeslots = 3,
getStudentViewTimetableForDayMutationMaybeNDays = Nothing,
getStudentViewTimetableForWeekMutationNTrials = 16,
getStudentViewTimetableForWeekMutationNTimeslots = 4,
getFecundityDecayRatio = recip 2,
getMinimumPopulationDiversityRatio = recip 2,
getMaybeNInitialScouts = Nothing
}
instance (
Fractional fecundityDecayRatio,
Fractional populationDiversityRatio,
HXT.XmlPickler fecundityDecayRatio,
HXT.XmlPickler populationDiversityRatio,
Ord fecundityDecayRatio,
Ord populationDiversityRatio,
Show fecundityDecayRatio,
Show populationDiversityRatio
) => HXT.XmlPickler (EvolutionStrategies fecundityDecayRatio populationDiversityRatio) where
xpickle = HXT.xpDefault defaultEvolutionStrategies . HXT.xpElem tag . HXT.xpWrap (
\(a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t) -> let
evolutionStrategies = MkEvolutionStrategies a b c d e f g h i j k l m n o p q r s t
in if ToolShed.SelfValidate.isValid evolutionStrategies
then evolutionStrategies
else error $ "WeekDaze.ExecutionConfiguration.EvolutionStrategies.xpickle:\t" ++ ToolShed.SelfValidate.getFirstError evolutionStrategies ++ ".",
\MkEvolutionStrategies {
getSynchronisedCourseMutationFecundity = synchronisedCourseMutationFecundity,
getSynchronisedCourseByDayMutationFecundity = synchronisedCourseByDayMutationFecundity,
getExcessRunlengthMutationFecundity = excessRunlengthMutationFecundity,
getHomogeneousStudentViewLessonMutationFecundity = homogeneousStudentViewLessonMutationFecundity,
getIncompleteCourseMutationFecundity = incompleteCourseMutationFecundity,
getRandomLessonMutationFecundity = randomLessonMutationFecundity,
getSingletonStudentClassMutationFecundity = singletonStudentClassMutationFecundity,
getSplitSessionMutationFecundity = splitSessionMutationFecundity,
getStudentBodyCombinationMutationFecundity = studentBodyCombinationMutationFecundity,
getStudentViewTimetableForDayMutationFecundity = studentViewTimetableForDayMutationFecundity,
getStudentViewTimetableForWeekMutationFecundity = studentViewTimetableForWeekMutationFecundity,
getSynchronousLessonMutationFecundity = synchronousLessonMutationFecundity,
getRandomLessonMutationNTrials = randomLessonMutationNTrials,
getRandomLessonMutationNTimeslots = randomLessonMutationNTimeslots,
getStudentViewTimetableForDayMutationMaybeNDays = studentViewTimetableForDayMutationMaybeNDays,
getStudentViewTimetableForWeekMutationNTrials = studentViewTimetableForWeekMutationNTrials,
getStudentViewTimetableForWeekMutationNTimeslots = studentViewTimetableForWeekMutationNTimeslots,
getFecundityDecayRatio = fecundityDecayRatio,
getMinimumPopulationDiversityRatio = minimumPopulationDiversityRatio,
getMaybeNInitialScouts = maybeNInitialScouts
} -> (
synchronisedCourseMutationFecundity,
synchronisedCourseByDayMutationFecundity,
excessRunlengthMutationFecundity,
homogeneousStudentViewLessonMutationFecundity,
incompleteCourseMutationFecundity,
randomLessonMutationFecundity,
singletonStudentClassMutationFecundity,
splitSessionMutationFecundity,
studentBodyCombinationMutationFecundity,
studentViewTimetableForDayMutationFecundity,
studentViewTimetableForWeekMutationFecundity,
synchronousLessonMutationFecundity,
randomLessonMutationNTrials,
randomLessonMutationNTimeslots,
studentViewTimetableForDayMutationMaybeNDays,
studentViewTimetableForWeekMutationNTrials,
studentViewTimetableForWeekMutationNTimeslots,
fecundityDecayRatio,
minimumPopulationDiversityRatio,
maybeNInitialScouts
)
) $ HXT.xp20Tuple (
HXT.xpElem synchronisedCourseMutationTag HXT.xpickle
) (
HXT.xpElem synchronisedCourseByDayMutationTag HXT.xpickle
) (
HXT.xpElem excessRunlengthMutationTag HXT.xpickle
) (
HXT.xpElem homogeneousStudentViewLessonMutationTag HXT.xpickle
) (
HXT.xpElem incompleteCourseMutationTag HXT.xpickle
) (
HXT.xpElem randomLessonMutationTag HXT.xpickle
) (
HXT.xpElem singletonStudentClassMutationTag HXT.xpickle
) (
HXT.xpElem splitSessionMutationTag HXT.xpickle
) (
HXT.xpElem studentBodyCombinationMutationTag HXT.xpickle
) (
HXT.xpElem studentViewTimetableForDayMutationTag HXT.xpickle
) (
HXT.xpElem studentViewTimetableForWeekMutationTag HXT.xpickle
) (
HXT.xpElem synchronousLessonMutationTag HXT.xpickle
) (
HXT.xpDefault (getRandomLessonMutationNTrials defaultEvolutionStrategies) $ HXT.xpAttr randomLessonMutationNTrialsTag HXT.xpInt
) (
HXT.xpDefault (getRandomLessonMutationNTimeslots defaultEvolutionStrategies) $ HXT.xpAttr randomLessonMutationNTimeslotsTag HXT.xpInt
) (
HXT.xpOption $ HXT.xpAttr studentViewTimetableForDayMutationNDaysTag HXT.xpInt
) (
HXT.xpDefault (getStudentViewTimetableForWeekMutationNTrials defaultEvolutionStrategies) $ HXT.xpAttr studentViewTimetableForWeekMutationNTrialsTag HXT.xpInt
) (
HXT.xpDefault (getStudentViewTimetableForWeekMutationNTimeslots defaultEvolutionStrategies) $ HXT.xpAttr studentViewTimetableForWeekMutationNTimeslotsTag HXT.xpInt
) (
getFecundityDecayRatio defaultEvolutionStrategies `HXT.xpDefault` HXT.xpAttr fecundityDecayRatioTag HXT.xpickle
) (
getMinimumPopulationDiversityRatio defaultEvolutionStrategies `HXT.xpDefault` HXT.xpAttr minimumPopulationDiversityRatioTag HXT.xpickle
) (
HXT.xpOption $ HXT.xpAttr nInitialScoutsTag HXT.xpInt
) where
defaultEvolutionStrategies = Data.Default.def
instance (
Num fecundityDecayRatio,
Num populationDiversityRatio,
Ord fecundityDecayRatio,
Ord populationDiversityRatio,
Show fecundityDecayRatio,
Show populationDiversityRatio
) => ToolShed.SelfValidate.SelfValidator (EvolutionStrategies fecundityDecayRatio populationDiversityRatio) where
getErrors evolutionStrategies = ToolShed.SelfValidate.extractErrors [
(
getRandomLessonMutationNTrials evolutionStrategies < 0,
show randomLessonMutationNTrialsTag ++ " can't be negative; " ++ show evolutionStrategies
), (
getRandomLessonMutationNTimeslots evolutionStrategies < 0,
show randomLessonMutationNTimeslotsTag ++ " can't be negative; " ++ show evolutionStrategies
), (
Data.Maybe.maybe False (
\nDays -> any ($ nDays) [(< 0), (> Temporal.Day.nDaysPerWeek)]
) $ getStudentViewTimetableForDayMutationMaybeNDays evolutionStrategies,
show studentViewTimetableForDayMutationNDaysTag ++ " (where specified) must be in the closed interval [0, " ++ show Temporal.Day.nDaysPerWeek ++ "]; " ++ show evolutionStrategies
), (
getStudentViewTimetableForWeekMutationNTrials evolutionStrategies < 0,
show studentViewTimetableForWeekMutationNTrialsTag ++ " can't be negative; " ++ show evolutionStrategies
), (
getStudentViewTimetableForWeekMutationNTimeslots evolutionStrategies < 0,
show studentViewTimetableForWeekMutationNTimeslotsTag ++ " can't be negative; " ++ show evolutionStrategies
), (
any ($ getFecundityDecayRatio evolutionStrategies) [(< 0), (> 1)],
show fecundityDecayRatioTag ++ " must be within the closed unit-interval; " ++ show evolutionStrategies
), (
any ($ getMinimumPopulationDiversityRatio evolutionStrategies) [(< 0), (> 1)],
show minimumPopulationDiversityRatioTag ++ " must be within the closed unit-interval; " ++ show evolutionStrategies
), (
Data.Maybe.maybe False (< 1) $ getMaybeNInitialScouts evolutionStrategies,
show nInitialScoutsTag ++ " can't be fewer than one"
)
]
instance (
Control.DeepSeq.NFData fecundityDecayRatio,
Control.DeepSeq.NFData populationDiversityRatio
) => Control.DeepSeq.NFData (EvolutionStrategies fecundityDecayRatio populationDiversityRatio) where
rnf MkEvolutionStrategies {
getSynchronisedCourseMutationFecundity = synchronisedCourseMutationFecundity,
getSynchronisedCourseByDayMutationFecundity = synchronisedCourseByDayMutationFecundity,
getExcessRunlengthMutationFecundity = excessRunlengthMutationFecundity,
getHomogeneousStudentViewLessonMutationFecundity = homogeneousStudentViewLessonMutationFecundity,
getIncompleteCourseMutationFecundity = incompleteCourseMutationFecundity,
getRandomLessonMutationFecundity = randomLessonMutationFecundity,
getSingletonStudentClassMutationFecundity = singletonStudentClassMutationFecundity,
getSplitSessionMutationFecundity = splitSessionMutationFecundity,
getStudentBodyCombinationMutationFecundity = studentBodyCombinationMutationFecundity,
getStudentViewTimetableForDayMutationFecundity = studentViewTimetableForDayMutationFecundity,
getStudentViewTimetableForWeekMutationFecundity = studentViewTimetableForWeekMutationFecundity,
getSynchronousLessonMutationFecundity = synchronousLessonMutationFecundity,
getRandomLessonMutationNTrials = randomLessonMutationNTrials,
getRandomLessonMutationNTimeslots = randomLessonMutationNTimeslots,
getStudentViewTimetableForDayMutationMaybeNDays = studentViewTimetableForDayMutationMaybeNDays,
getStudentViewTimetableForWeekMutationNTrials = studentViewTimetableForWeekMutationNTrials,
getStudentViewTimetableForWeekMutationNTimeslots = studentViewTimetableForWeekMutationNTimeslots,
getFecundityDecayRatio = fecundityDecayRatio,
getMinimumPopulationDiversityRatio = minimumPopulationDiversityRatio,
getMaybeNInitialScouts = maybeNInitialScouts
} = Control.DeepSeq.rnf (
[
synchronisedCourseMutationFecundity,
synchronisedCourseByDayMutationFecundity,
excessRunlengthMutationFecundity,
homogeneousStudentViewLessonMutationFecundity,
incompleteCourseMutationFecundity,
randomLessonMutationFecundity,
singletonStudentClassMutationFecundity,
splitSessionMutationFecundity,
studentBodyCombinationMutationFecundity,
studentViewTimetableForDayMutationFecundity,
studentViewTimetableForWeekMutationFecundity,
synchronousLessonMutationFecundity
],
randomLessonMutationNTrials,
randomLessonMutationNTimeslots,
studentViewTimetableForDayMutationMaybeNDays,
studentViewTimetableForWeekMutationNTrials,
studentViewTimetableForWeekMutationNTimeslots,
fecundityDecayRatio,
minimumPopulationDiversityRatio,
maybeNInitialScouts
)
type Mutator fecundityDecayRatio populationDiversityRatio = EvolutionStrategies fecundityDecayRatio populationDiversityRatio -> EvolutionStrategies fecundityDecayRatio populationDiversityRatio
zeroSynchronisedCourseMutationFecundity :: Mutator fecundityDecayRatio populationDiversityRatio
zeroSynchronisedCourseMutationFecundity evolutionStrategies = evolutionStrategies {
getSynchronisedCourseMutationFecundity = ExecutionConfiguration.TimetableBreederFecundity.zero
}
zeroSynchronisedCourseByDayMutationFecundity :: Mutator fecundityDecayRatio populationDiversityRatio
zeroSynchronisedCourseByDayMutationFecundity evolutionStrategies = evolutionStrategies {
getSynchronisedCourseByDayMutationFecundity = ExecutionConfiguration.TimetableBreederFecundity.zero
}
zeroExcessRunlengthMutationFecundity :: Mutator fecundityDecayRatio populationDiversityRatio
zeroExcessRunlengthMutationFecundity evolutionStrategies = evolutionStrategies {
getExcessRunlengthMutationFecundity = ExecutionConfiguration.TimetableBreederFecundity.zero
}
zeroHomogeneousStudentViewLessonMutationFecundity :: Mutator fecundityDecayRatio populationDiversityRatio
zeroHomogeneousStudentViewLessonMutationFecundity evolutionStrategies = evolutionStrategies {
getHomogeneousStudentViewLessonMutationFecundity = ExecutionConfiguration.TimetableBreederFecundity.zero
}
zeroIncompleteCourseMutationFecundity :: Mutator fecundityDecayRatio populationDiversityRatio
zeroIncompleteCourseMutationFecundity evolutionStrategies = evolutionStrategies {
getIncompleteCourseMutationFecundity = ExecutionConfiguration.TimetableBreederFecundity.zero
}
zeroRandomLessonMutationFecundity :: Mutator fecundityDecayRatio populationDiversityRatio
zeroRandomLessonMutationFecundity evolutionStrategies = evolutionStrategies {
getRandomLessonMutationFecundity = ExecutionConfiguration.TimetableBreederFecundity.zero
}
zeroSingletonStudentClassMutationFecundity :: Mutator fecundityDecayRatio populationDiversityRatio
zeroSingletonStudentClassMutationFecundity evolutionStrategies = evolutionStrategies {
getSingletonStudentClassMutationFecundity = ExecutionConfiguration.TimetableBreederFecundity.zero
}
zeroSplitSessionMutationFecundity :: Mutator fecundityDecayRatio populationDiversityRatio
zeroSplitSessionMutationFecundity evolutionStrategies = evolutionStrategies {
getSplitSessionMutationFecundity = ExecutionConfiguration.TimetableBreederFecundity.zero
}
zeroStudentBodyCombinationMutationFecundity :: Mutator fecundityDecayRatio populationDiversityRatio
zeroStudentBodyCombinationMutationFecundity evolutionStrategies = evolutionStrategies {
getStudentBodyCombinationMutationFecundity = ExecutionConfiguration.TimetableBreederFecundity.zero
}
zeroStudentViewTimetableForDayMutationFecundity :: Mutator fecundityDecayRatio populationDiversityRatio
zeroStudentViewTimetableForDayMutationFecundity evolutionStrategies = evolutionStrategies {
getStudentViewTimetableForDayMutationFecundity = ExecutionConfiguration.TimetableBreederFecundity.zero
}
zeroStudentViewTimetableForWeekMutationFecundity :: Mutator fecundityDecayRatio populationDiversityRatio
zeroStudentViewTimetableForWeekMutationFecundity evolutionStrategies = evolutionStrategies {
getStudentViewTimetableForWeekMutationFecundity = ExecutionConfiguration.TimetableBreederFecundity.zero
}
zeroSynchronousLessonMutationFecundity :: Mutator fecundityDecayRatio populationDiversityRatio
zeroSynchronousLessonMutationFecundity evolutionStrategies = evolutionStrategies {
getSynchronousLessonMutationFecundity = ExecutionConfiguration.TimetableBreederFecundity.zero
}
areAllZero :: EvolutionStrategies fecundityDecayRatio populationDiversityRatio -> Bool
areAllZero evolutionStrategies = all (
(== ExecutionConfiguration.TimetableBreederFecundity.zero) . ($ evolutionStrategies)
) [
getSynchronisedCourseMutationFecundity,
getSynchronisedCourseByDayMutationFecundity,
getExcessRunlengthMutationFecundity,
getHomogeneousStudentViewLessonMutationFecundity,
getIncompleteCourseMutationFecundity,
getRandomLessonMutationFecundity,
getSingletonStudentClassMutationFecundity,
getSplitSessionMutationFecundity,
getStudentBodyCombinationMutationFecundity,
getStudentViewTimetableForDayMutationFecundity,
getStudentViewTimetableForWeekMutationFecundity,
getSynchronousLessonMutationFecundity
]