language: Haskell (ghc-7.4.1)
date: 653 days 17 hours ago
link:
visibility: public 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89

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