Monday, August 30, 2010

F#, Fuzzy Logic, WPF, and Tomatoes!

This is my 100th blog post, and to celebrate, I’m pulling out all the stops. This example will combine F#, fuzzy logic, WPF, and tomatoes!

The example below illustrates a simple fuzzy logic control simulator. In this case, what’s being controlled is the behavior of graphical tomatoes which “chase” the mouse cursor. The fuzzy inference system has two inputs: 1) the distance from the tomato to the cursor, and 2) the speed of the cursor. There is a single output: the speed at which a tomato should chase the cursor. To make things even more interesting, I’ve simulated tomatoes of three dispositions: timid, cautious, and aggressive. The green tomato, being green, is the timid one. The yellow tomato, like the traffic light of the same color, is cautious. The red tomato, like its active color, is aggressive.

Below is the application with the window reduced a bit to fit the blog. In real life, it’s more fun to run it full screen.



This is a WPF application, so it will require a number of additional steps when making it a Visual Studio project:

1) First, create a new F# project of type console and copy and paste the code below. (To make things more convenient, I made the entire project, fuzzy logic included, into one big file. If there are problems with carriage returns and line feeds, try pasting via an intermediate editor such as WordPad.)

2) Second, under project properties, set the application type to “Windows Application.”

3) Third, add the appropriate references. The references for VS2010 and .NET 4.0 are listed in the source code below. For other versions of Visual Studio and .NET, you can use the time honored trial and error technique of letting the compiler complain about the missing references and then adding them.

And that’s it! As always, all the code here is presented "as-is" and without warranty or implied fitness of any kind; use at your own risk.

// I have the following libraries referenced
// in the solution as 4.0 Client Profile.
// These may vary for other versions of .NET.
//
// Accessibility
// FSharp.Core
// mscorlib
// PresentationCore
// PresentationFramework
// System
// System.Core
// System.Numerics
// System.Xaml
// UIAutomationTypes
// WindowsBase
 
open System
open System.Windows
open System.Windows.Controls
open System.Windows.Media
 
// Here is the fuzzy logic subsystem.
 
// The input functions are trapezoids.
// The precomputations and closures
// make them look more complicated than
// they really are.
 
// Technically, since Min and Max are
// trapezoids with one side at infinity,
// a single function would suffice.
// But three functions are more efficient
// and comprehensible.
 
// Infinite to the left.
let inMin x0 x1 =
  let m = 1.0/(x0-x1)
  let b = 1.0-x0*m 
  (fun x ->  
     match x<=x0 with
     | true -> 1.0
     | _ -> 
     match x<=x1 with
     | true -> x*m+b
     | _ -> 0.0 )
 
// In the middle.
let inMid x0 x1 x2 x3 =
  let ml = 1.0/(x1-x0)
  let mh = 1.0/(x2-x3)
  let bl = 1.0-x1*ml
  let bh = 1.0-x2*mh
  (fun x -> 
     match x<x0 with
     | true -> 0.0
     | _ ->
     match x<x1 with
     | true -> x*ml+bl
     | _ ->
     match x<=x2 with
     | true -> 1.0
     | _ ->
     match x<=x3 with
     | true -> x*mh+bh
     | _ -> 0.0 )
 
// Infinite to the right.
let inMax x0 x1 =
  let m = 1.0/(x1-x0)
  let b = 1.0-x1*m 
  (fun x ->  
     match x>=x1 with
     | true -> 1.0
     | _ -> 
     match x>=x0 with
     | true -> x*m+b
     | _ -> 0.0 )
 
// The output set is a symmetric triangle.
// This function returns the area and centroid.
let outSym xc dx h = 
  dx*(2.0-h)*h,xc   
 
// Fire one rule.
let fire x (inSet,outSet) =
  x |> inSet |> outSet
 
// Fire a rule vector.
let fireV xl (inSets,outSet) =
  Seq.map2 (fun f x->f x) inSets xl 
  |> Seq.min
  |> outSet 
 
// Fire and defuzzify a ruleset.
let private fireAll0 f sets x =
  List.map (f x) sets 
  |> List.fold (fun (aa,cc)(a,c)->(aa+a,cc+a*c)) (0.0,0.0)
  |> (fun (aa,cc)->cc/aa)
 
// Scalar fire and defuzzify a ruleset.
let fireAll sets x = 
  fireAll0 fire sets x
 
// Vector fire and defuzzify a ruleset.
let fireAllV sets x = 
  fireAll0 fireV sets x
 
// Helper functions for this ruleset.
 
let estimate rules distance speed =
  (fireAllV rules [distance;speed])
 
let estimateXY rules dX sX dY sY =
  estimate rules dX sX,
  estimate rules dY sY
 
// Here are the rules.
// I got them about 90% of the way
// on the first shot just by thinking 
// about them, and about 10% by
// experimentation and tweaking.
// That's the power of fuzzy logic!
 
// Distance values in WPF units.
let adjacent = inMin 0.0 4.0
let near     = inMid 2.0 4.0 10.0 80.0
let far      = inMid 10.0 80.0 140.0 200.0
let wayOff   = inMax 140.0 200.0
 
// Cursor movement values in WPF units.
let still  = inMin 0.0 2.0
let medium = inMid 0.0 2.0 10.0 40.0
let fast   = inMax 10.0 40.0
 
// Tomato movement values in WPF units.
let hold  = outSym 0.0 1.0
let creep = outSym 1.0 1.0
let walk  = outSym 2.5 1.0
let run   = outSym 7.0 1.0
 
// Constant.
let setConst h = (fun _->h)
 
// Three basic behaviour types
// will be illustrated using 
// three "tomatoes" of
// varying disposition.
 
let rulesTimid = 
  [
    ([adjacent;still], hold);
    ([near;    still], creep);
    ([far;     still], walk);
    ([wayOff;  still], run);
 
    ([(setConst 1.0);medium],creep);
    ([(setConst 1.0);fast],hold);
  ]
 
let rulesCautious =
  [
    ([adjacent;still], hold);
    ([near;    still], walk);
    ([far;     still], walk);
    ([wayOff;  still], run);
 
    ([adjacent;medium],hold);
    ([near;    medium],walk);
    ([far;     medium],walk);
    ([wayOff;  medium],run);
 
    ([(setConst 1.0);fast],hold);
  ]
 
let rulesAggressive =
  [
    ([adjacent;still], hold);
    ([near;    still], walk);
    ([far;     still], run);
    ([wayOff;  still], run);
 
    ([adjacent;medium],hold);
    ([near;    medium],walk);
    ([far;     medium],walk);
    ([wayOff;  medium],run);
 
    ([adjacent;fast],walk);
    ([near;    fast],walk);
    ([far;     fast],run);
    ([wayOff;  fast],run);
  ]
 
 
// Tomato record.
type Tomato<'Rules> = 
  {
    Shape : Shapes.Ellipse; 
    Rules : 'Rules;
    // These store momentum.
    mutable Mx : float; 
    mutable My : float; 
  }
 
let makeTomato rules brush =
  let shape = new Shapes.Ellipse();
  shape.Fill <- brush
  { 
    Shape = shape; 
    Rules = rules;
    Mx = 0.0;
    My = 0.0;
  }
 
// Define the tomatoes.
// This could also be done in MainWindow;
// I do it here for ease of reading.
 
let tomatoes = 
  [
    makeTomato rulesTimid Brushes.PaleGreen;
    makeTomato rulesCautious Brushes.Yellow;
    makeTomato rulesAggressive Brushes.Tomato;
  ]
 
 
// Here is the user interface subsystem.
 
/// WPF main window.
type MainWindow (app: Application) =
  inherit Window()
 
  let canvas = System.Windows.Controls.Canvas() 
 
  /// Momentum factor.
  /// Lower = more dampening.
  /// This can be fun to play with.
  [<Literal>]
  let momentum = 0.7
 
  [<Literal>]
  let tomatoRadiusX = 10.0
  [<Literal>]
  let tomatoRadiusY = 10.0
 
  let mutable tomatoTargetLeft = 0.0
  let mutable tomatoTargetTop = 0.0
  let mutable tomatoTargetLeft0 = 0.0
  let mutable tomatoTargetTop0 = 0.0
 
  // This timer handles tomato movement.
  let timer = 
    new System.Windows.Threading.DispatcherTimer()
 
  /// Tomato movement timer callback.
  let moveTomato e =
    // Target speed.
    let sX = tomatoTargetLeft-tomatoTargetLeft0
    let sY = tomatoTargetTop-tomatoTargetTop0
    // Cache current target.
    tomatoTargetLeft0 <- tomatoTargetLeft
    tomatoTargetTop0 <- tomatoTargetTop
    for t in tomatoes do
      // Tomato position.
      let tX = Canvas.GetLeft t.Shape
      let tY = Canvas.GetTop t.Shape
      // Distance to target.
      let dX = tX-tomatoTargetLeft
      let dY = tY-tomatoTargetTop
      // Estimate absolute delta x,y.
      let x = estimate t.Rules (abs(dX))(abs(sX))
      let y = estimate t.Rules (abs(dY))(abs(sY))
      // Restore the sign.
      let x0 = (float (sign(dX)))*x+t.Mx
      let y0 = (float (sign(dY)))*y+t.My
      // Cache the new momentum.
      t.Mx <- x0*momentum
      t.My <- y0*momentum
      // Move the tomato.
      Canvas.SetLeft(t.Shape,tX-x0) 
      Canvas.SetTop(t.Shape,tY-y0)
 
  /// Mouse move callback.
  let onMouseMove (e:Input.MouseEventArgs)  =
    let p = e.GetPosition(canvas) 
    // Mouse position is the target
    // for the tomato center.
    tomatoTargetLeft <- p.X-tomatoRadiusX 
    tomatoTargetTop <- p.Y-tomatoRadiusY 
 
  /// Initialize all and sundry.
  member this.Initialize () =
    // Window setup.
    this.Title <- "Fuzzy Tracker Tomatoes"
    this.Width <- 400.0
    this.Height <- this.Width
    // Tomato setup.
    tomatoTargetLeft <- this.Width/2.0
    tomatoTargetTop <- this.Height/2.0
    tomatoTargetLeft0 <- tomatoTargetLeft
    tomatoTargetTop0 <- tomatoTargetTop
    for t in tomatoes do
      t.Shape.Width <- tomatoRadiusX*2.0
      t.Shape.Height <- tomatoRadiusY*2.0
      Canvas.SetLeft(t.Shape,tomatoTargetLeft)
      Canvas.SetTop(t.Shape,tomatoTargetTop)
      canvas.Children.Add t.Shape |> ignore
    // Canvas setup.
    canvas.Background <- Brushes.SlateGray
    this.AddChild canvas
    // Start interaction.
    this.MouseMove.Add onMouseMove
    timer.Tick.Add moveTomato
    timer.Interval <- new System.TimeSpan(0,0,0,0,50)
    timer.Start()
 
 
/// WPF application.
type App () =
  inherit Application()
 
  static member Go () =
    let app = new App()
    let win = new MainWindow(app)
    win.Initialize()
    app.Run(win) |> ignore
 
 
/// Main entry point.
/// Runs the application.
[<STAThread>] 
do
  App.Go()
 
 

2 comments:

Unknown said...

Only a minor point, but you can prettify your nested pattern matches a little like this:

// In the middle.
let inMid x0 x1 x2 x3 =
let ml = 1.0/(x1-x0)
let mh = 1.0/(x2-x3)
let bl = 1.0-x1*ml
let bh = 1.0-x2*mh
(function
| x when x < x0 -> 0.0
| x when x < x1 -> x*ml+bl
| x when x <= x2 -> 1.0
| x when x <= x3 -> x*mh+bh
| _ -> 0.0)

Which (for me) is a bit easier to read.

TechNeilogy said...

Thanks Alec! I agree, your version is easier to read; I'll make the change in the "reference version" I'm developing for a later post. I not sure why I did it the way I did originally; just typed it in without thinking about it, I guess, lol.