public
Created

  • Download Gist
ride.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
import qualified Data.IntMap as M
import Maybe
 
fillBin capacity ws@(w:ws') weight count
| newWeight > capacity = (ws, weight, count)
| otherwise = fillBin capacity ws' newWeight (succ count)
where newWeight = weight + w
 
go period capacity bins weights acc state seen
| bins == 0 = acc
| M.notMember state seen =
let newSeen = M.insert state (bins, acc) seen
(newWeights, w, count) = fillBin capacity weights 0 0
newState = (state + count) `mod` period
in go period capacity (pred bins) newWeights (acc + w) newState newSeen
| otherwise =
let (oldBins, oldAcc) = fromJust $ M.lookup state seen
cycleLength = oldBins - bins
newAcc = acc + bins `div` cycleLength * (acc - oldAcc)
remainderBins = bins `mod` cycleLength
in go period capacity remainderBins weights newAcc state M.empty
 
solve weights capacity bins =
go (length weights) capacity' bins (cycle weights) 0 0 M.empty
where capacity' = min capacity (sum weights)
 
parseAndSolve [] = []
parseAndSolve [x] = error "Oh, crap, I can't even parse."
parseAndSolve (limits : weights : rest) =
show (solve weights' capacity bins) : parseAndSolve rest
where
(bins: capacity: _) = map read $ words limits
weights' = map read $ words weights
 
main = interact $ unlines . parseAndSolve . tail . lines
 
-- The Case thing annoys me, so I pipe in
-- awk '{print "Case #"NR": "$0}'

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.