14
\$\begingroup\$

As an excercise to "Haskell: The Craft of Functional Programming", I created some code to convert an Integer to Roman numerals.

This is the first version and I think I'm probably not doing it in the "Haskell way" since my background is in imperative programming.

Any advice on how to improve this? Sometimes I think I'm missing a obvious way to do it in just one function.

convMap = [(1000,"M"), (900,"CM"), (500,"D"), (400,"CD"), (100,"C"),
           (90,"XC"), (50,"L"), (40,"XL"), (10,"X"), (9,"IX"), (5,"V"),
           (4,"IV"), (1,"I")]

toRoman :: Integer -> String
toRoman x 
  | x == 0 = "N"
  | otherwise = (snd . numToSubtract $ x) ++ toRoman'(nextNum)
      where nextNum = x - (fst. numToSubtract $ x)

-- Auxiliary function just so we treat 0 differently
-- (avoids 3 == "IIIN" if not used)
toRoman' :: Integer -> String
toRoman' x 
  | x == 0 = ""
  | x > 0 = (snd . numToSubtract $ x) ++ toRoman'(nextNum)
      where nextNum = x - (fst. numToSubtract $ x)

-- Returns which item in the convMap should be subtracted
numToSubtract :: Integer -> (Integer, String)
numToSubtract x = head (filter (lessThan x) convMap)

-- Filter function to work on the tuples in convMap
lessThan :: Integer -> (Integer, String) -> Bool
lessThan n (a, b)
  | a <= n = True
  | otherwise = False
\$\endgroup\$
2
  • 1
    \$\begingroup\$ Do you know about hlint? \$\endgroup\$
    – Tyler
    Oct 24 '11 at 4:44
  • \$\begingroup\$ @MatrixFrog didn't know it until now! just installed and it's giving me tons of hints where to improve the code. Thank you! \$\endgroup\$ Oct 25 '11 at 2:03
14
\$\begingroup\$

Booleans are normal values:

lessThan n (a, b)
  | a <= n = True
  | otherwise = False

Simply write:

lessThan n (a, _) = a <= n

Use pattern matching:

toRoman' :: Integer -> String
toRoman' x 
  | x == 0 = ""
  | x > 0 = (snd . numToSubtract $ x) ++ toRoman'(nextNum)
      where nextNum = x - (fst. numToSubtract $ x)

If you want to take fst and snd of the same tuple, think about pattern matching. Minor point: brackets in toRoman'(nextNum) are redundant, simply write toRoman' nextNum.

toRoman' :: Integer -> String
toRoman' x
  | x == 0 = ""
  | x > 0 = b ++ toRoman' (x - a)
      where (a, b) = numToSubtract x

Remove duplication:

toRoman and toRoman' contain duplicate code. In fact toRoman is only used to treat specially 0, so can be changed:

toRoman :: Integer -> String
toRoman 0 = "N"
toRoman x = toRoman' x

Move or remove utility functions:

lessThan and numToSubtract are used only once and don't seem to be generally useful, maybe inline them:

toRoman' :: Integer -> String
toRoman' x
  | x == 0 = ""
  | x > 0 = b ++ toRoman' (x - a)
      where (a, b) = head $ filter (\(a,_) -> a <= x) convMap

As Dan Burton commented, you can write also:

      where (a, b) = head $ filter ((<= x) . fst) convMap

Final code

convMap = [(1000,"M"), (900,"CM"), (500,"D"), (400,"CD"), (100,"C"),
           (90,"XC"), (50,"L"), (40,"XL"), (10,"X"), (9,"IX"), (5,"V"),
           (4,"IV"), (1,"I")]

-- Auxiliary function just so we treat 0 differently
-- (avoids 3 == "IIIN" if not used)
toRoman :: Integer -> String
toRoman 0 = "N"
toRoman x = toRoman' x

toRoman' :: Integer -> String
toRoman' x 
  | x == 0 = ""
  | x > 0 = b ++ toRoman' (x - a)
      where (a, b) = head $ filter ((<= x) . fst) convMap

Fold

If you stare a little at the code, it turns out you each entry from convMap only once. First you check how many M's you need. Then CM's. Then D's. And so on. Using "filter" function always restarts search from beginning. In fact, toRoman can be written as a fold!

import Data.List (genericReplicate)

convMap = [(1000,"M"), (900,"CM"), (500,"D"), (400,"CD"), (100,"C"),
           (90,"XC"), (50,"L"), (40,"XL"), (10,"X"), (9,"IX"), (5,"V"),
           (4,"IV"), (1,"I")]

toRoman :: Integer -> String
toRoman 0 = "N"
toRoman x | x > 0 = snd $ foldl f (x,[]) convMap
  where f (n,s) (rn, rs) = (l, s ++ concat (genericReplicate k rs))
              where (k,l) = divMod n rn

Going crazy with abstractions

Erik Hilton's nice answer gives a solution using unfoldr. So you can write the code using fold and unfold, and these are two ways of looking at it. I believe that combination of fold and unfold is called "paramorphism" or "apomorphism" or something like that...

\$\endgroup\$
2
  • 2
    \$\begingroup\$ I would write that lambda like this: ((<= x) . fst). Also, it might make more sense semantically to use dropwhile ((> x) . fst) instead of filter; or even use find instead. However, in either case, the actual list traversal is identical. \$\endgroup\$
    – Dan Burton
    Oct 24 '11 at 2:11
  • \$\begingroup\$ I referenced this answer here :D \$\endgroup\$
    – Thank you
    Mar 31 '18 at 4:26
11
\$\begingroup\$

Try something like this

import Data.List
import Data.Maybe

convMap = [(1000,"M"), (900,"CM"), (500,"D"), (400,"CD"), (100,"C"),
           (90,"XC"), (50,"L"), (40,"XL"), (10,"X"), (9,"IX"), (5,"V"),
           (4,"IV"), (1,"I")]

intToRoman :: Int -> String
intToRoman = concat . unfoldr findLeast
             where findLeast n = case i of 
                                 Just (x,r) -> Just(r,n-x)
                                 Nothing -> Nothing
                                 where i = find (\(val,_) -> val <= n) convMap

Unfoldr is a function that is sadly underused but exactly what you want here. It takes a seed value, the one you are trying to convert and builds up a list (of roman numeral parts). This might be a touch more verbose than absolutely necessary but I believe it is very clear.

A note on how unfoldr works: you pass it a seed value and a function. this function returns either Just(a,b) or Nothing. In the former case, a is added to the accumulator and b is used as the next seed value. This will continue until the function returns Nothing. At this point the unfoldr is complete.

\$\endgroup\$
3
  • 2
    \$\begingroup\$ You can write intToRoman = concat . unfoldr findLeast \$\endgroup\$
    – sdcvvc
    Oct 24 '11 at 2:20
  • \$\begingroup\$ Ahh yes! Superb. Changing now. I always forget the point-free way. \$\endgroup\$
    – Erik Hinton
    Oct 24 '11 at 2:21
  • \$\begingroup\$ thank you very much. I'll be studying the Data.* modules. \$\endgroup\$
    – gtirloni
    Oct 24 '11 at 2:50
7
\$\begingroup\$

Here's my take on it. I've changed the algorithm slightly so that it only has to traverse convMap once.

toRoman 0 = "N"
toRoman x | x < 0 = error "toRoman: negative number"
toRoman x = loop x convMap
  where loop 0 _ = ""
        loop x cs@((a, b):cs') | x >= a    = b ++ loop (x - a) cs
                               | otherwise = loop x cs'

The pattern is perhaps a little ugly, but other than that I think it's both readable and efficient. You could also write it as a fold,

toRoman x = snd $ foldl f (x, []) convMap
  where f (x, s) (a, b) = let (q, r) = quotRem x a in (r, s ++ concat (replicate q b))

but that's slightly less efficient due to quadratic appending. Difference lists would work, but that would only make it messier.

\$\endgroup\$
4
  • \$\begingroup\$ Nice! What does cs@((a, b):cs' mean? I know what (cs:cs') means - first item and rest of the list. I have never seen it written like that before :) \$\endgroup\$ Dec 19 '11 at 16:18
  • \$\begingroup\$ Guessing I think that cs would be the whole list and cs' is the whole list minus the first 2 elements while a and b being those elements. Was that correct? \$\endgroup\$ Dec 19 '11 at 16:23
  • \$\begingroup\$ @Ancide: Almost. (a, b) is a tuple, so the whole pattern matches a list of tuples, where a and b are the components of the first tuple, cs' is the remaining tuples, and cs is the entire list. To match the first and second element of a list, you'd use the : pattern twice: a:b:cs'. \$\endgroup\$
    – hammar
    Dec 19 '11 at 16:51
  • \$\begingroup\$ @hammer I keep getting amazed all the time of how awesome Haskell is! Thank you for explaining! :) \$\endgroup\$ Dec 19 '11 at 18:21

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.