Hi I am generating a sparse DAG of 1000 X 1000 nodes each having ~4 edges (direction). Here is the relevant code : Full Code with imports
The problem i am solving has values between [0-1500]. I have hardcoded 1501 as upper value for now. I am trying to calculate longest path of edges in the DAG. However, these details are not direct part of my question :
My question is related to how to judge the usage of force or similar constructs while writing algos in haskell :
type OutGoingEdges = Map.Map NodeId [ NodeId ]
type NodesData = Map.Map NodeId Node
type NodeId = Int
data DAG = AdjList
{ outGoingEdges :: OutGoingEdges
, nodesData :: NodesData
} deriving (Eq, Show)
makeDAG :: DAGDataPath -> IO (DAG, SourceNodes)
makeDAG filepath = do
listOfListOfInts <- makeInteger <$> readLines filepath
let [width, height] = head listOfListOfInts
numNodes = width * height
rows = (replicate width 1501) : (drop 1 listOfListOfInts) ++ [(replicate width 1501)]
heightsWithNodeIdsRows = force . fmap (\ (row, rowId) -> fmap (\ (height, colId) -> (height, rowId * width + colId)) $ zip row [1..]) $ zip rows [1..]
emptyGraph = AdjList Map.empty $ Map.fromList (fmap (\(h, nid) -> (nid, Node h)) . concat . tail . init $ heightsWithNodeIdsRows)
emptyNodesWithEdges = Set.empty
threeRowsInOneGo = zip3 heightsWithNodeIdsRows (drop 1 heightsWithNodeIdsRows) (drop 2 heightsWithNodeIdsRows)
(graph, nodesWithInEdges) = DL.foldl' makeGraph (emptyGraph, emptyNodesWithEdges) threeRowsInOneGo
sourceNodes = Set.difference (Set.fromList . Map.keys . nodesData $ graph) nodesWithInEdges
-- traceShow [take 10 . Map.keys . nodesData $ graph] (return (Set.toList sourceNodes))
-- traceShow graph (return (Set.toList sourceNodes))
-- traceShow sourceNodes (return (Set.toList sourceNodes))
return (graph, force $ Set.toList sourceNodes)
where
makeGraph (graphTillNow, nodesWithInEdges) (prevRow, row, nextRow) =
let updownEdges = zip3 prevRow row nextRow
(graph', nodesInEdges') = addEdges (graphTillNow, nodesWithInEdges) updownEdges
leftRightEdges = zip3 ((1501, 0) : row) (drop 1 row) (drop 2 row)
(graph'', nodesInEdges'') = addEdges (graph', nodesInEdges') leftRightEdges
Next line is interesting... graph'' is DAG and nodesInEdges'' is a Set NodeId
in (graph'', nodesInEdges'')
addEdges (g, n) edges =
DL.foldl' (\ (!g', !n') ((p, pId), (c, cId), (n, nId)) ->
let (g'', n'') = if c > p
then (makeEdge cId pId g', Set.insert pId n')
else (g', n')
(g''', n''') = if c > n
then (makeEdge cId nId g'', Set.insert nId n'')
else (g'', n'')
in (g''', n'''))
(g, n)
edges
While profiling i found that, if i use (force graph'', force nodesInEdges'') instead of (graph'', nodesInEdges''), my memory usage reduces from 3 GB to 600 MB. But running time of program increases from 37 secs to 69 secs. These numbers are from time command and looking at activity monitor. I also checked with profiling and it was similar results.
I am compiling profile builds with :
stack build --executable-profiling --library-profiling --ghc-options="-fprof-auto -auto-all -caf-all -fforce-recomp -rtsopts" --file-watch
I have ghc-7.10.3 and stack 1.1.2.
I think that force goes over the data structure again and again.
Can force be told to not go over the graph if it already fully evaluated ?
Can i use some other strategy ?
Sample Input:
2 2 -- width height
1 2
3 4
Output:
3
Output is length of longest path in the graph. [4 -> 2 -> 1] i.e. [(1,1),(0,1), (0,0)]. Just to remind, correctness of program is not the question;
space/time efficiency is. Thanks
Related
I'm using a state transformer to randomly sample a dataset at every point of a 2D recursive walk, which outputs a list of 2D grids of samples that together succeed a condition. I'd like to pull from the results lazily, but my approach instead exhausts the whole dataset at every point before I can pull the first result.
To be concrete, consider this program:
import Control.Monad ( sequence, liftM2 )
import Data.Functor.Identity
import Control.Monad.State.Lazy ( StateT(..), State(..), runState )
walk :: Int -> Int -> [State Int [Int]]
walk _ 0 = [return [0]]
walk 0 _ = [return [0]]
walk x y =
let st :: [State Int Int]
st = [StateT (\s -> Identity (s, s + 1)), undefined]
unst :: [State Int Int] -- degenerate state tf
unst = [return 1, undefined]
in map (\m_z -> do
z <- m_z
fmap concat $ sequence [
liftM2 (zipWith (\x y -> x + y + z)) a b -- for 1D: map (+z) <$> a
| a <- walk x (y - 1) -- depth
, b <- walk (x - 1) y -- breadth -- comment out for 1D
]
) st -- vs. unst
main :: IO ()
main = do
std <- getStdGen
putStrLn $ show $ head $ fst $ (`runState` 0) $ head $ walk 2 2
The program walks the rectangular grid from (x, y) to (0, 0) and sums all the results, including the value of one of the lists of State monads: either the non-trivial transformers st that read and advance their state, or the trivial transformers unst. Of interest is whether the algorithm explores past the heads of st and unst.
In the code as presented, it throws undefined. I chalked this up to a misdesign of my order of chaining the transformations, and in particular, a problem with the state handling, as using unst instead (i.e. decoupling the result from state transitions) does produce a result. However, I then found that a 1D recursion also preserves laziness even with the state transformer (remove the breadth step b <- walk... and swap the liftM2 block for fmap).
If we trace (show (x, y)), we also see that it does walk the whole grid before triggering:
$ cabal run
Build profile: -w ghc-8.6.5 -O1
...
(2,2)
(2,1)
(1,2)
(1,1)
(1,1)
sandbox: Prelude.undefined
I suspect that my use of sequence is at fault here, but as the choice of monad and the dimensionality of the walk affect its success, I can't say broadly that sequenceing the transformations is the source of strictness by itself.
What's causing the difference in strictness between 1D and 2D recursion here, and how can I achieve the laziness I want?
Consider the following simplified example:
import Control.Monad.State.Lazy
st :: [State Int Int]
st = [state (\s -> (s, s + 1)), undefined]
action1d = do
a <- sequence st
return $ map (2*) a
action2d = do
a <- sequence st
b <- sequence st
return $ zipWith (+) a b
main :: IO ()
main = do
print $ head $ evalState action1d 0
print $ head $ evalState action2d 0
Here, in both the 1D and 2D calculations, the head of the result depends explicitly only on the heads of the inputs (just head a for the 1D action and both head a and head b for the 2D action). However, in the 2D calculation, there's an implicit dependency of b (even just its head) on the current state, and that state depends on the evaluation of the entirety of a, not just its head.
You have a similar dependency in your example, though it's obscured by the use of lists of state actions.
Let's say we wanted to run the action walk22_head = head $ walk 2 2 manually and inspect the first integer in the resulting list:
main = print $ head $ evalState walk22_head
Writing the elements of the state action list st explicitly:
st1, st2 :: State Int Int
st1 = state (\s -> (s, s+1))
st2 = undefined
we can write walk22_head as:
walk22_head = do
z <- st1
a <- walk21_head
b <- walk12_head
return $ zipWith (\x y -> x + y + z) a b
Note that this depends only on the defined state action st1 and the heads of walk 2 1 and walk 1 2. Those heads, in turn, can be written:
walk21_head = do
z <- st1
a <- return [0] -- walk20_head
b <- walk11_head
return $ zipWith (\x y -> x + y + z) a b
walk12_head = do
z <- st1
a <- walk11_head
b <- return [0] -- walk02_head
return $ zipWith (\x y -> x + y + z) a b
Again, these depend only on the defined state action st1 and the head of walk 1 1.
Now, let's try to write down a definition of walk11_head:
walk11_head = do
z <- st1
a <- return [0]
b <- return [0]
return $ zipWith (\x y -> x + y + z) a b
This depends only on the defined state action st1, so with these definitions in place, if we run main, we get a defined answer:
> main
10
But these definitions aren't accurate! In each of walk 1 2 and walk 2 1, the head action is a sequence of actions, starting with the action that invokes walk11_head, but continuing with actions based on walk11_tail. So, more accurate definitions would be:
walk21_head = do
z <- st1
a <- return [0] -- walk20_head
b <- walk11_head
_ <- walk11_tail -- side effect of the sequennce
return $ zipWith (\x y -> x + y + z) a b
walk12_head = do
z <- st1
a <- walk11_head
b <- return [0] -- walk02_head
_ <- walk11_tail -- side effect of the sequence
return $ zipWith (\x y -> x + y + z) a b
with:
walk11_tail = do
z <- undefined
a <- return [0]
b <- return [0]
return [zipWith (\x y -> x + y + z) a b]
With these definitions in place, there's no problem running walk12_head and walk21_head in isolation:
> head $ evalState walk12_head 0
1
> head $ evalState walk21_head 0
1
The state side effects here are not needed to calculate the answer and so never invoked. But, it's not possible to run them both in sequence:
> head $ evalState (walk12_head >> walk21_head) 0
*** Exception: Prelude.undefined
CallStack (from HasCallStack):
error, called at libraries/base/GHC/Err.hs:78:14 in base:GHC.Err
undefined, called at Lazy2D_2.hs:41:8 in main:Main
Therefore, trying to run main fails for the same reason:
> main
*** Exception: Prelude.undefined
CallStack (from HasCallStack):
error, called at libraries/base/GHC/Err.hs:78:14 in base:GHC.Err
undefined, called at Lazy2D_2.hs:41:8 in main:Main
because, in calculating walk22_head, even the very beginning of walk21_head's calculation depends on the state side effect walk11_tail initiated by walk12_head.
Your original walk definition behaves the same way as these mockups:
> head $ evalState (head $ walk 1 2) 0
1
> head $ evalState (head $ walk 2 1) 0
1
> head $ evalState (head (walk 1 2) >> head (walk 2 1)) 0
*** Exception: Prelude.undefined
CallStack (from HasCallStack):
error, called at libraries/base/GHC/Err.hs:78:14 in base:GHC.Err
undefined, called at Lazy2D_0.hs:15:49 in main:Main
> head $ evalState (head (walk 2 2)) 0
*** Exception: Prelude.undefined
CallStack (from HasCallStack):
error, called at libraries/base/GHC/Err.hs:78:14 in base:GHC.Err
undefined, called at Lazy2D_0.hs:15:49 in main:Main
It's hard to say how to fix this. Your toy example was excellent for the purposes of illustrating the problem, but it's not clear how the state is used in your "real" problem and if head $ walk 2 1 really has a state dependency on the sequence of walk 1 1 actions induced by head $ walk 1 2.
The accepted answer by K.A. Buhr is right: while getting the head of one step in each direction is fine (try walk with either x < 2 or y < 2) the combination of the implicit >>= in liftM2, the sequence in the value of a and the state dependency in the value of b makes b depend on all side effects of a. As he also pointed out, a working solution depends on what dependencies are actually wanted.
I'll share a solution for my particular case: each walk call depends on the state of the caller at least, and perhaps some other states, based on a pre-order traversal of the grid and alternatives in st. In addition, as the question suggests, I want to try to make a full result before testing any unneeded alternatives in st. This is a little difficult to explain visually, but here's the best I could do: the left shows the variable number of st alternatives at each coordinate (which is what I have in my actual use case) and the right shows a [rather messy] map of the desired dependency order of the state: we see it traverses x-y first in a 3D DFS, with "x" as depth (fastest axis), "y" as breadth (middle axis), then finally alternatives as the slowest axis (shown in dashed lines with open circles).
The central issue in the original implementation came from sequencing lists of state transitions to accommodate the non-recursive return type. Let's replace the list type altogether with a type that's recursive in the monad parameter, so the caller can better control the dependency order:
data ML m a = MCons a (MML m a) | MNil -- recursive monadic list
newtype MML m a = MML (m (ML m a)) -- base case wrapper
An example of [1, 2]:
MCons 1 (MML (return (MCons 2 (MML (return MNil)))))
Functor and Monoid behaviors are used often, so here's the relevant implementations:
instance Functor m => Functor (ML m) where
fmap f (MCons a m) = MCons (f a) (MML $ (fmap f) <$> coerce m)
fmap _ MNil = MNil
instance Monad m => Semigroup (MML m a) where
(MML l) <> (MML r) = MML $ l >>= mapper where
mapper (MCons la lm) = return $ MCons la (lm <> (MML r))
mapper MNil = r
instance Monad m => Monoid (MML m a) where
mempty = MML (pure MNil)
There are two critical operations: combining steps in two different axes, and combining lists from different alternatives at the same coordinate. Respectively:
Based on the diagram, we want to get a single full result from the x step first, then a full result from the y step. Each step returns a list of results from all combinations of viable alternatives from inner coordinates, so we take a Cartesian product over both lists, also biased in one direction (in this case y fastest). First we define a "concatenation" that applies a base case wrapper MML at the end of a bare list ML:
nest :: Functor m => MML m a -> ML m a -> ML m a
nest ma (MCons a mb) = MCons a (MML $ nest ma <$> coerce mb)
then a Cartesian product:
prodML :: Monad m => (a -> a -> a) -> ML m a -> ML m a -> ML m a
prodML f x (MCons ya ym) = (MML $ prodML f x <$> coerce ym) `nest` ((f ya) <$> x)
prodML _ MNil _ = MNil
We want to smash the lists from different alternatives into one list and we don't care that this introduces dependencies between alternatives. This is where we use mconcat from the Monoid instance.
All in all, it looks like this:
walk :: Int -> Int -> MML (State Int) Int
-- base cases
walk _ 0 = MML $ return $ MCons 1 (MML $ return MNil)
walk 0 _ = walk 0 0
walk x y =
let st :: [State Int Int]
st = [StateT (\s -> Identity (s, s + 1)), undefined]
xstep = coerce $ walk (x-1) y
ystep = coerce $ walk x (y-1)
-- point 2: smash lists with mconcat
in mconcat $ map (\mz -> MML $ do
z <- mz
-- point 1: product over results
liftM2 ((fmap (z+) .) . prodML (+)) xstep ystep
) st
headML (MCons a _) = a
headML _ = undefined
main :: IO ()
main = putStrLn $ show $ headML $ fst $ (`runState` 0) $ (\(MML m) -> m) $ walk 2 2
Note the result have changed with the semantics. It doesn't matter to me since my goal only needed to pull random numbers from state, and whatever dependency order is needed can be controlled with the right shepherding of list elements into the final result.
(I'll also warn that without memoization or attention to strictness, this implementation is very inefficient for large x and y.)
I want to rotate a string in haskell, so if I give "Now I want to scream" to rotate [[want to scream now I],[scream now I want to]] , if the string start with "I" or "to" then must eliminate it. Till now I still have problems with the rotation.
reverseWords :: String -> String
reverseWords = unwords . reverse . words
shiftt :: [a] -> Int -> [a]
shiftt l n = drop n l ++ take n l
rot::String->[String]
rot l = [ reverseWords l i | i <- [0 .. (length l) -1]]
create a list of all rotations, then filter out based on your predicate. For example,
rotations x = take (length x) $ iterate rot1 x
where rot1 = drop 1 x ++ take 1 x
filteredRots = map unwords . filter (\x -> length (head x) > 2) . rotations . words
and use as
> filteredRots "Now I want to scream"
["Now I want to scream","want to scream Now I","scream Now I want to"]
Prelude>
all.
While trying to solve some programming quiz:
https://www.hackerrank.com/challenges/missing-numbers
, I came across with space leak.
Main function is difference, which implements multi-set difference.
I've found out that List ':' and Triples (,,) kept on heaps
with -hT option profiling. However, only big lists are difference's
two arguments, and it shrinks as difference keeps on tail recursion.
But the memory consumed by lists keeps increasing as program runs.
Triples is ephemeral array structure, used for bookkeeping the count of multiset's each element. But the memory consumed by triples also
keeps increasing, and I cannot find out why.
Though I've browsed similar 'space leak' questions in stackoverflow,
I couldn't grasp the idea. Surely I have much to study.
I appreciate any comments. Thank you.
p.s) executable is compiled with -O2 switch.
$ ./difference -hT < input04.txt
Stack space overflow: current size 8388608 bytes.
$ ghc --version
The Glorious Glasgow Haskell Compilation System, version 7.6.3
.
import Data.List
import Data.Array
-- array (non-zero-count, start-offset, array_data)
array_size=101
myindex :: Int -> Int -> Int
myindex key offset
| key >= offset = key - offset
| otherwise = key - offset + array_size
mylookup x (_,offset,arr) = arr ! idx
where idx = myindex x offset
addOrReplace :: Int -> Int -> (Int, Int, Array Int (Int,Int)) -> (Int, Int, Array Int (Int,Int))
addOrReplace key value (count,offset,arr) = (count', offset, arr // [(idx,(key,value))])
where idx = myindex key offset
(_,prev_value) = arr ! idx
count' = case (prev_value, value) of
(0,0) -> count
(0,_) -> count + 1
(_,0) -> count - 1
otherwise -> count
difference :: (Int,Int,Array Int (Int,Int)) -> [Int] -> [Int] -> [Int]
difference (count,offset,arr) [] []
| count == 0 = []
| otherwise = [ k | x <- [0..array_size-1], let (k,v) = (arr ! x), v /= 0]
difference m (x:xs) y = difference new_m xs y
where (_,v) = mylookup x m
new_m = addOrReplace x (v + 1) m
difference m [] (y:ys) = difference new_m [] ys
where (_,v) = mylookup y m
new_m = if v == 0
then m
else addOrReplace y (v - 1) m
main = do
n <- readLn :: IO Int
pp <- getLine
m <- readLn :: IO Int
qq <- getLine
let p = map (read :: String->Int) . words $ pp
q = map (read :: String->Int) . words $ qq
startArray = (0,head q, array (0,100) [(i,(0,0)) | i <- [0..100]] )
putStrLn . unwords . map show . sort $ difference startArray q p
[EDIT]
I seq'ed value and Array thanks to Carl's advice.
I attach heap diagram.
[original heap profiling]
[]1
[after seq'ing value v]
difference m (x:xs) y = difference new_m xs y
where (_,v) = mylookup x m
new_m = v `seq` addOrReplace x (v + 1) m
[after seq'ing value v and Array]
difference m (x:xs) y = new_m `seq` difference new_m xs y
where (_,v) = mylookup x m
new_m = v `seq` addOrReplace x (v + 1) m
I see three main problems with this code.
First (and not the cause of the memory use, but definitely the cause of generally poor performance) Array is horrible for this use case. O(1) lookups are useless when updates are O(n).
Speaking of, the values being stored in the Array aren't forced while difference is looping over its first input. They are thunks containing pointers to an unevaluated lookup in the previous version of the array. You can ensure that the value is evaluated at the same time the array is updated, in a variety of ways. When difference loops over its second input, it does this accidentally, in fact, by comparing the value against 0.
Third, difference doesn't even force the evaluation of the new arrays being created while traversing its first argument. Nothing requires the old array to be evaluated during that portion of the loop.
Both of those latter issues need to be resolved to fix the space leak. The first issue doesn't cause a space leak, just much higher overheads than needed.
I hope this works by just pasting and running it with "runghc euler4.hs 1000". Since I am having a hard time learning Haskell, can someone perhaps tell me how I could improve here? Especially all those "fromIntegral" are a mess.
module Main where
import System.Environment
main :: IO ()
main = do
args <- getArgs
let
hBound = read (args !! 0)::Int
squarePal = pal hBound
lBound = floor $ fromIntegral squarePal /
(fromIntegral hBound / fromIntegral squarePal)
euler = maximum $ takeWhile (>squarePal) [ x | y <- [lBound..hBound],
z <- [y..hBound],
let x = y * z,
let s = show x,
s == reverse s ]
putStrLn $ show euler
pal :: Int -> Int
pal n
| show pow == reverse (show pow) = n
| otherwise = pal (n-1)
where
pow = n^2
If what you want is integer division, you should use div instead of converting back and forth to Integral in order to use ordinary /.
module Main where
import System.Environment
main :: IO ()
main = do
(arg:_) <- getArgs
let
hBound = read arg :: Int
squarePal = pal hBound
lBound = squarePal * squarePal `div` hBound
euler = maximum $ takeWhile (>squarePal) [ x | y <- [lBound..hBound],
z <- [y..hBound],
let x = y * z,
let s = show x,
s == reverse s ]
print euler
pal :: Int -> Int
pal n
| show pow == reverse (show pow) = n
| otherwise = pal (n - 1)
where
pow = n * n
(I've re-written the lbound expression, that used two /, and fixed some styling issues highlighted by hlint.)
Okay, couple of things:
First, it might be better to pass in a lower bound and an upper bound for this question, it makes it a little bit more expandable.
If you're only going to use the first two (one in your previous case) arguments from the CL, we can handle this with pattern matching easily and avoid yucky statements like (args !! 0):
(arg0:arg1:_) <- getArgs
Let's convert these to Ints:
let [a, b] = map (\x -> read x :: Int) [arg0,arg1]
Now we can reference a and b, our upper and lower bounds.
Next, let's make a function that runs through all of the numbers between an upper and lower bound and gets a list of their products:
products a b = [x*y | x <- [a..b], y <- [x..b]]
We do not have to run over each number twice, so we start x at our current y to get all of the different products.
from here, we'll want to make a method that filters out non-palindromes in some data set:
palindromes xs = filter palindrome xs
where palindrome x = show x == reverse $ show x
finally, in our main function:
print . maximum . palindromes $ products a b
Here's the full code if you would like to review it:
import System.Environment
main = do
(arg0:arg1:_) <- getArgs
let [a, b] = map (\x -> read x :: Int) [arg0,arg1]
print . maximum . palindromes $ products a b
products a b = [x*y | x <- [a..b], y <- [x..b]]
palindromes = filter palindrome
where palindrome x = (show x) == (reverse $ show x)
I am doing another Project Euler problem 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.
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
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 :)
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.
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.