module WeekDaze.Model.Timetable(
Timetable,
AugmentMarkup,
GenericTimetableToMarkup,
Booking,
Wrapper(
MkWrapper,
deconstruct
),
tag,
calculateAverageAbsoluteDeviationOfFreeLessonsPerDay,
calculateUtilisationRatioByObserverId,
locateUnallocatedAvailableUnreservedCoordinates,
findGeneralisedLessonRunlengthsByTimeslotIdByDayByObserverId,
findGeneralisedLessonRunlengthsByCoordinates,
findSeparatedEqualLessonsWithinAnyDayByObserverId,
findSeparatedEqualLessonRunlengthsByStartingTimeslotIdByLessonByDayByObserverId,
countLessons,
countUnallocatedAvailableTimeslots,
extractLessons,
extractCoordinates,
extractDistinctLessons,
extractSynchronousLessonsAt,
calculateMeanFreePeriodCompliance,
mkFreeTimetable,
getMaybeLesson,
getBookedCoordinates,
getBookedLesson,
defineTimeslot,
undefineTimeslot,
undefineTimeslots,
undefineTimeslotsFor,
purge,
isDefinedTimeslot,
areMergeableWith,
hasMatchingLessonAt,
isBookedWith,
toGeneralisedBooking
) where
import Control.Arrow((&&&))
import Data.Map((!))
import qualified Control.Arrow
import qualified Data.Array.IArray
import qualified Data.Foldable
import qualified Data.Map
import qualified Data.Maybe
import qualified Data.Set
import qualified Factory.Data.Interval
import qualified Factory.Math.Statistics
import qualified Text.XML.HXT.Arrow.Pickle as HXT
import qualified WeekDaze.Data.HumanResource as Data.HumanResource
import qualified WeekDaze.Data.Resource as Data.Resource
import qualified WeekDaze.Model.GeneralisedBooking as Model.GeneralisedBooking
import qualified WeekDaze.Model.Lesson as Model.Lesson
import qualified WeekDaze.Model.ResourceUser as Model.ResourceUser
import qualified WeekDaze.Model.TimetableCoordinates as Model.TimetableCoordinates
import qualified WeekDaze.Model.TimetableForDay as Model.TimetableForDay
import qualified WeekDaze.Model.TimetableForWeek as Model.TimetableForWeek
import qualified WeekDaze.Size as Size
import qualified WeekDaze.Temporal.Time as Temporal.Time
tag :: String
tag = "timetable"
observerIdTag :: String
observerIdTag = "observerId"
observerIdToTimetableAssociationTag :: String
observerIdToTimetableAssociationTag = "observerIdToTimetableAssociation"
type Timetable observerId timeslotId resourceIds level = Data.Map.Map observerId (Model.TimetableForWeek.TimetableForWeek timeslotId resourceIds level)
type AugmentMarkup = Bool
type GenericTimetableToMarkup locationId minimumContrastRatio teacherId timeslotId timetable = AugmentMarkup -> Model.TimetableForWeek.GenericTimetableToMarkup' locationId minimumContrastRatio teacherId timeslotId timetable
mkFreeTimetable :: (
Data.Array.IArray.Ix timeslotId,
Enum timeslotId,
Ord observerId
)
=> [observerId]
-> Factory.Data.Interval.Interval timeslotId
-> Timetable observerId timeslotId resourceIds level
mkFreeTimetable observerIds = Data.Map.fromList . zip observerIds . repeat . Model.TimetableForWeek.mkFreeTimetableForWeek
getMaybeLesson
:: (Data.Array.IArray.Ix timeslotId, Ord observerId)
=> Model.TimetableCoordinates.Coordinates observerId timeslotId
-> Timetable observerId timeslotId resourceIds level
-> Model.Lesson.GeneralisedLesson resourceIds level
getMaybeLesson (observerId, time) = Model.TimetableForWeek.getMaybeLesson time . (! observerId)
isDefinedTimeslot
:: (Data.Array.IArray.Ix timeslotId, Ord observerId)
=> Model.TimetableCoordinates.Coordinates observerId timeslotId
-> Timetable observerId timeslotId resourceIds level
-> Bool
isDefinedTimeslot coordinates = Data.Maybe.isJust . getMaybeLesson coordinates
extractSynchronousLessonsAt
:: Data.Array.IArray.Ix timeslotId
=> Temporal.Time.Time timeslotId
-> Timetable observerId timeslotId resourceIds level
-> [Model.Lesson.Lesson resourceIds level]
extractSynchronousLessonsAt time = Data.Map.foldr (Data.Maybe.maybe id (:) . Model.TimetableForWeek.getMaybeLesson time) []
extractLessons :: Data.Array.IArray.Ix timeslotId => Timetable observerId timeslotId resourceIds level -> [Model.Lesson.Lesson resourceIds level]
extractLessons = Data.Foldable.concatMap Model.TimetableForWeek.extractLessons
extractCoordinates :: Data.Array.IArray.Ix timeslotId => Timetable observerId timeslotId resourceIds level -> [Model.TimetableCoordinates.Coordinates observerId timeslotId]
extractCoordinates timetable = [
(observerId, time) |
(observerId, timetableForWeek) <- Data.Map.toList timetable,
time <- Model.TimetableForWeek.extractTimes timetableForWeek
]
extractDistinctLessons :: (
Data.Array.IArray.Ix timeslotId,
Ord resourceIds,
Ord level
) => Timetable observerId timeslotId resourceIds level -> Data.Set.Set (Model.Lesson.Lesson resourceIds level)
extractDistinctLessons = Data.Set.fromList . extractLessons
defineTimeslot
:: (Data.Array.IArray.Ix timeslotId, Ord observerId)
=> Model.GeneralisedBooking.GeneralisedBooking observerId timeslotId resourceIds level
-> Timetable observerId timeslotId resourceIds level
-> Timetable observerId timeslotId resourceIds level
defineTimeslot ((observerId, time), maybeLesson) timetable = Data.Map.insert observerId (Model.TimetableForWeek.defineTimeslot (time, maybeLesson) $ timetable ! observerId) timetable
undefineTimeslot
:: (Data.Array.IArray.Ix timeslotId, Ord observerId)
=> Model.TimetableCoordinates.Coordinates observerId timeslotId
-> Timetable observerId timeslotId resourceIds level
-> Timetable observerId timeslotId resourceIds level
undefineTimeslot coordinates = defineTimeslot (coordinates, Nothing)
undefineTimeslots :: (
Data.Array.IArray.Ix timeslotId,
Data.Foldable.Foldable foldable,
Ord observerId
)
=> Timetable observerId timeslotId resourceIds level
-> foldable (Model.TimetableCoordinates.Coordinates observerId timeslotId)
-> Timetable observerId timeslotId resourceIds level
undefineTimeslots = Data.Foldable.foldr $ defineTimeslot . flip (,) Nothing
undefineTimeslotsFor :: (
Data.Array.IArray.Ix timeslotId,
Data.Foldable.Foldable foldable,
Ord observerId
)
=> observerId
-> Timetable observerId timeslotId resourceIds level
-> foldable (Temporal.Time.Time timeslotId)
-> Timetable observerId timeslotId resourceIds level
undefineTimeslotsFor observerId timetable = ($ timetable) . Data.Map.insert observerId . Model.TimetableForWeek.undefineTimeslots (timetable ! observerId)
purge :: (
Data.Array.IArray.Ix timeslotId,
Enum timeslotId,
Ord observerId
) => Timetable observerId timeslotId resourceIds level -> Timetable observerId timeslotId resourceIds level
purge timetable
| Data.Map.null timetable = timetable
| otherwise = mkFreeTimetable (
Data.Map.keys timetable
) . Data.Array.IArray.bounds . (
Data.Array.IArray.! minBound
) . snd $ Data.Map.findMin timetable
findGeneralisedLessonRunlengthsByTimeslotIdByDayByObserverId :: (
Data.Array.IArray.Ix timeslotId,
Enum timeslotId,
Eq resourceIds,
Eq level
) => Timetable observerId timeslotId resourceIds level -> Data.Map.Map observerId (Model.TimetableForWeek.GeneralisedLessonRunlengthByTimeslotIdByDay timeslotId resourceIds level)
findGeneralisedLessonRunlengthsByTimeslotIdByDayByObserverId = Data.Map.map Model.TimetableForWeek.findGeneralisedLessonRunlengthsByTimeslotIdByDay
findGeneralisedLessonRunlengthsByCoordinates :: (
Data.Array.IArray.Ix timeslotId,
Enum timeslotId,
Eq resourceIds,
Eq level
) => Timetable observerId timeslotId resourceIds level -> [(Model.TimetableCoordinates.Coordinates observerId timeslotId, Model.TimetableForDay.GeneralisedLessonRunlength resourceIds level)]
findGeneralisedLessonRunlengthsByCoordinates timetable = [
((observerId, Temporal.Time.mkTime day startingTimeslotId), runlengthCode) |
(observerId, generalisedLessonRunlengthsByTimeslotIdByDay) <- Data.Map.toList $ findGeneralisedLessonRunlengthsByTimeslotIdByDayByObserverId timetable,
(day, generalisedLessonRunlengthsByTimeslotId) <- Data.Array.IArray.assocs generalisedLessonRunlengthsByTimeslotIdByDay,
(startingTimeslotId, runlengthCode) <- generalisedLessonRunlengthsByTimeslotId
]
findSeparatedEqualLessonsWithinAnyDayByObserverId :: (
Data.Array.IArray.Ix timeslotId,
Ord level,
Ord resourceIds
) => Timetable observerId timeslotId resourceIds level -> Data.Map.Map observerId (Model.TimetableForDay.LessonRunlengths resourceIds level)
findSeparatedEqualLessonsWithinAnyDayByObserverId = Data.Map.map Model.TimetableForWeek.findSeparatedEqualLessonsWithinAnyDay
findSeparatedEqualLessonRunlengthsByStartingTimeslotIdByLessonByDayByObserverId :: (
Data.Array.IArray.Ix timeslotId,
Ord level,
Ord resourceIds
) => Timetable observerId timeslotId resourceIds level -> Data.Map.Map observerId (Model.TimetableForWeek.RunlengthsByTimeslotIdByLessonByDay resourceIds level timeslotId)
findSeparatedEqualLessonRunlengthsByStartingTimeslotIdByLessonByDayByObserverId = Data.Map.map Model.TimetableForWeek.findSeparatedEqualLessonRunlengthsByStartingTimeslotIdByLessonByDay
countLessons :: Data.Array.IArray.Ix timeslotId => Timetable observerId timeslotId resourceIds level -> Size.NTimeslots
countLessons = length . extractLessons
locateUnallocatedAvailableCoordinates :: (
Data.Array.IArray.Ix timeslotId,
Data.Resource.Resource resource,
Ord observerId
)
=> Data.Resource.ResourceMap observerId resource
-> Timetable observerId timeslotId resourceIds level
-> Model.TimetableCoordinates.Vector observerId timeslotId
locateUnallocatedAvailableCoordinates resourceMap timetable = [
(observerId, unallocatedAvailableTime) |
(observerId, timetableForWeek) <- Data.Map.toList timetable,
unallocatedAvailableTime <- Model.TimetableForWeek.locateUnallocatedAvailableTimes (resourceMap ! observerId) timetableForWeek
]
locateUnallocatedAvailableUnreservedCoordinates :: (
Data.Array.IArray.Ix timeslotId,
Data.Resource.Resource resource,
Ord observerId
)
=> Data.Map.Map (Temporal.Time.Time timeslotId) (Data.Set.Set observerId)
-> Data.Resource.ResourceMap observerId resource
-> Timetable observerId timeslotId resourceIds level
-> Model.TimetableCoordinates.Vector observerId timeslotId
locateUnallocatedAvailableUnreservedCoordinates observerIdsBookedForMeetingByTime resourceMap = filter (
uncurry (
Data.Maybe.maybe True
) . (
Data.Set.notMember . Model.TimetableCoordinates.getObserverId &&& (`Data.Map.lookup` observerIdsBookedForMeetingByTime) . Model.TimetableCoordinates.getTime
)
) . locateUnallocatedAvailableCoordinates resourceMap
countUnallocatedAvailableTimeslots :: (
Data.Array.IArray.Ix timeslotId,
Data.Resource.Resource resource,
Ord observerId
)
=> Data.Resource.ResourceMap observerId resource
-> Timetable observerId timeslotId resourceIds level
-> Size.NTimeslots
countUnallocatedAvailableTimeslots resourceMap = length . locateUnallocatedAvailableCoordinates resourceMap
calculateAverageAbsoluteDeviationOfFreeLessonsPerDay :: (
Data.Array.IArray.Ix timeslotId,
Data.Resource.Resource resource,
Fractional average,
Ord observerId
)
=> Data.Resource.ResourceMap observerId resource
-> Timetable observerId timeslotId resourceIds level
-> average
calculateAverageAbsoluteDeviationOfFreeLessonsPerDay resourceMap timetable
| Data.Map.null timetable = 0
| otherwise = Factory.Math.Statistics.getMean $ Data.Map.mapWithKey (
\observerId timetableForWeek -> Model.TimetableForWeek.calculateAverageAbsoluteDeviationOfFreeLessonsPerDay (resourceMap ! observerId) timetableForWeek :: Rational
) timetable
calculateUtilisationRatioByObserverId :: (
Data.Array.IArray.Ix timeslotId,
Data.HumanResource.HumanResource resource,
Fractional teachingRatio,
Ord observerId
)
=> Data.Resource.ResourceMap observerId resource
-> Size.NTimeslots
-> Timetable observerId timeslotId resourceIds level
-> Data.Map.Map observerId teachingRatio
calculateUtilisationRatioByObserverId resourceMap nTimeslotsPerDay = Data.Map.mapWithKey (Model.TimetableForWeek.calculateUtilisationRatio nTimeslotsPerDay . (resourceMap !))
areMergeableWith :: (
Data.Array.IArray.Ix timeslotId,
Eq resourceIds,
Eq level,
Model.ResourceUser.ResourceUser resourceIds
)
=> Model.TimetableForWeek.Booking timeslotId resourceIds level
-> Timetable observerId timeslotId resourceIds level
-> Bool
areMergeableWith booking = Model.ResourceUser.areMergeableWith (Model.TimetableForWeek.getBookedLesson booking) . extractSynchronousLessonsAt (Model.TimetableForWeek.getBookedTime booking)
calculateMeanFreePeriodCompliance :: (
Data.Array.IArray.Ix timeslotId,
Data.HumanResource.HumanResource humanResource,
Data.Resource.Resource humanResource,
Fractional ratio,
Ord observerId
)
=> Data.Resource.ResourceMap observerId humanResource
-> (humanResource -> Temporal.Time.TimeSet timeslotId)
-> Timetable observerId timeslotId resourceIds level
-> ratio
calculateMeanFreePeriodCompliance humanResourceMap getMeetingTimes timetable
| null ratios = 1
| otherwise = Factory.Math.Statistics.getMean ratios
where
ratios = [
compliantPortionOfDay :: Rational |
(observerId, timetableForWeek) <- Data.Map.toList timetable,
let profile = humanResourceMap ! observerId,
compliantPortionOfDay <- Data.Maybe.maybe [] (
\freePeriodPreference -> Model.TimetableForWeek.getFreePeriodCompliance freePeriodPreference (
Temporal.Time.categoriseByDay $ getMeetingTimes profile
) profile timetableForWeek
) $ Data.HumanResource.getMaybeFreePeriodPreference profile
]
newtype Wrapper observerId timeslotId resourceIds level = MkWrapper {
deconstruct :: Timetable observerId timeslotId resourceIds level
}
instance (
Data.Array.IArray.Ix timeslotId,
HXT.XmlPickler level,
HXT.XmlPickler observerId,
HXT.XmlPickler resourceIds,
HXT.XmlPickler timeslotId,
Ord observerId,
Show level
) => HXT.XmlPickler (Wrapper observerId timeslotId resourceIds level) where
xpickle = HXT.xpElem tag . HXT.xpWrap (
MkWrapper . Data.Map.fromList,
Data.Map.toList . deconstruct
) . HXT.xpList1 . HXT.xpElem observerIdToTimetableAssociationTag $ HXT.xpElem observerIdTag HXT.xpickle `HXT.xpPair` Model.TimetableForWeek.xpickle
type Booking observerId timeslotId resourceIds level = (Model.TimetableCoordinates.Coordinates observerId timeslotId, Model.Lesson.Lesson resourceIds level)
getBookedCoordinates :: Booking observerId timeslotId resourceIds level -> Model.TimetableCoordinates.Coordinates observerId timeslotId
getBookedCoordinates = fst
getBookedLesson :: Booking observerId timeslotId resourceIds level -> Model.Lesson.Lesson resourceIds level
getBookedLesson = snd
toGeneralisedBooking :: Booking observerId timeslotId resourceIds level -> Model.GeneralisedBooking.GeneralisedBooking observerId timeslotId resourceIds level
toGeneralisedBooking = Control.Arrow.second Just
hasMatchingLessonAt
:: (Data.Array.IArray.Ix timeslotId, Ord observerId)
=> (Model.Lesson.Lesson resourceIds level -> Bool)
-> Model.TimetableCoordinates.Coordinates observerId timeslotId
-> Timetable observerId timeslotId resourceIds level
-> Bool
hasMatchingLessonAt lessonPredicate coordinates = Data.Maybe.maybe False lessonPredicate . getMaybeLesson coordinates
isBookedWith :: (
Data.Array.IArray.Ix timeslotId,
Eq level,
Eq resourceIds,
Ord observerId
)
=> Booking observerId timeslotId resourceIds level
-> Timetable observerId timeslotId resourceIds level
-> Bool
isBookedWith booking = hasMatchingLessonAt (== getBookedLesson booking) (getBookedCoordinates booking)