fork download
--
-- 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

Not running #stdin #stdout 0s 0KB
stdin
Standard input is empty
stdout

Standard output is empty