~fkfd/sections

7a8ae210747f784e255e9ba4cec88740d907fa9e — Frederick Yin 1 year, 6 months ago b59e91a main
Use data and type for courses and sections
1 files changed, 32 insertions(+), 24 deletions(-)

M main.hs
M main.hs => main.hs +32 -24
@@ 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"])])]