{-
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 .
-}
{- |
[@AUTHOR@] Dr. Alistair Ward
[@DESCRIPTION@]
* Defines the fitness of a /timetable/ for the given configuration,
as required for selection within one generation of its evolution; .
-}
module WeekDaze.Implementation.TimetableFitness(
-- * Functions
-- calculateRatioOfSeparatedEqualLessonsWithinAnyDayCriterion,
-- measureDeviationFromMinimumConsecutiveLessonsCriterion,
-- measureLocationChangesOfTeachers,
evaluateFitness
) where
import Control.Arrow((&&&))
import Data.Map((!))
import qualified Control.Monad.Writer -- The lazy instance.
import qualified Data.Array.IArray
import qualified Data.Foldable
import qualified Data.Map
import qualified Data.Maybe
import qualified Data.Set
import qualified ToolShed.Data.List.Runlength
import qualified WeekDaze.Aggregate.StudentBody as Aggregate.StudentBody
import qualified WeekDaze.Data.Course as Data.Course
import qualified WeekDaze.Data.Requirements as Data.Requirements
import qualified WeekDaze.Dynamic.StudentViewTimetableUtilities as Dynamic.StudentViewTimetableUtilities
import qualified WeekDaze.Dynamic.TeacherViewTimetableUtilities as Dynamic.TeacherViewTimetableUtilities
import qualified WeekDaze.ExecutionConfiguration.Criterion as ExecutionConfiguration.Criterion
import qualified WeekDaze.ExecutionConfiguration.ExecutionOptions as ExecutionConfiguration.ExecutionOptions
import qualified WeekDaze.ExecutionConfiguration.TimetableCriteriaWeights as ExecutionConfiguration.TimetableCriteriaWeights
import qualified WeekDaze.Model.Timetable as Model.Timetable
import qualified WeekDaze.ProblemConfiguration.ProblemAnalysis as ProblemConfiguration.ProblemAnalysis
import qualified WeekDaze.ProblemConfiguration.ProblemParameters as ProblemConfiguration.ProblemParameters
import qualified WeekDaze.Size as Size
import qualified WeekDaze.StudentView.Timetable as StudentView.Timetable
import qualified WeekDaze.TeacherView.Timetable as TeacherView.Timetable
import qualified WeekDaze.Temporal.Day as Temporal.Day
{- |
* Counts the number of separated equal /lesson/s, occuring in any single /day/, across the whole /timetable/,
discounting those implied by the specified /time/s for the /course/ to which they belong.
* The number of such occurances is weighted by the number of /student/s in the body affected, & finally normalised to the unit-interval.
-}
calculateRatioOfSeparatedEqualLessonsWithinAnyDayCriterion :: (
Data.Array.IArray.Ix timeslotId,
Fractional criterionValue,
Ord level,
Ord locationId,
Ord synchronisationId,
Ord teacherId,
Real criterionValue
)
=> ProblemConfiguration.ProblemParameters.ProblemParameters campus level locationId stream synchronisationId teacherId teachingRatio timeslotId
-> ProblemConfiguration.ProblemAnalysis.ProblemAnalysis level locationId synchronisationId teacherId timeslotId
-> StudentView.Timetable.Timetable timeslotId locationId teacherId level
-> ExecutionConfiguration.Criterion.Criterion criterionValue
calculateRatioOfSeparatedEqualLessonsWithinAnyDayCriterion problemParameters problemAnalysis
| denominator == 0 = error "WeekDaze.Implementation.TimetableFitness.calculateRatioOfSeparatedEqualLessonsWithinAnyDayCriterion:\tattempt to divide by zero (time-slots)."
| otherwise = ExecutionConfiguration.Criterion.reflectUnitInterval "ratioOfSeparatedEqualLessonsWithinAnyDay" . (
/ fromIntegral denominator -- Normalise to the unit-interval.
) . fromIntegral . Data.Map.foldrWithKey (
\studentBody -> (+) . (
* Aggregate.StudentBody.getSize studentBody -- Weight according to the number of students affected.
) . foldr (
(+) . pred {-two is one too many-} . ToolShed.Data.List.Runlength.getLength
) 0 . filter (
(
`Data.Set.notMember` ProblemConfiguration.ProblemAnalysis.getCoursesRequestingSeparatedLessonsWithinAnyDay problemAnalysis -- No course specifying times, separated within a day, deprecates them; unless it's possible to join them using a contiguous span.
) . ProblemConfiguration.ProblemAnalysis.findCourseFor problemParameters . ToolShed.Data.List.Runlength.getDatum {-Lesson-}
)
) 0 . Model.Timetable.findSeparatedEqualLessonsWithinAnyDayByObserverId
where
denominator = (
ProblemConfiguration.ProblemAnalysis.getNTimeslotsPerDay problemAnalysis - 2 -- Concept doesn't exist until there're three timeslots/day.
) * ProblemConfiguration.ProblemAnalysis.getNAvailableDaysPerStudentTimetable problemAnalysis
{- |
* Totals over the whole /timetable/, the absolute deviation between the lengths of consecutive equal /lesson/s,
& the minimum specified for the corresponding /course/.
* /Course/s where 'Data.Course.getRequiredLessonsPerWeek' isn't an integral multiple of 'Data.Course.getMinimumConsecutiveLessons',
would show a discrepancy for all /lesson/s,
to avoid which, deviations smaller than half a /time-slot/ are ignored.
* The deviation is weighted by the number of /student/s in the body affected, & finally normalised to the unit-interval.
* When a /course/ specifies consecutive times, it is considered to tacitly approve runlengths of that magnitude.
* If (requiredLessonsPerWeek `div` minimumConsecutiveLessons) for the course > nAvailableDays for the student, then bookings long tranches is unavoidable.
This calculation is complicated because the /lesson/s which must be booked each day, (which may well exceed 'Data.Course.calculateIdealConsecutiveLessons'),
might be partitioned into shorter tranches by other /lesson/s or unallocated /time-slots/, thus reducing the runlength.
So in practice, there's typically no increase to 'Data.Course.calculateIdealConsecutiveLessons'.
-}
measureDeviationFromMinimumConsecutiveLessonsCriterion :: (
Data.Array.IArray.Ix timeslotId,
Enum timeslotId,
Eq locationId,
Fractional criterionValue,
Ord level,
Ord synchronisationId,
Ord teacherId,
Real criterionValue
)
=> ProblemConfiguration.ProblemParameters.ProblemParameters campus level locationId stream synchronisationId teacherId teachingRatio timeslotId
-> ProblemConfiguration.ProblemAnalysis.ProblemAnalysis level locationId synchronisationId teacherId timeslotId
-> StudentView.Timetable.Timetable timeslotId locationId teacherId level
-> ExecutionConfiguration.Criterion.Criterion criterionValue
measureDeviationFromMinimumConsecutiveLessonsCriterion problemParameters problemAnalysis
| denominator == 0 = error "WeekDaze.Implementation.TimetableFitness.measureDeviationFromMinimumConsecutiveLessonsCriterion:\tattempt to divide by zero (time-slots)."
| otherwise = ExecutionConfiguration.Criterion.reflectUnitInterval "ratioOfConsecutiveEqualLessons" . (
/ fromIntegral denominator -- Normalise to the unit-interval by dividing by the worse possible case.
) . fromIntegral . Data.Map.foldrWithKey (
\studentBody -> (+) . (
* Aggregate.StudentBody.getSize studentBody -- Weight the discrepancy according to the number of students affected.
) . Data.Foldable.foldr (
flip $ foldr (
\(_ {-timeslotId-}, generalisedLessonRunlengthCode) -> let
(runlength, generalisedLesson) = ToolShed.Data.List.Runlength.getLength &&& ToolShed.Data.List.Runlength.getDatum $ generalisedLessonRunlengthCode -- Deconstruct.
in Data.Maybe.maybe id (
\lesson -> let
course = ProblemConfiguration.ProblemAnalysis.findCourseFor problemParameters lesson
in if Data.Set.member runlength $ ProblemConfiguration.ProblemAnalysis.getDistinctRunlengthsOfSpecifiedTimesByCourse problemAnalysis ! course
then id -- No course which specifies consecutive times, of equal duration to that observed, can reasonably deprecate it.
else (
+ floor (
abs $ toRational runlength - Data.Course.calculateIdealConsecutiveLessons course -- Measure the absolute deviation, to prevent cancellation of deviations resulting from excess & deficit.
) -- If the ideal lies between two integers, then either is acceptable.
)
) generalisedLesson
)
) 0
) 0 . Model.Timetable.findGeneralisedLessonRunlengthsByTimeslotIdByDayByObserverId
where
denominator = pred {-concept doesn't exist until there're two timeslots/day-} (ProblemConfiguration.ProblemAnalysis.getNTimeslotsPerDay problemAnalysis) * ProblemConfiguration.ProblemAnalysis.getNAvailableDaysPerStudentTimetable problemAnalysis
{- |
* Gets the number of /location/-changes over all /teacher/s, normalised to the unit-interval.
* The minimum value of zero; is achieved either by a completely unbooked /timetable/, or by completely booking /lesson/s in the same /location/.
-}
measureLocationChangesOfTeachers :: (
Data.Array.IArray.Ix timeslotId,
Eq locationId,
Fractional mean
)
=> ProblemConfiguration.ProblemAnalysis.ProblemAnalysis level locationId synchronisationId teacherId timeslotId
-> TeacherView.Timetable.Timetable teacherId timeslotId locationId level
-> mean
measureLocationChangesOfTeachers problemAnalysis = (
/ fromIntegral (
ProblemConfiguration.ProblemAnalysis.getNTeachers {-counts only those offering a service-} problemAnalysis * pred {-fence-post-} (ProblemConfiguration.ProblemAnalysis.getNTimeslotsPerDay problemAnalysis * Temporal.Day.nDaysPerWeek)
)
) . fromIntegral . Data.Foldable.sum . TeacherView.Timetable.countLocationChangesByTeacherId
{- |
* Evaluates the fitness of the /timetable/ according to the /weighted mean/ of the /timetable-criteria/, which defines the direction of the evolutionary process.
* Also writes the value of each /timetable-criterion/, for post-analysis.
-}
evaluateFitness :: (
Data.Array.IArray.Ix timeslotId,
Enum criterionValue,
Enum timeslotId,
Eq campus,
Fractional criterionValue,
Fractional weightedMean,
Ord level,
Ord locationId,
Ord synchronisationId,
Ord teacherId,
Real criterionValue,
Real criterionWeight,
RealFrac teachingRatio,
Show level,
Show locationId,
Show teacherId,
Show timeslotId
)
=> ProblemConfiguration.ProblemParameters.ProblemParameters campus level locationId stream synchronisationId teacherId teachingRatio timeslotId
-> ExecutionConfiguration.ExecutionOptions.ExecutionOptions criterionWeight fecundityDecayRatio populationDiversityRatio
-> ProblemConfiguration.ProblemAnalysis.ProblemAnalysis level locationId synchronisationId teacherId timeslotId
-> StudentView.Timetable.Timetable timeslotId locationId teacherId level -- ^ The /timetable/ to evaluate.
-> Control.Monad.Writer.Writer [Maybe criterionValue] weightedMean -- ^ The fitness of the specified /timetable/, including the values of /timetable-criteria/ (where the weight is non-zero).
evaluateFitness problemParameters executionOptions problemAnalysis studentViewTimetable = ExecutionConfiguration.TimetableCriteriaWeights.calculateWeightedMean (
ExecutionConfiguration.ExecutionOptions.getTimetableCriteriaWeights executionOptions
) (
ExecutionConfiguration.Criterion.mkCriterion ExecutionConfiguration.TimetableCriteriaWeights.weightOfMaximiseComplianceWithFreePeriodPreferencesTag $ (
Dynamic.StudentViewTimetableUtilities.calculateMeanFreePeriodCompliance problemParameters studentViewTimetable + Dynamic.TeacherViewTimetableUtilities.calculateMeanFreePeriodCompliance problemParameters teacherViewTimetable
) / 2
) (
ExecutionConfiguration.Criterion.mkCriterion ExecutionConfiguration.TimetableCriteriaWeights.weightOfMaximiseMeanRatioOfStudentClassSizeToLocationCapacityTag $ Dynamic.TeacherViewTimetableUtilities.calculateMeanRatioOfStudentClassSizeToLocationCapacity problemParameters teacherViewTimetable
) (
ExecutionConfiguration.Criterion.mkCriterion ExecutionConfiguration.TimetableCriteriaWeights.weightOfMaximiseMeanStudentClassSizeTag $ TeacherView.Timetable.calculateMeanStudentClassSize teacherViewTimetable / fromIntegral (ProblemConfiguration.ProblemAnalysis.getNStudents problemAnalysis)
) (
ExecutionConfiguration.Criterion.reflectUnitInterval ExecutionConfiguration.TimetableCriteriaWeights.weightOfMaximiseSynchronisationOfSynchronisedCoursesTag $ Dynamic.TeacherViewTimetableUtilities.calculateRatioOfAsynchronousLessonsInSynchronisedCourses problemAnalysis teacherViewTimetable
) (
ExecutionConfiguration.Criterion.mkCriterion ExecutionConfiguration.TimetableCriteriaWeights.weightOfMaximiseWeightedMeanStudentBodyUtilisationRatioTag . realToFrac $ Dynamic.StudentViewTimetableUtilities.calculateWeightedMeanUtilisationRatio problemParameters problemAnalysis studentViewTimetable
) (
let
denominator = pred {-fence-post-} nTimeslotsPerDay -- Normalise to the unit-interval.
in if denominator == 0
then minBound -- Zero lessons have been booked for courses which define an ideal timeslotId; the concept is void.
else ExecutionConfiguration.Criterion.reflectUnitInterval ExecutionConfiguration.TimetableCriteriaWeights.weightOfMinimiseAverageAbsoluteDeviationFromIdealTimeslotRequestTag $ Dynamic.StudentViewTimetableUtilities.calculateAverageAbsoluteDeviationFromIdealTimeslotRequest problemParameters problemAnalysis studentViewTimetable / fromIntegral denominator
) (
ExecutionConfiguration.Criterion.reflectUnitInterval ExecutionConfiguration.TimetableCriteriaWeights.weightOfMinimiseDispersionOfStudentFreePeriodsPerDayTag . (
* (
2 / fromIntegral nTimeslotsPerDay
) -- Normalise to the unit-interval; the maximum average absolute deviation is half the number of timeslots per day.
) $ Model.Timetable.calculateAverageAbsoluteDeviationOfFreeLessonsPerDay (
ProblemConfiguration.ProblemParameters.getStudentBodyRegister problemParameters
) studentViewTimetable -- CAVEAT: ought to be weighted by the size of the student-body.
) (
ExecutionConfiguration.Criterion.reflectUnitInterval ExecutionConfiguration.TimetableCriteriaWeights.weightOfMinimiseDispersionOfTeacherFreePeriodsPerDayTag . (
* (
2 / fromIntegral nTimeslotsPerDay
) -- Normalise to the unit-interval; the maximum average absolute deviation is half the number of timeslots-per-day.
) $ Model.Timetable.calculateAverageAbsoluteDeviationOfFreeLessonsPerDay (ProblemConfiguration.ProblemParameters.getTeacherRegister problemParameters) teacherViewTimetable
) (
ExecutionConfiguration.Criterion.reflectUnitInterval ExecutionConfiguration.TimetableCriteriaWeights.weightOfMinimiseDispersionOfTeacherWorkloadTag . (
* 2 -- Normalise to the unit-interval; the maximum average absolute deviation in utilisation-ratio is 1/2.
) $ Dynamic.TeacherViewTimetableUtilities.calculateAverageAbsoluteDeviationInUtilisationRatio problemParameters problemAnalysis teacherViewTimetable
) (
ExecutionConfiguration.Criterion.invertWholeNumbersIntoUnitInterval ExecutionConfiguration.TimetableCriteriaWeights.weightOfMinimiseMeanInterCampusMigrationsOfStudentsTag . (
/ fromIntegral (
ProblemConfiguration.ProblemAnalysis.getNAvailableDaysPerStudentTimetable problemAnalysis * pred nTimeslotsPerDay -- The maximum possible number of migrations.
) -- Derive mean & normalise.
) . fromIntegral $ Dynamic.StudentViewTimetableUtilities.countInterCampusMigrations problemParameters studentViewTimetable
) (
ExecutionConfiguration.Criterion.invertWholeNumbersIntoUnitInterval ExecutionConfiguration.TimetableCriteriaWeights.weightOfMinimiseMeanInterCampusMigrationsOfTeachersTag . (
/ fromIntegral (
ProblemConfiguration.ProblemAnalysis.getNAvailableDaysPerTeacherTimetable problemAnalysis * pred nTimeslotsPerDay -- The maximum possible number of migrations.
) -- Derive mean & normalise.
) . fromIntegral $ Dynamic.TeacherViewTimetableUtilities.countInterCampusMigrations problemParameters teacherViewTimetable
) (
ExecutionConfiguration.Criterion.reflectUnitInterval ExecutionConfiguration.TimetableCriteriaWeights.weightOfMinimiseMeanLocationChangesOfTeachersTag $ measureLocationChangesOfTeachers problemAnalysis teacherViewTimetable -- CAVEAT: may conflict with 'minimiseRatioOfConsecutiveEqualLessons'.
) (
ExecutionConfiguration.Criterion.invertWholeNumbersIntoUnitInterval ExecutionConfiguration.TimetableCriteriaWeights.weightOfMinimiseMeanLocusOperandiOfTeachersTag $ StudentView.Timetable.calculateMeanLocusOperandiOfTeachers studentViewTimetable
) (
ExecutionConfiguration.Criterion.reflectUnitInterval ExecutionConfiguration.TimetableCriteriaWeights.weightOfMinimiseMeanRatioOfIncompletelyBookedCoreKnowledgeTag $ Data.Requirements.getCore meanRatioOfIncompletelyBookedKnowledgeRequirements
) (
ExecutionConfiguration.Criterion.reflectUnitInterval ExecutionConfiguration.TimetableCriteriaWeights.weightOfMinimiseMeanRatioOfIncompletelyBookedOptionalKnowledgeTag $ Data.Requirements.getOptional meanRatioOfIncompletelyBookedKnowledgeRequirements
) (
ExecutionConfiguration.Criterion.invertNaturalNumbersIntoUnitInterval ExecutionConfiguration.TimetableCriteriaWeights.weightOfMinimiseMeanStudentBodyCombinationsPerLessonTag $ StudentView.Timetable.calculateWeightedMeanStudentBodyCombinationsPerLesson studentViewTimetable -- CAVEAT: performance-hotspot.
) (
measureDeviationFromMinimumConsecutiveLessonsCriterion problemParameters problemAnalysis studentViewTimetable -- minimiseRatioOfConsecutiveEqualLessons.
) (
calculateRatioOfSeparatedEqualLessonsWithinAnyDayCriterion problemParameters problemAnalysis studentViewTimetable
) where
nTimeslotsPerDay :: Size.NTimeslots
nTimeslotsPerDay = ProblemConfiguration.ProblemAnalysis.getNTimeslotsPerDay problemAnalysis
teacherViewTimetable = Dynamic.TeacherViewTimetableUtilities.fromStudentViewTimetable executionOptions problemAnalysis studentViewTimetable
meanRatioOfIncompletelyBookedKnowledgeRequirements = Dynamic.StudentViewTimetableUtilities.findMeanRatioOfIncompletelyBookedKnowledgeRequirements problemParameters problemAnalysis studentViewTimetable