2
\$\begingroup\$

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?

\$\endgroup\$
1
\$\begingroup\$

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.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.