Skip to content

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
A solution to John D. Cook's roman numerals puzzle
-- written for a puzzle presented by John D. Cook:
-- http://www.johndcook.com/blog/2012/01/14/roman-numeral-puzzle/
--
-- Copyright (C) 2012, John Bartholomew.
-- You may use this code for any purpose, WITHOUT WARRANTY.
module Main where
import Control.Monad
import Data.Char
import Data.List
{-
Combinatorial:
Rules: restrictive subtraction rules. I'll also add a rule that a
smaller value cannot appear before a larger value except as a subtraction.
The alphabet contains 7 characters, which are (in order from lowest-value
to highest-value): I, V, X, L, C, D, and M.
V, L, D and M can never be subtracted, but may be included or not.
I, X and C each have four possibilities: they can be skipped; they can
appear in their positive position, or they can appear in one of two negative
positions.
Those choices lead to 2**4 * 4**3 = 2**10 possibilities. Howeve, that assumes
all the choices are independent, which they are not. If 'V' does not appear,
then 'I' cannot be subtracted from it; if 'X' is subtracted from 'L' or 'C',
then 'I' cannot be subtracted from 'X', and so on.
So let's start again. We can split the possibilities into four cases,
based on the number of subtractions in each one. Given N subtractions,
we have 2^(7-2N) possibilities. This comes from having 7 - 2N positive
value characters that can (each, independently) be chosen to appear or
not appear in the string. For the case of N = 0, we subtract 1 to remove
the possibility of the empty string.
0 subtractions: 2^7 - 1
1 subtraction: 6 * 2^5
2 subtractions: 8 * 2^3
(IV,XL ; IV,XC; IV,CD; IV,CM; IX,CD ; IX,CM; XL,CD ; XL,CM)
3 subtractions: 2 * 2
(IV,XL,CD ; IV,XL,CM)
Total possibilities: 2^7 + 6*2^5 + 8*2^3 + 4 - 1 = 387
This matches the number of results emitted by the code in my previous
comment, which gives me a lot of confidence that the result is correct.
-----------
Excluding CMD, XCL and IXV:
0 subtractions: 2^7 - 1
1 subtraction: 3 * 2^5 + 3 * 2^4
2 subtractions: 3 * 2^3 + 4 * 2^2 + 2
(IV,XL ; IV,XC ; IV,CD; IV,CM ; IX,CD ; IX,CM ; XL,CD ; XL,CM)
3 subtractions: 3
(IV,XL,CD ; IV,XL,CM)
Total possibilities: 2^7 + 3 * 2^5 + 3 * 2^4 + 3 * 2^3 + 4 * 2^2 + 2 + 3 - 1 = 316
-}
romanNumerals
= "(M? D? C? | M? CD | CM D?) ((L? X? | XL) (V? I? | IV) | L? IX V?) | M? D? XC L? (V? I? | IV)"
-- this excludes CMD, XCL and IXV
romanNumerals2
= "(M? D? C? | M? CD | CM) ((L? X? | XL) (V? I? | IV) | L? IX) | M? D? XC (V? I? | IV)"
totalNumerals = 2^7 + 6*2^5 + 8*2^3 + 4 - 1
totalNumerals2 = 2^7 + 3 * 2^5 + 3 * 2^4 + 3 * 2^3 + 4 * 2^2 + 2 + 3 - 1
enumerateRegex = nub . fst . go1 . filter (not . isSpace)
where
go1 = go [""] [""]
go :: [String] -> [String] -> String -> ([String], String)
go prefix atom ('(':xs) = let (a,b) = go1 xs in go (allPairs prefix atom) a b
go prefix atom (')':xs) = (allPairs prefix atom, xs)
go prefix atom ('|':xs) = let (a,b) = go1 xs in (allPairs prefix atom ++ a, b)
go prefix atom ('?':xs) = go (allPairs prefix (atom ++ [""])) [""] xs
--go prefix atom ('?':xs) = go prefix atom xs
go prefix atom ( c :xs) = go (allPairs prefix atom) [[c]] xs
go prefix atom [] = (allPairs prefix atom, "")
allPairs :: [String] -> [String] -> [String]
allPairs a b = concatMap (\x -> map (x ++) b) a
main = do
let numerals = enumerateRegex romanNumerals2
forM_ numerals putStrLn
putStrLn ("total should be " ++ show totalNumerals2)
putStrLn ("and is actually " ++ show (length numerals - 1))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.