Rash thoughts about .NET, C#, F# and Dynamics NAV.


"Every solution will only lead to new problems."

Monday, 21. December 2009


Observing asynchronous downloads with F# and the Reactive Extensions for .NET

Filed under: F# — Steffen Forkmann at 18:01 Uhr

In one of my lasts posts I showed how we can transform some of the operators from the Reactive Framework for an easier use in F#. This time I will demonstrate how we can use this API and asynchronous workflows to download a couple of websites asynchronous and in parallel.

First of all we create a synchronous download function:

let SyncHttp (url:string) =

  let request = WebRequest.Create url

  let response = request.GetResponse()

  use stream = response.GetResponseStream()

  use reader = new StreamReader(stream)

  let result = reader.ReadToEnd()

  url,result

In F# we can easily make this function asynchronously:

let AsyncHttp (url:string) =

  async { // using asynchronous workflows

    let request = WebRequest.Create url

    // async call of GetResponse

    let! response = request.AsyncGetResponse()

    use stream = response.GetResponseStream()

    use reader = new StreamReader(stream)

    // async call of ReadToEnd

    let! result = reader.AsyncReadToEnd()

    return url,result} 

Now we use this AsyncHttp function to create a list of async downloads:

/// Async<string * string> list

let downloads =

  ["http://www.google.com";

   "http://www.twitter.com";

   "http://www.nytimes.com/";

   "http://www.navision-blog.de/";

   "http://www.nba.com/"

    |> List.map AsyncHttp

The next step is to convert the list of async calls into a list of observables and to merge this list into a single IObservable. The effect is that whenever one download is completed we will be notified about the result:

/// IObservable<string * string>

let observableDownloads =

  downloads

    |> Seq.map Observable.ofAsync

    |> Observable.merge

 

 

observableDownloads

  |> Observable.subscribe (fun (url,result) ->

       printfn "%A: %d" url result.Length)

 

If you want to learn more about Observable.merge and see the marble diagram you should watch this video.

https://hrvatskaedfarmacija.com
Tags: , ,

Saturday, 12. December 2009


Christmas tree in F#

Filed under: Diverses — Steffen Forkmann at 12:19 Uhr

Today I had way too much time on the train 😉 , so I wrote a little functional christmas tree program:

let line width j =

  List.init

    width

    (fun i -> if abs(width/2 – i) <= j then "*" else " ")

 

let tree n =

  List.init (n/2) (line n) @        // treetop

    List.init 2 (fun _ -> line n 0) // trunk

 

let printTree =

  tree >> Seq.iter (Seq.fold (+) "" >> printfn "%s")

 

printTree 11

 

    *     
   ***    
  *****
 *******  
********* 
    *     
    * 
Tags: ,

Friday, 27. November 2009


Observing the FileSystem

Filed under: Diverses — Steffen Forkmann at 10:38 Uhr

The following class is a wrapper for the System.IO.FileSystemWatcher and converts the FileSystem events into observables. You need to download and reference the Reactive Extensions for .NET (Rx) to use this code:

public class FileSystemObservable

{

  private readonly FileSystemWatcher _fileSystemWatcher;

 

 

  public FileSystemObservable(string directory,

    string filter, bool includeSubdirectories)

  {

    _fileSystemWatcher =

      new FileSystemWatcher(directory, filter)

        {

          EnableRaisingEvents = true,

          IncludeSubdirectories = includeSubdirectories

        };

 

 

    ChangedFiles =

      Observable.FromEvent<FileSystemEventHandler,

                             FileSystemEventArgs>

      (h => h.Invoke,

       h => _fileSystemWatcher.Changed += h,

       h => _fileSystemWatcher.Changed -= h)

      .Select(x => x.EventArgs);

 

    CreatedFiles =

      Observable.FromEvent<FileSystemEventHandler,

                             FileSystemEventArgs>

      (h => h.Invoke,

       h => _fileSystemWatcher.Created += h,

       h => _fileSystemWatcher.Created -= h)

      .Select(x => x.EventArgs);

 

    DeletedFiles =

      Observable.FromEvent<FileSystemEventHandler,

                             FileSystemEventArgs>

      (h => h.Invoke,

       h => _fileSystemWatcher.Deleted += h,

       h => _fileSystemWatcher.Deleted -= h)

      .Select(x => x.EventArgs);

 

    RenamedFiles =

      Observable.FromEvent<RenamedEventHandler,

                             RenamedEventArgs>

      (h => h.Invoke,

       h => _fileSystemWatcher.Renamed += h,

       h => _fileSystemWatcher.Renamed -= h)

      .Select(x => x.EventArgs);

 

    Errors =

      Observable.FromEvent<ErrorEventHandler, ErrorEventArgs>

      (h => h.Invoke,

       h => _fileSystemWatcher.Error += h,

       h => _fileSystemWatcher.Error -= h)

      .Select(x => x.EventArgs);

  }

 

  /// <summary>

  /// Gets or sets the errors.

  /// </summary>

  /// <value>The errors.</value>

  public IObservable<ErrorEventArgs> Errors

           { get; private set; }

 

  /// <summary>

  /// Gets the changed files.

  /// </summary>

  /// <value>The changed files.</value>

  public IObservable<FileSystemEventArgs> ChangedFiles

           { get; private set; }

 

  /// <summary>

  /// Gets the created files.

  /// </summary>

  /// <value>The created files.</value>

  public IObservable<FileSystemEventArgs> CreatedFiles

           { get; private set; }

 

  /// <summary>

  /// Gets the deleted files.

  /// </summary>

  /// <value>The deleted files.</value>

  public IObservable<FileSystemEventArgs> DeletedFiles

           { get; private set; }

 

  /// <summary>

  /// Gets the renamed files.

  /// </summary>

  /// <value>The renamed files.</value>

  public IObservable<RenamedEventArgs> RenamedFiles

           { get; private set; }

}

Now we can use the observable and can easily create meta-events:

IDisposable writer =

    new FileSystemObservable(@"d:\Test\", "*.*", false)

        .CreatedFiles

        .Where(x => (new FileInfo(x.FullPath)).Length > 0)

          // … you can do much more with the combinators

        .Select(x => x.Name)

        .Subscribe(Console.WriteLine);

Tags: ,

Tuesday, 24. November 2009


Generating an IObservable<T> from an IEvent in F#

Filed under: F# — Steffen Forkmann at 12:39 Uhr

Yesterday I showed how we can map some of the Rx operators to an API which looks more like the F# base classes. Today I wanted to use these mapped operators in a WPF-application written in F#.

F# gives us a nice way to use events as first class citizen (via IEvent) but these events implement their own version of IObservable<T> (in FSharp.Core.dll), which is unfortunately incompatible with the Rx version and therefore with the mapped API.

The solution I found is to wrap the F# IEvent with a Rx IObservable<T>:

/// Generates an observable from an IEvent

let fromEvent (event:IEvent<_,_>) =      

  Observable.Create<_>(fun x ->

    event.Subscribe x.OnNext |> ignore

    new System.Action(fun () -> ()))     

Now we are able to use the WPF events as observables:

// Register ListBox Commands

listBox1.KeyDown

  |> Observable.fromEvent

  |> Observable.filter (fun args -> args.Key = Key.Delete)

  |> Observable.subscribe deleteElement

I am interested if someone has a different and maybe better solution to this problem.

Updated: 21.12.2009 – Observable.Context is no longer supported by Rx ==> Removed

Tags: ,

Monday, 23. November 2009


Mapping the Reactive Framework (Rx) operators for F#

Filed under: F# — Steffen Forkmann at 13:35 Uhr

The “Reactive Extensions for .NET (Rx)” comes with lot’s of operators for using IObservable<T>. This code mimics the signature of the default F# sequence combinators and allows to use observables like sequences. It is a similar approach like Matthews Podwysocki’s blog post about mapping the IParallelEnumerable.

I will update this post from time to time to include more of the operators.

  • Update: 25.11.2009 – new operators mapped
  • Update: 21.11.2009 – Updated to new Rx release

module RxExtensions.Observable

 

open System.Linq

open System

open System.Threading

open System.Windows.Threading

 

type ‘a observable = IObservable<‘a>

type ‘a observer = IObserver<‘a>

 

/// converts a lambda in a System.Action

let asAction f = new System.Action(f)

 

/// System.Action whichs does nothing

let doNothing = asAction (fun () -> ())

 

/// Creates an observer

let createObserver next error completed =

  {new System.IObserver<_> with

      member this.OnCompleted() = completed()

      member this.OnError(e) = error e

      member this.OnNext(args) = next args}

 

/// Creates a new observable

let create f =

  Observable.Create<_>(fun x ->

    f x

    doNothing)  

 

/// Creates a observable from a async

let ofAsync async =

  create

    (fun obs ->

       Async.StartWithContinuations

         (async,obs.OnNext,obs.OnError,obs.OnError))

 

/// Gets a dispatcher Schdeuler for the current dispatcher

let getDispatcherScheduler _ =

  new DispatcherScheduler(Dispatcher.CurrentDispatcher)

 

/// Generates an observable from an IEvent

let fromEvent (event:IEvent<_,_>) = create (fun x -> event.Add x.OnNext)

 

/// Generates an empty observable

let empty<‘a> = Observable.Empty<‘a>()

 

/// Takes the head of the elements

let head = Observable.First

 

/// Merges the two observables

let mergeWith obs1 obs2 = Observable.Merge(obs2, obs1)

 

/// Merges all observables

let mergeAll (observables:IObservable<IObservable<‘a>>) =

  Observable.Merge observables

 

/// Merges all observables

let merge (observables:(IObservable<‘a>) seq) =

  Observable.Merge observables

 

/// Creates a range as an observable

let range start count = Observable.Range(start, count)

 

/// Converts a seq in an observable

let toObservable (seq: ‘a seq) = Observable.ToObservable seq

 

/// Converts a observable in a seq

let toEnumerable = Observable.ToEnumerable

 

/// Subscribes to the Observable with all 3 callbacks

let subscribeComplete next error completed (observable: ‘a observable) =

   observable.Subscribe(

     (fun x -> next x),

     (fun e -> error e),

     (fun () -> completed()))

 

/// Subscribes to the Observable with a

/// next and an error-function

let subscribeWithError next error observable =

  subscribeComplete next error (fun () -> ()) observable

 

/// Subscribes to the Observable with just a next-function

let subscribe next observable =

  subscribeWithError next ignore observable

 

/// throttles the observable for the given interval

let throttle interval observable =

  Observable.Throttle(observable,interval)   

 

/// throttles the observable scheduled on the current dispatcher

let throttleOnCurrentDispatcher interval observable =

  Observable.Throttle(

     observable,getDispatcherScheduler(),interval)

 

/// samples the observable at the given interval

let sample interval observable =

  Observable.Sample(observable,interval)   

 

/// samples the observable at the given interval

/// scheduled on the current dispatcher

let sampleOnCurrentDispatcher interval observable =

  Observable.Sample(

    observable,getDispatcherScheduler(),interval)

 

/// returns the observable sequence that reacts first.

let takeFirstOf2Reactions obs1 obs2 =

  Observable.Amb(obs1,obs2)

 

/// returns the observable sequence that reacts first.

let amb (obs: IObservable<‘a> seq) =

  Observable.Amb obs  

 

/// returns the observable sequence that reacts first.

let takeFirstReaction (obs: IObservable<‘a> seq) =

  Observable.Amb obs  

 

/// Matches when both observable sequences

/// have an available value.

let both obs1 obs2 = Observable.And(obs1,obs2)

 

/// Merges two observable sequences

/// into one observable sequence.

let zip obs1 obs2 =   

   Observable.Zip(obs1, obs2, Func<_,_,_>(fun a b -> a, b))

 

/// Merges two observable sequences into one observable sequence

/// whenever one of the observable sequences has a new value.

///    ==> More results than zip

let combineLatest obs1 obs2 =   

   Observable.CombineLatest(

     obs1, obs2, Func<_,_,_>(fun a b -> a, b))    

 

/// Concats the two observables to one observable

let concat observable =

  Observable.SelectMany(

    observable,

    Func<_,_>(fun (x:IObservable<‘a>) -> x))

 

/// maps the given observable with the given function

let map f observable =

  Observable.Select(observable,Func<_,_>(f))  

 

/// maps the given observable with the given function

let mapi f observable =

  Observable.Select(observable,Func<_,_,_>(fun x i ->f i x))  

 

/// Filters all elements where the given predicate is satified

let filter f observable =

  Observable.Where(observable, Func<_,_>(f))

 

/// Splits the observable into two observables

/// Containing the elements for which the predicate returns

/// true and false respectively

let partition predicate observable =

  filter predicate observable,

  filter (predicate >> not) observable

 

/// Skips n elements

let skip n observable = Observable.Skip(observable, n)

 

/// Skips elements while the predicate is satisfied

let skipWhile f observable =

  Observable.SkipWhile(observable, Func<_,_>(f))

 

/// Runs all observable sequences in parallel

/// and combines their first values.

let forkJoin (observables: (‘a observable) seq) =

  Observable.ForkJoin observables

 

/// Counts the elements

let length = Observable.Count

 

/// Takes n elements

let take n observable =

  Observable.Take(observable, n)  

 

/// Determines whether the given observable is empty 

let isEmpty observable = Observable.IsEmpty observable

 

/// Determines whether the given observable is not empty 

let isNotEmpty observable = not (Observable.IsEmpty observable)

 

/// Determines whether an observable sequence

/// contains a specified value

/// which satisfies the given predicate

let exists predicate observable =

  observable

    |> skipWhile (predicate >> not)

    |> isNotEmpty

 

/// Continues an observable sequence that is terminated

/// by an exception with the next observable sequence.

let catch (newObservable:IObservable<‘a>) failingObservable =

  Observable.Catch(failingObservable,newObservable) 

 

/// Takes elements while the predicate is satisfied

let takeWhile f observable =

  Observable.TakeWhile(observable, Func<_,_>(f))

 

/// Iterates through the observable

/// and performs the given side-effect

let perform f observable =

  Observable.Do(observable,fun x -> f x)

 

/// Invokes finallyAction after source observable

/// sequence terminates normally or by an exception.

let performFinally f observable =

  Observable.Finally(observable,fun _ -> f())

 

/// Folds the observable

let fold f seed observable =

  Observable.Aggregate(observable, seed, Func<_,_,_>(f))  

 

/// Retruns an observable from a async pattern 

let fromAsync beginF endF =

   Observable.FromAsyncPattern<_>(

     Func<_,_,_>(fun x y -> beginF(x,y)),

       (fun x -> endF x)).Invoke()

 

/// Runs all observable sequences in parallel

/// and combines their first values.

let subscribeAll next observables =

  observables |> Seq.map (subscribe next) |> Seq.toList     

 

type IObservable<‘a> with

  /// Subscribes to the Observable with just a next-function

  member this.Subscribe(next) =

    subscribe next this

 

  /// Subscribes to the Observable with a next

  /// and an error-function

  member this.Subscribe(next,error) =

    subscribeWithError next error this

 

  /// Subscribes to the Observable with all 3 callbacks

  member this.Subscribe(next,error,completed) =

    subscribeComplete next error completed this

 

open System.Net

 

type WebRequest with

  member this.GetRequestStreamAsync() =

    fromAsync

     this.BeginGetRequestStream

     this.EndGetRequestStream

 

  member this.GetResponseAsync() =

    fromAsync

      this.BeginGetResponse

      this.EndGetResponse

 

  member this.GetResponseStreamAsync() =

    fromAsync

      this.BeginGetRequestStream

      this.EndGetRequestStream

 

type Async<‘a> with

  member this.ToObservable() = ofAsync this

Tags: , , ,

Sunday, 8. November 2009


"Getting started" with NaturalSpec – (Updated 08.11.2009)

Filed under: .NET,F#,NaturalSpec — Steffen Forkmann at 10:48 Uhr

In my last article (Introducing NaturalSpec – A Domain-specific language (DSL) for testing) I used NaturalSpec in two small samples. This time I will show how we can set up a NaturalSpec environment to write our first automatically testable scenarios.

1. Choosing an IDE

The first step is to choose an integrated development environment for NaturalSpec. At the current project status you should be able to use NaturalSpec with Visual Studio 2008, Visual Studio 2010 beta 2, the freely available Visual Studio 2008 Shell or the free IDE SharpDevelop 3.0.

2. Installing the testing framework

As NaturalSpec uses NUnit as the underlying testing framework we have to install NUnit 2.5. I also recommend installing TestDriven.Net in order to get a Unit Test runner within Visual Studio.

3. Installing F#

NaturalSpec is completely written in F# and all specs will also be written in F#. This doesn’t imply you have to learn programming in F# but we need the F# compiler to get things working. You can download the F# October 2009 CTP from the Microsoft F# Developer Center.

4. Downloading the latest version of NaturalSpec

You can download a .zip with the latest NaturalSpec libraries from GoogleCode.

5. Creating a spec

This part is written for using Visual Studio 2008. If you use SharpDevelop or Visual Studio 2008 Shell this might differ in some detail.

Start Visual Studio 2008 and create a new F# class library.

Creating a spec project

Rename Module1.fs in ListSpec.fs and delete script.fsx from the project:

Solution explorer

Create a folder “Lib” and unzip the NaturalSpec libraries into it.

Add NaturalSpec.dll and nunit.framework.dll as references to your project:

Adding project references

Copy the following code into ListSpec.fs:

module ListSpec
open NaturalSpec

[<Scenario>]
let When_removing_an_3_from_a_small_list_it_should_not_contain_3() =
  Given [1;2;3;4;5]
    |> When removing 3
    |> It shouldn't contain 3
    |> Verify

If you have TestDriven.Net installed you can run your spec via right click in the solution explorer:

Run spec with TestDriven.net

If you don’t like the TestDriven.Net test runner you might want to use the NUnit GUI runner. The output should look like:

NUnit Gui runner

In addition the test runner should produce a Spec output file with the name “Spec.txt” within the same folder.

Summary

In a minimal environment you need SharpDevelop, the F# compiler, NUnit and the NaturalSpec libraries for using NaturalSpec.

In the next post I will show how you can use NaturalSpec to create a spec for C# projects.

Tags: , , , , ,

Friday, 6. November 2009


Observing global hotkeys in C# / F#

Filed under: C#,F# — Steffen Forkmann at 11:08 Uhr

I recently had the problem to register a global hotkey, but my “old” Win32-API calls didn’t work with WPF. I looked around the web and found the “Managed Windows API”, but I didn’t want to add another external dependency to my project, so I extracted the core functions for registering hotkeys and condensed the code to a new version.

As the original “Managed Windows API” is licensed by the GNU Lesser General Public License (LGPL) I want to provide my modifications here.

First we need a Window which can dispatch the window messages to our event handlers:

/// <summary>

/// A Win32 native window that delegates window messages to

/// handlers. So several

/// components can use the same native window to save

/// "USER resources". This class

/// is useful when writing your own components.

/// </summary>

public sealed class EventDispatchingNativeWindow : NativeWindow

{

    private static readonly Object MyLock = new Object();

    private static EventDispatchingNativeWindow _instance;

 

    /// <summary>

    /// Create your own event dispatching window.

    /// </summary>

    public EventDispatchingNativeWindow()

    {

        CreateHandle(new CreateParams());

    }

 

    /// <summary>

    /// A global instance which can be used by components

    /// that do not need their own window.

    /// </summary>

    public static EventDispatchingNativeWindow Instance

    {

        get

        {

            lock (MyLock)

            {

                return

                  _instance ??

                     (_instance =

                       new EventDispatchingNativeWindow());

            }

        }

    }

 

    /// <summary>

    /// Attach your event handlers here.

    /// </summary>

    public event WndProcEventHandler EventHandler;

 

    /// <summary>

    /// Parse messages passed to this window and send

    /// them to the event handlers.

    /// </summary>

    /// <param name="m">A System.Windows.Forms.Message

    /// that is associated with the

    /// current Windows message.</param>

    protected override void WndProc(ref Message m)

    {

        bool handled = false;

        if (EventHandler != null)

            EventHandler(ref m, ref handled);

        if (!handled)

            base.WndProc(ref m);

    }

}

Now we can write our global hotkey handler class:

/// <summary>

/// Specifies a class that creates a global keyboard hotkey.

/// </summary>

public class GlobalHotkey

{

    private static readonly Object MyStaticLock = new Object();

    private static int _hotkeyCounter = 0xA000;

 

    private readonly int _hotkeyIndex;

    private readonly IntPtr _hWnd;

 

    /// <summary>

    /// Initializes a new instance of this class.

    /// </summary>

    /// <param name="keys">The keys.</param>

    /// <param name="ctrl">if <c>true</c> [CTRL].</param>

    /// <param name="alt">if <c>true</c> [alt].</param>

    /// <param name="shift">if <c>true</c> [shift].</param>

    /// <param name="winKey">if <c>true</c> [win key].</param>

    public GlobalHotkey(Keys keys, bool ctrl,

               bool alt, bool shift, bool winKey)

    {

        KeyCode = keys;

        Ctrl = ctrl;

        Alt = alt;

        Shift = shift;

        WindowsKey = winKey;

        EventDispatchingNativeWindow.Instance.EventHandler

                += NwEventHandler;

        lock (MyStaticLock)

        {

            _hotkeyIndex = ++_hotkeyCounter;

        }

        _hWnd = EventDispatchingNativeWindow.Instance.Handle;

        Enable();

    }

 

    /// <summary>

    /// The key code of the hotkey.

    /// </summary>

    public Keys KeyCode { get; private set; }

 

    /// <summary>

    /// Whether the shortcut includes the Control modifier.

    /// </summary>

    public bool Ctrl { get; private set; }

 

    /// <summary>

    /// Whether this shortcut includes the Alt modifier.

    /// </summary>

    public bool Alt { get; private set; }

 

    /// <summary>

    /// Whether this shortcut includes the shift modifier.

    /// </summary>

    public bool Shift { get; private set; }

 

    /// <summary>

    /// Whether this shortcut includes the Windows key modifier.

      /// </summary>

    public bool WindowsKey { get; private set; }

 

    ~GlobalHotkey()

    {

        Disable();

        EventDispatchingNativeWindow.Instance.EventHandler

            -= NwEventHandler;

    }

 

    /// <summary>

    /// Enables the hotkey. When the hotkey is enabled,

    /// pressing it causes a

    /// <c>HotkeyPressed</c> event instead of being

    /// handled by the active application.

    /// </summary>

    private void Enable()

    {

        // register hotkey

        int fsModifiers = 0;

        if (Shift) fsModifiers += ModShift;

        if (Ctrl) fsModifiers += ModControl;

        if (Alt) fsModifiers += ModAlt;

        if (WindowsKey) fsModifiers += ModWin;

        bool success =

           RegisterHotKey(_hWnd, _hotkeyIndex,

                fsModifiers, (int) KeyCode);

 

        if (!success)

            throw new

              Exception(

                "Could not register hotkey (already in use).");

    }

 

    /// <summary>

    /// Disables this instance.

    /// </summary>

    private void Disable()

    {

        // unregister hotkey

        UnregisterHotKey(_hWnd, _hotkeyIndex);

    }

 

    /// <summary>

    /// Occurs when the hotkey is pressed.

    /// </summary>

    public event EventHandler HotkeyPressed;

 

    private void NwEventHandler(ref Message m, ref bool handled)

    {

        if (handled) return;

        if (m.Msg != WmHotkey ||

                m.WParam.ToInt32() != _hotkeyIndex)

            return;

        if (HotkeyPressed != null)

            HotkeyPressed(this, EventArgs.Empty);

        handled = true;

    }

 

    #region PInvoke Declarations

 

    private const int ModAlt = 0x0001;

    private const int ModControl = 0x0002;

    private const int ModShift = 0x0004;

    private const int ModWin = 0x0008;

    private const int WmHotkey = 0x0312;

 

    [DllImport("user32.dll", SetLastError = true)]

    private static extern bool RegisterHotKey(IntPtr hWnd,

          int id, int fsModifiers, int vlc);

 

    [DllImport("user32.dll", SetLastError = true)]

    private static extern bool UnregisterHotKey(IntPtr hWnd,

          int id);

 

    #endregion

}

Now we can easily register a global hotkey or use it as an observable in F#:

/// system-wide keyboard hook

let hotkey = new GlobalHotkey(Keys.Q,true,false,false,false)

let hookObserver =

  hotkey.HotkeyPressed 

    |> Observable.subscribe (fun _ -> printfn "Hotkey pressed")

Tags: , , , ,

Friday, 23. October 2009


Using monads in F# – Part I: The State Monad

Filed under: F# — Steffen Forkmann at 10:10 Uhr

Currently I’m trying to implement some of the standard monads in F#. If you want to read about the theory behind monads and their implementation (in Haskell) it’s a good start to look into “All about Monads” on haskell.org.

In this blog post series I don’t care about mathematical details. Instead I will try to show how monads can help to simplify our code.

Motivation

We have a generic binary tree with some test data:

type Tree<‘a> =

| Leaf of ‘a

| Branch of Tree<‘a> * Tree<‘a> 

 

let tree =

  Branch(

    Leaf "Max",

    Branch(

      Leaf "Bernd",

      Branch(

        Branch(

          Leaf "Holger",

          Leaf "Ralf"),

        Branch(

          Leaf "Kerstin",

          Leaf "Steffen"))))

If we want to print this tree we can use the following recursive function:

/// prints a binary tree

let printTree t =

  let rec print t level  =

    let indent = new String(‘ ‘, level * 2)

    match t with

    | Leaf l -> printfn "%sLeaf: %A" indent l

    | Branch (left,right) ->

        printfn "%sBranch:" indent

        print left (level+1)

        print right (level+1)

  print t 0

 

printfn "Unlabeled:"

printTree tree 

And what we get is something like this:

Unlabeled:

Branch:

  Leaf: "Max"

  Branch:

    Leaf: "Bernd"

    Branch:

      Branch:

        Leaf: "Holger"

        Leaf: "Ralf"

      Branch:

        Leaf: "Kerstin"

        Leaf: "Steffen"

Labeling the tree with mutable state

Now we want to give every tree a unique label. This can be easily done by another recursive function:

let mutable label = -1

let rec labelTreeMS t =

  match t with

  | Leaf l ->

      label <- label + 1 // changing the state

      Leaf(l,label) 

  | Branch(oldL,oldR) ->

      let newL = labelTreeMS oldL

      let newR = labelTreeMS oldR

      Branch(newL,newR)        

 

let treeMS = labelTreeMS tree

printfn "Labeled (with global mutable state):"

printTree treeMS     

And the output would look like this:

Labeled (with global mutable state):

Branch:

  Leaf: ("Max", 0)

  Branch:

    Leaf: ("Bernd", 1)

    Branch:

      Branch:

        Leaf: ("Holger", 2)

        Leaf: ("Ralf", 3)

      Branch:

        Leaf: ("Kerstin", 4)

        Leaf: ("Steffen", 5)

The only problem with labelTreeMS is that it uses global state, which is very bad because we can’t be sure if the mutable label variable is changed (from maybe another thread) or not.

Labeling the tree without global state

If we want to remove this side effect, we can pass the state directly into the function:

// non-monadic version

// passing the state around explicitly

let rec labelTreeNM t s =

  match t with

  | Leaf l -> s+1,Leaf(l,s)  // changing the state

  | Branch(oldL,oldR) ->

      let stateL,newL =

        labelTreeNM oldL s

      let stateR,newR =

        labelTreeNM oldR stateL  // passing the state around

      stateR,Branch(newL,newR)              

 

let _,treeNM = labelTreeNM tree 0

printfn "Labeled (non-monadic):"

printTree treeNM

Labeling the tree by using the State Monad

With the help of the State Monad we get a very similar function:

/// labels a tree by using the state monad

/// (uses F#’s sugared syntax)

let rec labelTree t = state {

   match t with

   | Leaf l ->

       let! s = getState

       do! setState (s+1)  // changing the state

       return Leaf(l,s)

   | Branch(oldL,oldR) ->

      let! newL = labelTree oldL

      let! newR = labelTree oldR

      return Branch(newL,newR)}

 

 

printfn "Labeled (monadic):"

let treeM = Execute (labelTree tree) 0

printTree treeM

Thanks to the F# sugared syntax this labelTree and labelTreeMS are visually nearly the same. Every time we are dealing with state we use the exclamation mark. There is only one point (in the Leaf case) where have to use (and change) the state.

The nice thing is, that we can write the function like the first version, but we don’t have to perform the side effect on the shared state.

If we want to use the de-sugared version we have to write it like this:

/// labels a tree and uses de-sugared syntax

/// (implementation looks different to labelTreeNM)

let rec labelTreeDesugared t =

   match t with

   | Leaf l -> (fun s -> Leaf(l,s),(s+1))

   | Branch(oldL,oldR) ->

       labelTreeDesugared oldL >>=

        (fun newL ->

           labelTreeDesugared oldR >>=

             (fun newR ->

                 Branch(newL,newR) |> returnS))   

State monad implementation

In order to use the state monad, of course we have to implement it first. Here is my version, which allows to use the de-sugared and sugared version:

module StateMonad

 

let (>>=) x f =

   (fun s0 ->

      let a,s = x s0

      f a s)      

 

let returnS a = (fun s -> a, s)

 

type StateBuilder() =

  member m.Bind(x, f) = x >>= f

  member m.Return a = returnS a

 

let state = new StateBuilder()

 

let getState = (fun s -> s, s)

let setState s = (fun _ -> (),s) 

let Execute m s = m s |> fst

 

If you want to learn more about the State Monad I recommend watching Brian Beckman’s Channel 9 video “The Zen of Stateless State – The State Monad".

Tags: , ,

Thursday, 22. October 2009


IObservable/IObserver – Using the Reactive Framework with F# – part II

Filed under: F# — Steffen Forkmann at 17:23 Uhr

In the last article I showed how to filter and combine events via the Reactive Framework and how to deal with errors. This time we will create our own observables.

I got the idea for this sample from a very good Expert to Expert video (“Reactive Framework (Rx) Under the Hood”) with Erik Meijer and Wes Dyer.

We want to implement an asynchronous dictionary lookup. Whenever sometimes types something into the Textbox, our application starts looking into a dictionary and searches for words starting with the given prefix.

Async Dict

Let’s start with generating this simple form:

open System.Windows.Forms

 

let form = new Form(Visible=true, Text="Async dict",

                       TopMost=true)

let textBox1 =

  new TextBox(

    Location = new System.Drawing.Point(12, 12),

    Size = new System.Drawing.Size(260, 20))

form.Controls.Add textBox1

 

let resultsBox =

  new ListBox(

    Location = new System.Drawing.Point(13, 39),

    Size = new System.Drawing.Size(259, 211))

form.Controls.Add resultsBox

 

// create a list with common words

// this might be very large

let data =

  ["hell"; "Hello"; "Halle"; "Html";

      "Bonn"; "Bonjour"; "Steffen"

 

// create observable for text changes

let textChanged =

  textBox1.TextChanged

    |> Observable.map (fun _ -> textBox1.Text)

Now we have to define a base class for observables. This class will help our dictionary lookup function to use the IObservable<T> interface:

module Observable

 

/// A Observable base class which notifies

/// all observers in parallel 

type ‘a Observable() =

  let mutable observers = []

 

  /// Notifies all observers in parallel about the new value

  let notifyObservers f =

    observers

      |> Seq.map (fun (observer:IObserver<‘a>) –>

                         async { return f observer})

      |> Async.Parallel

      |> Async.RunSynchronously

      |> ignore

 

  interface IObservable<‘a> with

    member observable.Subscribe(observer)  =

      // subscribe observer

      observers <- observer :: observers

      // create Disposable to unsubscribe observer later

      {new IDisposable with

         member this.Dispose() =

            observers <-

                observers |> List.filter ((<>) observer)}

 

  /// Notifies all observers in parallel about the new value

  member observable.OnNext value =

   notifyObservers (fun observer -> observer.OnNext value)

 

  /// Notifies all observers in parallel about the error

  /// and finishes all observations

  member observable.OnError error =

    notifyObservers (fun observer -> observer.OnError error)

    observers <- []

 

  /// Notifies all observers in parallel about the completion

  /// and finishes all observations

  member observable.Completed =

    notifyObservers (fun observer -> observer.OnCompleted())

    observers <- [] 

I hope there will be a similar base class in the .NET Framework 4.0 RTM.

Now we are able to use this class and to build our dictionary lookup observable:

let wordsObservable = new Observable.Observable<_>()

 

let findWords prefix =

  if prefix <> "" then

    let prefix’ = prefix.ToUpper()

    for word in data do

      if word.ToUpper().StartsWith(prefix’) then

        wordsObservable.OnNext (prefix,word)

The last step is to create observers and subscribe them to the observables:

// create observers

let clean =

  textChanged

    |> Observable.subscribe (fun _ -> resultsBox.Items.Clear())

 

let searchForWords =

  // Every time the text changes

  // we start our wordsObservable to push words

  textChanged

    |> Observable.subscribe (fun text -> findWords text)

 

let wordFound =

  // subscribe to the "word found"-event

  wordsObservable   

    |> Observable.subscribe

        (fun (_,word) -> resultsBox.Items.Add word |> ignore)

Tags: , , ,

Tuesday, 20. October 2009


IObservable/IObserver – Using the Reactive Framework with F#

Filed under: F# — Steffen Forkmann at 16:50 Uhr

One of the nice new features in .NET 4.0 beta 2 is the IObservable<T>/IObserver<T> support from the Reactive Framework (“Rx Framework” or sometimes “LinqToEvents”). It is a really powerful way to use reactive programming in .NET and especially in F# developed by Erik Meijer and his team.

If you want to see some of the beautiful math behind the Reactive Framework you should definitely watch this Expert to Expert video on Channel 9. You can see Brian Beckman and Erik Meijer showing that IObservable<T> is the mathematical dual of IEnumerable<T>.

What can I do with the Rx Framework?

Consider this small sample (it is taken from Matthew Podwysocki’s blog): We want to get notified whenever a user clicks on our form and moves the mouse within a special area (XPos and YPos smaller than 100px).

First of all we define our observable by merging and filtering .NET events:

open System.Windows.Forms

 

let form = new Form(Visible=true, TopMost=true)

 

/// Creates two observables

///  – left is triggered when the left mouse button is down

         and the mouse is in the area (x < 100 && y < 100)

///  – right is triggered when the right mouse button is down

         and the mouse is in the area (x < 100 && y < 100)

let left,right =

  form.MouseDown

    |> Observable.merge form.MouseMove

    |> Observable.filter (fun args -> 

          args.Button = MouseButtons.Left ||

          args.Button = MouseButtons.Right)

    |> Observable.map (fun args -> args.X, args.Y, args.Button)

    |> Observable.filter (fun (x,y,b) -> x < 100 && y < 100)

    |> Observable.partition (fun (_,_,button) -> button = MouseButtons.Left)

Now it’s easy to subscribe a function to this observable:

let leftSubscription =

  left

    |> Observable.subscribe

         (fun (x,y,_) -> printfn "Left (%d,%d)" x y)

If we want to unsubscribe we only have to dispose the object:

// unsubscribe

leftSubscription.Dispose()

We couldn’t unsubscribe this way with “classic” .NET events. Remember the –= operator in C# doesn’t work with lambda expressions.

Exception handling

We have seen an easy way to subscribe and unsubscribe to complicated observables but what should we do if an error occurs? As far as I know this case is not implemented for F# at the moment, but we can easily add this functionality:

module Observable

 

/// Creates an observer with the given functions

let createObserver next error completed =

    {new System.IObserver<_> with

        member this.OnCompleted() = completed()

        member this.OnError(e) = error e

        member this.OnNext(args) = next args}

 

/// Subscribes an observer with the given functions

///   param1: OnNext        (T -> unit)

///   param2: OnError       (Exception -> unit)

///   param3: OnCompleted   (unit -> unit)

///   param4: observable

let subscribeComplete next error completed (observable:System.IObservable<_>) =

  createObserver next error completed

    |> observable.Subscribe

Now we are able to create a complete IObserver<T> object and register the 3 functions:

let rightSubscription =

  right

    |> Observable.subscribeComplete

         (fun (x,y,_) -> printfn "Right (%d,%d)" x y)

         (fun error   -> printfn "Error: %s" error.Message)

         (fun ()      -> printfn "Ready.")

Tags: , ,