public
Last active

Room allocations

  • Download Gist
Alloc.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
module Alloc where
 
import Data.List
import Control.Arrow
 
data Allocs = Allocs {checkouts :: [Int], checkins :: [Int]} deriving (Eq, Show)
 
 
allocs :: [[Int]] -> (Int, [Allocs])
allocs = first length . mapAccumL f []
where
f :: [Int] -> [Int] -> ([Int], Allocs)
f rooms arrivals = (rooms'', Allocs outs ins)
where
rooms' = map (subtract 1) rooms
outs = [room | (nights, room) <- zip rooms' [0..], nights == 0]
free = [room | (nights, room) <- zip rooms' [0..], nights <= 0]
ins = [room | (nights, room) <- zip arrivals (free ++ [length rooms..])]
rooms'' = allocNewRooms rooms' arrivals
 
 
allocNewRooms :: [Int] -> [Int]-> [Int]
allocNewRooms [] guests = guests
allocNewRooms rooms [] = rooms
allocNewRooms (r:rooms) (g:guests) | r <= 0 = g : allocNewRooms rooms guests
allocNewRooms (r:rooms) guests = r : allocNewRooms rooms guests
Alloc2.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
module Allocation where
 
import Data.List
import Control.Arrow
 
data Actions = Actions {deallocs :: [Int], allocs :: [Int]}
deriving (Eq, Show)
 
actions :: [[Int]] -> (Int, [Actions])
actions = first (\(_,_,maxSlot) -> maxSlot + 1) . mapAccumL processStep ([0..], repeat [], 0)
where
processStep (free, ds : futureDeallocs, maxSlot) items = (state', Actions ds as)
where
(state', as) = mapAccumL processItem (ds ++ free, futureDeallocs, maxSlot) items
processItem (slot : free', futureDeallocs, maxSlot) item =
((free', modifyNth (slot:) (item-1) futureDeallocs, max slot maxSlot), slot)
 
modifyNth :: (a -> a) -> Int -> [a] -> [a]
modifyNth _ _ [] = []
modifyNth f 0 (x : xs) = f x : xs
modifyNth f n (x : xs) = x : modifyNth f (n-1) xs

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.