~fkfd/sections

ed33fdb16e9c4154af150748d1284fe8819bcb01 — Frederick Yin 1 year, 6 months ago b1e2e41
Same thing but in Haskell
1 files changed, 52 insertions(+), 0 deletions(-)

A main.hs
A main.hs => main.hs +52 -0
@@ 0,0 1,52 @@
import qualified Data.List as List
import qualified Control.Monad as Monad

printTimetable choice = do
    putStrLn ""
    putStrLn $ List.intercalate ", " [course ++ "S" ++ sec | (course, (sec, _)) <- choice]
    putStrLn "M\tTu\tW\tTh\tF"
    putStr table
        where table = unlines samePeriodOfDay
              samePeriodOfDay = map (List.intercalate "\t" . horizontal) allPeriodsOfDay
              horizontal pod = map (courseInSlot pod) allDaysOfWeek
              courseInSlot pod dow = foldl (foldFunc pod dow) "" choice
              foldFunc pod dow acc x =
                  if (dow ++ " " ++ pod) `elem` (snd $ snd x) then fst x else acc
                  where periodString = dow ++ " " ++ pod
                        periodsOfCourse = snd $ snd x
                        courseName = fst 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)

-- all possible choices; cartesian product of all courses and all sections thereof
sectionChoices :: [(a, [(b, [c])])] -> [[(a, (b, [c]))]]
sectionChoices [crs] = [[(fst crs, secs)] | secs <- snd crs]
sectionChoices (crs : courses) =
    [(fst crs, secs) : known | secs <- snd crs, known <- known_courses]
    where known_courses = sectionChoices courses

-- only keep choices that do not conflict
resolve :: (Ord a, Ord b, Ord c, Eq c) => [(a, [(b, [c])])] -> [[(a, (b, [c]))]]
resolve courses = filter noConflict (sectionChoices courses)
    where noConflict secs = all (== False) $ map conflict $ comb2 secs
          comb2 secs = [(snd $ snd s1, snd $ snd s2) | s1 <- secs, s2 <- secs, 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"])])]