public
Created

A simple stream hotel room allocator...

  • Download Gist
Hotel.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
 
module Hotel where
 
import Data.List
 
data Allocs = Allocs {checkouts :: [RoomNo], checkins :: [RoomNo], currentMax :: Int}
deriving (Eq)
instance Show Allocs where
show (Allocs xo xi cm) = "A" ++ (show xo) ++ " " ++ (show xi)++" " ++ (show cm) ++ " "
 
type GuestStay = Int
type RoomNo = Int
type DailyGuests = [ GuestStay ]
type Bookings = [ DailyGuests ]
 
type RoomUse = (RoomNo,GuestStay)
 
data Hotel = Hotel { inUse :: [RoomUse], ready :: [RoomUse] , virgin :: [RoomNo] } deriving Eq
 
instance Show Hotel where
show h = "<< " ++ ( show $ inUse h ) ++ " " ++ (show $ ready h ) ++ " " ++ (init $ (show (take 3 $ virgin h) )) ++ "...] >>"
 
 
tes :: Bookings
tes = [ [3,3], [2,1], [], [4], [2,2], [] ]
 
emptyH = Hotel [] [] [1..]
 
nextDay :: Hotel -> Hotel
nextDay (Hotel i r v) = Hotel (map (\(r,s)->(r,s - 1)) i) (map (\(r,s)->(r,s - 1)) r) v
 
allocs :: Bookings -> [Allocs]
allocs bs = worker bs emptyH
where
worker [] (Hotel [] _ _) = []
worker (b:bs) h = let (hh, aa) = f h b in aa : worker bs hh
worker [] h = let (hh, aa) = f h [] in aa : worker [] hh
 
f :: Hotel -> DailyGuests -> (Hotel, Allocs)
f h g = (Hotel i'' r'' v'', Allocs xo xi ((head v'')-1))
where
n = length g
(Hotel i r v) = nextDay h
i' = [ ru | ru@(_, stay) <- i, stay > 0 ]
r' = [ ru | ru@(_, stay) <- i, stay == 0]
xo = map fst r'
freeRooms = r ++ r'
freeRoomsNos = map fst freeRooms
 
r'' = drop n (freeRooms) -- replace by a better room reuse strategy
xi = take n (freeRoomsNos ++ v)
v'' = drop (n - (length freeRooms)) v
i'' = i' ++ zip xi g

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.