地下鉄の求人広告2

一応動いたけど、ちょっと重い。手元のDebianでこんな感じ。もっとスマートな解き方が知りたい。

$ time ./Subway                                                                                                                       ~
'r'
./Subway 123.53s user 0.98s system 76% cpu 2:43.08 total

module Main where

s = ["zero", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine"]

s1 = tail s

size :: Integer -> Integer
size 1 = toInteger $ sum $ map length s1
size n = let prev = size (n - 1) in prev * 10 + 9 * (10 ^ (n - 2)) * base
    where base = toInteger $ sum $ map length s

place 1 = s1
place n = foldl f s (replicate (n - 1) s)
    where f :: [String] -> [String] -> [String]
          f xs ys = map concat $ sequence [xs, ys]

five_one_billion = 5100000000

exec idx = let (x, y) = recur 1 idx
           in at (place (fromInteger x)) y
    where recur n idx = let i = idx - size n
                        in if i < 0 then (n, idx) else recur (n + 1) i
          at :: [String] -> Integer -> Char
          at (x:xs) idx = let i = idx - (toInteger (length x))
                          in if i < 0 then x !! (fromInteger idx) else at xs i

main = print $ exec five_one_billion