brainfrz

Haskell number-English converter

Nov 3rd, 2017
5,686
0
Never
2
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. import Data.Char
  2. import Data.List
  3. import Data.Maybe
  4.  
  5.  
  6. ones :: Integral a => [(a, String)]
  7. ones = [(1,"one"), (2,"two"), (3,"three"), (4,"four"), (5,"five"), (6,"six"), (7,"seven"),
  8.         (8,"eight"), (9,"nine")]
  9.  
  10. teens :: Integral a => [(a, String)]
  11. teens = [(10,"ten"), (11,"eleven"), (12,"twelve"), (13,"thirteen"), (14,"fourteen"),
  12.          (15,"fifteen"), (16,"sixteen"), (17,"seventeen"), (18,"eighteen"), (19,"nineteen")]
  13.  
  14. tens :: Integral a => [(a, String)]
  15. tens = [(10,"ten"), (20,"twenty"), (30,"thirty"), (40,"forty"), (50,"fifty"), (60,"sixty"),
  16.         (70,"seventy"), (80,"eighty"), (90,"ninety")]
  17.  
  18. groups :: [String]
  19. groups = ["", " thousand", " million", " billion", " trillion", " quadrillion", " quintillion",
  20.           " sextillion", " septillion", " octillion", " nonillion", " decillion", " undecillion",
  21.           " duodecillion", " tredecillion", " quattuordecillion", " quindecillion", " sexdecillion",
  22.           " septendecillion", " octodecillion", " novemdecillion", " vigintillion"]
  23.  
  24. -- Maps a word to its power of 10
  25. groupList :: Integral a => [(String, a)]
  26. groupList = [("thousand",3), ("million",6), ("billion",9), ("trillion",12), ("quadrillion",15),
  27.              ("quintillion",18), ("sextillion",21), ("septillion",24), ("octillion",27),
  28.              ("nonillion",30), ("decillion",33), ("undecillion",36), ("duodecillion",39),
  29.              ("tredecillion",42), ("quattuordecillion",45), ("quindecillion",48),
  30.              ("sexdecillion",51), ("septendecillion",54), ("octodecillion",57),
  31.              ("novemdecillion",60), ("vigintillion",63)]
  32.  
  33.  
  34. numToWord :: Integral a => a -> String
  35. numToWord n
  36.     | n < 0      = "negative " ++ numToWord (-n)
  37.     | n == 0     = "zero"
  38.     | n >= 10^65 = error "Doesn't support numbers bigger than vigintillions! (10^65-1)"
  39.     | isHundred  = groupToWord d100 ++ " hundred"
  40.     | otherwise  = unwords $ reverse buildGroups
  41.     where
  42.         buildGroups = map (uncurry (++)) (filter (\(n,g) -> n /= "") (zip wordGroups groups))
  43.         wordGroups = map groupToWord $ splitNum n
  44.  
  45.         isHundred = n <= 9000 && r1000 /= 0 && r100 == 0
  46.         r1000 = n `rem` 1000
  47.         (d100,r100) = n `quotRem` 100
  48.  
  49.         toWord :: Integral a => a -> [(a, String)] -> String
  50.         toWord n table = fromMaybe "" (lookup n table)
  51.  
  52.         groupToWord :: Integral a => a -> String
  53.         groupToWord n
  54.             | n < 0     = "negative " ++ groupToWord (-n)
  55.             | n == 0    = ""
  56.             | otherwise = unwords $ numWords n
  57.             where
  58.                 numWords :: Integral a => a -> [String]
  59.                 numWords r
  60.                     | r <= 0               = []
  61.                     | r < 10               = [toWord r ones]
  62.                     | r < 20               = [toWord r teens]
  63.                     | r < 100 && r10 /= 0  = [toWord n10 tens ++ "-" ++ toWord r10 ones]
  64.                     | r < 100              = toWord n10 tens : numWords r10
  65.                     | r < 1000             = toWord d100 ones : "hundred" : numWords r100
  66.                     | otherwise            = error "groupToWord: not a 3-digit group"
  67.                     where
  68.                         (n10, r10) = (r - r10, r `rem` 10)
  69.                         (d100, r100) = r `quotRem` 100
  70.  
  71.         -- Splits a number into groups in reverse order
  72.         splitNum :: Integral a => a -> [a]
  73.         splitNum n
  74.             | d == 0  = [n]
  75.             | otherwise = m : splitNum d
  76.             where
  77.                 (d,m) = n `quotRem` 1000
  78.  
  79.  
  80.  
  81. wordToNum :: Integral a => String -> a
  82. wordToNum s
  83.     | s == ""    = 0
  84.     | isNegative = (-1) * (wordToNum $ unwords $ tail (words s))
  85.     | otherwise  = currBlock + nextBlock
  86.     where
  87.         isNegative = head (words s) == "negative" || head (words s) == "minus"
  88.         (b, bs) = span (\w -> not $ groupWord w) (words s)
  89.  
  90.         currBlock
  91.             | bs == []    = blockToNum $ unwords b
  92.             | otherwise   = (fromGroup $ head bs) * (blockToNum $ unwords b)
  93.         nextBlock
  94.             | bs == []        = 0
  95.             | length bs == 1  = 0
  96.             | otherwise       = wordToNum (unwords $ tail bs)
  97.  
  98.         fromWord :: Integral a => String -> [(a, String)] -> a
  99.         fromWord word table = key
  100.             where (key,val) = head $ dropWhile (\(n,w) -> w /= word) table
  101.  
  102.         -- Calculates the group's multiplier
  103.         fromGroup :: Integral a => String -> a
  104.         fromGroup g = 10 ^ (fromMaybe 0 (lookup g groupList))
  105.  
  106.         clean :: String -> String
  107.         clean "" = ""
  108.         clean ('-':cs) = ' ' : clean cs
  109.         clean (c:cs)
  110.             | isLetter c  = c : clean cs
  111.             | otherwise   = clean cs
  112.  
  113.         mapMember :: Integral a => String -> [(a,String)] -> Bool
  114.         mapMember _ [] = False
  115.         mapMember w ((_,s):ws) = w == s || mapMember w ws
  116.  
  117.         groupWord :: String -> Bool
  118.         groupWord s = inGroupList s groupList
  119.           where
  120.             inGroupList :: Integral a => String -> [(String,a)] -> Bool
  121.             inGroupList _ [] = False
  122.             inGroupList w ((s,_):ws) = w == s || inGroupList w ws  
  123.  
  124.         blockToNum :: Integral a => String -> a
  125.         blockToNum s = block (reverse (map clean (words s)))
  126.  
  127.         block :: Integral a => [String] -> a
  128.         block [] = 0
  129.         block [""] = 0
  130.         block (x:y:z:[]) = (100 * (fromWord z ones)) + (block $ words x)  -- must be x hundred z
  131.         block (x:y:[])
  132.             | x == "hundred" = 100 * (block $ words y) -- Must recurse for x hundred cases (e.g. seventeen hundred)
  133.             | otherwise      = (fromWord x tens) + (fromWord y ones)
  134.         block [w]
  135.             | length (words w) == 2  = block $ words w
  136.             | mapMember w ones       = fromWord w ones
  137.             | mapMember w teens      = fromWord w teens
  138.             | mapMember w tens       = fromWord w tens
Advertisement