combinatorial-problems 0.0.3 → 0.0.4
raw patch · 3 files changed
+414/−4 lines, 3 filesdep +parsecPVP ok
version bump matches the API change (PVP)
Dependencies added: parsec
API changes (from Hackage documentation)
+ CombinatorialOptimisation.TIM: TimeTable :: Int -> Int -> Int -> Int -> (PersonNumber -> [EventNumber]) -> (EventNumber -> [PersonNumber]) -> (EventNumber -> [RoomNumber]) -> (RoomNumber -> [EventNumber]) -> Map EventNumber (TimeSlot, RoomNumber) -> Map (TimeSlot, RoomNumber) EventNumber -> Map (TimeSlot, PersonNumber) Counter -> [EventNumber] -> Int -> Int -> Counter -> (TimeSlot -> DayNumber) -> (TimeSlot -> DaySlot) -> Map (DayNumber, PersonNumber) Counter -> Counter -> Counter -> Counter -> TimeTable
+ CombinatorialOptimisation.TIM: currentlyScheduledEvents :: TimeTable -> [EventNumber]
+ CombinatorialOptimisation.TIM: data TimeTable
+ CombinatorialOptimisation.TIM: daynumberDecode :: TimeTable -> TimeSlot -> DayNumber
+ CombinatorialOptimisation.TIM: dayslotDecode :: TimeTable -> TimeSlot -> DaySlot
+ CombinatorialOptimisation.TIM: descheduleEvent :: EventNumber -> TimeTable -> TimeTable
+ CombinatorialOptimisation.TIM: descheduleSlot :: TimeSlot -> RoomNumber -> TimeTable -> TimeTable
+ CombinatorialOptimisation.TIM: eventLocation :: TimeTable -> Map EventNumber (TimeSlot, RoomNumber)
+ CombinatorialOptimisation.TIM: eventPersonLookup :: TimeTable -> EventNumber -> [PersonNumber]
+ CombinatorialOptimisation.TIM: eventRoomLookup :: TimeTable -> EventNumber -> [RoomNumber]
+ CombinatorialOptimisation.TIM: eventsInDay :: TimeTable -> Map (DayNumber, PersonNumber) Counter
+ CombinatorialOptimisation.TIM: instance Show TimeTable
+ CombinatorialOptimisation.TIM: ittcObjectiveValue :: TimeTable -> Int
+ CombinatorialOptimisation.TIM: ittcValidity :: TimeTable -> Bool
+ CombinatorialOptimisation.TIM: lastDay :: TimeTable -> Int
+ CombinatorialOptimisation.TIM: lastSlotOfDay :: TimeTable -> Int
+ CombinatorialOptimisation.TIM: lastSlotOfDayCounter :: TimeTable -> Counter
+ CombinatorialOptimisation.TIM: locationEvent :: TimeTable -> Map (TimeSlot, RoomNumber) EventNumber
+ CombinatorialOptimisation.TIM: moreThanTwoEventsCounter :: TimeTable -> Counter
+ CombinatorialOptimisation.TIM: numberOfEvents :: TimeTable -> Int
+ CombinatorialOptimisation.TIM: numberOfPeople :: TimeTable -> Int
+ CombinatorialOptimisation.TIM: numberOfRooms :: TimeTable -> Int
+ CombinatorialOptimisation.TIM: numberOfTimeSlots :: TimeTable -> Int
+ CombinatorialOptimisation.TIM: overSchedule :: TimeTable -> Counter
+ CombinatorialOptimisation.TIM: personEventLookup :: TimeTable -> PersonNumber -> [EventNumber]
+ CombinatorialOptimisation.TIM: personUsage :: TimeTable -> Map (TimeSlot, PersonNumber) Counter
+ CombinatorialOptimisation.TIM: roomEventLookup :: TimeTable -> RoomNumber -> [EventNumber]
+ CombinatorialOptimisation.TIM: schedule :: TimeSlot -> RoomNumber -> EventNumber -> TimeTable -> TimeTable
+ CombinatorialOptimisation.TIM: singleEventInDayCounter :: TimeTable -> Counter
+ CombinatorialOptimisation.TIM: timeTableDetailsAsCSV :: TimeTable -> String
+ CombinatorialOptimisation.TIM: timeTableForRoomAsCSV :: TimeTable -> RoomNumber -> String
+ CombinatorialOptimisation.TIM: type Counter = Int
+ CombinatorialOptimisation.TIM: type DayNumber = Int
+ CombinatorialOptimisation.TIM: type DaySlot = Int
+ CombinatorialOptimisation.TIM: type EventNumber = Int
+ CombinatorialOptimisation.TIM: type FeatureNumber = Int
+ CombinatorialOptimisation.TIM: type PersonNumber = Int
+ CombinatorialOptimisation.TIM: type RoomNumber = Int
+ CombinatorialOptimisation.TIM: type TimeSlot = Int
+ CombinatorialOptimisation.TIM: unscheduledEvents :: TimeTable -> [EventNumber]
+ CombinatorialOptimisation.TIM: viewConstrainedProblem :: TimeTable -> String
+ CombinatorialOptimisation.TIM: viewTimeTableDetails :: TimeTable -> String
+ FileFormat.TIM: RawTimeTableProblem :: Int -> Int -> Int -> Int -> Int -> Int -> (RoomNumber -> Int) -> (PersonNumber -> [EventNumber]) -> (RoomNumber -> [FeatureNumber]) -> (EventNumber -> [FeatureNumber]) -> RawTimeTableProblem
+ FileFormat.TIM: convertToConstrainedProblem :: RawTimeTableProblem -> TimeTable
+ FileFormat.TIM: data RawTimeTableProblem
+ FileFormat.TIM: loadTIMFile :: String -> IO TimeTable
+ FileFormat.TIM: loadTIMFileRaw :: String -> IO RawTimeTableProblem
+ FileFormat.TIM: parseFile :: Parser RawTimeTableProblem
+ FileFormat.TIM: rawEventFeatureLookup :: RawTimeTableProblem -> EventNumber -> [FeatureNumber]
+ FileFormat.TIM: rawNumberOfDays :: RawTimeTableProblem -> Int
+ FileFormat.TIM: rawNumberOfEvents :: RawTimeTableProblem -> Int
+ FileFormat.TIM: rawNumberOfFeatures :: RawTimeTableProblem -> Int
+ FileFormat.TIM: rawNumberOfPeople :: RawTimeTableProblem -> Int
+ FileFormat.TIM: rawNumberOfRooms :: RawTimeTableProblem -> Int
+ FileFormat.TIM: rawNumberOfSlotsPerDay :: RawTimeTableProblem -> Int
+ FileFormat.TIM: rawPersonEventLookup :: RawTimeTableProblem -> PersonNumber -> [EventNumber]
+ FileFormat.TIM: rawRoomFeatureLookup :: RawTimeTableProblem -> RoomNumber -> [FeatureNumber]
+ FileFormat.TIM: rawRoomSizes :: RawTimeTableProblem -> RoomNumber -> Int
+ FileFormat.TIM: rawToCSV :: RawTimeTableProblem -> String
Files
- CombinatorialOptimisation/TIM.hs +242/−0
- FileFormat/TIM.hs +164/−0
- combinatorial-problems.cabal +8/−4
+ CombinatorialOptimisation/TIM.hs view
@@ -0,0 +1,242 @@+-----------------------------------------------------------------------------+-- |+-- Module : CombinatorialOptimisation.TIM+-- Copyright : (c) Richard Senington 2011+-- License : GPL-style+-- +-- Maintainer : Richard Senington <sc06r2s@leeds.ac.uk>+-- Stability : provisional+-- Portability : portable+-- +-- A library for the representation and manipulation of Time Tabling Problems.+-- Still experimental and not particularly general. The underlying problem +-- description is that used by the International Timetabling Competition, +-- and the code is rather specialised towards that, with the aim of being used +-- for meta-heuristics.+----------------------------------------------------------------------------- ++module CombinatorialOptimisation.TIM(TimeTable(TimeTable,numberOfEvents,numberOfRooms,numberOfPeople,numberOfTimeSlots,+ personEventLookup, eventPersonLookup,eventRoomLookup,roomEventLookup,+ eventLocation,locationEvent,personUsage,unscheduledEvents,overSchedule,+ daynumberDecode,dayslotDecode,eventsInDay,singleEventInDayCounter,lastSlotOfDayCounter,+ moreThanTwoEventsCounter,lastDay,lastSlotOfDay),+ viewConstrainedProblem,descheduleEvent,descheduleSlot,schedule,viewTimeTableDetails,+ ittcValidity,ittcObjectiveValue,timeTableDetailsAsCSV,timeTableForRoomAsCSV,+ currentlyScheduledEvents,+ TimeSlot,DayNumber,DaySlot,RoomNumber,EventNumber,PersonNumber,FeatureNumber,Counter+)where++import qualified Data.Array as A+import qualified Data.Map as M+import Data.List++type TimeSlot = Int+type DayNumber = Int+type DaySlot = Int+type RoomNumber = Int+type EventNumber = Int+type PersonNumber = Int+type FeatureNumber = Int+type Counter = Int++{-| Core concepts, location, timeslot, person, two events cannot happen in the same place at the same time.+ This version expects a constrained data set, so that the roomEvent lookup for example only yields events that can + reasonably be scheduled in that room. ++ Originally I intended the objectives (low over scheduling of people) and the soft objectives to be handled somewhere else.+ At this time, I am unsure how to abstract this, and I want a system that works now, so I will over specialise to the + time tabling competition specifications. Hopefully this can be rectified in a later version. -}++data TimeTable = TimeTable { numberOfEvents :: Int+ , numberOfRooms :: Int+ , numberOfPeople :: Int+ , numberOfTimeSlots :: Int+ , personEventLookup :: PersonNumber->[EventNumber]+ , eventPersonLookup :: EventNumber->[PersonNumber]+ , eventRoomLookup :: EventNumber->[RoomNumber]+ , roomEventLookup :: RoomNumber->[EventNumber]+ , eventLocation :: M.Map EventNumber (TimeSlot,RoomNumber)+ , locationEvent :: M.Map (TimeSlot,RoomNumber) EventNumber+ , personUsage :: M.Map (TimeSlot,PersonNumber) Counter+ , unscheduledEvents :: [EventNumber]+ , lastDay :: Int+ , lastSlotOfDay :: Int+ -- objectives, and related code+ , overSchedule :: Counter+ , daynumberDecode :: TimeSlot->DayNumber+ , dayslotDecode :: TimeSlot->DaySlot+ , eventsInDay :: M.Map (DayNumber,PersonNumber) Counter+ , singleEventInDayCounter :: Counter+ , lastSlotOfDayCounter :: Counter+ , moreThanTwoEventsCounter :: Counter }++instance Show TimeTable where+ show t = concat ["TimeTable Problem & Solution : \n",+ " Validity : ",if ittcValidity t then "VALID\n" else "INVALID\n",+ " Objective Function Value : ",show . ittcObjectiveValue $ t,"\n",+ " Over Scheduled By : ",show . overSchedule $ t,"\n",+ " Single Session In A Day Counter : ",show . singleEventInDayCounter $ t,"\n",+ " Last Slot Of Day Counter : ",show . lastSlotOfDayCounter $ t,"\n",+ " More Than Two Events In Succession Counter : ",show . moreThanTwoEventsCounter $ t,"\n",+ " Still Unscheduled : ",show . length . unscheduledEvents $ t,"\n"]++{-| The objective function as specific by the 2002 competition rules. -}+ittcObjectiveValue :: TimeTable->Int+ittcObjectiveValue t = singleEventInDayCounter t + lastSlotOfDayCounter t + moreThanTwoEventsCounter t++{-| The validity function as specific by the 2002 competition rules. Basically no clashes at this point.-}+ittcValidity :: TimeTable->Bool+ittcValidity t = (overSchedule t == 0) && (null (unscheduledEvents t))++{-| Splitting off the two parts of show, so we have a simple show for the state of the solution, + a more complex solution description and the constant constrained problem.+-} +viewConstrainedProblem :: TimeTable->String+viewConstrainedProblem t = concat [header,personEventHeader,personEvent,eventPersonHeader,eventPerson,eventRoomHeader,eventRoom,roomEventHeader,roomEvent]+ where+ header = concat [concat ["Number Of ",a,",",b,"\n"] | (a,b)<-zip ["Events","Rooms","People","Time Slots"] $ map show [numberOfEvents t,numberOfRooms t,numberOfPeople t,numberOfTimeSlots t]]+ personEventHeader = "\nPerson To Event Lookup\n"+ personEvent = concatMap concat ["\nPerson":(show p): (map (\l->","++show l) (personEventLookup t p)) | p<-[0 .. numberOfPeople t -1]]+ eventPersonHeader = "\n\nEvent To Person Lookup\n"+ eventPerson = concatMap concat ["\nEvent":(show p): (map (\l->","++show l) (eventPersonLookup t p)) | p<-[0 .. numberOfEvents t -1]]+ eventRoomHeader = "\n\nEvent To Room Lookup\n"+ eventRoom = concatMap concat ["\nEvent":(show p): (map (\l->","++show l) (eventRoomLookup t p)) | p<-[0 .. numberOfEvents t -1]]+ roomEventHeader = "\n\nRoom To Event Lookup\n" + roomEvent = concatMap concat ["\nRoom":(show p): (map (\l->","++show l) (roomEventLookup t p)) | p<-[0 .. numberOfRooms t -1]]+++{-| The other part of the time table data type. See the current status of the solution. -}++viewTimeTableDetails :: TimeTable->String+viewTimeTableDetails t = unsched++locs+ where+ timeSlots = [0 .. numberOfTimeSlots t -1]+ roomCodes = [0 .. numberOfRooms t -1]+ persCodes = [0 .. numberOfPeople t -1]+ unsched = "Currently Unscheduled Events : "++(concat [show x++" " |x<-unscheduledEvents t]) ++ "\n"+ locs = concat [makeTimeSlotDisplay s | s<-timeSlots,somethingAllocated s] ++ somethingAllocated s = or [M.member (s,r) (locationEvent t) | r<-roomCodes]+ personRequested s p = (M.member (s,p) (personUsage t)) && ((personUsage t) M.! (s,p) >0)+ makeTimeSlotDisplay s = concat $ ["Time Slot : ",show (daynumberDecode t s,dayslotDecode t s),"\n",+ makePersonUsage s]+++ [" Room "++(show r)++" : "++ (show $ (locationEvent t) M.! (s,r))++"\n" | r<-roomCodes,M.member (s,r) (locationEvent t) ]+ makePersonUsage s = " Persons Used : "++concat [ show p++" " | p<-persCodes,personRequested s p]++"\n"+ +{-| A simple spread sheet display seems like a good idea. -}+timeTableDetailsAsCSV :: TimeTable->String+timeTableDetailsAsCSV t = concat [(timeTableForRoomAsCSV t r)++"\n\n" | r<-[0 .. numberOfRooms t -1] ] ++{-| Maybe a helper, making it public anyway. -}+timeTableForRoomAsCSV :: TimeTable->RoomNumber->String+timeTableForRoomAsCSV t r = header ++ (concatMap concat [["Slot ",show s]++ [checkLocation (d * mSlots + s,r) | d<-[0 .. mDays]]++["\n"] |s<-[0 .. mSlots]])+ where+ (days,slots) = unzip [(daynumberDecode t s,dayslotDecode t s) | s<-[0..numberOfTimeSlots t -1]]+ mDays = lastDay t + mSlots = lastSlotOfDay t + checkLocation sl | M.member sl (locationEvent t) = ","++ (show $ (locationEvent t) M.! sl)+ | otherwise = ","+ header = ","++ concat ["Day "++(show d)++"," | d<-[0 .. mDays]]++"\n"++{-| Fails silently and does no update the schedule if the very hard constraints fail. -}+schedule :: TimeSlot->RoomNumber->EventNumber->TimeTable->TimeTable+schedule s r e t = if validEvent && validRoom && validSlot + then t{unscheduledEvents=newUnscheduled,eventLocation=el,locationEvent=le,personUsage=pu,overSchedule=newOverSchedule,eventsInDay=newEventsInDay,+ lastSlotOfDayCounter=newLastSlot,singleEventInDayCounter=newSingleEventCounter,moreThanTwoEventsCounter = newTwoCounter}+ else t + where+ validEvent = M.notMember e (eventLocation t)+ validRoom = elem r (eventRoomLookup t e)+ validSlot = M.notMember (s,r) (locationEvent t)+ day = daynumberDecode t s+ dayS = dayslotDecode t s++ newUnscheduled = filter (/=e) (unscheduledEvents t)+ el = M.insert e (s,r) (eventLocation t)+ le = M.insert (s,r) e (locationEvent t)+ pu = foldl' (\c k->M.alter f (s,k) c) (personUsage t) (eventPersonLookup t e)+ f Nothing = Just 1+ f p = fmap (+1) p+ newOverSchedule = (overSchedule t) + sum [1 | p<-eventPersonLookup t e,pu M.! (s,p) >1]+ newEventsInDay = foldl' (\c p->M.alter f (day,p) c) (eventsInDay t) (eventPersonLookup t e)+ + newLastSlot = if dayS == lastSlotOfDay t then lastSlotOfDayCounter t + (length $ eventPersonLookup t e)+ else lastSlotOfDayCounter t+ newSingleEventCounter = singleEventInDayCounter t + sum [1 | p<-eventPersonLookup t e,newEventsInDay M.! (day,p) == 1]+ + beforeChain = before s dayS+ afterChain = after (lastSlotOfDay t) s dayS++ newTwoCounter = moreThanTwoEventsCounter t + (sum . (map changeInChains) $ [(findChain p beforeChain pu,findChain p afterChain pu) | p<-eventPersonLookup t e])++ + +changeInChains :: (Int,Int)->Int+changeInChains (0,0) = 0+changeInChains (0,1) = 0+changeInChains (1,0) = 0+changeInChains (2,0) = 1+changeInChains (0,2) = 1+changeInChains (2,1) = 2+changeInChains (1,2) = 2+changeInChains _ = 3++before :: TimeSlot->DaySlot->[TimeSlot]+before _ 0 = []+before s ds = let s' = s-1 in s':before s' (ds-1) ++after :: DaySlot->TimeSlot->DaySlot->[TimeSlot]+after l s ds | ds == l = []+ | otherwise = let s' = s+1 in s' : after l s' (ds+1)++findChain :: PersonNumber->[TimeSlot]->M.Map (TimeSlot,PersonNumber) Counter->Int+findChain p slots m = length $ takeWhile (\x->M.member (x,p) m) slots+++{-| A helper method, that does not validate before descheduling. Not for export. -}+deschedule :: TimeSlot->RoomNumber->EventNumber->TimeTable->TimeTable+deschedule s r e t = t{unscheduledEvents=newUnscheduled,eventLocation=el,locationEvent=le,personUsage=pu,overSchedule=newOverSchedule,eventsInDay=newEventsInDay,+ lastSlotOfDayCounter=newLastSlot,singleEventInDayCounter=newSingleEventCounter,moreThanTwoEventsCounter = newTwoCounter}+ where+ day = daynumberDecode t s+ dayS = dayslotDecode t s++ newUnscheduled = e:(unscheduledEvents t)+ el = M.delete e (eventLocation t)+ le = M.delete (s,r) (locationEvent t)+ pu = foldl' (\c k->M.alter f (s,k) c) (personUsage t) (eventPersonLookup t e)+ f Nothing = Nothing+ f (Just 1) = Nothing+ f (Just x) = Just (x-1)++ newLastSlot = if dayS == lastSlotOfDay t then lastSlotOfDayCounter t - (length $ eventPersonLookup t e)+ else lastSlotOfDayCounter t+ newSingleEventCounter = singleEventInDayCounter t - sum [1 | p<-eventPersonLookup t e,M.notMember (day,p) newEventsInDay ]+ newOverSchedule = (overSchedule t) - sum [1 | p<-eventPersonLookup t e,M.member (s,p) pu,pu M.! (s,p) == 1]+ newEventsInDay = foldl' (\c p->M.alter f (day,p) c) (eventsInDay t) (eventPersonLookup t e)+ + beforeChain = before s dayS+ afterChain = after (lastSlotOfDay t) s dayS++ newTwoCounter = moreThanTwoEventsCounter t - (sum . (map changeInChains) $ [(findChain p beforeChain pu,findChain p afterChain pu) | p<-eventPersonLookup t e])++{-| Fails silently if the event is not currently scheduled. -}+descheduleEvent :: EventNumber->TimeTable->TimeTable+descheduleEvent e t = if validEvent then deschedule s r e t + else t+ where+ validEvent = M.member e (eventLocation t)+ (s,r) = (eventLocation t) M.! e++{-| Fails silently if the time slot and room number are not booked. -}+descheduleSlot :: TimeSlot->RoomNumber->TimeTable->TimeTable+descheduleSlot s r t = if validSlot then deschedule s r e t+ else t+ where+ validSlot = M.member (s,r) (locationEvent t)+ e = (locationEvent t) M.! (s,r)++{-| Just a combination of existing useful functions. -}+currentlyScheduledEvents :: TimeTable->[EventNumber]+currentlyScheduledEvents = M.keys . eventLocation +
+ FileFormat/TIM.hs view
@@ -0,0 +1,164 @@+-----------------------------------------------------------------------------+-- |+-- Module : FileFormat.TIM+-- Copyright : (c) Richard Senington 2011+-- License : GPL-style+-- +-- Maintainer : Richard Senington <sc06r2s@leeds.ac.uk>+-- 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]]+
combinatorial-problems.cabal view
@@ -1,5 +1,5 @@ Name: combinatorial-problems-Version: 0.0.3+Version: 0.0.4 Synopsis: A number of data structures to represent and allow the manipulation of standard combinatorial problems, used as test problems in computer science. Description: In computer science there are a number of standard test problems that are used for testing algorithms, especially those related to Artificial Intelligence and Operations Research. Online there are a number @@ -10,8 +10,9 @@ This library seeks to provide implementations of data structures to store these problems, along with functions for manipulating the problems and routines to load problem files from various sources. .- At present it only supports TSP\/TSPLIB and SAT\/SATLIB, however it is hoped that the loading routines - can be expanded and the range of problems expanded to cover problems like scheduling and timetabling.+ At present it supports TSP\/TSPLIB, SAT\/SATLIB and TIM (format used by the International Timetabling Competition, + which has been run twice at current date), however it is hoped that the loading routines + can be expanded and the range of problems expanded to cover problems like scheduling and more general timetabling. The internal data structures make heavy use of the @Data.Map@ library and @Data.Array@. It is not currently using unboxed values. The library does not use the @bytestring@ library for loading and saving data either, which will probably need to be changed later.@@ -30,11 +31,14 @@ library Exposed-Modules: FileFormat.SATLIB FileFormat.TSPLIB+ FileFormat.TIM CombinatorialOptimisation.SAT CombinatorialOptimisation.TSP CombinatorialOptimisation.TSP.FixedPoint+ CombinatorialOptimisation.TIM Build-Depends: base >= 2.0 && <=5, random >= 1.0.0.1, containers >= 0.2.0.1,- array >= 0.2.0.0+ array >= 0.2.0.0,+ parsec >= 3.1.1 extensions: