Project Euler: Problem 14

“The following iterative sequence is defined for the set of positive integers: n → n/2 (n is even) n → 3n + 1 (n is odd).  Using the rule above and starting with 13, we generate the following sequence: 13 → 40 → 20 → 10 → 5 → 16 → 8 → 4 → 2 → 1.  It can be seen that this sequence (starting at 13 and finishing at 1) contains 10 terms.  Although it has not been proved yet (Collatz Problem), it is thought that all starting numbers finish at 1.  Which starting number, under one million, produces the longest chain?  NOTE: Once the chain starts the terms are allowed to go above one million.”

Not many of you may be aware of this, but about a year ago I wrote up a blog post that discussed Collatz chains in Haskell.  You can find that post here: . Having some of the code already written made coming up with the solution easier.  However, just because I had one function doesn't mean I had the whole problem licked.  I still had a fair amount of work in front of me.  Below is my code from the first attempt at a solution:

  1. module Main where
  2.  
  3. import Data.List
  4.  
  5. chain' :: Integer -> [Integer]
  6. chain' 1 = [1]
  7. chain' n
  8.    | n <= 0 = []
  9.    | even n = n : chain' (n `div` 2)
  10.    | odd n = n : chain' (n * 3 + 1)
  11.  
  12. main :: IO ()
  13. main = do
  14.     let seqx = map chain' [3..1000000]
  15.     let lengthx = map length seqx
  16.     print . maximum $ zip lengthx seqx

This code appears to be logically correct but was incredibly slow - so slow that after over 2 minutes it still hadn’t completed.  I admit I can be a little impatient with these things from time to time, but in this case something was obviously wrong.

I devised two optimizations:

  • Reverse the order of the list. I will be more likely to find the number with the longest chain near 1,000,000 than 3.
  • Use odd numbers only. This is based on the fact that in the chain' function an odd number gets multiplied right off the bat, whereas an even number is instantly divided by 2, and also on the assumption that a higher number will be more likely to have a longer chain.  (I admit this was a complete experiment - I had no proof that it would work ahead of time, and knew it gave me the right answer only after the fact.)

The code then morphed into:

  1. module Main where
  2.  
  3. import Data.List
  4.  
  5. chain' :: Integer -> [Integer]
  6. chain' 1 = [1]
  7. chain' n
  8.    | n <= 0 = []
  9.    | even n = n : chain' (n `div` 2)
  10.    | odd n = n : chain' (n * 3 + 1)
  11.  
  12. main :: IO ()
  13. main = do
  14.     let seqx = map chain' [999999,999997..3]
  15.     let lengthx = map length seqx
  16.     print . maximum $ zip lengthx seqx

The problem I ran into with this code was that I received stack overflow errors; my list of tuples holding another long list of int’s was taking up to much memory.  I fixed this problem by computing the length of the list immediately after generating it.  The new code looked like this:

  1. import Data.List
  2.  
  3. chain' :: Integer -> [Integer]
  4. chain' 1 = [1]
  5. chain' n
  6.    | n <= 0 = []
  7.    | even n = n : chain' (n `div` 2)
  8.    | odd n = n : chain' (n * 3 + 1)
  9.  
  10. main :: IO ()
  11. main = do
  12.     let seqx = map (\x → (x, length $ chain' x) [999999,999997..3]
  13.     print . maximum $ seqx

This got me a result within the one minute time frame, but it still wasn't the right answer.  Can you figure out why?  Using the great code Jedai posted in the comments of my Apache log post, I was able to get my answer and finally complete the problem:

  1. module Main where                                                                             
  2.  
  3.  import Data.Tuple
  4.  import Data.List (sortBy)
  5.  import Data.Function (on)
  6.  
  7.  chain' :: Integer -> [Integer]
  8.  chain' 1 = [1]
  9.  chain' n
  10.    | n <= 0 = []
  11.    | even n = n : chain' (n `div` 2)
  12.    | odd n = n : chain' (n * 3 + 1)
  13.  
  14.  main :: IO ()
  15.  main = do
  16.      let seqx = map (\x -> (x, length $ chain' x)) [999999,999997..3]
  17.      print . fst . head $ sortBy (flip compare `on` snd) seqx

After figuring that out, getting the python answer was a breeze:

  1. #!/usr/bin/python
  2. """Python solution for Project Euler problem #14."""
  3.  
  4. from itertools import imap
  5.  
  6. def sequence(number):
  7. t_num = number
  8. count = 1
  9.  
  10. while(t_num > 1):
  11. if t_num % 2 == 0:
  12. t_num /= 2
  13. else:
  14. t_num = (t_num * 3) + 1
  15.  
  16. count += 1
  17.  
  18. return (count, number)
  19.  
  20. if __name__ == "__main__":
  21. print max(imap(sequence, xrange(999999,3,-2)))

Here are the speed numbers:
Haskell (complied) : 14.758s
Python : 18.537s
Haskell (runghc): 15.217s

I think the use of recursion in my Haskell code is affecting its speed of computation.  As I learned from problem 12, I can use the State Monad again to speed things up.  But I also learned from the comments of problem 12 that some people were able to substitute a scan or fold in the State Monad’s place.  So I decided to shoot for one more solution.  After studying up on scan and fold, and finding that neither was really what I wanted, I found iterate. Using iterate I was able to change the program to this:

  1. module Main where
  2.  
  3. import Data.Tuple
  4. import Data.List (sortBy, iterate)
  5. import Data.Function (on)
  6.  
  7. chain' :: Integer -> Int
  8. chain' n  
  9.     | n < 1 = 0
  10.     | otherwise = 1 + (length $ (takeWhile ( > 1) $ iterate (\x -> if even x then x `div` 2 else x * 3 + 1) n))
  11.  
  12. main :: IO ()
  13. main = do
  14.     let seqx = map (\x -> (x, chain' x)) [999999,999997..3]
  15.     print . fst . head $ sortBy (flip compare `on` snd) seqx

The new chain' function doesn't read as cleanly as the old one, but it does remove the recursion I was talking about earlier.  The computer gods rewarded my efforts by reducing the run times to these:

Haskell (complied) : 10.933s
Haskell (runghc): 11.744s

From 14.758 to 10.933 - almost 4 seconds taken off the clock!  I think a speed up like that calls for some celebrating.  Which is exactly what I'm going to do before I start on problem 15.

If you made it this far down into the article, hopefully you liked it enough to share it with your friends. Thanks if you do, I appreciate it.

Bookmark and Share