{-# LANGUAGE DeriveDataTypeable #-} {-| Module : $Header$ Description : Calculate schedules Copyright : (c) Justus Adam, 2015 License : LGPL-3 Maintainer : development@justusadam.com Stability : experimental Portability : POSIX This module provides functions for calculating possibilities for an ideal schedule layout from weighted Lessons as well as providing functions for converting them into readable/printable format. -} module SchedulePlanner.Calculator.Solver ( calcFromMap , calcFromList , mapToSubject , totalWeight , time , MappedSchedule(..) , MappedLessons(..) ) where import Control.Arrow ((&&&)) import Data.List as List (sortBy, uncons) import qualified Data.Map as Map (Map, empty, foldl, fromListWith, insert, keys, lookup, map, null) import Data.Maybe (fromMaybe) import qualified Data.Ord as Ord (comparing) import SchedulePlanner.Types {-| type Alias for readability maps lessons to their respective subject -} newtype MappedLessons s = MappedLessons { unMapLessons :: Map.Map s [Lesson s] } {-| type Alias for readability represents a schedule -} newtype MappedSchedule s = MappedSchedule { unMapSchedule :: Map.Map Cell (Lesson s) } -- | Convenience function extracing the (day, timeslot) 'Tuple' from a 'Lesson' time :: Lesson a -> Cell time = Cell . (day &&& timeslot) -- | Convenience function to obtain the total weight of a particular Schedule totalWeight :: MappedSchedule a -> Int totalWeight = Map.foldl (+) 0 . Map.map weight . unMapSchedule {-| Map a List of 'Lesson's to their respective subjects -} mapToSubject :: Ord s => [Lesson s] -> MappedLessons s mapToSubject = MappedLessons . Map.fromListWith (++) . map (subject &&& (:[])) {-| Same as 'calcFromMap' but operates on a List of 'Lesson's -} calcFromList :: Ord s => [Lesson s] -> Maybe [MappedSchedule s] calcFromList = calcFromMap . mapToSubject {-| Main evaluation function Transforms a map of weighted 'Lesson's of a particular subject into a list of lightest schedules by branching the evaluation at avery point where there is a timeslot collision -} calcFromMap :: Ord s => MappedLessons s -> Maybe [MappedSchedule s] calcFromMap (MappedLessons mappedLessons) | Map.null mappedLessons = Nothing | otherwise = reduceLists subjX (MappedLessons sortedLessons) (MappedSchedule Map.empty) minList where sortedLessons = Map.map (List.sortBy (Ord.comparing weight)) mappedLessons (subjX : minList) = Map.keys sortedLessons {-| One of the essential calculation steps, reducing the subject lists and recursing the calculation -} reduceLists :: Ord s => s -> MappedLessons s -> MappedSchedule s -> [s] -> Maybe [MappedSchedule s] reduceLists s (MappedLessons mappedLessons) schedules subjects = Map.lookup s mappedLessons >>= uncons >>= \(c, cs) -> calc' c (MappedLessons $ Map.insert s cs mappedLessons) schedules subjects {-| Helper function for 'calcFromMap' represents a recusively called and forking calculation step -} calc' :: Ord s => Lesson s -> MappedLessons s -> MappedSchedule s -> [s] -> Maybe [MappedSchedule s] calc' x lists (MappedSchedule hourMap) minList = maybe maybeEnd splitCalc (Map.lookup (time x) hourMap) where maybeEnd = maybe (return [newMap]) (\(c, cs) -> reduceLists c lists newMap cs) (uncons minList) sideCalc element aMap = fromMaybe [] (reduceLists (subject element) lists aMap minList) splitCalc old = return $ sideCalc x (MappedSchedule hourMap) ++ sideCalc old newMap newMap = MappedSchedule $ Map.insert (time x) x hourMap