dhc7.hs

import Control.Parallel.Strategies ( parListChunk, rdeepseq, using )
import Data.List                   ( any, genericLength, group, sort, sortBy )
import Data.Set                    ( deleteFindMin, fromList, insert )

digits :: Integer -> [Integer]
digits 0 = [0]
digits n = (n `mod` 10) : if n > 9 then digits (n `div` 10) else []

nextTerm :: Integer -> Integer
nextTerm n = foldl (\acc (a, b) -> acc * 100 + a * 10 + b) 0 gs
    where gs = (\g -> (genericLength g, head g)) <$> (group . sort . digits) n

cleanChain :: [Integer] -> Integer -> [Integer]
cleanChain s n | n `elem` s = []
               | otherwise  = n : cleanChain (n : s) (nextTerm n)

chain :: Integer -> [Integer]
chain = cleanChain []

chainLength :: Integer -> Int
chainLength = length . chain

terms :: Int -> [Integer]
terms n = 0 : concat (pad <$> ts)
  where
    ts = takeWhile (< 10 ^ n) $ f (fromList [1 .. 9])
    pad t = scanl (\x _ -> x * 10) t [length $ digits t .. n - 1]
    f s = m : f (foldl (flip insert) s' $ map (10 * m +) [m `mod` 10 .. 9])
        where (m, s') = deleteFindMin s

main :: IO ()
main = mapM_ print $ take 5 sorted
  where
    gt t = (t, chainLength t)
    gs     = gt <$> terms 10 `using` parListChunk 128 rdeepseq
    sorted = sortBy (\(_, a) (_, b) -> compare b a) gs