language: Haskell (ghc-7.4.1)
date: 654 days 19 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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120

--
-- 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
 
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"]
 
-- onesLengths = map (fromIntegral . length) ones
-- tensLengths = map (fromIntegral . length) tens
-- teensLengths = map (fromIntegral . length) teens
 
-- As suggested on #haskell, pattern matching
-- 'lensOnes n' should be faster than 'onesLengths !! n'
 
lenOnes, lenTens, lenTeens :: Int64 -> Int64
lenOnes 0 = 0
lenOnes 1 = 3
lenOnes 2 = 3
lenOnes 3 = 5
lenOnes 4 = 4
lenOnes 5 = 5
lenOnes 6 = 3
lenOnes 7 = 5
lenOnes 8 = 5
lenOnes 9 = 4
 
lenTens 0 = 0
lenTens 1 = 3
lenTens 2 = 6
lenTens 3 = 6
lenTens 4 = 5
lenTens 5 = 5
lenTens 6 = 5
lenTens 7 = 7
lenTens 8 = 6
lenTens 9 = 6
 
lenTeens 0 = 3
lenTeens 1 = 6
lenTeens 2 = 6
lenTeens 3 = 8
lenTeens 4 = 8
lenTeens 5 = 7
lenTeens 6 = 7
lenTeens 7 = 9
lenTeens 8 = 8
lenTeens 9 = 8
 
-- 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
-- n-th number (51000000000 in our problem) -> accumulated result -> list of 'zipped' left to try
-- accumulated has the format (sum of numbers, current lengths of the whole chain, the current number)
solve :: Int64 -> (Int64, Int64, Int64) -> [(Int64, Int64)] -> (Int64, Int64, Int64)
solve !n !acc@(!sumNum, !sumLen, !curr) ((!num, !len):xs)
    | sumLen' >= n = (sumNum', sumLen, num)
    | otherwise = solve n (sumNum', sumLen', num) xs
    where
        sumNum' = sumNum + num
        sumLen' = sumLen + len
 
solution :: Int64 -> (Int64, Char)
solution !x =
    let (sumNum, sumLen, n) = solve x (0,0,1) (map (\n -> (n, wordLength n)) [1..])
    in (sumNum, (wordify n) !! (fromIntegral $ x - sumLen - 1))
 
main = do
    print $ solution 1234 -- Make sure we are sane
    print $ solution 51000000000