Detecting cyclic behaviour in Haskell

Question

Hi

I am doing yet another projecteuler question in Haskell, where I must find if the sum of the factorials of each digit in a number is equal to the original number. If not repeat the process until the original number is reached. The next part is to find the number of starting numbers below 1 million that have 60 non-repeating units. I got this far:

prob74 = length [ x | x <- [1..999999], 60 == ((length $ chain74 x)-1)]

factorial n = product [1..n]

factC x = sum $ map factorial (decToList x)

chain74 x  | x == 0 = []
           | x == 1 = [1]
           | x /= factC x = x : chain74 (factC x)

But what I don't know how to do is to get it to stop once the value for x has become cyclic. How would I go about stopping chain74 when it gets back to the original number?

Answer 1

What about passing another argument (y for example) to the chain74 in the list comprehension.

Morning fail so EDIT:

[.. ((length $ chain74 x x False)-1)]



chain74 x y not_first  | x == y && not_first = replace_with_stop_value_:-)
                       | x == 0 = []
                       | x == 1 = [1]
                       | x == 2 = [2]
                       | x /= factC x = x : chain74 (factC x) y True

Answer 2

I implemented a cycle-detection algorithm in Haskell on my blog. It should work for you, but there might be a more clever approach for this particular problem:

http://coder.bsimmons.name/blog/2009/04/cycle-detection/

Just change the return type from String to Bool.

EDIT: Here is a modified version of the algorithm I posted about:

cycling :: (Show a, Eq a) => Int -> [a] -> Bool
cycling k []     = False --not cycling
cycling k (a:as) = find 0 a 1 2 as
    where find _ _ c _  [] = False
          find i x c p (x':xs) 
            | c >  k    =  False  -- no cycles after k elements
            | x == x'   =  True   -- found a cycle 
            | c == p    = find c x' (c+1) (p*2) xs 
            | otherwise = find i x  (c+1) p xs

You can remove the 'k' if you know your list will either cycle or terminate soon.

EDIT2: You could change the following function to look something like:

prob74 = length [ x | x <- [1..999999], let chain = chain74 x, not$ cycling 999 chain, 60 == ((length chain)-1)]

Answer 3

Quite a fun problem. I've come up with a corecursive function that returns the list of the "factorial chains" for every number, stopping as soon as they would repeat themselves:

chains = [] : let f x = x : takeWhile (x /=) (chains !! factC x) in (map f [1..])

Giving:

take 4 chains == [[],[1],[2],[3,6,720,5043,151,122,5,120,4,24,26,722,5044,169,363601,1454]]

map head $ filter ((== 60) . length) (take 10000 chains) 
is 
[1479,1497,1749,1794,1947,1974,4079,4097,4179,4197,4709,4719,4790,4791,4907,4917
,4970,4971,7049,7094,7149,7194,7409,7419,7490,7491,7904,7914,7940,7941,9047,9074
,9147,9174,9407,9417,9470,9471,9704,9714,9740,9741]

It works by calculating the "factC" of its position in the list, then references that position in itself. This would generate an infinite list of infinite lists (using lazy evaluation), but using takeWhile the inner lists only continue until the element occurs again or the list ends (meaning a deeper element in the corecursion has repeated itself).

If you just want to remove cycles from a list you can use:

decycle :: Eq a => [a] -> [a]
decycle = dc []
    where
        dc _ [] = []
        dc xh (x : xs) = if elem x xh then [] else x : dc (x : xh) xs

decycle [1, 2, 3, 4, 5, 3, 2] == [1, 2, 3, 4, 5]

Answer 4

When you walk through the list that might contain a cycle your function needs to keep track of the already seen elements to be able to check for repetitions. Every new element is compared against the already seen elements. If the new element has already been seen, the cycle is complete, if it hasn't been seen the next element is inspected.

So this calculates the length of the non-cyclic part of a list:

uniqlength :: (Eq a) => [a] -> Int
uniqlength l = uniqlength_ l []
   where uniqlength_ [] ls = length ls
         uniqlength_ (x:xs) ls
            | x `elem` ls = length ls
            | otherwise   = uniqlength_ xs (x:ls)

(Performance might be better when using a set instead of a list, but I haven't tried that.)