module WeekDaze.StudentView.Timetable(
InterCampusMigrationsByStudentBody,
LessonRunlengthByStudentBody,
Timetable,
StudentClassesByLesson,
Booking,
calculateMeanLocusOperandiOfTeachers,
calculateWeightedMeanStudentBodyCombinationsPerLesson,
extractStudentClassAt,
findDistinctLocationIdsFor,
findDistinctTeacherIdsFor,
findStudentClassesByLessonFor,
findStudentClassByTimeByLesson,
findStudentClassesByLesson,
getStudentBodies,
areBookedResourcesAt,
breaksRoutine,
toXHtml
) where
import Control.Arrow((&&&), (***))
import Data.Map((!))
import qualified Data.Array.IArray
import qualified Data.Map
import qualified Data.Maybe
import qualified Data.Set
import qualified Data.Tuple
import qualified Factory.Math.Statistics
import qualified Text.XHtml.Strict
import qualified ToolShed.Data.List
import qualified ToolShed.Data.List.Runlength
import qualified ToolShed.Data.Pair
import qualified WeekDaze.Aggregate.StudentBody as Aggregate.StudentBody
import qualified WeekDaze.Aggregate.StudentBodyRegister as Aggregate.StudentBodyRegister
import qualified WeekDaze.Aggregate.StudentClass as Aggregate.StudentClass
import qualified WeekDaze.Data.Course as Data.Course
import qualified WeekDaze.Data.HumanResource as Data.HumanResource
import qualified WeekDaze.Data.Location as Data.Location
import qualified WeekDaze.Data.Requirements as Data.Requirements
import qualified WeekDaze.Data.Student as Data.Student
import qualified WeekDaze.Data.Subject as Data.Subject
import qualified WeekDaze.LinearModel.Timetable as LinearModel.Timetable
import qualified WeekDaze.LinearModel.TimetableForWeek as LinearModel.TimetableForWeek
import qualified WeekDaze.Model.Lesson as Model.Lesson
import qualified WeekDaze.Model.Meeting as Model.Meeting
import qualified WeekDaze.Model.Timetable as Model.Timetable
import qualified WeekDaze.Model.TimetableCoordinates as Model.TimetableCoordinates
import qualified WeekDaze.Model.TimetableForWeek as Model.TimetableForWeek
import qualified WeekDaze.Size as Size
import qualified WeekDaze.StudentView.Lesson as StudentView.Lesson
import qualified WeekDaze.StudentView.LessonResourceIds as StudentView.LessonResourceIds
import qualified WeekDaze.StudentView.TimetableForWeek as StudentView.TimetableForWeek
import qualified WeekDaze.Temporal.Time as Temporal.Time
import qualified WeekDaze.Text.CSS as Text.CSS
import Text.XHtml.Strict((+++), (<<))
import WeekDaze.Text.XHTML()
type Timetable timeslotId locationId teacherId level = Model.Timetable.Timetable Aggregate.StudentBody.StudentBody timeslotId (StudentView.LessonResourceIds.LessonResourceIds locationId teacherId) level
getStudentBodies :: Timetable timeslotId locationId teacherId level -> [Aggregate.StudentBody.StudentBody]
getStudentBodies = Data.Map.keys
extractBookedResourceIdsAt
:: Data.Array.IArray.Ix timeslotId
=> Temporal.Time.Time timeslotId
-> Timetable timeslotId locationId teacherId level
-> ([locationId], [teacherId])
extractBookedResourceIdsAt time = foldr (
\lesson (l, t) -> (: l) . StudentView.LessonResourceIds.getLocationId &&& (: t) . StudentView.LessonResourceIds.getTeacherId $ Model.Lesson.getResourceIds lesson
) ([], []) . Model.Timetable.extractSynchronousLessonsAt time
areBookedResourcesAt :: (
Data.Array.IArray.Ix timeslotId,
Eq locationId,
Eq teacherId
)
=> StudentView.TimetableForWeek.Booking timeslotId locationId teacherId level
-> Timetable timeslotId locationId teacherId level
-> Bool
areBookedResourcesAt studentViewBooking = uncurry (||) . (
elem (StudentView.LessonResourceIds.getLocationId resourceIds) *** elem (StudentView.LessonResourceIds.getTeacherId resourceIds)
) . extractBookedResourceIdsAt (Model.TimetableForWeek.getBookedTime studentViewBooking) where
resourceIds = Model.Lesson.getResourceIds $ Model.TimetableForWeek.getBookedLesson studentViewBooking
extractStudentClassAt :: (
Data.Array.IArray.Ix timeslotId,
Eq level,
Eq locationId,
Eq teacherId
)
=> StudentView.TimetableForWeek.Booking timeslotId locationId teacherId level
-> Timetable timeslotId locationId teacherId level
-> Aggregate.StudentClass.StudentClass
extractStudentClassAt studentViewBooking = Data.Map.foldrWithKey (
\studentBody studentViewTimetableForWeek -> case Model.TimetableForWeek.getMaybeLesson (Model.TimetableForWeek.getBookedTime studentViewBooking) studentViewTimetableForWeek of
Just studentViewLesson'
| studentViewLesson' == Model.TimetableForWeek.getBookedLesson studentViewBooking -> Data.Set.insert studentBody
| otherwise -> id
_ -> id
) Data.Set.empty
extractRoutineForStudentBodyBySubject :: (
Data.Array.IArray.Ix timeslotId,
Ord level,
Ord locationId,
Ord teacherId
)
=> Timetable timeslotId locationId teacherId level
-> Aggregate.StudentBody.StudentBody
-> Data.Map.Map (Data.Subject.Subject level) (Data.Set.Set (StudentView.LessonResourceIds.LessonResourceIds locationId teacherId))
extractRoutineForStudentBodyBySubject timetable = StudentView.TimetableForWeek.extractRoutineBySubject . (timetable !)
breaksRoutine :: (
Data.Array.IArray.Ix timeslotId,
Ord level,
Ord locationId,
Ord teacherId
)
=> Timetable timeslotId locationId teacherId level
-> Aggregate.StudentBody.StudentBody
-> StudentView.Lesson.Lesson locationId teacherId level
-> Bool
breaksRoutine timetable studentBody = uncurry (
Data.Maybe.maybe False
) . (
Data.Set.notMember . Model.Lesson.getResourceIds &&& (`Data.Map.lookup` extractRoutineForStudentBodyBySubject timetable studentBody) . Model.Lesson.getSubject
)
findDistinctLocationIdsFor :: (
Data.Array.IArray.Ix timeslotId,
Eq teacherId,
Ord locationId
)
=> teacherId
-> Timetable timeslotId locationId teacherId level
-> Data.Location.Locus locationId
findDistinctLocationIdsFor teacherId = foldr (
Data.Set.insert . StudentView.LessonResourceIds.getLocationId
) Data.Set.empty . filter (
(== teacherId) . StudentView.LessonResourceIds.getTeacherId
) . map Model.Lesson.getResourceIds . Model.Timetable.extractLessons
findDistinctTeacherIdsFor :: (
Data.Array.IArray.Ix timeslotId,
Eq locationId,
Ord teacherId
)
=> locationId
-> Timetable timeslotId locationId teacherId level
-> Data.Set.Set teacherId
findDistinctTeacherIdsFor locationId = foldr (
Data.Set.insert . StudentView.LessonResourceIds.getTeacherId
) Data.Set.empty . filter (
(== locationId) . StudentView.LessonResourceIds.getLocationId
) . map Model.Lesson.getResourceIds . Model.Timetable.extractLessons
calculateMeanLocusOperandiOfTeachers :: (
Data.Array.IArray.Ix timeslotId,
Fractional mean,
Ord locationId,
Ord teacherId
) => Timetable timeslotId locationId teacherId level -> mean
calculateMeanLocusOperandiOfTeachers timetable
| Data.Map.null distinctLocationsByTeacherId = 0
| otherwise = Factory.Math.Statistics.getMean $ Data.Map.map Data.Set.size distinctLocationsByTeacherId
where
distinctLocationsByTeacherId = foldr (
uncurry (Data.Map.insertWith Data.Set.union) . (
StudentView.LessonResourceIds.getTeacherId &&& Data.Set.singleton . StudentView.LessonResourceIds.getLocationId
) . Model.Lesson.getResourceIds
) Data.Map.empty $ Model.Timetable.extractLessons timetable
type StudentClassesByLesson locationId teacherId level = Data.Map.Map (StudentView.Lesson.Lesson locationId teacherId level) (Data.Set.Set Aggregate.StudentClass.StudentClass)
findStudentClassesByLessonFor :: (
Data.Array.IArray.Ix timeslotId,
Ord level,
Ord locationId,
Ord teacherId
)
=> Timetable timeslotId locationId teacherId level
-> Aggregate.StudentBody.StudentBody
-> StudentClassesByLesson locationId teacherId level
findStudentClassesByLessonFor timetable = foldr (
\booking -> Data.Map.insertWith Data.Set.union (
Model.TimetableForWeek.getBookedLesson booking
) . Data.Set.singleton $ extractStudentClassAt booking timetable
) Data.Map.empty . LinearModel.TimetableForWeek.fromTimetableForWeek . (timetable !)
findStudentClassByTimeByLesson :: (
Data.Array.IArray.Ix timeslotId,
Ord level,
Ord locationId,
Ord teacherId
) => Timetable timeslotId locationId teacherId level -> Data.Map.Map (StudentView.Lesson.Lesson locationId teacherId level) (Data.Map.Map (Temporal.Time.Time timeslotId) Aggregate.StudentClass.StudentClass)
findStudentClassByTimeByLesson = foldr (
uncurry (
Data.Map.insertWith $ Data.Map.unionWith Data.Set.union
) . (
Model.Timetable.getBookedLesson &&& uncurry Data.Map.singleton . (
Model.TimetableCoordinates.getTime &&& Data.Set.singleton . Model.TimetableCoordinates.getObserverId
) . Model.Timetable.getBookedCoordinates
)
) Data.Map.empty . LinearModel.Timetable.fromTimetable
findStudentClassesByLesson :: (
Data.Array.IArray.Ix timeslotId,
Ord level,
Ord locationId,
Ord teacherId
) => Timetable timeslotId locationId teacherId level -> StudentClassesByLesson locationId teacherId level
findStudentClassesByLesson = Data.Map.map (
Data.Set.fromList . Data.Map.elems
) . findStudentClassByTimeByLesson
calculateWeightedMeanStudentBodyCombinationsPerLesson :: (
Data.Array.IArray.Ix timeslotId,
Fractional weightedMean,
Ord level,
Ord locationId,
Ord teacherId
) => Timetable timeslotId locationId teacherId level -> weightedMean
calculateWeightedMeanStudentBodyCombinationsPerLesson timetable
| denominator == 0 = 1
| otherwise = fromIntegral numerator / fromIntegral denominator
where
(numerator, denominator) = Data.Map.foldr (
\studentClassSet pair -> if Data.Set.size studentClassSet == 1
then ToolShed.Data.Pair.mirror (
+ Aggregate.StudentClass.getSize (Data.Set.findMin studentClassSet)
) pair
else Data.Set.foldr (
\studentBody -> let
(memberOfNStudentClasses, weight) = Data.Set.size . (
`Data.Set.filter` studentClassSet
) . Data.Set.member &&& Aggregate.StudentBody.getSize $ studentBody
in (+ memberOfNStudentClasses * weight) *** (+ weight)
) pair . Data.Set.unions $ Data.Set.elems studentClassSet
) (0, 0) $ findStudentClassesByLesson timetable
type InterCampusMigrationsByStudentBody = Data.Map.Map Aggregate.StudentBody.StudentBody Size.NTimeslots
type LessonRunlengthByStudentBody timeslotId locationId teacherId level = Data.Map.Map Aggregate.StudentBody.StudentBody [(Temporal.Time.Time timeslotId, ToolShed.Data.List.Runlength.Code (StudentView.Lesson.Lesson locationId teacherId level))]
toXHtml :: (
Data.Array.IArray.Ix timeslotId,
Fractional minimumContrastRatio,
Ord level,
Ord locationId,
Ord minimumContrastRatio,
Ord teacherId,
RealFrac teachingRatio,
Show level,
Show locationId,
Show stream,
Show teacherId,
Text.XHtml.Strict.HTML level,
Text.XHtml.Strict.HTML locationId,
Text.XHtml.Strict.HTML stream,
Text.XHtml.Strict.HTML synchronisationId,
Text.XHtml.Strict.HTML teacherId,
Text.XHtml.Strict.HTML timeslotId
)
=> InterCampusMigrationsByStudentBody
-> Data.Requirements.Requirements (Aggregate.StudentBodyRegister.KnowledgeByStudentBody level)
-> LessonRunlengthByStudentBody timeslotId locationId teacherId level
-> LessonRunlengthByStudentBody timeslotId locationId teacherId level
-> Size.NTimeslots
-> (StudentView.Lesson.Lesson locationId teacherId level -> Data.Course.Course synchronisationId level timeslotId)
-> Aggregate.StudentBodyRegister.StudentBodyRegister level stream teachingRatio
-> Model.Timetable.GenericTimetableToMarkup locationId minimumContrastRatio teacherId timeslotId (Timetable timeslotId locationId teacherId level)
toXHtml interCampusMigrationsByStudentBody unbookedKnowledgeRequirementsByStudentBody excessivelyLongSessionsByStudentBody shortSessionsByStudentBody nTimeslotsPerDay findCourseFor studentBodyRegister displaySupplementaryInformation meetingsByTime htmlMergeDuplicateTimeslots displayAxisLabels weekend maybeGenerateLessonColourFrom timetable = Text.XHtml.Strict.defList . map (
\(studentBody, timetableForWeek) -> let
(studentProfile, (excessivelyLongSessions, shortSessions)) = (studentBodyRegister !) &&& ((excessivelyLongSessionsByStudentBody !) &&& (shortSessionsByStudentBody !)) $ studentBody
in (
Text.XHtml.Strict.unordList (
Text.XHtml.Strict.toHtml studentBody : if displaySupplementaryInformation
then Data.Maybe.catMaybes [
let
nInterCampusMigrations = interCampusMigrationsByStudentBody ! studentBody
in if nInterCampusMigrations == 0
then Nothing
else Just $ Text.XHtml.Strict.thediv Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.warningCSSIdentifier,
Text.XHtml.Strict.title "The number of inter-campus migrations required by these students."
] << (
"Inter-campus migrations" +++ Text.XHtml.Strict.spaceHtml +++ '=' +++ Text.XHtml.Strict.spaceHtml +++ Text.XHtml.Strict.thespan Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.numericDataCSSIdentifier
] << nInterCampusMigrations
),
let
stream = Data.Student.getStream studentProfile
in if any ($ show stream) [null, (== "\"\"")]
then Nothing
else Just $ Text.XHtml.Strict.thespan Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.infoCSSIdentifier,
Text.XHtml.Strict.title "The year/stream for this student-body."
] << (
"Stream" +++ Text.XHtml.Strict.spaceHtml +++ '=' +++ Text.XHtml.Strict.spaceHtml +++ Text.XHtml.Strict.thespan Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.dataCSSIdentifier
] << stream
),
(
(
Text.XHtml.Strict.thediv Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.warningCSSIdentifier,
Text.XHtml.Strict.title "Any core knowledge-requirements for this student-body, which are incompletely booked."
] <<
) . (
"Incomplete core knowledge-requirements" +++
) . (
Text.XHtml.Strict.thediv Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.dataCSSIdentifier
] <<
) . Text.XHtml.Strict.unordList . Data.Set.toAscList
) `fmap` Data.Map.lookup studentBody (
Data.Requirements.getCore unbookedKnowledgeRequirementsByStudentBody
),
(
(
Text.XHtml.Strict.thediv Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.warningCSSIdentifier,
Text.XHtml.Strict.title "Any optional knowledge-requirements for this student-body, which are incompletely booked."
] <<
) . (
"Incomplete optional knowledge-requirements:" +++
) . (
Text.XHtml.Strict.thediv Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.dataCSSIdentifier
] <<
) . Text.XHtml.Strict.unordList . Data.Set.toAscList
) `fmap` Data.Map.lookup studentBody (
Data.Requirements.getOptional unbookedKnowledgeRequirementsByStudentBody
),
Just $ Text.XHtml.Strict.thespan Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.infoCSSIdentifier,
Text.XHtml.Strict.title "Time allocated to teaching / time available for teaching."
] << (
"Utilisation-ratio" +++ Text.XHtml.Strict.spaceHtml +++ '=' +++ Text.XHtml.Strict.spaceHtml +++ Text.XHtml.Strict.thespan Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.numericDataCSSIdentifier
] << (
round $ 100 * (
Model.TimetableForWeek.calculateUtilisationRatio nTimeslotsPerDay studentProfile timetableForWeek ::Rational
) :: Int
) +++ '%'
),
let
nFreePeriods :: Size.NTimeslots
nFreePeriods = Model.TimetableForWeek.countUnallocatedAvailableTimeslots studentProfile timetableForWeek - Data.HumanResource.getNTimeslotsPerWeekOfNonTeaching nTimeslotsPerDay studentProfile
in if nFreePeriods == 0
then Nothing
else Just $ Text.XHtml.Strict.thespan Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.warningCSSIdentifier,
Text.XHtml.Strict.title "The number of available but unallocated time-slots, excluding those allocated to free study & meetings, multiplied by the size of the student-body."
] << (
"Free-periods" +++ Text.XHtml.Strict.spaceHtml +++ '=' +++ Text.XHtml.Strict.spaceHtml +++ Text.XHtml.Strict.thespan Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.numericDataCSSIdentifier
] << nFreePeriods +++ Text.XHtml.Strict.primHtmlChar "times" +++ Text.XHtml.Strict.thespan Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.numericDataCSSIdentifier
] << Aggregate.StudentBody.getSize studentBody
),
let
separatedEqualSubjectLessons = Model.TimetableForWeek.findSeparatedEqualSubjectLessonsWithinAnyDay timetableForWeek
in if null separatedEqualSubjectLessons
then Nothing
else Just $ Text.XHtml.Strict.thediv Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.warningCSSIdentifier,
Text.XHtml.Strict.title "The number of instances of separated sessions in the same subject, in any single day."
] << (
"Split sessions:" +++ Text.XHtml.Strict.unordList (
map (
uncurry (+++) . Data.Tuple.swap . (
(
((Text.XHtml.Strict.spaceHtml +++ Text.XHtml.Strict.primHtmlChar "Implies" +++ Text.XHtml.Strict.spaceHtml) +++) . Text.XHtml.Strict.thespan Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.numericDataCSSIdentifier
] <<
) . pred *** Model.Lesson.getSubject
)
) separatedEqualSubjectLessons
)
),
if null excessivelyLongSessions
then Nothing
else Just $ Text.XHtml.Strict.thediv Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.warningCSSIdentifier,
Text.XHtml.Strict.title "Some subjects have been booked in longer sessions than necessary (and therefore also longer than requested)."
] << (
"Long sessions:" +++ (
Text.XHtml.Strict.thediv Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.dataCSSIdentifier
] << Text.XHtml.Strict.unordList (
ToolShed.Data.List.nub' $ map (
Model.Lesson.getSubject . ToolShed.Data.List.Runlength.getDatum . snd
) excessivelyLongSessions
)
)
),
if null shortSessions
then Nothing
else Just $ Text.XHtml.Strict.thediv Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.warningCSSIdentifier,
Text.XHtml.Strict.title "Some subjects have been booked in shorter sessions than requested."
] << (
"Short sessions:" +++ (
Text.XHtml.Strict.thediv Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.dataCSSIdentifier
] << Text.XHtml.Strict.unordList (
ToolShed.Data.List.nub' $ map (
Model.Lesson.getSubject . ToolShed.Data.List.Runlength.getDatum . snd
) shortSessions
)
)
),
let
studentBodyCombinationsByLesson = Data.Map.filter ((> 1) . Data.Set.size) $ findStudentClassesByLessonFor timetable studentBody
in if Data.Map.null studentBodyCombinationsByLesson
then Nothing
else Just $ Text.XHtml.Strict.thediv Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.warningCSSIdentifier,
Text.XHtml.Strict.title "Those subjects studied with different combinations of student-bodies."
] << (
"Student-body combinations:" +++ Text.XHtml.Strict.unordList (
map (
uncurry (+++) . (
Model.Lesson.getSubject *** (
((Text.XHtml.Strict.spaceHtml +++ Text.XHtml.Strict.primHtmlChar "Implies" +++ Text.XHtml.Strict.spaceHtml) +++) . Text.XHtml.Strict.thespan Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.numericDataCSSIdentifier,
Text.XHtml.Strict.title "Number of combinations."
] <<
) . Data.Set.size
)
) $ Data.Map.toList studentBodyCombinationsByLesson
)
)
]
else []
) Text.XHtml.Strict.! [Text.XHtml.Strict.theclass Text.CSS.observerSummaryCSSIdentifier],
Model.TimetableForWeek.toXHtml findCourseFor studentProfile (Model.Meeting.deleteStudentBody studentBody meetingsByTime) htmlMergeDuplicateTimeslots displayAxisLabels weekend maybeGenerateLessonColourFrom timetableForWeek
)
) $ Data.Map.toList timetable
type Booking timeslotId locationId teacherId level = Model.Timetable.Booking Aggregate.StudentBody.StudentBody timeslotId (StudentView.LessonResourceIds.LessonResourceIds locationId teacherId) level