Skip to main content
1 of 2

Very slow algorithm in Haskell (Advent of Code 2018)

I tried to do the second part of the 1. December challenge of Advent of Code in Haskell. I'm fairly new to Haskell but I have plenty of experience in other (procedural) languages. I struggled with the challenge for hours because the program would hang and it wouldn't produce any output although I couldn't find a problem in my code. Eventually it turned out that my programm worked correctly but it just took very long. To be exact the program took 2 minutes and 40 seconds. According to Advent of Code every challenge should able to execute within 15 seconds though.

So what makes my code so slow?

The task:

You notice that the device repeats the same frequency change list over and over. To calibrate the device, you need to find the first frequency it reaches twice.

For example, using the same list of changes above, the device would loop as follows:

Current frequency  0, change of +1; resulting frequency  1.
Current frequency  1, change of -2; resulting frequency -1.
Current frequency -1, change of +3; resulting frequency  2.
Current frequency  2, change of +1; resulting frequency  3.
(At this point, the device continues from the start of the list.)
Current frequency  3, change of +1; resulting frequency  4.
Current frequency  4, change of -2; resulting frequency  2, which has already been seen.

In this example, the first frequency reached twice is 2. Note that your device might need to repeat its list of frequency changes many times before a duplicate frequency is found, and that duplicates might be found while in the middle of processing the list.

Here are other examples:

+1, -1 first reaches 0 twice.
+3, +3, +4, -2, -4 first reaches 10 twice.
-6, +3, +8, +5, -6 first reaches 5 twice.
+7, +7, -2, -7, -4 first reaches 14 twice.

What is the first frequency your device reaches twice?

My code:

module DayOnePartTwo where

    import System.IO
    import Data.Maybe
    
    inputFileName = "input.txt"
    
    input :: String -> [Integer]
    input contents = toNum (cleanNumbers (splitNumbers contents))
        where 
            cleanNumbers strs = map removeLeadingPlus strs
            splitNumbers string = words string
            toNum numbers = map read numbers
            removeLeadingPlus str = if str !! 0 == '+' then tail str else str
    
    accumulate :: [Integer] -> [Integer]
    accumulate list = accumulator list 0
        where
            accumulator :: Num a => [a] -> a -> [a]
            accumulator (x:xs) state = (x + state) : accumulator xs (x + state)
            accumulator [] state = []
    
    duplicate :: [Integer] -> Maybe Integer
    duplicate list = dup list [0]
        where
            dup (x:xs) visited =
                if elem x visited
                    then Just x
                    else dup xs (x:visited)
            dup [] _ = Nothing
    
    firstCyclicDuplicate :: [Integer] -> Maybe Integer
    firstCyclicDuplicate list = duplicate (accumulate cycledList)
        where
            cycledList = cycle list
    
    main :: IO ()
    main = do
        contents <- readFile inputFileName
        case (firstCyclicDuplicate (input contents)) of
            Just a -> print (show a)
            Nothing -> print "There is no first duplicate"
    

Edit:

This seems to be related to Advent of Code 2018 day 1 part 2: find the first repeated number after some increases and decreases although my algorithm is different.