F# Finger Tree und RegEx. Teil 3.

Teil 1.
Teil 2.

Zurück zum eigentlichen Problem. Hier übrigens Online RegEx to Finite State Machine Tool.

#load @"..\fingertree.fsx"

open FData.FingerTree

let inline flip f b a= f a b

//Finite State Machine for Regex ".*(.*007.*).*"
let inline fsm i c =
    match i, c with
    |0, '(' -> 1
    |0, _ -> 0
    |1, '0' -> 2
    |1, _ -> 1
    |2, '0' -> 3
    |2, _ -> 1
    |3, '7' -> 4
    |3, '0' -> 3
    |3, _ -> 1
    |4, ')' -> 5
    |4, _ -> 4
    |5, _ -> 5

let inline tabulate f = Array.init 6 (fun i-> f i)

//Table with tabulated function for each letter in our alphabet.
let letters =
    [|' '..'z'|]
    |>Array.map (fun i->i,tabulate (flip fsm i))
    |>Map.ofArray

type Table= int []

type Size =
    |Size of int

//product monoid.
type Monoid() =
        interface IMonoid<Size * Table> with
            member inline this.Zero = Size 0,tabulate id
            member inline this.Plus a b = 
                match a,b with
                |(Size a, ta), (Size b, tb) -> Size (a + b), tabulate (fun st -> tb.[ta.[st]] )


type Element =
    |Elem of char
    interface IMeasured<Size * Table> with
        member inline this.Value = 
            match this with
            |Elem a -> 
                 Size 1, Map.find a letters

type FingerString =FingerTree<Element,Size * Table, Monoid>

let inline matches007 (s:FingerString) = (snd (measured s)).[0]=5

let inline fromList s=(s,Empty)||> List.foldBack (push_front<<Elem)

let inline insert i c tree = 
    let (l,r) = split (fun (Size n,_) -> n>i) tree
    concat l (push_front (Elem c) r)

let inline replace i c tree = 
    update (fun (Size n,_) -> n>i) (Elem c) tree

let treeString : seq<char>->FingerString = fromList<<List.ofSeq

//Simulate an interactive loop
let loop l f tree=
    let res = List.fold (fun acc (i,c)->
        let result= f i c acc
        result) tree l
    printfn "with Loop. Result %A" (matches007 res) 
    res

//Tests
open System
open System.Text.RegularExpressions

let test f =
    printfn "Test Start"
    let sw = new System.Diagnostics.Stopwatch()
    sw.Start()
    f()
    sw.Stop()
    printfn "Time Duration : %A" sw.ElapsedMilliseconds

//Regex for test.
let regex = new Regex (".*\(.*007.*\).*")

//String with 100 000 chars.
let str = String.Concat( Array.create 10000 " Match Me " )

//List of strings for test.
let listString=[str; str + "(007)"; "(007" + str + ")"; "(007)" + str]

//List of finger trees for test.
let listFingerString = List.map treeString listString

let runTest ()= 
    List.fold (fun acc str->
        test (fun ()->printfn "with Regex %A. Result %A " acc (regex.Match(str).Success))
        acc+1) 0 listString|>ignore
    List.fold (fun acc str->
        test (fun ()->printfn "with Finger Tree %A. Result %A " acc (matches007 str))
        acc+1) 0 listFingerString|>ignore

runTest ()

test (fun ()->loop [(3,'(');(4000,'u');(20005,'0');(20006,'0');(20007,'7');(20008,'r');(40009,')');(40010,' ');(11,'I')] insert stringTree|>ignore)

test (fun ()->loop  [(3,'(');(4,'0');(5,'0');(6,'7');(8,')');(40010,' ');(11,'I')] insert stringTree|>ignore)

test (fun ()->loop [(40004,'(');(40005,'0');(40006,'0');(40007,'7');(40008,'r');(40009,')');(40010,' ');(11,'I')] insert stringTree|>ignore)

test (fun ()->loop [(3,'(');(4000,'u');(20005,'0');(20006,'0');(20007,'7');(20008,'r');(40009,')');(40010,' ');(11,'I')] replace stringTree|>ignore)

F# Finger Tree und RegEx. Teil 1.

Finger Tree ist eine Datenstruktur aus der Welt der funktionalen Programmierung. Die verständliche und ausführliche Erklärung findet man hier 1, 2.

Hier ist ein sehr interessantes Problem beschrieben, das mittels der Finger Tree-Datenstruktur elegant gelöst wird.

Kurz gefasst: Sei einen regulären Ausdruck R gegeben, der auf einen String S der Länge N angewendet wird und angenommen der String S wird durch Einfügen, Ersetzen oder Löschen einzelner Zeichen geändert. Wie schnell kann die geänderte Zeichenfolge mit dem Ausdruck R erneut verglichen werden. Erstmal scheint es, dass die gesamte Zeichenfolge neu überprüft werden soll. Der Artikel jedoch zeigt, dass man nur O (log n) Zeit für die Neuberechnung benötigt.

Zuerst aber F# Finger Tree Version.
Grundlegende Ansätze zur F#-Implementierung habe ich bei diesen Postings - 1 und 2 - abgeschaut. Für weitere Funktionalitäten - split, concat und find Funktionen - ist die Haskell-Version herangezogen worden.

//Types
type IMeasured<'V>  =
    abstract inline Value : 'V

let inline measured (v : #IMeasured<_>) = v.Value

type IMonoid<'V> =
    abstract inline Zero : 'V
    abstract inline Plus : 'V -> 'V -> 'V

type Singleton<'T when 'T : (new : unit -> 'T)> private () =
    static let instance = new 'T()
    static member Instance = instance


type Node<'T,'V when 'T :> IMeasured<'V>> = 
    | Node2 of 'V * 'T * 'T
    | Node3 of 'V * 'T * 'T * 'T
    interface IMeasured<'V> with
        member x.Value =
            match x with
            |Node2 (v,_,_) ->v
            |Node3 (v,_,_,_) ->v

type Digit<'T,'V,'M when 'M :> IMonoid<'V> and 'M : (new  : unit -> 'M) and 'T :> IMeasured<'V>> =
    |One of 'T
    |Two of 'T * 'T
    |Three of 'T * 'T * 'T
    |Four of 'T * 'T * 'T * 'T
    interface IMeasured<'V> with
        member x.Value = 
            let monoid = Singleton<'M>.Instance
            match x with
            |One x-> measured x
            |Two(a,b)->  monoid.Plus (measured a) (measured b)
            |Three(a,b,c)->  monoid.Plus ((measured a, measured b)||>monoid.Plus) (measured c)
            |Four(a,b,c,d)->  monoid.Plus ((measured a, measured b)||>monoid.Plus) ((measured c,measured d)||>monoid.Plus)

type FingerTree<'T, 'V, 'M when 'M :> IMonoid<'V> and 'M : (new  : unit -> 'M) and 'T :> IMeasured<'V>> = 
    | Empty
    | Single of 'T
    | Deep of 'V * Digit<'T,'V,'M> * FingerTree<Node<'T,'V>,'V,'M> * Digit<'T,'V,'M>
    interface IMeasured<'V> with
        member x.Value =
            let monoid = Singleton<'M>.Instance
            match x with
            | Empty -> monoid.Zero
            | Single s -> measured s
            | Deep (v,_,_,_)->v

//Tree Construction.
let inline node2<'T,'V,'M when 'M :> IMonoid<'V> and 'M : (new  : unit -> 'M) and 'T :> IMeasured<'V>> (a:'T) (b:'T)= 
    let monoid = Singleton<'M>.Instance
    Node2 (monoid.Plus (measured a) (measured b),a,b)

let inline node3<'T,'V,'M when 'M :> IMonoid<'V> and 'M : (new  : unit -> 'M) and 'T :> IMeasured<'V>> (a:'T) (b:'T) (c:'T)=
    let monoid = Singleton<'M>.Instance
    Node3 (monoid.Plus ((measured a, measured b)||>monoid.Plus) (measured c),a,b,c)

let inline consDigit a dig=
    match dig with
    |One b->Two(a,b)
    |Two(b,c)->Three(a,b,c)
    |Three(b,c,d)-> Four(a,b,c,d)
    |_->raise FTreeException

let rec push_front<'T,'V,'M when 'M :> IMonoid<'V> and 'M : (new  : unit -> 'M) and 'T :> IMeasured<'V>> (a:'T) (t:FingerTree<'T,'V,'M> ):FingerTree<'T,'V,'M> =
        match t with 
        |Empty-> Single a
        |Single b->deep (One a) Empty (One b)
        |Deep (v, left, mid, right)->
            let monoid = Singleton<'M>.Instance
            match left with
            |Four(e,f,g,h) ->
                Deep(monoid.Plus (measured a) v,Two(a,e),push_front (node3<'T,'V,'M> f g h) mid,right)
            |_-> 
                Deep (monoid.Plus (measured a) v, consDigit a left, mid, right)

Der vollständige Quellcode - fingertree.fsx.
Wie wir sehen können ist die Baumstruktur mit einem Monoid parametrisiert. Dadurch kann eine und dieselbe Baumstruktur für verschiedene Zwecke verwendet werden. Wir können z.B. eine Random Access Datenstruktur definieren.

open FData.FingerTree

//Random Access
type Monoid() =
        interface IMonoid<int> with
            member this.Zero = 0
            member this.Plus a b = a + b

type Element<'T>  =
    |Element of 'T
    interface IMeasured<int> with
        member this.Value = 1

type RandomAccess<'T> = FingerTree<Element<'T>, int, Monoid>

//Index-Zugriff.
let nth index tree =
    match (find ((<) index) tree) with
    |Some value-> value
    |None-> failwith "invalid index" 

oder Max-Priority Queue

open FData.FingerTree

//Max-Priority Queue
type Monoid() =
        interface IMonoid<int> with
            member this.Zero = System.Int32.MinValue
            member this.Plus a b = max a b

type Element<'V> =
        { Prio : int
          Element : 'V }
          interface IMeasured<int> with
            member this.Value = this.Prio

type Priority<'T> =FingerTree<Element<'T>,int,Monoid>

//Das Element mit der höchsten Priorität finden
let findPrio tree = 
    match tree with
    |Empty->failwith "tree is empty"
    |Single b->Some b
    |Deep (v, _,_,_)->
        find (fun x->x = v) tree

Teil 2.