5
\$\begingroup\$

Yet another exercise in converting values between the decimal and roman number systems. I have tried the functional way.

Any comments are welcome - but I'm especially interested in answers focusing on the F# specific functional approach and less in if I obey each and every rule for roman numbers.

A type definition:

module RomanNumbers
open System

type RomanNumber = {
Roman: string;
Value: int;
}

Acts as a "pivot" object holding the values from both systems, so maybe the name is not quite adequate.

Functionality

let getValue = function 
    | 'I' -> 1
    | 'V' -> 5
    | 'X' -> 10
    | 'L' -> 50
    | 'C' -> 100
    | 'D' -> 500
    | 'M' -> 1000
    | ch -> failwith (sprintf "Invalid character: %c" ch)

let validate roman =    
    if String.IsNullOrWhiteSpace(roman) then raise (ArgumentNullException())

    let exceptions = [
        "IIV"; "IIX"; "IL"; "IC"; "ID"; "IM";
        "XXL"; "XXC"; "XD"; "XM";
        "CCD"; "CCM";
        "IVV"; "IXX"; // Ascending order rule: "IVV" means 4 + 5 but should be VIV 5 + 4 (but that will also be caught by noDuplicates (se below))
        "XLL"; "XCC";
        "CDD"; "CMM"
    ]

    let noDuplicates = [ 'V'; 'L'; 'D' ] 

    roman 
    |> Seq.iter 
        (fun ch -> getValue ch |> ignore)

    exceptions 
    |> List.iter 
        (fun part -> 
            if (string roman).Contains(part) 
            then failwith (sprintf "Invalid Sequence: %s" part))

    noDuplicates
    |> List.iter 
        (fun part -> 
            if roman |> Seq.countBy (fun ch -> ch = part) |> Seq.last |> (fun (k, i) -> k && i > 1)
            then failwith (sprintf "%c can only appear once in %s" part roman))
    ()

let fromRoman roman = 
    validate roman

    let length = roman.Length
    let first = getValue roman.[0]

    if length = 1 then 
        { Roman = roman; Value = first }
    else
        let rec converter index prev sum =
            match index with
            | x when x = length -> sum
            | _ -> 
                let curValue = getValue roman.[index]
                match curValue with
                | x when x > prev -> converter (index + 1) curValue (sum + curValue - prev * 2)
                | _ -> converter (index + 1) curValue (sum + curValue)

        let value = converter 1 first first
        { Roman = roman; Value = value }

let fromDecimal value =
    if value <= 0 then raise (ArgumentOutOfRangeException("value", sprintf "Decimal value must be > 0: %d" value))
    let postfixBy value postfix = sprintf "%s%s" value postfix

    let rec converter num result = 
        match num with
        | 0 -> result
        | _ when num >= 1000 -> converter (num - 1000) (postfixBy result "M")
        | _ when num >= 900 -> converter (num - 900) (postfixBy result "CM")
        | _ when num >= 500 -> converter (num - 500) (postfixBy result "D")
        | _ when num >= 400 -> converter (num - 400) (postfixBy result "CD")
        | _ when num >= 100 -> converter (num - 100) (postfixBy result "C")
        | _ when num >= 90 -> converter (num - 90) (postfixBy result "XC")
        | _ when num >= 50 -> converter (num - 50) (postfixBy result "L")
        | _ when num >= 40 -> converter (num - 40) (postfixBy result "XL")
        | _ when num >= 10 -> converter (num - 10) (postfixBy result "X")
        | _ when num >= 9 -> converter (num - 9) (postfixBy result "IX")
        | _ when num >= 5 -> converter (num - 5) (postfixBy result "V")
        | _ when num >= 4 -> converter (num - 4) (postfixBy result "IV")
        | _ -> converter (num - 1) (postfixBy result "I")

    let roman = converter value ""
    { Roman = roman; Value = value }

// Takes any roman number string and transform it to its normalized or minimal form
let asNormalizedRoman roman = fromDecimal (fromRoman roman).Value

Operator extensions

let inline romanOper r1 oper r2 = fromDecimal (oper r1.Value r2.Value)    
// Extending with operators
type RomanNumber 
with 
    static member inline (+) (r1, r2) = romanOper r1 (+) r2
    static member inline (-) (r1, r2) = romanOper r1 (-) r2
    static member inline (*) (r1, r2) = romanOper r1 (*) r2
    static member inline (/) (r1, r2) = romanOper r1 (/) r2
    static member inline (%) (r1, r2) = romanOper r1 (%) r2

Some test cases

printfn "Numbers from 1 to 3999"
for i in 1..3999 do
    let roman = fromDecimal i
    let decimal = fromRoman roman.Roman
    //if roman.Roman <> decimal.Roman || roman.Value <> decimal.Value then
    printfn "%A <-> %A" roman decimal


let path = "<your path>\p089_roman.txt"

printfn ""
printfn "From File: "
for line in File.ReadAllLines(path) do
    let value = fromRoman line
    let roman = fromDecimal value.Value
    if roman.Roman <> value.Roman || roman.Value <> value.Value then
        printfn "%A <-> %A" value roman

printfn ""
printfn "Test of Operators: "

let r1 = fromDecimal 1000
let r2 = fromDecimal 3

printfn "%A" (r1 + r2)
printfn "%A" (r1 - r2)
printfn "%A" (r1 * r2)
printfn "%A" (r1 / r2)
printfn "%A" (r1 % r2)

p089_roman.txt contains one thousand Roman numerals that are not necessarily in canonical form.


As an attempt to minimize magic numbers and strings/chars and to get rid of the heavy match pattern in fromDecimal, one could define the following:

let I = 1
let V = 5
let X = 10
let L = 50
let C = 100
let D = 500
let M = 1000

type RomanValue = RV of int * string

let specialRomans = [ 
    RV(M, "M"); 
    RV(M-C, "CM"); 
    RV(D, "D"); 
    RV(D-C, "CD"); 
    RV(C, "C"); 
    RV(C-X, "XC"); 
    RV(L, "L"); 
    RV(L-X, "XL"); 
    RV(X, "X"); 
    RV(X-I, "IX"); 
    RV(V, "V"); 
    RV(V-I, "IV"); 
    RV(I, "I"); 
]

let getValue = function 
    | 'I' -> I
    | 'V' -> V
    | 'X' -> X
    | 'L' -> L
    | 'C' -> C
    | 'D' -> D
    | 'M' -> M
    | ch -> failwith (sprintf "Invalid character: %c" ch)

and then fromDecimal could be "reduced" to:

let fromDecimal value =
    if value <= 0 then raise (ArgumentOutOfRangeException("value", sprintf "Decimal value must be > 0: %d" value))
    let postfixBy value postfix = sprintf "%s%s" value postfix

    let rec folder (res, num) rv =
        match num, rv with
        | 0, _ -> res, num
        | _, RV(v, s) -> 
            match num with
            | _ when num >= v -> folder (postfixBy res s, num - v) rv
            | _ -> (res, num)

    let roman, _ = specialRomans |> List.fold folder ("", value)
    { Roman = roman; Value = value }

I'm not sure, what I like best?

\$\endgroup\$
1
\$\begingroup\$

General

I think the correct translation is Roman numeral.

As far as I understood, it is not a good functional style to throw exceptions in case of unexpected input because it breaks the purity. An alternative approach is Railway oriented programming which makes the code much cleaner and separates the business logic from the exception handling.

Internal stuff (like getValue) could be private.

Function validate

The whole validation logic is placed in one function. Splitting the single rules in its own function allows to give each rule a name and it puts things together that belongs together (e.g. exceptions and duplicates are used by one rule only).

Function fromRoman

It is not required to handle the case length = 1 specially. The recursive converter function can be simplified by using fold (as you did in fromDecimal in the updated version)

Function fromDecimal

The function postfixBy is actually not required because string can be concatinated with result + "M".


Below is an alternative implementaion (based on your initial question) where I tried to consider the points above. The API has chnaged to RomanNumeral.fromNumber (int -> Result<RomanNumeral, string>) and RomanNumeral.fromStr (string -> Result<RomanNumeral, string>). The Result<a', b'> type requires handle the error case (similar to an Option type). If desired, it can be unwrapped with an exception in case of an error using the (external) unwrap function. However, the actual error handling has been moved to the caller who has to handle possible errors befor getting the result.

open System

module RomanNumeral =    

    (* TYPES *)

    type RomanNumeral =
        { Text:string;
          Value:int}

    type private ParsingState = 
        { Sum:int;
          Prev:int } 

    (* GENERIC HELPER *)

    let private getDuplicates items = 
        items |> List.groupBy id
        |> List.filter( fun (_,set) -> set.Length > 1)
        |> List.map( fun (key,_) -> key )

    let private getNones selector items =
        items 
        |> List.map (fun x -> (selector x, x))
        |> List.filter (fst >> Option.isNone)
        |> List.map snd

    let private toError msg invalidItems =
        Error(sprintf "%s: %s" msg (invalidItems |> String.concat "; "))

    (* DOMAIN HELPER *)

    let private getOptionValue = function 
        | 'I' -> Some(1)
        | 'V' -> Some(5)
        | 'X' -> Some(10)
        | 'L' -> Some(50)
        | 'C' -> Some(100)
        | 'D' -> Some(500)
        | 'M' -> Some(1000)
        | _ -> None

    let private getValue x =
        match x |> getOptionValue with
        | Some(v) -> v
        | None -> failwith "Invalid character"

    let private parseStr str =        
        let folder state current =
            if current > state.Prev
            then { Sum = state.Sum + current - state.Prev * 2; Prev = current}
            else { Sum = state.Sum + current; Prev = current}        
        str 
            |> Seq.map getValue 
            |> Seq.fold folder { Sum = 0; Prev = 0; } 
            |> (fun x -> x.Sum)

    let private parseNumber num =
        let map = [ (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") ]
        let rec converter (result:string) num =             
            let element = map |> List.tryFind (fun (v, _) -> num >= v)                        
            match element with
            | Some (value, romanStr) -> (num - value) |> converter (result + romanStr)
            | None -> result             
        num |> converter ""

    (* VALIDATION *)

    let private validateSingeCharacters (roman:string) =
        let invaliChars = roman |> Seq.toList |> getNones getOptionValue |> List.map string
        match invaliChars with
        | _::_ -> invaliChars |> toError "Invalid Characters"
        | [] -> Ok(roman)

    let private validateNotNullOrEmpty roman =    
        match (roman |> String.IsNullOrWhiteSpace) with
            | true -> Error("Input null or empty")
            | false -> Ok(roman)

    let private validateExceptionalRules (roman:string) =
        // Ascending order rule: "IVV" means 4 + 5 but should be VIV 5 + 4 (but that will also be caught by noDuplicates (se below))
        let exceptions = 
            [ "IIV"; "IIX"; "IL"; "IC"; "ID"; "IM"; "XXL"; "XXC"; "XD"; "XM";
              "CCD"; "CCM"; "IVV"; "IXX"; "XLL"; "XCC"; "CDD"; "CMM" ]

        let invalidParts = exceptions |> List.filter (fun part -> roman.Contains(part))
        match invalidParts with
        | _::_ -> invalidParts |> toError "Invalid Sequences"
        | [] -> Ok(roman)

    let private validateNoDuplicates roman =
        let charsThatMustBeUnique = [ "V"; "L"; "D" ]
        let duplicates = charsThatMustBeUnique |> getDuplicates
        match duplicates with
        | _::_ -> duplicates |> toError "Following characters must be unique"
        | [] -> Ok(roman)

    let private validateStr x =
            x 
            |> validateSingeCharacters 
            |> Result.bind validateNotNullOrEmpty
            |> Result.bind validateExceptionalRules
            |> Result.bind validateExceptionalRules
            |> Result.bind validateNoDuplicates

    let private validateNumberGreaterThanZero number =
        match number > 0 with
        | true -> Ok(number)
        | false -> Error("Number must be greater than 0.")

    let private validateNumber x =
            x |> validateNumberGreaterThanZero

    (* PUBLIC API *)

    let fromStr str =
        str 
        |> validateStr
        |> Result.map (fun s -> { Text = s; Value = s |> parseStr})

    let fromNumber number =
        number
        |> validateNumber
        |> Result.map  (fun number -> { Text = number |> parseNumber; Value = number})

    let inline private romanOper oper (r1) (r2) = (oper r1.Value r2.Value)

    // Extending with operators
    type RomanNumeral with 
        static member inline (+) (r1, r2) = romanOper (+) r1 r2 
        static member inline (-) (r1, r2) = romanOper (-) r1 r2
        static member inline (*) (r1, r2) = romanOper (*) r1 r2
        static member inline (/) (r1, r2) = romanOper (/) r1 r2
        static member inline (%) (r1, r2) = romanOper (%) r1 r2    

module Test =

    let unwrap x = match x with | Ok(v) -> v | Error(msg) -> failwith(msg)

    // fromNumber / fromStr
    printfn "Numbers from 1 to 100"
    for i in 1..100 do
        let dec = i
        let roman = i |> RomanNumeral.fromNumber |> unwrap
        let romanRev = RomanNumeral.fromStr roman.Text |> unwrap
        printfn "%i: %s -> %i; %s -> %i" dec roman.Text roman.Value romanRev.Text romanRev.Value

    // operator
    let a = RomanNumeral.fromStr("X") |> unwrap
    let b = RomanNumeral.fromStr("XI") |> unwrap
    let c = b - a

    // error input
    let d = RomanNumeral.fromStr("fdsgfdgas")
    let e = RomanNumeral.fromNumber(-22)
\$\endgroup\$
  • \$\begingroup\$ Thanks a lot for the review. I've added an answer that builds on your comments and implementation. Your answer is very instructive. I haven't been aware of the Result type, - it seems rather useful. A little remark: your validateNoDuplicates doesn't seem to relate to the argument roman string? \$\endgroup\$ – Henrik Hansen Apr 17 at 18:14
1
\$\begingroup\$

Building on JanDotNet's answer, I've revised my code, and the result is as below. I have both rethought the algorithms and the overall design and flow. Especially the validation of input is changed to use the Result<'T,'TError> type - and (I hope) conforms to the "railway" pattern. One difference to JanDotNet's is that I return a roman numeral only if the input is valid, else I throw an exception, in contrast to returning a Result<RomanNumeral, string> (Ok(RomaNumeral) or Error("<msg>"). There may be pros and cons for both approaches so it is open for change. I hope the overall impression is a solution that is considerable more stringent and easy to follow and maintain.

module RomanNumerals
open System

let I = 1
let V = 5
let X = 10
let L = 50
let C = 100
let D = 500
let M = 1000

type RomanNumeral = {
    Text: string;
    Value: int 
}

let private createRoman text value = { Text = text; Value = value }

let private toError<'a> msg (invalidItems: 'a seq) =
    Error(sprintf "%s: %s" msg (String.Join("; ", invalidItems)))

let private handleResult = function
    | Ok(rn) -> rn
    | Error(msg) -> failwith(msg)

let private tryGetValue = function 
    | 'I' -> Some(I)
    | 'V' -> Some(V)
    | 'X' -> Some(X)
    | 'L' -> Some(L)
    | 'C' -> Some(C)
    | 'D' -> Some(D)
    | 'M' -> Some(M)
    | _ -> None

let private handleInvalids okResult msg invalids =
    match invalids |> Seq.isEmpty with
    | true -> Ok(okResult)
    | false -> toError msg invalids

let private validateNotEmpty str = 
    if String.IsNullOrWhiteSpace(str) then Error("The input string is empty")
    else Ok(str)

let private validateCharacters str = 
    str 
    |> Seq.map (fun ch -> (ch, tryGetValue ch)) 
    |> Seq.where (fun (ch, v) -> v.IsNone)
    |> Seq.map fst
    |> handleInvalids str "Invalid Characters"

let private validateDuplicates str = 
    let tests = [ 'V'; 'L'; 'D' ] 
    str
    |> Seq.groupBy (fun ch -> ch)
    |> Seq.where (fun (key, data) -> tests |> List.contains key && data |> Seq.length > 1)
    |> Seq.map fst
    |> handleInvalids str "These chars can only appear once"

let private validateInvalidSequences str = 
    [ "IIV"; "IIX"; "IL"; "IC"; "ID"; "IM";
    "XXL"; "XXC"; "XD"; "XM"; "CCD"; "CCM";
    "IVV"; "IXX"; "XLL"; "XCC"; "CDD"; "CMM" ] 
    |> List.where ((string str).Contains)
    |> handleInvalids str "Invalid sequence(s)"

let private validateString str =
    str
    |> validateNotEmpty
    |> Result.bind validateCharacters
    |> Result.bind validateDuplicates
    |> Result.bind validateInvalidSequences

let private convertString str = 
    let getValue ch = (tryGetValue ch).Value // We know by now, that it will return a valid value

    let folder (sum, prev) current = 
        if (current > prev) then (sum + current - prev * 2, current)
        else (sum + current, current)

    let value = 
        str
        |> Seq.map getValue
        |> Seq.fold folder (0, 0)
        |> fst

    createRoman str value

let private isNaturalNumber num = 
    match num with 
    | x when x > 0 -> Ok(num) 
    | _ -> Error(sprintf "%d is not a natural number > 0" num)

let private validateNumber num = isNaturalNumber num

let private convertNumber num =
    let limits = 
        [ (M, "M"); (M-C, "CM"); (D, "D"); (D-C, "CD"); 
        (C, "C"); (C-X, "XC"); (L, "L"); (L-X, "XL"); 
        (X, "X"); (X-I, "IX"); (V, "V"); (V-I, "IV"); (I, "I"); ] 
        |> List.skipWhile (fun (v, s) -> v > num)

    let rec converter lims value result =
        match value, lims with 
        | 0, _ -> result
        | _, (v, s)::_ when value >= v -> converter lims (value - v) (result + s)
        | _, _::tail -> converter tail value result

    createRoman (converter limits num "") num

let fromString str =
    str
    |> validateString
    |> Result.map (fun s -> convertString s)
    |> handleResult

let fromNumber num =
    num
    |> validateNumber
    |> Result.map (fun n -> convertNumber n)
    |> handleResult

let inline private romanOper oper (r1) (r2) = fromNumber (oper r1.Value r2.Value)
// Extending with operators
type RomanNumeral with 
    static member inline (+) (r1, r2) = romanOper (+) r1 r2 
    static member inline (-) (r1, r2) = romanOper (-) r1 r2
    static member inline (*) (r1, r2) = romanOper (*) r1 r2
    static member inline (/) (r1, r2) = romanOper (/) r1 r2
    static member inline (%) (r1, r2) = romanOper (%) r1 r2    

Public Helper Functions

// Returns the minimal representation of an input string roman expression
let asCanonicalRoman str = fromNumber (fromString str).Value

let romanRange start stop =
    let decStart = (fromString start).Value
    let decStop = (fromString stop).Value
    let step = if decStart <= decStop then 1 else -1
    seq { for dec in decStart..step..decStop do yield fromNumber dec }

let toString roman = sprintf "%s <-> %d" (roman.Text) (roman.Value)
let printRoman roman = printfn "%s" (toString roman)

Test Cases

printfn "Numbers from 1 to 3999"
for i in 1..3999 do
    let roman = fromNumber i
    let decimal = fromString roman.Text
    //if roman.Roman <> decimal.Roman || roman.Value <> decimal.Value then
    printfn "%s <==> %s" (toString roman) (toString decimal)



//printfn ""
//printfn "From File: "
//let path = "<your path>.p089_roman.txt"
//for line in File.ReadAllLines(path) do
//    let value = fromString line
//    let roman = fromNumber value.Value
//    if roman.Text <> value.Text || roman.Value <> value.Value then
//        printfn "%s <==> %s" (toString value) (toString roman)

//printfn ""
//printfn "Operator testing:"
//let r1 = fromNumber 5
//let r2 = fromNumber 3
//printRoman(r1 + r2)
//printRoman(r1 - r2)
//printRoman(r1 * r2)
//printRoman(r1 / r2)
//printRoman(r1 % r2)


//romanRange "X" "C" |> Seq.iter printRoman
//romanRange "C" "X" |> Seq.iter printRoman
\$\endgroup\$

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.