http://code.google.com/codejam/contest/dashboard?c=433101#s=p2

ride.hs

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}'