----------------------------------------------------------------------------- -- | -- Module : FileFormat.TIM -- Copyright : (c) Richard Senington 2011 -- License : GPL-style -- -- Maintainer : Richard Senington -- Stability : provisional -- Portability : portable -- -- The loading routines for the TIM file format. -- I am not sure what (if anything) TIM stands for. -- The format has been used by the |International Timetabling Competition| -- which has been run twice so far (2002,2007). Problems in this format can be found on -- their websites. ----------------------------------------------------------------------------- module FileFormat.TIM ( RawTimeTableProblem(RawTimeTableProblem,rawNumberOfEvents,rawNumberOfRooms, rawNumberOfPeople,rawNumberOfFeatures,rawNumberOfSlotsPerDay, rawNumberOfDays,rawRoomSizes,rawPersonEventLookup,rawRoomFeatureLookup, rawEventFeatureLookup), parseFile,loadTIMFileRaw,loadTIMFile,convertToConstrainedProblem,rawToCSV )where import CombinatorialOptimisation.TIM import qualified Data.Array as A import qualified Data.Map as M import Data.List import Control.Monad import Text.ParserCombinators.Parsec {-| This is intended to be an internal format only, though I will provide access and visibility to it so that it can be inspected by other programs. In practice I do not expect users to operate upon the raw problem, but instead upon TimeTable.-} data RawTimeTableProblem = RawTimeTableProblem { rawNumberOfEvents :: Int , rawNumberOfRooms :: Int , rawNumberOfPeople :: Int , rawNumberOfFeatures :: Int , rawNumberOfSlotsPerDay :: Int , rawNumberOfDays :: Int , rawRoomSizes :: RoomNumber->Int , rawPersonEventLookup :: PersonNumber->[EventNumber] , rawRoomFeatureLookup :: RoomNumber->[FeatureNumber] , rawEventFeatureLookup :: EventNumber->[FeatureNumber] } {-| Helper function that will not be exported. -} readHeader :: Parser (Int,Int,Int,Int) readHeader = do [a,b,c,d] <-replicateM 4 readNum return (a,b,c,d) {-| Helper function that will not be exported. -} readNum :: Parser Int readNum = do as<-many digit;spaces;return $ read as {-| Helper function that will not be exported. -} chunkStream :: Int->[a]->[[a]] chunkStream i [] = [] chunkStream i xs = let (as,bs) = splitAt i xs in as : chunkStream i bs {-| Helper function not for export. -} invertLookup :: (Ord a,Ord b,A.Ix b)=> [a]->[b]->(a->[b])->b->[a] invertLookup baseIndices newIndices baseLookup = (A.!) (A.array (minimum newIndices,maximum newIndices) (M.toList dat)) where dat'' = M.fromList $ zip newIndices (repeat []) dat' = foldl' f dat'' baseIndices dat = M.map sort dat' f c k = let xs = baseLookup k in foldl' (\c' k'->M.adjust (k:) k' c') c xs {-| parseFile is a file parser for the /tim/ format. For the output format, the FullyDescriptiveTimeTableProblem data type, I have included a number of slots per day and number of days. These are constants in this loading routine. -} parseFile :: Parser RawTimeTableProblem parseFile = do (nEvents,nRooms,nFeatures,nPeople)<-readHeader roomSizes<-replicateM nRooms readNum personEventGrid <-replicateM (nEvents*nPeople) readNum roomFeatureGrid<-replicateM (nRooms*nFeatures) readNum eventFeatureGrid <-replicateM (nEvents*nFeatures) readNum return $ RawTimeTableProblem nEvents nRooms nPeople nFeatures 9 5 (makeArrayLookup roomSizes) (cga nEvents personEventGrid) (cga nFeatures roomFeatureGrid) (cga nFeatures eventFeatureGrid) where gridToLookup xs = [b |(a,b)<-zip xs [0..],a==1] makeArrayLookup xs = (A.!) (A.listArray (0,length xs -1) xs) cga n as = makeArrayLookup . (map gridToLookup) . (chunkStream n) $ as {-| Load in a TIM file, but keep the data in the original form, as a large number of grids of bits.-} loadTIMFileRaw :: String->IO RawTimeTableProblem loadTIMFileRaw fName = do rawContents<-readFile fName let k = parse parseFile "" rawContents let (Right x) = k return x {-| Load a TIM file, and transform it into the constrained data format so that the look up tables no longer give back just ones and zeros, but lists of valid options. This should be easier to work with. -} loadTIMFile :: String->IO TimeTable loadTIMFile s = (loadTIMFileRaw s) >>= (return . convertToConstrainedProblem) {-| Use the raw data to constrain problem. Only rooms that can reasonably be chosen (feature and size constraints) should be available for specific events and so on. In short I am doing my own constraint (hard coded urg) processing here. -} convertToConstrainedProblem :: RawTimeTableProblem->TimeTable convertToConstrainedProblem input = TimeTable (rawNumberOfEvents input) (rawNumberOfRooms input) (rawNumberOfPeople input) (rawNumberOfDays input * rawNumberOfSlotsPerDay input) (rawPersonEventLookup input) eventToPerson eventToRoom (invertLookup eventList roomList eventToRoom) M.empty M.empty M.empty eventList (numDays-1) (numSlots-1) 0 (\x->x `div` numSlots) (\x->x `mod` numSlots) numEventsInDayEmpty 0 0 0 where eventToPerson = invertLookup [0 .. rawNumberOfPeople input -1] eventList (rawPersonEventLookup input) roomList = [0 .. rawNumberOfRooms input -1] eventList = [0 .. rawNumberOfEvents input -1] allEventsAnywhere = M.fromList $ zip eventList (repeat roomList) -- initially any event can go anywhere filteredForSizes = foldl' filterOnRoomSize allEventsAnywhere eventList -- filter rooms, based upon event size/room size correlation filteredForFeatures = foldl' filterOnRoomFeature filteredForSizes eventList -- filter rooms, based upon event feature/room feature corelation filterOnRoomSize c e = let numPeople = length . eventToPerson $ e previousValidRooms = c M.! e in M.insert e (filter (\r->rawRoomSizes input r >= numPeople) previousValidRooms) c filterOnRoomFeature c e = let previousValidRooms = c M.! e eFs = rawEventFeatureLookup input e f r = let rFs = rawRoomFeatureLookup input r in and $ map (\e->elem e rFs) eFs in M.insert e (filter f previousValidRooms) c eventToRoom = (A.!) (A.array (0 , rawNumberOfEvents input -1) (M.toList filteredForFeatures)) numEventsInDayEmpty = M.fromList [ ((d,p),0) | d<-[0 .. numDays -1],p<-[0 .. rawNumberOfPeople input -1]] numDays = rawNumberOfDays input numSlots = rawNumberOfSlotsPerDay input {-| This is for human readability. It will take a raw format and return a comma and new line separated format as a String. Dump the string to a file and it should now be easy to load into a spread sheet and inspect. I was not comfortable incoding this as a |show| function, it seems to me that there is far too much information here to easily display it to a user, at least in a terminal window. -} rawToCSV :: RawTimeTableProblem->String rawToCSV ffdttp = concat [header,"\n\nRoom Sizes\n",roomOutput,"\nStudent Event Table\n",studentEventTable,"\nRoom Feature Table\n",roomFeatureTable,"\nEvent Feature Table\n",eventFeatureTable] where pList = [0..rawNumberOfPeople ffdttp -1] rList = [0..rawNumberOfRooms ffdttp -1] eList = [0 .. rawNumberOfEvents ffdttp -1] fList = [0..rawNumberOfFeatures ffdttp -1] header = concat $ (zipWith (++)) ["Number Of Events,","\nNumber Of Rooms,","\nNumber Of Features,","\nNumber Of People,","\nSlots Per Day,","\nDays,"] (map (\f->show $ f ffdttp) [rawNumberOfEvents,rawNumberOfRooms,rawNumberOfFeatures,rawNumberOfPeople,rawNumberOfSlotsPerDay,rawNumberOfDays]) roomOutput = concatMap concat [["Room ",show r,",",show $ rawRoomSizes ffdttp r,"\n"] | r <- rList] studentEventTable = eventHeaderRow ++ (concat ['S':(show r) ++ (indexesToBools (rawNumberOfEvents ffdttp) $ rawPersonEventLookup ffdttp r)++"\n" | r<-pList]) roomFeatureTable = featureHeaderRow ++ (concat [ 'R':(show r) ++ (indexesToBools (rawNumberOfFeatures ffdttp) $ rawRoomFeatureLookup ffdttp r)++"\n" | r<-rList]) eventFeatureTable = featureHeaderRow ++ (concat [ 'E':(show r) ++ (indexesToBools (rawNumberOfFeatures ffdttp) $ rawEventFeatureLookup ffdttp r)++"\n" | r<-eList]) eventHeaderRow = (concat [ ",E"++show x | x<-eList])++"\n" featureHeaderRow = (concat [ ",F"++show x | x<-fList])++"\n" indexesToBools lim xs = concat [ [',',if elem i xs then '1' else '0'] |i<-[0..lim-1]]