{-# LANGUAGE CPP, FlexibleContexts #-}
module WeekDaze.ExecutionConfiguration.ExecutionOptions(
RandomSeed,
PermitTemporaryStudentBodyMerger,
ReduceStudentBodyRegister,
RemoveRedundantCourses,
ExecutionOptions(..),
inputStudentViewTimetableTag,
permitTemporaryStudentBodyMergerTag,
randomSeedTag,
reduceStudentBodyRegisterTag,
removeRedundantCoursesTag,
removePointlessGroupsTag,
removeUnsubscribedGroupsTag,
zeroInappropriateOptionsTag,
setPermitTemporaryStudentBodyMerger,
setSynchronisedCourseMutationFecundity,
setSynchronisedCourseByDayMutationFecundity,
setExcessRunlengthMutationFecundity,
setFecundityDecayRatio,
setHomogeneousStudentViewLessonMutationFecundity,
setIncompleteCourseMutationFecundity,
setMinimumPopulationDiversityRatio,
setMaybeNInitialScouts,
setSingletonStudentClassMutationFecundity,
setSplitSessionMutationFecundity,
setStudentBodyCombinationMutationFecundity,
setStudentViewTimetableForDayMutationFecundity,
setStudentViewTimetableForWeekMutationFecundity,
setSynchronousLessonMutationFecundity,
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,
Data.Convertible.Convertible Database.HDBC.SqlValue fecundityDecayRatio,
Data.Convertible.Convertible Database.HDBC.SqlValue populationDiversityRatio,
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 . (
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)
}
_ -> 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
) {
getEvolutionStrategies = evolutionStrategies,
getOptimiseLessonCriteriaWeights = optimiseLessonCriteriaWeights,
getLessonCriteriaWeights = lessonCriteriaWeights,
getTimetableCriteriaWeights = timetableCriteriaWeights
}
#endif /* USE_HDBC */
tag :: String
tag = "executionOptions"
filePathTag :: String
filePathTag = "filePath"
inputStudentViewTimetableTag :: String
inputStudentViewTimetableTag = "inputStudentViewTimetable"
permitTemporaryStudentBodyMergerTag :: String
permitTemporaryStudentBodyMergerTag = "permitTemporaryStudentBodyMerger"
randomSeedTag :: String
randomSeedTag = "randomSeed"
reduceStudentBodyRegisterTag :: String
reduceStudentBodyRegisterTag = "reduceStudentBodyRegister"
removeRedundantCoursesTag :: String
removeRedundantCoursesTag = "removeRedundantCourses"
removePointlessGroupsTag :: String
removePointlessGroupsTag = "removePointlessGroups"
removeUnsubscribedGroupsTag :: String
removeUnsubscribedGroupsTag = "removeUnsubscribedGroups"
zeroInappropriateOptionsTag :: String
zeroInappropriateOptionsTag = "zeroInappropriateOptions"
type Hint = Either Model.TimetableAxisTriple.Axes System.FilePath.FilePath
type RandomSeed = Int
type PermitTemporaryStudentBodyMerger = Bool
type ReduceStudentBodyRegister = Bool
type RemoveRedundantCourses = Bool
data ExecutionOptions criterionWeight fecundityDecayRatio populationDiversityRatio = MkExecutionOptions {
getEvolutionStrategies :: ExecutionConfiguration.EvolutionStrategies.EvolutionStrategies fecundityDecayRatio populationDiversityRatio,
getMaybeHint :: Maybe Hint,
getMaybeRandomSeed :: Maybe RandomSeed,
getOptimiseLessonCriteriaWeights :: ExecutionConfiguration.OptimiseLessonCriteriaWeights.OptimiseLessonCriteriaWeights criterionWeight,
getLessonCriteriaWeights :: ExecutionConfiguration.LessonCriteriaWeights.LessonCriteriaWeights criterionWeight,
getPermitTemporaryStudentBodyMerger :: PermitTemporaryStudentBodyMerger,
getReduceStudentBodyRegister :: ReduceStudentBodyRegister,
getRemoveRedundantCourses :: RemoveRedundantCourses,
getRemovePointlessGroups :: Bool,
getRemoveUnsubscribedGroups :: Bool,
getTimetableCriteriaWeights :: ExecutionConfiguration.TimetableCriteriaWeights.TimetableCriteriaWeights criterionWeight,
getZeroInappropriateOptions :: Bool
} 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,
\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
)
) $ HXT.xp12Tuple HXT.xpickle (
HXT.xpOption . Enhanced.EnhancedEither.xpickle HXT.xpickle . HXT.xpElem inputStudentViewTimetableTag $ HXT.xpTextAttr filePathTag
) (
HXT.xpAttrImplied randomSeedTag HXT.xpInt
) HXT.xpickle HXT.xpickle (
getPermitTemporaryStudentBodyMerger defaultExecutionOptions `HXT.xpDefault` HXT.xpAttr permitTemporaryStudentBodyMergerTag HXT.xpickle
) (
getReduceStudentBodyRegister defaultExecutionOptions `HXT.xpDefault` HXT.xpAttr reduceStudentBodyRegisterTag HXT.xpickle
) (
getRemoveRedundantCourses defaultExecutionOptions `HXT.xpDefault` HXT.xpAttr removeRedundantCoursesTag HXT.xpickle
) (
getRemovePointlessGroups defaultExecutionOptions `HXT.xpDefault` HXT.xpAttr removePointlessGroupsTag HXT.xpickle
) (
getRemoveUnsubscribedGroups defaultExecutionOptions `HXT.xpDefault` HXT.xpAttr removeUnsubscribedGroupsTag HXT.xpickle
) HXT.xpickle (
getZeroInappropriateOptions defaultExecutionOptions `HXT.xpDefault` HXT.xpAttr zeroInappropriateOptionsTag HXT.xpickle
) where
defaultExecutionOptions :: ExecutionOptions Rational Rational Rational
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
)
type Mutator criterionWeight fecundityDecayRatio populationDiversityRatio = ExecutionOptions criterionWeight fecundityDecayRatio populationDiversityRatio -> ExecutionOptions criterionWeight fecundityDecayRatio populationDiversityRatio
setPermitTemporaryStudentBodyMerger :: Num criterionWeight => PermitTemporaryStudentBodyMerger -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setPermitTemporaryStudentBodyMerger permitTemporaryStudentBodyMerger executionOptions@MkExecutionOptions {
getLessonCriteriaWeights = lessonCriteriaWeights,
getTimetableCriteriaWeights = timetableCriteriaWeights
}
| permitTemporaryStudentBodyMerger = executionOptions' {
getLessonCriteriaWeights = lessonCriteriaWeights {
ExecutionConfiguration.LessonCriteriaWeights.getWeightOfMaximiseStudentClassSizeOverLocationCapacity = minBound,
ExecutionConfiguration.LessonCriteriaWeights.getWeightOfMaximiseStudentClassSizeOverCourseClassSize = minBound
}
}
| otherwise = executionOptions' {
getLessonCriteriaWeights = lessonCriteriaWeights {
ExecutionConfiguration.LessonCriteriaWeights.getWeightOfMinimiseStudentBodyCombinations = minBound,
ExecutionConfiguration.LessonCriteriaWeights.getWeightOfAreResourcesReused = minBound
},
getTimetableCriteriaWeights = timetableCriteriaWeights {
ExecutionConfiguration.TimetableCriteriaWeights.getWeightOfMinimiseMeanStudentBodyCombinationsPerLesson = minBound,
ExecutionConfiguration.TimetableCriteriaWeights.getWeightOfMaximiseMeanStudentClassSize = minBound
}
}
where
executionOptions' = executionOptions { getPermitTemporaryStudentBodyMerger = permitTemporaryStudentBodyMerger }
setSynchronisedCourseMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setSynchronisedCourseMutationFecundity timetableBreederFecundity executionOptions = executionOptions {
getEvolutionStrategies = (getEvolutionStrategies executionOptions) {
ExecutionConfiguration.EvolutionStrategies.getSynchronisedCourseMutationFecundity = timetableBreederFecundity
}
}
setSynchronisedCourseByDayMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setSynchronisedCourseByDayMutationFecundity timetableBreederFecundity executionOptions = executionOptions {
getEvolutionStrategies = (getEvolutionStrategies executionOptions) {
ExecutionConfiguration.EvolutionStrategies.getSynchronisedCourseByDayMutationFecundity = timetableBreederFecundity
}
}
setExcessRunlengthMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setExcessRunlengthMutationFecundity timetableBreederFecundity executionOptions = executionOptions {
getEvolutionStrategies = (getEvolutionStrategies executionOptions) {
ExecutionConfiguration.EvolutionStrategies.getExcessRunlengthMutationFecundity = timetableBreederFecundity
}
}
setFecundityDecayRatio :: fecundityDecayRatio -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setFecundityDecayRatio fecundityDecayRatio executionOptions = executionOptions {
getEvolutionStrategies = (getEvolutionStrategies executionOptions) {
ExecutionConfiguration.EvolutionStrategies.getFecundityDecayRatio = fecundityDecayRatio
}
}
setHomogeneousStudentViewLessonMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setHomogeneousStudentViewLessonMutationFecundity timetableBreederFecundity executionOptions = executionOptions {
getEvolutionStrategies = (getEvolutionStrategies executionOptions) {
ExecutionConfiguration.EvolutionStrategies.getHomogeneousStudentViewLessonMutationFecundity = timetableBreederFecundity
}
}
setIncompleteCourseMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setIncompleteCourseMutationFecundity timetableBreederFecundity executionOptions = executionOptions {
getEvolutionStrategies = (getEvolutionStrategies executionOptions) {
ExecutionConfiguration.EvolutionStrategies.getIncompleteCourseMutationFecundity = timetableBreederFecundity
}
}
setMinimumPopulationDiversityRatio :: populationDiversityRatio -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setMinimumPopulationDiversityRatio populationDiversityRatio executionOptions = executionOptions {
getEvolutionStrategies = (getEvolutionStrategies executionOptions) {
ExecutionConfiguration.EvolutionStrategies.getMinimumPopulationDiversityRatio = populationDiversityRatio
}
}
setMaybeNInitialScouts :: Maybe Size.NTimetables -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setMaybeNInitialScouts maybeNInitialScouts executionOptions = executionOptions {
getEvolutionStrategies = (getEvolutionStrategies executionOptions) {
ExecutionConfiguration.EvolutionStrategies.getMaybeNInitialScouts = maybeNInitialScouts
}
}
setSingletonStudentClassMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setSingletonStudentClassMutationFecundity timetableBreederFecundity executionOptions = executionOptions {
getEvolutionStrategies = (getEvolutionStrategies executionOptions) {
ExecutionConfiguration.EvolutionStrategies.getSingletonStudentClassMutationFecundity = timetableBreederFecundity
}
}
setSplitSessionMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setSplitSessionMutationFecundity timetableBreederFecundity executionOptions = executionOptions {
getEvolutionStrategies = (getEvolutionStrategies executionOptions) {
ExecutionConfiguration.EvolutionStrategies.getSplitSessionMutationFecundity = timetableBreederFecundity
}
}
setStudentBodyCombinationMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setStudentBodyCombinationMutationFecundity timetableBreederFecundity executionOptions = executionOptions {
getEvolutionStrategies = (getEvolutionStrategies executionOptions) {
ExecutionConfiguration.EvolutionStrategies.getStudentBodyCombinationMutationFecundity = timetableBreederFecundity
}
}
setStudentViewTimetableForDayMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setStudentViewTimetableForDayMutationFecundity timetableBreederFecundity executionOptions = executionOptions {
getEvolutionStrategies = (getEvolutionStrategies executionOptions) {
ExecutionConfiguration.EvolutionStrategies.getStudentViewTimetableForDayMutationFecundity = timetableBreederFecundity
}
}
setStudentViewTimetableForWeekMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setStudentViewTimetableForWeekMutationFecundity timetableBreederFecundity executionOptions = executionOptions {
getEvolutionStrategies = (getEvolutionStrategies executionOptions) {
ExecutionConfiguration.EvolutionStrategies.getStudentViewTimetableForWeekMutationFecundity = timetableBreederFecundity
}
}
setSynchronousLessonMutationFecundity :: ExecutionConfiguration.TimetableBreederFecundity.TimetableBreederFecundity -> Mutator criterionWeight fecundityDecayRatio populationDiversityRatio
setSynchronousLessonMutationFecundity timetableBreederFecundity executionOptions = executionOptions {
getEvolutionStrategies = (getEvolutionStrategies executionOptions) {
ExecutionConfiguration.EvolutionStrategies.getSynchronousLessonMutationFecundity = timetableBreederFecundity
}
}
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,
"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"
)
]
]