fork download
  1. --
  2. -- Problem: Find the 51000000000-th character of the string (wordNumber Infinity)
  3. -- where a wordNumber is defined as
  4. --
  5. -- wordNumber 1 = "one"
  6. -- wordNumber 2 = "onetwo"
  7. -- wordNumber 3 = "onetwothree"
  8. -- wordNumber 15 = "onetwothreefourfivesixseveneightnineteneleventwelvethirteenfourteenfifteen"
  9. -- ...
  10. --
  11. -- The answer should be presented as ( sum of all numbers up to that point
  12. -- , the 51000000000-th character
  13. -- )
  14.  
  15. {-# LANGUAGE BangPatterns #-}
  16.  
  17. import Debug.Trace
  18. import Data.Int
  19. import Control.Monad
  20. import Data.Array.Unboxed
  21.  
  22. ones = ["", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine"]
  23. tens = ["", "ten", "twenty", "thirty", "forty", "fifty", "sixty", "seventy", "eighty", "ninety"]
  24. teens = ["ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen"]
  25.  
  26. lenOnes, lenTens, lenTeens :: UArray Int64 Int64
  27. lenOnes = listArray (0,9) $ [0,3,3,5,4,5,3,5,5,4] -- "", "one","two", ...
  28. lenTens = listArray (0,9) $ [0,3,6,6,5,5,5,7,6,6]
  29. lenTeens = listArray (0,9) $ [3,6,6,8,8,7,7,9,8,8] -- first element is "ten" 3
  30.  
  31. -- potentially cleaner version
  32. -- but I feared Haskell might do surprising things behind my
  33. -- back so I stuck with the above
  34. -- lenBelowHundred = listArray (0,99) $ map (fromIntegral . length . wordify) [1..99]
  35.  
  36. -- wordify 123 = "onehundredtwentythree"
  37. -- This is only used once in presenting the final result character
  38. wordify :: Int64 -> String
  39. wordify n
  40. | n < 10 = ones !! fromIntegral n
  41. | n < 20 = teens !! (fromIntegral n-10)
  42. | n < 100 = splitterTen
  43. | n < 1000 = splitter 100 "hundred"
  44. | n < 1000000 = splitter 1000 "thousand"
  45. | n < 1000000000 = splitter 1000000 "million"
  46. where
  47. splitterTen = let (t, x) = n `divMod` 10
  48. in (tens !! fromIntegral t) ++ wordify x
  49. splitter div suffix = let (t, x) = n `divMod` div
  50. in (wordify t) ++ suffix ++ wordify x
  51.  
  52. -- Optimized version of length (wordify n)
  53. -- Used in number crunching
  54. wordLength n = wordLength' 0 n
  55.  
  56. -- Tail recursive version
  57. wordLength' :: Int64 -> Int64 -> Int64
  58. wordLength' !pad !n
  59. | n < 10 = lenOnes ! n + pad
  60. | n < 20 = lenTeens ! (n-10) + pad
  61. | n < 100 = splitterTen
  62. | n < 1000 = splitter 100 7
  63. | n < 1000000 = splitter 1000 8
  64. | otherwise = splitter 1000000 7
  65. where
  66. splitterTen = let !(!t, !x) = n `divMod` 10
  67. in wordLength' (lenTens ! t + pad) x
  68. splitter !d !suffix = let !(!t, !x) = n `divMod` d
  69. in wordLength' (wordLength' (suffix+pad) t) x
  70.  
  71. -- Tail recursive
  72. solve :: Int64 -> (Int64, Int64, Int64) -> [Int64] -> (Int64, Int64, Int64)
  73. solve !n !acc@(!sumNum, !sumLen, !curr) (!num:nums)
  74. | sumLen' >= n = (sumNum', sumLen, num)
  75. | otherwise = solve n (sumNum', sumLen', num) nums
  76. where
  77. sumNum' = sumNum + num
  78. sumLen' = sumLen + wordLength num
  79.  
  80. solution :: Int64 -> (Int64, Char)
  81. solution !x =
  82. let (sumNum, sumLen, n) = solve x (0,0,1) [1..]
  83. in (sumNum, (wordify n) !! (fromIntegral $ x - sumLen - 1))
  84.  
  85. main = do
  86. print $ solution 1234 -- Make sure we are sane
  87. print $ solution 51000000000
  88.  
  89.  
Not running #stdin #stdout 0s 0KB
stdin
Standard input is empty
stdout

Standard output is empty