6 people like it.

Use of Active Patterns to convert integer to Roman numerals

A good use case for demonstrating the use of active patterns

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
open System

let rep times letter = [for _ in 1 .. times -> letter]

let div n divisor letter =
    let q = n / divisor
    if q > 0 then 
        let roman = rep q letter
        let rem = n % divisor
        Some(roman,rem)
    else
        None
        
let sub n divisor letterList = if n / divisor > 0 then Some(letterList,n - divisor) else None
        
let (|Thousand|_|) n = div n 1000 'M'
let (|NineH|_|) n    = sub n 900 ['C';'M']
let (|FiveH|_|) n    = div n 500 'D'
let (|FourH|_|) n    = sub n 400 ['C';'D']
let (|Hundred|_|) n  = div n 100 'C'
let (|Ninety|_|) n   = sub n 90 ['X';'C']
let (|Fifty|_|) n    = div n 50 'L'
let (|Forty|_|) n    = sub n 40 ['X';'L']
let (|Ten|_|) n      = div n 10 'X'
let (|Nine|_|) n     = sub n 9 ['I';'X']
let (|Five|_|) n     = div n 5 'V'
let (|Four|_|) n     = sub n 4 ['I';'V']
let (|One|_|) n      = div n 1 'I'

let toRoman (n:int) =

    let rec loop acc dvnd =
        match dvnd with
        | 0                    -> String(acc |> List.rev |> List.collect (fun x->x) |> List.toArray)
        | Thousand (roman,rem) 
        | NineH (roman,rem)
        | FiveH (roman,rem)
        | FourH (roman,rem)
        | Hundred (roman,rem)
        | Ninety (roman,rem)
        | Fifty (roman,rem)
        | Forty (roman,rem)
        | Ten (roman,rem)
        | Nine (roman,rem)
        | Five (roman,rem)
        | Four (roman,rem)
        | One (roman,rem) -> loop (roman::acc) rem
        | _               -> failwithf "unable to convert %A" dvnd
        

    loop [] n
    
toRoman 3999         //"MMMCMXCIX" 
toRoman 3000         //"MMM"
toRoman 495          //"CDXCV"
toRoman 1            // "I"
toRoman 2            // "II"
namespace System
val rep : times:int -> letter:'a -> 'a list
val times : int
val letter : 'a
val div : n:int -> divisor:int -> letter:'a -> ('a list * int) option
val n : int
val divisor : int
val q : int
val roman : 'a list
val rem : int
union case Option.Some: Value: 'T -> Option<'T>
union case Option.None: Option<'T>
val sub : n:int -> divisor:int -> letterList:'a -> ('a * int) option
val letterList : 'a
val toRoman : n:int -> String
Multiple items
val int : value:'T -> int (requires member op_Explicit)

--------------------
type int = int32

--------------------
type int<'Measure> = int
val loop : (char list list -> int -> String)
val acc : char list list
val dvnd : int
Multiple items
type String =
  new : value:char[] -> string + 8 overloads
  member Chars : int -> char
  member Clone : unit -> obj
  member CompareTo : value:obj -> int + 1 overload
  member Contains : value:string -> bool + 3 overloads
  member CopyTo : sourceIndex:int * destination:char[] * destinationIndex:int * count:int -> unit
  member EndsWith : value:string -> bool + 3 overloads
  member EnumerateRunes : unit -> StringRuneEnumerator
  member Equals : obj:obj -> bool + 2 overloads
  member GetEnumerator : unit -> CharEnumerator
  ...

--------------------
String(value: char []) : String
String(value: nativeptr<char>) : String
String(value: nativeptr<sbyte>) : String
String(value: ReadOnlySpan<char>) : String
String(c: char, count: int) : String
String(value: char [], startIndex: int, length: int) : String
String(value: nativeptr<char>, startIndex: int, length: int) : String
String(value: nativeptr<sbyte>, startIndex: int, length: int) : String
String(value: nativeptr<sbyte>, startIndex: int, length: int, enc: Text.Encoding) : String
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
    interface IReadOnlyList<'T>
    interface IReadOnlyCollection<'T>
    interface IEnumerable
    interface IEnumerable<'T>
    member GetReverseIndex : rank:int * offset:int -> int
    member GetSlice : startIndex:int option * endIndex:int option -> 'T list
    member Head : 'T
    member IsEmpty : bool
    member Item : index:int -> 'T with get
    member Length : int
    ...
val rev : list:'T list -> 'T list
val collect : mapping:('T -> 'U list) -> list:'T list -> 'U list
val x : char list
val toArray : list:'T list -> 'T []
active recognizer Thousand: int -> (char list * int) option
val roman : char list
active recognizer NineH: int -> (char list * int) option
active recognizer FiveH: int -> (char list * int) option
active recognizer FourH: int -> (char list * int) option
active recognizer Hundred: int -> (char list * int) option
active recognizer Ninety: int -> (char list * int) option
active recognizer Fifty: int -> (char list * int) option
active recognizer Forty: int -> (char list * int) option
active recognizer Ten: int -> (char list * int) option
active recognizer Nine: int -> (char list * int) option
active recognizer Five: int -> (char list * int) option
active recognizer Four: int -> (char list * int) option
active recognizer One: int -> (char list * int) option
val failwithf : format:Printf.StringFormat<'T,'Result> -> 'T
Next Version Raw view Test code New version

More information

Link:http://fssnip.net/7XX
Posted:4 years ago
Author:Faisal Waris
Tags: #active patterns , recursion