Purity - A CLR-Hosted Total Functional Programming Langauge.

Purity - A CLR-Hosted Total Functional Programming Langauge.

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 2. Polymorphic Recursion.

Teil 1.
Die push_front-Funktion ist rekursiv und ruft sich selbst mit verschiedenen Typ-Parameter. In diesem Fall spricht man von "Polymorphic Recursion".

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> 

Wenn beim Funktionsparameter a der Typ-Parameter weggelassen wird, bekommen wir folgende Fehlermeldung.

let rec push_front<'T,'V,'M when 'M :> IMonoid<'V> and 'M : (new  : unit -> 'M) and 'T :> IMeasured<'V>> a (t:FingerTree<'T,'V,'M> ):FingerTree<'T,'V,'M> 

Um besser zu sehen, mit welchem Parameter die Funktion aufgerufen wird, loggen wir die einzelne Funktionsaufrufe.

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> =
        printfn "Argument a = %A" a
...

let tree:RandomAccess<char> = List.foldBack (push_front<<Element) ['a'..'i'] Empty

Teil 3.

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.

Funktionale Animation. Teil 4.

Teil 1.
Teil 2.
Teil 3.


Es ist soweit. Ich kann endlich eine kleine animierte Statistik generieren.
Nehmen wir an, es gibt eine Firma, die die verschiedene Produkte über Amazon verkauft. Für diese Firma wird z.B eine Statistik über Gewinn, Kosten und Amazon-Rating von einzelnen Produkten im Verlauf der Zeit erstellt.

• Gewinn - Y-Achse
• Kosten - X-Achse
• Rating - Kreisdurchmesser

Die Daten werden einfach von der Random-Funktion generiert und danach weiter interpoliert so, dass letztendlich eine Sequenz folgendes Formates herauskommt.
data: (int * string * float * float * 'color) seq

(Zeitangabe, Produktname, Gewinn, Kosten, Farbe)
oder für die Rating-Werte
(Zeitangabe, Produktname, Rating, der Feld wird ignoriert , Farbe)

Einfachheitshalber werden als Zeitangabe ausschließlich Jahreswerte angegeben, die in fortlaufenden Nummern umgewandelt werden.

[(1,"Produkt A",70.50, 64.00, Brushes.Black );
(1,"Produkt B",80.50, 144.00, Brushes.Red );
(1,"Produkt C",187.50, 54.00, Brushes.Green);
(2,"Produkt A",70.55, 106.05, Brushes.Black );
(2,"Produkt B",80.55, 44.00, Brushes.Red );
(2,"Produkt C",45.50, 54.00, Brushes.Green)]

Der Code für die Datenerstellung befindet sich hier (Data.fsx).

//Behavior.fs
module BehaviorDrawing  =
   open System.Drawing
   open Demo.Drawing
   open Demo.DrawingFunctions
   open Demo.Data
   
   ...

    //Erstellt die Daten für XY-Achsen.
    let createDataXYAxis (data: (int * string * float * float * 'a) seq) =
        behavior{
            let! createdData = 
                 filterData data 
                            (fun (_,text,posx,posy,_)->
                                 let fposx,fposy = (float32 posx),(float32 posy)
                                 text,fposx,fposy
                            )
                            (fun (text,_,_)->text)
            return createdData
        }

    //Erstellt aus der Daten die Kreise.
    let createDataCircle (data: (int * string * float * float * 'a) seq) =
        behavior{
            let! createdData = 
                 filterData data 
                            (fun (_,text,diameter,_,color)->
                                 let fdiameter = float32 diameter
                                 text, circle color fdiameter fdiameter text
                            )
                            (fun (text,_)->text)
            return createdData|>Seq.map snd
        }

    //Alles zusammenfügen.
    let dataDrawing dataXY dataCircle=
        behavior{
            let! xy = dataXY
            let! c = dataCircle
            match Seq.isEmpty xy,Seq.isEmpty c with
            |false,false-> 
                return (
                    Seq.zip xy c
                    |>Seq.map (fun ((_,fposx,fposy),circle)->
                        let moveCircle = translate fposx fposy circle        
                        let textX = drawText (fposy.ToString()) (20.0f) -fposy
                        let lineX = textX
                                    |>compose (lineDraw 40.f -fposy fposx -fposy)
                        let textY = drawText (fposx.ToString()) fposx (-20.0f)
                        let lineY = textY
                                    |>compose (lineDraw fposx -40.f fposx -fposy) 
                        Seq.fold compose moveCircle (lineX::[lineY]))
                    |>Seq.fold compose emptyDrawing)
            |_-> return emptyDrawing
        }

    //Anzeige der Jahresüberschrift.
    let animationYearText duration init =
        let year timeStep = 
            //let td = t % duration
            //let o= (td*255/duration)%255
            let year = init + (timeStep  / duration)
            ("Jahr " + (year.ToString()))
        behavior{
            let! t = time
            return  (drawText (year t) 300.f (-570.f))
        }

    let animationPart4 duration init=
       //Initialisiere die Funktion mit der Dauer und dem Startwert.
       let fInterpolation = createInterpolation duration init
       //Erstelle die Daten im angegebenen Bereich 
       //für den Kreisdurchmesser. 
       let circles = fInterpolation  20 70
       //Erstelle die Daten im angegebenen Bereich 
       //für die X- Y-Achsen.
       let xyAxis = fInterpolation  40 500
       behavior{
           //Erstelle das komplette Bild.
           let! all = 
               dataDrawing  (createDataXYAxis xyAxis) (createDataCircle circles)
           return all
           }
    let singelton=
        let one duration init = behavior{
              let! a = animationPart4 duration init//animation
              let! animYear = animationYearText duration init 
              return (compose a animYear)
              }
        one

Dequeue.fs
Data.fsx
Drawing.fs
BehaviorPart4.fsx
AnimationPart4.fsx
mainPart4.fs

Funktionale Animation. Teil 3. Like a satellite.

Teil 1
Teil 2


Als Nächstes möchte ich eine Art von einfacher Planetenbewegung simulieren. Sagen wir, drei Kreise sollen sich mit unterschiedlicher Geschwindigkeit bewegen, und jeder Kreis besitzt noch einen eigenen Satellit.

Die rotate-Funktion wird erweitert.

let rotate speed radius = behavior {
   let fast = faster speed time
   let! posx = fast|>wiggle
   let! posy = fast|>wait 0.5f|>wiggle
   return posx * radius, posy * radius
   }

Dann brauche ich eine leere Behavior-Animation.

let forever a = Behavior(fun _->a)

let emptyBehavior = forever emptyDrawing 

Wie man sieht, egal zu welchem Zeitpunkt, gibt die forever-Funktion immer den gleichen Wert zurück.
Die Komposition zweier Drawing-Werte ist bereits in Drawing.fs definiert. Zur Erinnerung:

//Drawing.fs
...
let compose (img1:Drawing) (img2:Drawing) =
    drawing(fun g ->
      img1.Draw(g)
      img2.Draw(g) )

Das Gleiches implementiere ich für die Behavior-Werte und zwar als ein Operator. Der Vorteil dabei ist, dass in F# der Operator in der Infix- und Präfixnotation geschrieben werden kann. z.B

//let sum = 1 + 2
//let sum = (+) 1 2

let (--) a b =
    behavior {
        let! x = a
        let! y = b
        return compose x y
    } 

Die Verschiebefunktion.

let rotateAndTranslate speed radius drawingBehavior =
    behavior {
        let! x,y = rotate speed radius
        let! image = drawingBehavior
        return translate x y image
    } 

Und schließlich kann die Animation-Funktion geschrieben werden.

let animationPart3 =
    let satellite = rotateAndTranslate 0.8f 45.0f<<forever<<circle Brushes.DimGray 20.0f 20.0f
    let folder (acc,count) (color, speed) =
        let planet =
            rotateAndTranslate speed 70.0f<<(--) (satellite "moon")<<forever<<circle color 40.0f 40.0f
        let result = acc -- (count.ToString()|>planet)
        result,count+1
    [(Brushes.Black,0.1f);(Brushes.OliveDrab,0.3f);(Brushes.SteelBlue,0.6f)]
    |>Seq.fold folder (emptyBehavior,1)
    |>fst

Gehen wir den Code jetzt Schritt für Schritt durch.

 let satellite = rotateAndTranslate 0.8f 45.0f<<forever<<circle Brushes.DimGray 20.0f 20.0f

Am einfachsten liest man diesen Ausdruck der Funktionskomposition von rechts nach links. (<<) ist der Funktionskomposition-Operator.

1. circle Brushes.DimGray 20.0f 20.0f - Erstelle einen Kreis mit den übergebenen Parametern. Mit der Hilfe von Currying bekommen wir eine reduzierte Funktion, die noch das letzte Argument verlangt und Drawing zurückliefert. Die Typ-Signatur ist - (string->Drawing).
   
2. forever-Funktion wandelt Drawing in Behavior<Drawing>. Die Typ-Signatur - (string->Behavior<Drawing>).
   
3. Verschiebe den in Behavior "versteckten" Drawing-Wert mit der angegebenen Geschwindigkeit auf der Laufbahn vom angegebenen Halbmesser. Die Typ-Signatur - (string->Behavior<Drawing>)
   

Die folder-Funktion folgt später.

     [(Brushes.Black,0.1f);(Brushes.OliveDrab,0.3f);(Brushes.SteelBlue,0.6f)]
    |>Seq.fold folder (emptyBehavior,1)
    |>fst

Hier wird die Liste von Paaren mit der Farbe und der Geschwindigkeit an der Seq.fold übergeben. (|>) ist der Pipe-Operator. Der Wert vom linken Ausdruck wird an das letzte Argument des rechten Ausdruckes übergeben. Das Resultat von fold ist ein Tupel, von dem wird mit der fst-Funktion (fst für "first") der erste Wert genommen.
Nun zur folder-Funktion. Das Prinzip ist hier und speziell für F# Seq.fold erklärt.

let folder (acc,count) (color, speed) =
        let planet = rotateAndTranslate speed 70.0f<<(--) (satellite "moon")<<forever<<circle color 40.0f 40.0f
        let result = acc -- (count.ToString()|>planet)
        result,count+1

Wie beschrieben, folder wird auf jeden Element - (color, speed) - der oben genannten Liste angewendet. Der Akkumulator (ich kenne keinen besseren Namen) ist (acc, count), wobei acc - wie man beim Funktionsaufruf sieht - am Anfang emptyBehavior ist und count gleich 1 ist.

let planet = 
    rotateAndTranslate speed 70.0f<<(--) (satellite "moon")<<forever<<circle color 40.0f 40.0f

Hier is das gleiche wie beim satellite-Ausdruck. Anders ist nur, dass vor dem Verschieben der Kreis vom Planet mit dem Satellit zusammengesetzt wird. Dann setzen wir den Planet mit dem Akkumulator zusammen, dadurch wird am Ende des Fold-Prozesses ein allen Elementen enthaltener, akkumulierter Behavior-Wert entstehen. Der Zähler count ist für die Durchnummerierung von Kreisen auf dem Formular da.
Alles zusammen.

//Behavior.fsx
...
let rotate speed radius= behavior{
  let fast = faster speed time
  let! posx = fast|>wiggle
  let! posy = fast|>wait 0.5f|>wiggle
  return posx * radius, posy * radius}

module BehaviorDrawing  =
open Demo.Drawing
open Demo.DrawingFunctions
let emptyBehavior = forever emptyDrawing
let (--) a b =
    behavior{
        let! x = a
        let! y = b
        return compose x y
    }
let rotateAndTranslate speed radius drawingBehavior =
    behavior{
        let! x,y = rotate speed radius
        let! image = drawingBehavior
        return translate x y image
    }

let animationPart3 =
    let satellite = rotateAndTranslate 0.8f 45.0f<<forever<<circle Brushes.DimGray 20.0f 20.0f
    let folder (acc,count) (color, speed) =
        let planet = rotateAndTranslate speed 70.0f<<(--) (satellite "moon")<<forever<<circle color 40.0f 40.0f
        let result = acc -- (count.ToString()|>planet)
        result,count + 1
    [(Brushes.Black,0.1f);(Brushes.OliveDrab,0.3f);(Brushes.SteelBlue,0.6f)]
    |>Seq.fold folder (emptyBehavior,1)
    |>fst

let singelton =
    let one =behavior{
          let! a = animationPart3
          return a
          }
    one

Drawing.fs
Behavior.fsx
Animation.fsx
main.fs

Funktionale Animation. Teil 2.

Bevor ich mit der Behavior-Monade aus Teil 1 fortfahre, brauche ich erstmal die Windows-Form, auf der die Animation stattfinden soll.

//Animation.fsx
module Demo.Animations
#load @"C:\Temp\Behavior.fsx"
open System
open System.Drawing
open System.Drawing.Imaging
open System.Windows.Forms
open Demo.Behavior

type AnimationForm() as x =
  inherit Form()
  let mutable startTime = DateTime.Now
  let anim = singelton //hier wird die Behavior-Animation zugewiesen.

  do
    x.SetStyle(ControlStyles.AllPaintingInWmPaint  ControlStyles.OptimizedDoubleBuffer, true)
    let tmr = new Timers.Timer(Interval = 25.0)
    tmr.Elapsed.Add(fun _ -> x.Invalidate() )
    tmr.Start()
 
  // Gets or sets the currently displayed animation
  member x.Animation
    with get() = anim
  override x.OnPaint(e) = 
      let wid, hgt = x.ClientSize.Width, x.ClientSize.Height
      e.Graphics.FillRectangle(Brushes.White, 0, 0, wid, hgt)
      e.Graphics.TranslateTransform(float32 wid/2.0f, float32 hgt/2.0f) 
      let elapsed = (DateTime.Now - startTime).TotalSeconds
      //Hier wird die Animation ausgeführt.
      let drawing = runBehavior anim {Time=float32 elapsed}
      drawing.Draw(e.Graphics) startTime).TotalSeconds

Zurück zur Behavior-Monade. Nun ist es möglich verschiedene Behavior-Funktionen zu definieren. Zuerst die wichtigste Zeitfunktion, die direkt über den Behavior-Typkonstruktor erstellt wird.

//Behavior.fsx
...
let behavior = new BehaviorBuilder()

let time = Behavior(fun context -> context.Time)

Spaßeshalber definiere ich die Funktion auch "monadisch".

let time = behavior{
    let! t = Behavior(fun context -> context.Time)
    return t}

und weitere Funktionen.

let wait (delay:float32) a = behavior{
    let! t = a
    return delay + t}

let faster (speed:float32) a = behavior{
    let! t = a
    return speed * t}

let wiggle b = behavior{
    let! t = b
    return sin (t * float32 Math.PI)}

let rotate= behavior{
  let! posx = wiggle time
  let! posy = time|>wait 0.5f|>wiggle
  return posx * 100.0f, posy * 100.0f}

Die Funktionen für die Animation.

module BehaviorDrawing  =
    open Demo.DrawingFunctions
    open System.Drawing
    let animation = 
        let moon  = circle Brushes.DimGray 20.0f 20.0f "moon"
        behavior{
            let! x,y = rotate
            return translate x y moon
            }
    let singelton=
        let one = behavior{
              let! a = animation
              return a
              }
        one

Zuletzt Main().

//main.fs
#load @"C:\Temp\Animation.fsx"
open Demo.Animations
open System
open System.Drawing
open System.Windows.Forms

let test =
    let af = new AnimationForm(ClientSize = Size(1000, 1000), Visible=true)
    af
let main() =
    test |> ignore
[]
    do main()

Hier der Beweis.

Alle Dateien zum Download:
Drawing.fs
Behavior.fsx
Animation.fsx
main.fs

Funktionale Animation. Teil 1. Ich sehe was, was du nicht siehst, und das ist die Monade.

Seit einem halben Jahr beschäftige ich mich mit F# und funktionaler Programmierung.

Ich habe diverse Bücher studiert bis ich auf Real World Functional Programming gestoßen bin, wo in Kapitel 15 ein sehr eleganter Lösungsansatz für die funktionale Animation beschrieben ist.

Ich wollte das Beispiel sofort ausprobieren und zu einer Art animierte Statistik bzw. Reports erweitern. In diesem Blog beschreibe ich die einzelnen Schritte zu diesem Ziel.

Der Ausgangspunkt ist der originale Code aus dem Buch hier. Die Idee ist sehr einfach wenn nicht sogar trivial.

Animations can be elegantly modeled using time-varying values. In Fran, these values are called behaviors and
we'll follow this naming. The following note explains what a behavior is.
WHAT IS A BEHAVIOR?
Behavior is a time-varying value. It can be represented as a composite value, whose
actual value may be different depending on the time. ….
Similarly, we'll have a type

Behavior<int>

, whose actual integer value can be different depending on the time.
Behaviors are an essential part of our animation framework, because we can use them
for specifying locations of objects. When the location changes depending on the time, it
means that the whole object will be moving.

Erstmal brauchen wir unsere Grafikfunktionen.

//Drawing.fs
module Demo

open System
open System.Drawing
open System.Drawing.Imaging
open System.Drawing.Drawing2D

module Drawing =
  type Drawing =
    abstract Draw : Graphics -> unit

  let drawing f =
    { new Drawing with
        member x.Draw(gr) = f(gr) }

  let emptyDrawing =
    { new Drawing with
        member x.Draw(gr) = () }

open Drawing

module DrawingFunctions=
    let translate x y (img:Drawing) =
      drawing (fun g ->
        g.TranslateTransform(x, -y)
        img.Draw(g)
        g.TranslateTransform(-x, y) )
    
    let rectangle (t1, p1) =
      drawing(fun g ->
         use font = new Font ("Calibri",14.0f)
         g.DrawString(t1,font,Brushes.Black,950.0f,p1))
    
    let circle brush size arg text=
      drawing(fun g ->
         g.SmoothingMode <- SmoothingMode.AntiAlias
         g.FillEllipse(brush, -arg/2.0f, -size/2.0f, arg, size)
         use font = new Font ("Calibri",10.0f)
         g.DrawString(text,font,Brushes.Black,size/2.0f, size/2.0f))

    let compose (img1:Drawing) (img2:Drawing) =
      drawing(fun g ->
         img1.Draw(g)
         img2.Draw(g) )

Der Code sofort in die F#-Konsole kopieren oder laden und dann sehen wir bereits die Typ-Signaturen.

Also bisher nichts wildes. Weiter geht es mit dem Behavior-Typ. Den wollte ich unbedingt als eine Monade implementieren. In F# nennt man eine Monade "Computation expression, was ein bisschen verwirrt.

//Behavior.fsx
module Demo.Behavior
//Laden Grafikfunktionen
#load @"C:\Temp\Drawing.fs"

open System
type BehaviorContext = { Time : float32 }

// Single case discriminated union
type Behavior<'a> = Behavior of (BehaviorContext -> 'a)

let runBehavior (Behavior fBehavior) t = fBehavior t

BehaviorContext ist "record type". So ein Typ hat mehrere benannte Elemente, in unserem Fall ist das nur eins. Am Anfang habe ich ihm aus Bequemlichkeit als float32 definiert, richtiger wäre es den Typ zu parametrisieren.
Bei Behavior<'a> sieht man, was mir im OOP-Welt öfter fehlte, eine "Unterscheidungs-Union" aka Tagged union aka ADT. "Behavior" nach dem "type" Schlüsselwort ist der Typ-Konstruktor, "Behavior" nach Gleichhetzeichen ist ein Daten-Konstruktor. Unser Behavior-Typ ist nichts anderes als eine Funktion, die als Parameter BehaviorContext-Typ - also letztendlich die Zeit - nimmt und den 'a -Typ zurückgibt.

runBehavior wendet dann Behavior zu einem konkreten Zeitpunkt an. Was da in Klammer steht ist nichts Wenigeres als Pattern Matching eines Funktionsargumentes. Jetzt kann die Monade gebaut werden, aber vorerst die Signaturen.


Ich würde von mir nicht behaupten, dass ich das Konzept von der Monade halbwegs verstanden habe. Das stört mir aber nicht, da an die Monade auch ganz formal herangegangen werden kann.

F# braucht für die Monade-Erstellung einen bestimmten Typ mit wenigstens zwei Membern Return und Bind.

member Return : 'a -> M<'a>
member Bind :M <'a> * ('a -> M<'b>) -> M<'b>

Return ist schnell abgehakt.

//member Return : 'a -> Behavior<'a>
type BehaviorBuilder() =
  member this.Return a = Behavior(fun _->a)//in Klammer steht ein Lambda-Ausdruck

Mit der Bind-Funktion habe ich eine gute Stunde gekämpft.

//member Bind : Bahavior<'a> * ('a -> Behavior<'b>) -> Behavior<'b>
let bind (Behavior fBehavior) generator = ?...

Wir haben als Input Behavior vom Typ 'a mit seiner fBehavior Funktion vom Typ (BehaviorContext->'a) und eine Generator-Funktion, die aus 'a den neuen Behavior vom Typ 'b erzeugt. Als Resultat kommt Behavior vom 'b heraus. Also schreibe ich:

let bind (Behavior fBehavior) generator = Behavior(fun behaviorContext->'b?)

Typ 'b kann uns eigentlich nur die runBehavior-Funktion liefern.

let bind (Behavior fBehavior) generator = Behavior(fun behaviorContext->runBehavior arg1?  arg2?)

runBehavior erwartet als Parameter Behavior und BehaviorContext. Was für ein Glück, den Kontext habe ich parat.

let bind (Behavior fBehavior) generator =
    Behavior(fun behaviorContext->runBehavior arg1?  behaviorContext)

Nicht genutzt sind fBehavior und generator. Von beiden kann ausschließlich generator uns der benötigte Behavior-Typ bereitstellen.

let bind (Behavior fBehavior) generator = 
    Behavior(fun behaviorContext->runBehavior (generator arg1?)  behaviorContext)

Ab hier ist es ein bloßes Kinderspiel.

let bind (Behavior fBehavior) generator =
    Behavior(fun behaviorContext->runBehavior (generator (fBehavior behaviorContext))  behaviorContext)

Überall wird gesagt, dass man Lambdas möglichst durch Currying ersetzen werden sollte. Die hässliche Klammern lassen mir auch keine Ruhe. Die vertreibt man mit Funktionskomposition.

let applyDoubly f a = f a a

let bind (Behavior fBehavior) generator =
    Behavior(runBehavior<<generator<<fBehavior|>applyDoubly)

Nun haben wir alles.

type BehaviorContext = { Time : float32 }

// Single case discriminated union
type Behavior<'a> = Behavior of (BehaviorContext -> 'a)

let runBehavior (Behavior fBehavior) t = fBehavior t

let applyDoubly f a = f a a

let bind (Behavior fBehavior) generator =
    Behavior(runBehavior<<generator<<fBehavior|>applyDoubly)

type BehaviorBuilder()=
 member this.Return a = Behavior(fun _->a)
 member this.Bind (m, k) = bind m k
 //ein Paar Hilfsfunktionen
 member this.Zero () = Behavior(fun _->())
 member this.ReturnFrom m = m

let behavior = new BehaviorBuilder()

behavior ist die zu verwendende Monade.

Wozu eigentlich die ganze Mühe? Siehe nächsten Einträge.
Teil 2