Project Euler #45 in Haskell

Question

I've got a solution for Project Euler's problem 45.

Triangle, pentagonal, and hexagonal numbers are generated by the following formulae:

$$\begin{array}{lll} \textrm{Triangle} & T_n=n(n+1)/2 & 1, 3, 6, 10, 15, \ldots \\ \textrm{Pentagonal} & P_n=n(3n−1)/2 & 1, 5, 12, 22, 35, \ldots \\ \textrm{Hexagonal} & H_n=n(2n−1) & 1, 6, 15, 28, 45, \ldots \\ \end{array}$$

It can be verified that \$T_{285} = P_{165} = H_{143} = 40755\$.

Find the next triangle number that is also pentagonal and hexagonal.

It runs in under a second (so performance isn't an issue), but I can't help but feel that I'm doing it in an ugly way; I feel like I'm missing some sort of builtin like zipWith3.

Here's my current code:

tris  = scanl (+) 1 [2..]
pents = scanl (+) 1 [4,7..]
hexes = scanl (+) 1 [5,9..]

These are just the infinite lists of triangle, pentagonal, and hexagonal numbers.

findSame :: [Int] -> [Int] -> [Int] -> [Int]
findSame (x:xs) (y:ys) (z:zs)
    | (x==y) && (x==z) = x:(findSame xs ys zs)
    | (x<=y) && (x<=z) = findSame xs (y:ys) (z:zs)
    | (y<=x) && (y<=z) = findSame (x:xs) ys (z:zs)
    | (z<=x) && (z<=y) = findSame (x:xs) (y:ys) zs

This goes through the 3 lists at the same time and puts the numbers in a new list if they're equal (this also creates an infinite list).

This is the part where I think I could improve - this ended up looking relatively ugly.

main = do
    print $ last $ take 3 $ findSame tris pents hexes

This is just the main method and is pretty straightforward.

Any feedback on this code, especially the middle portion, would be very appreciated. Creating code that looks clean is what motivates me to keep doing these, so ending up with this more brute-force approach leaves me hanging a bit.

Answer 1

The first observation that I would make is that your type signature is too specific:

findSame :: [Int] -> [Int] -> [Int] -> [Int]

The function should work for any Ord a:

findSame :: Ord a => [a] -> [a] -> [a] -> [a]

The second observation is that you don't need to work on three lists at a time. You could just take two lists at a time:

findSame tris $ findSame pents hexes

But what is the findSame operation then? It's the intersection of two ordered lists. A quick search reveals an isect function in Data.Ordered.List.

So, the solution could just be

import Data.List.Ordered (isect)
head $ filter (> 40755) $ isect tris $ isect pents hexes

Or, more elegantly:

head $ filter (> 40755) $ foldr1 isect [hexes, pents, tris]

The implementation of isect is simple enough that you could just "steal" it.

---

Minor note: Personally, I would define the sequences so that the subscripts match the notation in the problem statement.

tris  = scanl (+) 0 [1..]
pents = scanl (+) 0 [1, 4..]
hexes = scanl (+) 0 [1, 5..]

That also makes it easier to generalize:

polygonalSeq :: Int -> [Int]
polygonalSeq s = scanl (+) 0 [1, (s - 1)..]
head $ filter (> 40755) $ foldr1 isect $ map polygonalSeq [6, 5, 3]