Skip to content
Create a gist now

Instantly share code, notes, and snippets.

@rgrig /ride.hs

Embed URL


Subversion checkout URL

You can clone with
Download ZIP
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
(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}'
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.