Hello Haskellers, I have been trying to learn a bit about Haskell by solving Project Euler problems. For those of you who don't know what Project Euler is, see http://projecteuler.net After solving problem 21, which is related to amicable pairs, I decided to attempt problem 95 since it is an extension of the same topic. The full description of problem 95 is here: http://projecteuler.net/index.php?section=problems&id=95 This is the summary: "Find the smallest member of the longest amicable chain with no element exceeding one million." I have attempted to solve this problem, but my solution is too resource hungry to search the full set of 1000000 numbers. I am hoping someone reading this list can suggest : - How I can improve my algorithm - An alternative algorithm that will be more efficient - Ways to profile a Haskell program to help me understand why my implementation is performing poorly. In addition to the question above, I would also be interested in comments on the style of the code. If there is a more idiomatic way to write portions of the code, I would like to see what it is. My solution is at the bottom of this e-mail. The program will probably run obscenely slow or die from stack overflow unless you replace [1..999999] with [1..somethingSmaller] in main. Thanks, David Frey --- BEGIN Main.hs --- module Main where import ProjectEuler (takeUntil, divisors) import qualified Data.Map as M import qualified Data.IntSet as I main = let initialContext = Context (I.fromList []) 0 0 in print $ cycleStart $ foldl checkForChain initialContext [1..999999] {- Idea: * Put all the numbers that have been visited into a map regardless of whether they are a part of a chain or not. * Store the min element in the cycle and the number of elements in the cycle * As you process, from 1->n if the stopping conditions for a sumOfDivisors result are: * has already been seen before * number is less than the start of this chain attempt * >= 1,000,000 -} data Context = Context {seenNum::I.IntSet, cycleStart::Int, cycleLength::Int} hasBeenSeen :: Int -> Context -> Bool hasBeenSeen n context = I.member n (seenNum context) markSeen :: Int -> Context -> Context markSeen n context = context { seenNum = (I.insert n (seenNum context)) } deleteFromSeen :: Int -> Context -> Context deleteFromSeen n context = context { seenNum = (I.delete n (seenNum context)) } {- - Examines the context to see if the input has potential to be a chain or not - based on whether the input number has been visited before. If it could be a - chain, an attempt is made to build the chain. -} checkForChain :: Context -> Int -> Context checkForChain context n = if hasBeenSeen n context then deleteFromSeen n context else buildChain context (sum $ divisors n) n [n] {- - Builds a chain until ones of the 3 stopping conditions are met or a chain is - found. If a chain is found the context will be updated with the new chain if - it is the longest. - - Stopping Conditions: - * Number has already been seen before - * Number is less than the start of this chain attempt - * Number >= 1,000,000 -} buildChain :: Context -> Int -> Int -> [Int] -> Context buildChain context candidate first cycleList = if elem candidate cycleList then foundChain (takeUntil ((==) candidate) cycleList) context else if candidate < first || candidate >= 1000000 || hasBeenSeen candidate context then context else buildChain (markSeen candidate context) (sum $ divisors candidate) first (candidate : cycleList) {- - Updates the context with the new longest chain and the start value if the - chain input parameter is longer than the one currently in the context. -} foundChain :: [Int] -> Context -> Context foundChain ls context = let l = length ls m = minimum ls in if l > (cycleLength context) then context { cycleLength = l, cycleStart = m } else if l == (cycleLength context) then let m = minimum ls in if m < (cycleStart context) then context { cycleStart = m } else context else context --- END Main.hs --- I put a bunch of common functions in ProjectEuler.hs. Here are the relevant functions for this problem: {- - Gets all of the proper divisors of a number. That is all divisors starting - from 1, but not including itself. -} divisors :: (Integral a) => a -> [a] divisors n = let p1 = [x | x <- [1 .. floor $ sqrt $ fromIntegral n], n `mod` x == 0] p2 = map (div n) (tail p1) in p1 `concatNoDupe` (reverse p2) where {- - Concatenate two lists. If the last element in the first list and the - first element in the second list are ==, produce only the value from - the first list in the output. -} concatNoDupe :: (Eq a) => [a] -> [a] -> [a] concatNoDupe [] ys = ys concatNoDupe [x] (y:ys) = if x == y then (y : ys) else (x : y : ys) concatNoDupe (x:xs) ys = x : (concatNoDupe xs ys) {- - Similar to takeWhile, but also takes the first element that fails the - predicate. -} takeUntil :: (a -> Bool) -> [a] -> [a] takeUntil pred (x:xs) = (x : if pred x then [] else takeUntil pred xs) takeUntil _ [] = []