Project Euler Problem 57 in Haskell

Question

I'm very new to Haskell, and I would like some feedback on my coding style. Is there anything here that could be made more elegant or concise?

This is my solution to Project Euler Problem 57.

It is possible to show that the square root of two can be expressed as an infinite continued fraction.

$$\sqrt 2 = 1 + \dfrac{1}{2 + \dfrac{1}{2 + \dfrac{1}{2 + \ldots}}} = 1.414213\ldots$$

By expanding this for the first four iterations, we get:

1 + 1/2 = 3/2 = 1.5

1 + 1/(2 + 1/2) = 7/5 = 1.4

1 + 1/(2 + 1/(2 + 1/2)) = 17/12 = 1.41666...

1 + 1/(2 + 1/(2 + 1/(2 + 1/2))) = 41/29 = 1.41379...

The next three expansions are 99/70, 239/169, and 577/408, but the eighth expansion, 1393/985, is the first example where the number of digits in the numerator exceeds the number of digits in the denominator.

In the first one-thousand expansions, how many fractions contain a numerator with more digits than denominator?

numerator = 
 3 : 7 : zipWith (+) numerator (map ((*) 2) (tail numerator))
denominator = 
 2 : 5 : zipWith (+) denominator (map ((*) 2) (tail denominator))
numDigits :: Integer -> Int
numDigits = length . show
moreDigits :: Integer -> Integer -> Bool
moreDigits x y = (numDigits x) > (numDigits y)
countTrue :: [Bool] -> Int
countTrue = length . filter ((&&) True)
pe_057 = countTrue $ 
 take 1000 (zipWith moreDigits numerator denominator)
main :: IO ()
main = do
 print pe_057

Answer 1

I like the way you defined numerator and denominator.

I think that using length . show to compute the number of digits is a bit overkill. Do you really need to convert the number to a string to do that? I think that using a logarithm is better.

log10 = logBase 10
numDigits = ceiling . log10 . (+) 1

I don't think that moreDigits is a good name. What about longerThan?

countTrue style doesn't look too functional. What about count :: (a -> bool) -> [a] -> Int? In that way you'll have a function you can use to count the number of items matching a predicate in any list, instead of having to compute first the a list of boolean values.

If you use count you'll need to rearrange change moreDigits :: (Int, Int) -> bool and pe_057.

pe_057 = countTrue moreDigits $ 
 take 1000 (zip numerator denominator)

I also implemented an alternative solution. The main difference with respect to yours is that I generare a list of (numerator, denominator) pairs instead of having two separate lists.

nextFraction :: (Integer, Integer) -> (Integer, Integer)
nextFraction (n, d) = (2*d + n, d + n)
generator :: [(Integer, Integer)] -> [(Integer,Integer)]
generator (x: xs) = nextFraction x : generator xs
fractions :: [(Integer,Integer)]
fractions = (3,2) : generator fractions
numeratorLonger :: (Integer,Integer) -> Bool
numeratorLonger (n,d) = (numDigits n) > (numDigits d)
numDigits :: Integer -> Int
numDigits n = numDigitsImpl (div n 10) 1
numDigitsImpl :: Integer -> Int -> Int
numDigitsImpl n counter = if next == 0
 then counter
 else numDigitsImpl next (counter + 1)
 where next = div n 10
count :: (a -> Bool) -> [a] -> Int
count f xs = length $ filter id $ map f xs
projectEuler57 n = count numeratorLonger $ take n fractions
main :: IO ()
main = do
 print $ projectEuler57 1000

• castle-bravo: logBase 10 was the first thing I tried. I think the issue is that the higher values of numerator and denominator are bigger than a double can represent. The 1000th expansion of numerator, for example is 1272 bits!. That means that when logBase 10 casts it to a double, there's an overflow and logBase 10 returns Infinity. If both numerator and denominator have an infinite number of digits, then we can't say which is larger. It turns out that the logBase 10 implementation misses 30 out of 153 instances of numerator having more digits.
• mariosangiorgio: Fair enough. I didn't thought at the size that these numbers can get. I'm looking for an alternative approach to this problem. If I find any I'll let you know
• mariosangiorgio: I just added an alternative solution. I'm not sure which one is better, but I thought you might have wanted to have a look at it.
• castle-bravo: I like how you seem to have done everything in a different way. My solution is more performant though (18ms to your 48ms). Most surprising is that the recursive numDigits function that I wrote (numDigits 0 = 0, numDigits x = 1 + (numDigits (div x 10))) adds 40ms to the execution time over length . show!! I also tried using zip instead of zipWith representation and re-writing moreDigits to take tuples - also much slower. Thanks for your response!
• mariosangiorgio: Thanks for your feedback. I'm not experienced in how to improve Haskell programs performance. This evening I could give it a go with the profiler to see if I can make mine faster

Answer 2

Haskell is great for it's declarative style programs and most of the first hundred Project Euler problems are easy to write in such a way.

First of all, this problem is about ratios, so let us import Data.Ratio module.

import Data.Ratio (Ratio, numerator, denominator)

From that nice formula it is easy to see that the process of computing √2 is iterative. You just need to decide what function to iterate. Let us consider this one:

f :: Ratio Integer -> Ration Integer
f x = 1 + 1 / (1 + x)

You can check in GHCi that it is somehow relevant to the problem:

*Main> f 1
3 % 2
*Main> f it
7 % 5
*Main> f it
17 % 12
*Main> f it
41 % 29

(it is the result of the last computation in GHCi.)

There is a function iterate :: (a -> a) -> a -> [a] in Prelude that captures such a process of applying some function to the result of applying that function to the .... and so ad infinitum.

rootExpansions :: [Ratio Integer]
rootExpansions = iterate f 1

Now, when you have all of the expansions, you need to filter and count those with numerator longer than denominator.

numIsLonger :: Ratio Integer -> Bool
numIsLonger x = length (show $ numerator x) > length (show $ denominator x)

Having all parts ready you can write solution in a declarative style

main :: IO ()
main
 = print
 $ length
 $ filter numIsLonger
 $ take 1000
 $ rootExpansion

---

As an extra bonus, here is unreadable minified solution:

import GHC.Real (Ratio(..))
main :: IO ()
main
 = print
 $ length
 $ filter (\(n :% d) -> length (show n) > length (show d))
 $ take 1000
 $ iterate (\x -> 1 + 1 / (1 + x)) 1