@@ 1,9 1,15 @@
import qualified Data.List as List
import qualified Control.Monad as Monad
+data Course = Course { courseName :: String, courseSecs :: [Section] }
+data Section = Section { secName :: String, secPeriods :: [String] } deriving (Eq)
+data Choice = Choice { chosenCourse :: String, chosenSec :: Section } deriving (Eq)
+type Scheme = [Choice]
+
printTimetable scheme = do
putStrLn ""
- putStrLn $ List.intercalate ", " [course ++ "S" ++ sec | (course, (sec, _)) <- scheme]
+ putStrLn $ List.intercalate ", "
+ [course ++ "S" ++ sec | (Choice course (Section sec _)) <- scheme]
putStrLn "M\tTu\tW\tTh\tF"
putStr table
where table = unlines periodsOfDay
@@ 13,40 19,42 @@ printTimetable scheme = do
foldFunc pod dow acc x =
if periodString `elem` periodsOfCourse then courseName else acc
where periodString = dow ++ " " ++ pod
- periodsOfCourse = snd $ snd x
- courseName = fst x
+ periodsOfCourse = secPeriods $ chosenSec x
+ courseName = chosenCourse x
allPeriodsOfDay = ["08", "10", "12", "14", "16", "18"]
allDaysOfWeek = ["M", "Tu", "W", "Th", "F"]
-- check if two courses use the same period
conflict :: (Eq a) => ([a], [a]) -> Bool
-conflict courses = not $ null $ List.intersect (fst courses) (snd courses)
+conflict (c1, c2) = not $ null $ List.intersect c1 c2
-- all possible schemes; cartesian product of all courses and all sections thereof
-sectionSchemes :: [(a, [(b, [c])])] -> [[(a, (b, [c]))]]
-sectionSchemes [crs] = [[(fst crs, secs)] | secs <- snd crs]
+sectionSchemes :: [Course] -> [Scheme]
+sectionSchemes [crs] = [[Choice (courseName crs) sec] | sec <- courseSecs crs]
sectionSchemes (crs : courses) =
- [(fst crs, secs) : known | secs <- snd crs, known <- known_courses]
+ [(Choice (courseName crs) sec) : known | sec <- courseSecs crs, known <- known_courses]
where known_courses = sectionSchemes courses
-- only keep schemes that do not conflict
-resolve :: (Ord a, Ord b, Ord c, Eq c) => [(a, [(b, [c])])] -> [[(a, (b, [c]))]]
+resolve :: [Course] -> [Scheme]
resolve courses = filter noConflict (sectionSchemes courses)
- where noConflict secs = all (== False) $ map conflict $ comb2 secs
- comb2 secs = [(snd $ snd s1, snd $ snd s2) | s1 <- secs, s2 <- secs, s1 < s2]
+ where noConflict scheme = all (== False) $ map conflict $ comb2 scheme
+ comb2 scheme =
+ [(secPeriods $ chosenSec s1, secPeriods $ chosenSec s2)
+ | s1 <- scheme, s2 <- scheme, s1 /= s2]
main = do
- Monad.mapM_ printTimetable secs
- where secs = resolve
- [("216", [("0", ["Tu 10", "Th 10", "F 10"])])
- ,("401", [("0", ["M 16", "W 16", "F 16"])])
- ,("110", [("1", ["Tu 08", "Th 08", "F 08"])
- ,("2", ["Tu 10", "Th 10", "F 10"])
- ,("3", ["Tu 12", "Th 12", "F 12"])
- ,("4", ["Tu 14", "Th 14", "F 14"])])
- ,("1203", [("1", ["Tu 12", "Tu 14", "F 12", "F 14"])
- ,("2", ["Tu 18", "F 18"])
- ,("3", ["W 08", "W 10", "Th 08", "Th 10"])])
- ,("1204", [("1", ["M 18", "W 18"])
- ,("2", ["Tu 18", "Th 18"])
- ,("3", ["Tu 12", "Tu 14", "Th 12", "Th 14"])])]
+ Monad.mapM_ printTimetable schemes
+ where schemes = resolve
+ [(Course "216" [(Section "0" ["Tu 10", "Th 10", "F 10"])])
+ ,(Course "401" [(Section "0" ["M 16", "W 16", "F 16"])])
+ ,(Course "110" [(Section "1" ["Tu 08", "Th 08", "F 08"])
+ ,(Section "2" ["Tu 10", "Th 10", "F 10"])
+ ,(Section "3" ["Tu 12", "Th 12", "F 12"])
+ ,(Section "4" ["Tu 14", "Th 14", "F 14"])])
+ ,(Course "1203" [(Section "1" ["Tu 12", "Tu 14", "F 12", "F 14"])
+ ,(Section "2" ["Tu 18", "F 18"])
+ ,(Section "3" ["W 08", "W 10", "Th 08", "Th 10"])])
+ ,(Course "1204" [(Section "1" ["M 18", "W 18"])
+ ,(Section "2" ["Tu 18", "Th 18"])
+ ,(Section "3" ["Tu 12", "Tu 14", "Th 12", "Th 14"])])]