62 lines
1.9 KiB
Haskell
62 lines
1.9 KiB
Haskell
module Data.RomanNum (
|
|
RomanNum(..)
|
|
, nullus
|
|
, plus
|
|
, r
|
|
) where
|
|
|
|
import Data.Map (Map, (!))
|
|
import qualified Data.Map as Map (fromList)
|
|
|
|
newtype RomanNum = RomanNum Int
|
|
|
|
data RomanChar = I | V | X | L | C | D | M deriving (Bounded, Eq, Ord, Enum, Show, Read)
|
|
|
|
romanChars :: [RomanChar]
|
|
romanChars = [minBound .. maxBound]
|
|
|
|
base :: [(Int, [Char])]
|
|
base = base' 1 [] . concat $ show <$> romanChars where
|
|
base' _ l "" = l
|
|
base' size l chars =
|
|
base' (size * 10) ((size, take 3 chars):l) (drop 2 chars)
|
|
|
|
values :: Map RomanChar Int
|
|
values = Map.fromList $
|
|
zip romanChars (concat $ iterate (fmap (*10)) [1, 5])
|
|
|
|
instance Show RomanNum where
|
|
show (RomanNum 0) = "nullus"
|
|
show (RomanNum n) = show' n base where
|
|
show' 0 _ = ""
|
|
show' _ [] = error "Numeral system not fine-grained enough"
|
|
show' k ((size, digits):others)
|
|
| k < size = show' k others
|
|
| otherwise =
|
|
let decDigit = k `div` size in
|
|
showDecDigit decDigit digits ++ show' (k `mod` size) others
|
|
showDecDigit _ [] = error "no digits for conversion"
|
|
showDecDigit k [digit] = k `times` digit
|
|
showDecDigit k digits
|
|
| k == 4 || (k == 9 && length digits > 2) =
|
|
(head digits) : [head (drop (if k > 5 then 2 else 1) digits)]
|
|
| k > 4 = head (drop 1 digits) : (showDecDigit (k-5) digits)
|
|
| otherwise = k `times` (head digits)
|
|
times count letter = take count $ repeat letter
|
|
|
|
r :: String -> RomanNum
|
|
r "" = nullus
|
|
r "nullus" = nullus
|
|
r n@[_] = RomanNum (values ! (read n))
|
|
r (digit:nextDigit:otherDigits) =
|
|
let (rChar, nextRChar) = (read [digit], read [nextDigit]) in
|
|
if rChar < nextRChar
|
|
then RomanNum (values ! nextRChar - values ! rChar) `plus` r otherDigits
|
|
else RomanNum (values ! rChar) `plus` r(nextDigit:otherDigits)
|
|
|
|
nullus :: RomanNum
|
|
nullus = RomanNum 0
|
|
|
|
plus :: RomanNum -> RomanNum -> RomanNum
|
|
plus (RomanNum a) (RomanNum b) = RomanNum (a + b)
|