Comparing 3 output lists in haskell

Question

Hi I am doing another project euler question and I need to find when the result of these 3 lists is equal (we are given 40755 as the first time they are equal, I need to find the next:

hexag n = [ n*(2*n-1)   | n <- [40755..]] 
penta n = [ n*(3*n-1)/2 | n <- [40755..]] 
trian n = [ n*(n+1)/2   | n <- [40755..]]

I tried adding in the other lists as predicates of the first list, but that didn't work:

hexag n = [ n*(2*n-1)   | n <- [40755..], penta n == n, trian n == n]

I am stuck as to where to to go from here.

I tried graphing the function and even calculus but to no avail, so I must resort to a Haskell solution.

Answer 1

There's at least a couple ways you can do this.

You could look at the first item, and compare the rest of the items to it:

Prelude> (\x -> all (== (head x)) $ tail x) [ [1,2,3], [1,2,3], [4,5,6] ]
False
Prelude> (\x -> all (== (head x)) $ tail x) [ [1,2,3], [1,2,3], [1,2,3] ]
True

Or you could make an explicitly recursive function similar to the previous:

-- test.hs
f [] = True
f (x:xs) = f' x xs where
    f' orig (y:ys) = if orig == y then f' orig ys else False
    f' _ [] = True


Prelude> :l test.hs
[1 of 1] Compiling Main             ( test.hs, interpreted )
Ok, modules loaded: Main.
*Main> f [ [1,2,3], [1,2,3], [1,2,3] ]
True
*Main> f [ [1,2,3], [1,2,3], [4,5,6] ]
False

You could also do a takeWhile and compare the length of the returned list, but that would be neither efficient nor typically Haskell.

---

Oops, just saw that didn't answer your question at all. Marking this as CW in case anyone stumbles upon your question via Google.

Answer 2

• Your functions are weird. They get n and then ignore it?
• You also have a confusion between function's inputs and outputs. The 40755th hexagonal number is 3321899295, not 40755.

If you really want a spoiler to the problem (but doesn't that miss the point?):

binarySearch :: Integral a => (a -> Bool) -> a -> a -> a
binarySearch func low high
  | low == high = low
  | func mid = search low mid
  | otherwise = search (mid + 1) high
  where
    search = binarySearch func
    mid = (low+high) `div` 2

infiniteBinarySearch :: Integral a => (a -> Bool) -> a
infiniteBinarySearch func =
  binarySearch func ((lim+1) `div` 2) lim
  where
    lim = head . filter func . lims $ 0
    lims x = x:lims (2*x+1)

inIncreasingSerie :: (Ord a, Integral i) => (i -> a) -> a -> Bool
inIncreasingSerie func val =
  val == func (infiniteBinarySearch ((>= val) . func))

figureNum :: Integer -> Integer -> Integer
figureNum shape index = (index*((shape-2)*index+4-shape)) `div` 2

main :: IO ()
main =
  print . head . filter r $ map (figureNum 6) [144..]
  where
    r x = inIncreasingSerie (figureNum 5) x && inIncreasingSerie (figureNum 3) x

Answer 3

Here's a simple, direct answer to exactly the question you gave:

*Main> take 1 $ filter (\(x,y,z) -> (x == y) && (y == z)) $ zip3 [1,2,3] [4,2,6] [8,2,9]
[(2,2,2)]

Of course, yairchu's answer might be more useful in actually solving the Euler question :)

Answer 4

The easiest way is to respecify your problem slightly

Rather than deal with three lists (note the removal of the superfluous n argument):

hexag = [ n*(2*n-1) | n <- [40755..]]
penta = [ n*(3*n-1)/2 | n <- [40755..]] 
trian = [ n*(n+1)/2   | n <- [40755..]]

You could, for instance generate one list:

matches :: [Int]
matches = matches' 40755


matches' :: Int -> [Int]
matches' n 
    | hex == pen && pen == tri = n : matches (n + 1)
    | otherwise                =     matches (n + 1) where
   hex = n*(2*n-1)
   pen = n*(3*n-1)/2
   tri = n*(n+1)/2

Now, you could then try to optimize this for performance by noticing recurrences. For instance when computing the next match at (n + 1):

(n+1)*(n+2)/2 - n*(n+1)/2 = n + 1

so you could just add (n + 1) to the previous tri to obtain the new tri value.

Similar algebraic simplifications can be applied to the other two functions, and you can carry all of them in accumulating parameters to the function matches'.

That said, there are more efficient ways to tackle this problem.