optimizing a rollercoaster queue

Question

I am working on a haskell exercise where I have to compute the amount of people riding a rollercoaster in a day. I have the following data: the number of rides in a day, the number of seats, and the composition of the queue.

The queue is a list of groups. During each ride, the first few groups of the list enter the ride. A group always rides together. The total number of people cannot exceed the number of seat during one ride.

After the ride, the groups go to the end of the queue (in the same order).

So the exercise is not really hard. But when numbers get big, my haskell implementation becomes quite slow. I have used the profiler to improve some parts, but I wasn't able to spot a bottleneck.

The first time I ran the profiler, the part that was parsing the groups was slow. Here is my second version (1st one was replicateM n $ read <$> getLine):

getGroups :: IO [Int]
getGroups = do
 c <- TIO.getContents
 return $ readInts c
readInts :: T.Text -> [Int]
readInts s
 | T.null s = []
 | otherwise = val : rest where
 (Right (val, s')) = TR.decimal s
 rest = if T.null s'
 then []
 else (readInts $ T.tail s')

Another cost center is the actual computing function:

type Queue = Seq.Seq Int
data Roller = Roller Int Int Queue
compEarn :: Roller -> Int
compEarn (Roller placeNbr rideNbr groups) = go rideNbr groups 0
 where
 go turnsLeft queue accum
 | turnsLeft == 0 = accum
 | otherwise = let
 (riding, waiting) = breakQueue placeNbr queue
 newQueue = waiting Seq.>< riding
 newAccum = accum + (F.sum riding)
 in go (turnsLeft - 1) newQueue newAccum
breakQueue :: Int -> Queue -> (Queue, Queue)
breakQueue placeNbr queue = go Seq.empty queue placeNbr where
 go riding waiting spaceLeft = case Seq.viewl waiting of
 Seq.EmptyL -> (riding, waiting)
 group Seq.:< rest -> if spaceLeft' < 0
 then (riding, waiting)
 else go (riding Seq.|> group) rest spaceLeft'
 where
 spaceLeft' = spaceLeft - group

Am I missing something obvious regarding performances with this program?

Answer 1

So I found a few improvements which solve my problem. First, I used a vector to represent the queue, and a rolling index to store the head of the queue:

type Queue = V.Vector Int
data RollingQ = RollingQ Queue Int
currentVal :: RollingQ -> Int
currentVal (RollingQ v i) = v V.! i
nextVal :: RollingQ -> RollingQ
nextVal (RollingQ v i)
 | i == V.length v = RollingQ v 0
 | otherwise = RollingQ v (i + 1)

This led me to realize that there might be a cycle in the computation: if the number of rides is bigger than the number of groups in the queue, the state of the queue loops. I used a Map to remember information about the computation to detect the loop and compute a shortcut to get the result almost immediately.