-- -- Problem: Find the 51000000000-th character of the string (wordNumber Infinity) -- where a wordNumber is defined as -- -- wordNumber 1 = "one" -- wordNumber 2 = "onetwo" -- wordNumber 3 = "onetwothree" -- wordNumber 15 = "onetwothreefourfivesixseveneightnineteneleventwelvethirteenfourteenfifteen" -- ... -- -- The answer should be presented as ( sum of all numbers up to that point -- , the 51000000000-th character -- ) {-# LANGUAGE BangPatterns #-} import Debug.Trace import Data.Int import Control.Monad import Data.Array.Unboxed ones = ["", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine"] tens = ["", "ten", "twenty", "thirty", "forty", "fifty", "sixty", "seventy", "eighty", "ninety"] teens = ["ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen"] lenOnes, lenTens, lenTeens :: UArray Int64 Int64 lenOnes = listArray (0,9) $ [0,3,3,5,4,5,3,5,5,4] -- "", "one","two", ... lenTens = listArray (0,9) $ [0,3,6,6,5,5,5,7,6,6] lenTeens = listArray (0,9) $ [3,6,6,8,8,7,7,9,8,8] -- first element is "ten" 3 -- potentially cleaner version -- but I feared Haskell might do surprising things behind my -- back so I stuck with the above -- lenBelowHundred = listArray (0,99) $ map (fromIntegral . length . wordify) [1..99] -- wordify 123 = "onehundredtwentythree" -- This is only used once in presenting the final result character wordify :: Int64 -> String wordify n | n < 10 = ones !! fromIntegral n | n < 20 = teens !! (fromIntegral n-10) | n < 100 = splitterTen | n < 1000 = splitter 100 "hundred" | n < 1000000 = splitter 1000 "thousand" | n < 1000000000 = splitter 1000000 "million" where splitterTen = let (t, x) = n `divMod` 10 in (tens !! fromIntegral t) ++ wordify x splitter div suffix = let (t, x) = n `divMod` div in (wordify t) ++ suffix ++ wordify x -- Optimized version of length (wordify n) -- Used in number crunching wordLength n = wordLength' 0 n -- Tail recursive version wordLength' :: Int64 -> Int64 -> Int64 wordLength' !pad !n | n < 10 = lenOnes ! n + pad | n < 20 = lenTeens ! (n-10) + pad | n < 100 = splitterTen | n < 1000 = splitter 100 7 | n < 1000000 = splitter 1000 8 | otherwise = splitter 1000000 7 where splitterTen = let !(!t, !x) = n `divMod` 10 in wordLength' (lenTens ! t + pad) x splitter !d !suffix = let !(!t, !x) = n `divMod` d in wordLength' (wordLength' (suffix+pad) t) x -- Tail recursive solve :: Int64 -> (Int64, Int64, Int64) -> [Int64] -> (Int64, Int64, Int64) solve !n !acc@(!sumNum, !sumLen, !curr) (!num:nums) | sumLen' >= n = (sumNum', sumLen, num) | otherwise = solve n (sumNum', sumLen', num) nums where sumNum' = sumNum + num sumLen' = sumLen + wordLength num solution :: Int64 -> (Int64, Char) solution !x = let (sumNum, sumLen, n) = solve x (0,0,1) [1..] in (sumNum, (wordify n) !! (fromIntegral $ x - sumLen - 1)) main = do print $ solution 1234 -- Make sure we are sane print $ solution 51000000000