packages feed

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 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: