Question

The number 145 is well known for the property that the sum of the factorial of its digits is equal to 145:

\begin{aligned} 1! + 4! + 5! = 1 + 24 + 120 = 145 \end{aligned}

Perhaps less well known is 169, in that it produces the longest chain of numbers that link back to 169; it turns out that there are only three such loops that exist:

\begin{aligned} 169 &\to 363601 \to 1454 \to 169 \\ 871 &\to 45361 \to 871 \\ 872 &\to 45362 \to 872 \end{aligned}

It is not difficult to prove that EVERY starting number will eventually get stuck in a loop. For example,

\begin{aligned} 69 &\to 363600 \to 1454 \to 169 \to 363601 \, (\to 1454) \\ 78 &\to 45360 \to 871 \to 45361 \, (\to 871) \\ 540 &\to 145 \, (\to 145) \end{aligned}

Starting with 69 produces a chain of five non-repeating terms, but the longest non-repeating chain with a starting number below one million is sixty terms.

How many chains, with a starting number below one million, contain exactly sixty non-repeating terms?

Haskell

import qualified Data.Set as Set

factorial :: Integer -> Integer
factorial n = product [1..n]

digits :: Integer -> [Integer]
digits 0 = []
digits n = r : digits q
    where (q, r) = quotRem n 10

next :: Integer -> Integer
next = sum . map factorial . digits

chain :: Integer -> Integer
chain = inner Set.empty where
    inner set x | Set.member x set = 0
                | otherwise = 1 + inner (Set.insert x set) (next x)

main :: IO ()
main = print $ length $ filter ((== 60) . chain) [1..1000000]

$ ghc -O2 -o factorial-chains factorial-chains.hs
$ time ./factorial-chains
real   0m23.054s
user   0m22.973s
sys    0m0.079s