nroot.hs

import System.Environment
import Data.List
getNs :: IO [Integer]
getNs = getArgs >>= mapM (return . read) 
f 2 x = x * 2 + 1
f 3 x = x ^ 2 * 3 + x * 3 + 1 
next g l m = 
    if null t   then (0,0) 
                else (last t, genericLength t)
    where t = takeWhile (<= l) $ scanl1 (+) $ map (f m) [g..]
iPart i n m = let (r,d) = next i n m in return (d+1)
loop c g l m root = do
    let (r,d) = next g l m
    putStr $ show d
    let nr = newroot d
    loop (c+1)(nr*10) ((l - r) * 10 ^ m) m nr
    where newroot d = root*10+d
main = do    
    n:m:[] <- getNs    
    r <- iPart 1 n m
    print r
    if r ^ m == n 
        then print ()
        else loop 1 (r * 10) ((n-r^m)*10^m) m r