F# Computation Expressions: Basic Data Retrieval Mechanics

One of the uses often mentioned for F# computation expressions is that of simplifying the syntax of database retrieval. To investigate how the mechanics of this could work, I decided to implement a simple relational retrieval system. I tried to pare it down to the utmost basics, and I’m happy to say I got further than I expected; the sample problem has far more lines of code than does the computation expression itself!

The test database itself consists of two record types. The first is a simple key/value pair. The second is a linking record type which consists of two keys. This keeps things simple for the test, but the method would remain the same even for more complex record structures.

The computation expression doesn’t really do much other than see that work is properly partitioned into the classic collection and decision phases. Even less work is done by the operators (from, where, and select), which don’t have any function other than documentation. My test code uses a simple database of flags and colors, where the tables are implemented as lists.

Disclaimer: this oversimplified code is designed to illustrate the basic mechanics of this type of workflow. It is *not* to be considered ideal, practical or canonical! To solve this type of problem in production code, please use the F# Linq extensions; they are consistent, composable, and standard. (And as always, the code and information here are presented "as-is" and without warranty or implied fitness of any kind; use at your own risk.)

Credit: I think I first saw this idea from a web video, but I can’t recall where (possibly Channel9?). If anyone knows and can point me to it, I’ll be happy to revise this post to give credit to the source.

// Micro relational database.

/// ID,Value table.

type Rec = 

  {

    Key : int;

    Value : string

  }

  static member Make (k,v) =

    { Key=k; Value=v }

/// ID to ID relational link table.

type Link = 

  {

    KeyFrom : int;

    KeyTo : int;

  }

  static member Make (kf,kt) =

    { KeyFrom=kf; KeyTo=kt }

/// Micro query workflow.

/// Note the austere quality of the functions.

/// The real work is done by the collect in

/// the first bind and the decision in the second.

/// The workflow just sees to it that things 

/// get routed properly.

type MicroQuery () =

  // This de-sugars the "from" operator.

  member this.Bind (s,f) =

    Seq.collect f s 

  // This de-sugars the "where" operator.

  member this.Bind (b,f) =

    if b then f() else Seq.empty 

  // This de-sugars the "select" operator.

  member this.Return v =

    Seq.singleton v

// Since all the logic is contained

// in the workflow, these are not really

// necessary except as a form of

// self-documentation.

let inline from s = s

let inline where b = b

let inline select v = v

// For test data, I define some countries and

// the colors of their flags.  

// For consistency, I used the names 

// and spellings used in the USA.)

// If I left out your country, consider it 

// an exercise to the reader to add it!

let countries =

  [(0,"Australia");   (1,"Brazil");(2,"Germany");    

   (3,"Italy");       (4,"Mexico");(5,"Netherlands");

   (6,"South Africa");(7,"Spain"); (8,"USA")]

  |> List.map Rec.Make  

let colors = 

  [(0,"Black");(1,"Blue");(2,"Gold");

   (3,"Green");(4,"Red"); (5,"White")]

 |> List.map Rec.Make 

let flags =

  [(0,1);(0,4);(0,5);

   (1,1);(1,2);(1,3);

   (2,0);(2,2);(2,4);

   (3,3);(3,4);(3,5);

   (4,3);(4,4);(4,5);

   (5,1);(5,4);(5,5);

   (6,0);(6,1);(6,2);

     (6,3);(6,4);(6,5);

   (7,2);(5,4);

   (8,1);(8,4);(8,5)]

  |> List.map Link.Make 

/// This query will return the colors of

/// a country's flag.

let flagColors countryIn = MicroQuery () {

  let! country = from countries

  do! where country.Value=countryIn

  let! flag = from flags

  do! where country.Key=flag.KeyFrom

  let! color = from colors

  do! where color.Key=flag.KeyTo

  return select color.Value }

/// Test it:

let flagColorsBrazil = 

  flagColors "Brazil" 

  |> Seq.toList 

printfn "Your breakpoint here."

More Novice F# Computation Expression Bind/Return Mechanics

Today’s post is more F# “beginner” stuff I’m doing to help myself learn to think about workflows (or computation expressions as they are also called). As I’ve said before, I’ve gotten to the stage where I can usually puzzle out how to make a workflow do what I need it to do. However, my goal is to internalize the mechanics of workflows to the point where I can proactively recognize situations where they might be useful.

Paradoxically then, here is a particularly useless example. It does little more than simply perform a set of serial conversions. But it does illustrate the Bind/Return calling chain in a way that makes plain the “de-sugaring” mechanics. So I thought I would post it here. (As always, the code and information here are presented "as-is" and without warranty or implied fitness of any kind; use at your own risk.)

type Binder () =

  // Bind:0

  member this.Bind (v:int,f:string->float) =

    // v From Caller

    let down = v.ToString()

    let func = f down // Calls Bind:1

    let up = (float) func

    up // To Caller:

  // Bind:1

  member this.Bind (v:string,f:float->string) =

    // v From Bind:0

    let down = (float) v

    let func = f down // Calls Bind:2

    let up = (float) func

    up // To Bind:0

  // Bind:2

  member this.Bind (v:float,f:byte->double) =

    // v From Bind:1

    let down = (byte) v

    let func = f down // Calls Bind:3

    let up = func.ToString()

    up // To Bind:1

  // Bind:3

  member this.Bind (v:byte,f:byte list->int) =

    // v From Bind:2

    let down = [v;v]

    let func = f down // Calls Return

    let up = (double) func

    up // To Bind:2

  // Return

  member this.Return (v:byte list) = 

    // v From Bind:3

    let up = (int) (List.sum v)

    up // To Bind:3

let f = Binder () {

  let! x = 32 // Bind:0

  let! x = x  // Bind:1

  let! x = x  // Bind:2

  let! x = x  // Bind:3

  return x    // Return

  }

printfn "Your breakpoint here."

F# Computation Expressions, Yield/For Mechanics

Today’s episode of the ongoing computation expression saga features Yield/YieldFrom and For. One encounters fewer examples of these than of Bind/Return, though in most respects their operation is every bit as fundamental.

The code accompanying this post shows the use of these computation expression members in creating a rudimentary list comprehension builder. Of course, in real life you’ll want to use F#’s far superior built-in list comprehensions. But playing “how would I implement built-in construct X” is an old tradition in functional languages, so here it is. (As always, the code and information here are presented "as-is" and without warranty or implied fitness of any kind; use at your own risk.)

First, although the desired output is a list, the ongoing concatenation is maintained internally as a sequence. The Run operator does the work of converting the final sequence into a list. This makes the computation expression class more general, because the internal sequence could easily be converted to an array, .NET generic collection, etc., with a single change or override.

  member this.Run a = 

    a |> Seq.toList 

Most of the work for the yield operations in the example is done by the Combine operators. The Yield, YieldFrom, Delay, and Zero members are really just defaults (in fact, Yield and YieldFrom are identical in form). Three Combine operators cover most cases:

1) Prepending a yielded item to an ongoing sequence. This is the basic yield operation.

2) Combining a two sequences. This is the yield! operation.

3) Appending a yielded item with an ongoing sequence. This makes it possible to avoid calling the Zero operation using a “().” (Although Zero is supplied in case it is desired.)

  member this.Combine (a,b) = 

    Seq.append (Seq.singleton a) b

  member this.Combine (a,b) = 

    Seq.append a b 

  member this.Combine (a,b) = 

    Seq.append a (Seq.singleton b) 

The For operator just maps the body of the loop onto each item in the “for” sequence. This is essentially a default behavior for comprehensions. (An iteration across the “for” sequence might be a more appropriate default for some situations.)

  member this.For (s,f) =

    s |> Seq.map f 

At last, here is the full code plus an example. I named the computation expression builder class “SlightComprehension” both in order to reflect its rudimentary nature and to indicate my slight (but improving!) understanding of computation expressions, lol.

/// Rudimentary list comprehension builder.

type SlightComprehension () =

  /// Combine an item and a list.

  member this.Combine (a,b) = 

    Seq.append (Seq.singleton a) b

  member this.Combine (a,b) = 

    Seq.append a b 

  member this.Combine (a,b) = 

    Seq.append a (Seq.singleton b) 

  /// Map the function and convert

  /// the result to a list.

  member this.For (s,f) =

    s |> Seq.map f 

  // The following members are basically defaults.

  member this.Delay f = f()

  /// The concatenations are maintained

  /// internally as a sequence.

  /// This call converts them to a list

  /// on output.

  member this.Run a = 

    a |> Seq.toList 

  // The Combine overload makes 

  // Yield and YieldFrom identical

  // in form.

  member this.Yield a = a

  member this.YieldFrom a = a

  member this.Zero() = Seq.empty 

// Test.

let result0 = SlightComprehension () {

   yield 1

   for i in 2..3 do

     yield i 

   yield 4 

   // The following calls Zero.

   () }  

let result1 = SlightComprehension () {

   yield 0

   yield! result0

   yield seq { for i in 5..7 -> i }

   yield 8 }

// result1 = [0;1;2;3;4;5;6;7;8]

printfn "%A" result1

printfn "Your breakpoint here."

F# Computation Expression Bind/Return Mechanics Continued.

Isn’t it always the way? Almost as soon as I posted the previous entry, I came up with an example I like better. Rather than replace that example, I’ll just post the new one here.

This one adds overloads to Bind, which show how both multiple types of let! bindings as well as do! bindings can be produced. It prints a trace of the calls and returns to the console, illustrating the descend an return behavior.

Below are the output and the code. As always, it is presented "as-is" and without warranty or implied fitness of any kind; use at your own risk.

/// Sample do!,let!,return! binder.

type Binder () =

  /// For indent to list level.

  let rec spaces spc = function

    | [] -> spc

    | h::t -> spaces ("  "+spc) t

  /// let! binding (first use).

  member this.Bind (s:string,

                    f:string list->string list) =

    printfn "Entering let! %s,[]" s

    let rtn = List.tail (f [s])

    printfn "%sLeaving let! %s,%A" (spaces "" rtn) s rtn

    rtn

  /// let! binding (nth use).

  member this.Bind ((s,sl):string*(string list),

                    f:string list->string list) =

    printfn "%sEntering let! %s,%A" (spaces "" sl) s sl

    let rtn = List.tail (f (s::sl))

    printfn "%sLeaving let! %s,%A" (spaces "" rtn) s rtn

    rtn

  /// do! binding.

  member this.Bind ((s,sl):string*(string list),

                    f:unit->string list) =

    printfn "%sEntering do! %s,%A" (spaces "" sl) s sl

    let rtn = f()

    printfn "%sLeaving do! %s,%A" (spaces "" rtn) s rtn

    rtn

  /// return.

  member this.Return (a:string list) =

    printfn "%sReturn %A" (spaces "" a) a

    a

// Test.

let result = Binder () {

   let! x = "A"

   let! x = "B",x

   do! "B0",x

   let! x = "C",x

   return x }  

printfn "Your breakpoint here."

p.s. For the spaces function you could also use something like:
new string(' ',sl.Length*2)

F# Computation Expressions, a Simple Bind/Return Mnemonic

I’ve gotten to the point where I can usually puzzle out what I need in a computation expression while I’m sitting at the computer. However, I can still have some trouble visualizing the process when I’m thinking “offline” (e.g. while in line at the grocery store, cleaning the rabbit’s litter pan, etc.). So I’m trying to come up with some useful patterns that I can keep in my head for such occasions.

Below is one I’ve come up with for basic Bind/Return operation. It’s just a simple computation expression that increments a different column of a base ten number depending on the operation. What are important to me are the names I came up with for the variables. I don’t claim that they are either academically correct or that they are the best possible names, but they are ones that make sense to me.

At the bottom of this post is my pattern. (As always, it is presented "as-is" and without warranty or implied fitness of any kind; use at your own risk.)

The Bind operation takes two parameters: “rhs” and “theRest.” “rhs” is the result from evaluating the right hand side of the let! assignment. In the example below, that’s the return from calling “add1.” “theRest” represents the remainder of the computation. As you can see, “rhs” (or in this case “rhs” after having 10 added to it), get passed down the line as an “assignedDownX” to “theRest.” When that call returns, the result gets “returnedUp.”

The Return operation takes a single parameter, “assignedDown.” For example purposes, this has 100 added to it. The result is then “returnedUp.”

The computation expression example shows the whole thing put together.

As I said, the names may not be ideal; they represent a particularly mechanical way of thinking about what is happening. In a context where more sophisticated computation is taking place, conceptual labels will be more meaningful. But I generally find it easier to remember the mechanical and work towards the conceptual, rather than vice versa. Perhaps I’m peculiar in that respect; I couldn’t really say for certain, lol.

Still, it's amazing how simple Bind/Return looks when sticking to the mechanics in light of the power that can be leveraged by augmenting those basic mechanics.

/// Add 1.

let add1 i = i+1

/// Adds a 10 on Bind, 

/// or a 100 on Return.

type BindAdd10ReturnAdd100 () =

  /// Add 10.

  member this.Bind (rhs,theRest) =

    let assignedDown = rhs+10

    let returnedUp = theRest assignedDown

    returnedUp

  /// Add 100.

  member this.Return assignedDown =

    let returnedUp = assignedDown+100

    returnedUp

// Test it out.

let result = BindAdd10ReturnAdd100() {

  let! assignedDownA = add1 0

  let! assignedDownB = add1 assignedDownA

  let! assignedDownC = add1 assignedDownB

  return assignedDownC

}

printfn "Your breakpoint here."

F# Workflow for Building Immutable Trees from Delimited Strings

Here is an update on an earlier post: Computation Expressions with .NET Data Types. In that case, I showed how to use computation expressions to build a tree from a character-delimited string. However, there were two things about it I wanted to correct. First, my understanding of idiomatic F# has improved; it’s still a long way from perfect, but it has improved. Second, and more important, I really wanted to create an immutable version, but I lacked the skill with computation expressions at the time of the earlier post.

This post corrects those flaws and presents an interesting workflow design pattern which I think I’m going to find useful in a number of contexts. (For example, it can be adapted to trees based on data structures other than lists; even .NET data structures as in the original post.)

(As always, presented "as-is" and without warranty or implied fitness of any kind; use at your own risk.)

/// Splits a string into a list, 

/// using char.

let splitter (c:char) =

  let ca = [|c|]

  (fun (s:string) ->

    s.Split(ca) |> Array.toList)

/// Canonical discriminated union tree.

type Tree = 

  | Branch of string*Tree list

  | Leaf of string

/// Computation expression class to

/// split a string into a tree.

type TreeSplitter () =

  member this.Bind (sa,f) =

    List.map (fun s->Branch(s,f s)) sa

  member this.Return sa = 

    List.map (fun s->Leaf(s)) sa

// Test.

/// Split by bar, colon, then dot.

let barColonDot s = 

  Branch(

    s, 

    TreeSplitter() {

      let! x = splitter '|' s

      let! x = splitter ':' x

      return splitter '.' x

    })

// Test print a tree.

let printo =

  let rec f (spc:string) = function

    | Branch(s,c) ->

      printfn "%s%s" spc s

      List.iter (f (spc+"  ")) c

    | Leaf(s) ->

      printfn "%s%s" spc s

  f ""

// Run a test.

printo 

  (barColonDot "a0.a1:b0.b1|c0.c1:d0.d1")

printfn "Your breakpoint here."

F# Async Computation Expressions: A Tiny Model System

Continuing my quest to learn computation expressions, I decided to explore from scratch the implementation of basic asynchronous behavior. This post is the result. It’s not too fancy, and lacks basic safety, resource management, etc., SO DON’T SIMPLY COPY AND USE IT IN REAL LIFE, but it gets the basic idea across. For real-world use, browse the Microsoft-supplied F# async classes (Microsoft.FSharp.Control.Async, etc.); you’ll find better stuff there than I could come up with. My goal here was to temporarily strip away most of the complexity, however necessary it is in real life, to investigate an underlying model.

My computation class below is just a simple thread spinner. It starts a thread process and then continues with the computation. As each bit completes, its caller waits for its own process to join, until the initial call joins and control continues at the module level. A test function in the form of a simple string printer is supplied. The screenshot below records a typical run.



As always: this code and other information is presented "as-is" and without warranty or implied fitness of any kind; use at your own risk. This is especially true in this case! Multi-threading can be a tricky business, and again I recommend you treat my code here as an oversimplified example, and use the Microsoft.FSharp.Control libraries for real-world use.

open System.Threading

/// A simple thread-runner.

/// Note: don't use this in real life!

/// Write something with better safety,

/// resource management, etc., or better yet,

/// use the F# supplied Async libraries!

type OverlySimpleAsync () = 

  /// Starts a thread and moves on,

  /// then waits for a join.

  member this.Bind (tp,f) =

    let t = Thread(ThreadStart(tp))

    t.Start()

    f()

    t.Join()

  /// Does nothing.

  member this.Return a = a

// Simple test.

/// This simple test prints a string

/// parameter a random number of times

/// with a random sleep between.

let r = System.Random()

let testThreadProc a =

  (fun () ->

    let count = r.Next(10,20)

    let sleep = r.Next(10,500)

    for i=0 to count do

      printf "%s" a

      Thread.Sleep(sleep))

// Spin some threads.

do OverlySimpleAsync() {

  do! testThreadProc "A"

  do! testThreadProc "B"

  do! testThreadProc "C"

  do! testThreadProc "D" 

}

printfn ""

printfn "Your breakpoint here."

Basic F# Computation Expressions Using Yield and Combine

I decided to learn a little bit about computation expressions beyond the basic Bind/Return operations. So I made a goal of learning something about the Yield/Combine operations.

To demonstrate these operations, I decided to leave behind the world of tomato pricing and return to the simple animal expert system. The code below implements a typical “toy” guess-the-animal expert system. It uses computation expressions and lazy evaluation to implement the query and inference logic. It’s perhaps a bit of a misuse of the “yield” idiom, but it does demonstrate the basic mechanics in a way that can be compared to examples in earlier posts.

The operation is simple: Yield, Return, and Delay really don’t do much except propagate values; the real logic is in the Combine function. It uses the short-circuit feature of the && and || logic operators to minimize the number of queries when establishing a hypothesis. Lazy evaluation insures that queries are not repeated. A couple of utility functions query and conclude, take care of gathering the data and reporting the result. (Note that pressing the ‘y’ or ‘Y’ key indicates an answer of “yes,” while pressing any other key indicates “no.”)

I’m not sure I’d want to make this the basis of a “Fifth-Generation” A.I. project, lol, but is does show how a neat little DSL can be built with only a few lines of F# code. The basic “engine,” the computation expression, takes up only 17 lines of code, including comments and whitespace! Now that’s a tiny expert system shell if there ever was one…

Here is the output from a typical session:



And below is the code. (As always: this code and other information is presented "as-is" and without warranty or implied fitness of any kind; use at your own risk.)

// Joins values asserted by Yield, using a 

// supplied combining function.

type Join (fCombine) =

  member this.Combine (a:Lazy<bool>,b:unit->Lazy<bool>) = 

    fCombine a b

  member this.Delay (f:unit->Lazy<bool>) =

    f

  member this.Return (a:Lazy<bool>) = 

    a

  member this.Yield (a:Lazy<bool>) = 

    a

  member this.Yield (a:unit->Lazy<bool>) = 

    a()

// Define conjunction and disjunction with short-circuiting.

let conjoin = Join(fun a b->Lazy(fun()->a.Value&&b().Value))

let disjoin = Join(fun a b->Lazy(fun()->a.Value||b().Value))

// Syntax helper to query for a boolean.

let query s =

  (fun () ->

    printf "%s " s

    let q =

      ("yY").IndexOf(

        System.Console.ReadKey().KeyChar)

          <>(-1)

    printfn ""

    q)

// Syntax helper to assert a lazy boolean.

let conclude s b =

  printfn "%s" s

  Lazy(fun()->b)

// Basic facts.

let black = 

  Lazy<bool>(query "Is the animal all or partly black?")

let orange = 

  Lazy<bool>(query "Is the animal all or partly orange?")

let white = 

  Lazy<bool>(query "Is the animal all or partly white?")

let spotted = 

  Lazy<bool>(query "Is the animal spotted?")

let striped = 

  Lazy<bool>(query "Is the animal striped?")

// Intermediate hypotheses.

let blackAndWhite = conjoin {

  yield black

  return white

}

let blackAndOrange = conjoin {

  yield black

  return orange

}

// Output hypotheses (i.e. animals).

let tiger = conjoin {

  yield blackAndOrange

  yield striped

  return conclude "It's a tiger." true

} 

let zebra = conjoin {

  yield blackAndWhite

  yield striped

  return conclude "It's a zebra." true

} 

let leopard = conjoin {

  yield blackAndOrange

  yield spotted

  return conclude "It's a leopard." true

} 

let dalmation = conjoin {

  yield blackAndWhite

  yield spotted

  return conclude "It's a dalmation." true

} 

// Root hypothesis.

let animal = disjoin {

  yield tiger

  yield zebra

  yield leopard

  yield dalmation 

  return conclude "It must be a sasquatch!" false

}

// Run the engine.

let isKnownAnimal = animal().Value 

printfn "Your breakpoint here."

F# Fuzzy0 Update

Just a quick note to say that the Fuzzy0 reference code has been updated. I added a few comments, a constant output function, and the input modifiers “very” and “somewhat.” These latter constrict and loosen the slope of fuzzification trapezoids or triangles in a manner similar to that in the following graphic:



More important in the long run, perhaps, is the reason I haven’t posted all week: I’ve been integrating the F# proof-of-concept code I discussed several months ago into the actual product I was writing it for! Since the product itself is still at the pre-sales stage, I can’t say much more about it until I clear it with the people who own it, but there it is: my first “real” F# project!

-Neil

Discrete Classification using F# and Fuzzy Logic

This post shows the first example based on the F# fuzzy logic reference module Fuzzy0. I continue with the theme of tomatoes. The example shows how fuzzy logic can be used to classify items such as tomatoes into discrete categories.

One of the nice things about the model used in Fuzzy0 is that it is so generic it can be adapted to anything. The input and fuzzification is simply a function, and the output and defuzzification is just another function. Several useful examples are included as part of Fuzzy0 both for the input function and the functionality connecting the input to the output, but many others are possible.

Previous examples have used as output a defuzzification method which produced a single number. This post shows something different. The output is a weight for each of several categories. Rather than combining these weights, they are kept discrete and a category is chosen based on the highest weight.

In the example below, the input uses the (fast becoming traditional) tomato diameter and color, while the output is a series of categories representing the highest-value use. The example is small and fairly straightforward, but some things merit pointing out:

1) The rule set uses “conjoin” to combine multiple input fuzzifications based on the minimum.

2) The tomato types are given a desirability factor. This is a dimensionless quantity representing all the things that go into deciding the value of a tomato: market price, cost of production, current supply, etc.

3) “inConst” is used to produce a constant value of 1.0 for ketchup, since all tomatoes are usable in some processed product such as ketchup.

4) The color is determined by a simple ratio similar to that you could get from a resistance bridge and a couple of photocells. Likewise, the size could be estimated using very simple sensor circuitry.

5) I don’t know a darn thing about the tomato industry.

If you're like me, one of the first questions that comes up when looking at a fuzzy logic system like this is: "why not do it some traditional way, such as a decision tree or a set of differential equations?" Here's one reason: with a few minutes of explanation, a domain expert such as a tomato buyer could look at the fuzzy logic rules and understand what is going on well enough to judge their quality and even update them. Try that with a set of differential equations; even most engineers wouldn't like to spend time doing it that way.

Without further ado, other than to add that, as always: this is presented "as-is" and without warranty or implied fitness of any kind; use at your own risk, here is the code:

open Fuzzy0

// Diameter of the tomato in inches.

let small  = inMin 1.0 2.0

let medium = inMid 1.0 2.0 3.0 4.0

let large  = inMax 3.0 4.0

// Color on a scale of green..red.

// If Red,Green are sensor values,

// could be computed by something like:

// color = (Red-Green)/(Red+Green+epsilon)

// ("epsilon" prevents division by zero.)

let green  = inMin -1.0 0.0

let yellow = inTri -1.0 0.0 1.0

let red    = inMax  0.0 1.0

/// Defines a tomato variety.

let variety label desirability  certainty =

  (label,desirability *certainty)

/// Rules to classify tomatoes.

// I just made these up.  

// In case it's still not obvious 

// by this blog post, I am clueless 

// about tomatoes.  

let tomatoRules = 

  [

    (conjoin[medium;green], (variety "canning"     0.7))

    (conjoin[large; green], (variety "fryer"       0.6))

    (conjoin[small; yellow],(variety "decorative"  1.0))

    (conjoin[medium;yellow],(variety "sandwich"    0.5))

    (conjoin[small; red],   (variety "cherry"      0.8))

    (conjoin[medium;red],   (variety "salad"       0.9))

    (conjoin[large; red],   (variety "ripe"        0.7))

    (inConst(1.0),          (variety "ketchup"     0.1))

  ]

/// Classify a tomato.

/// Returns all non-zero assignments.

/// In actual use, one might use List.max 

/// to return a single value.

let classified = 

  fireAll tomatoRules [3.7;-0.5] // [diameter;color]

  |> List.filter (fun (_,c)->c>0.0)

  |> List.sortBy (fun (_,c)->1.0-c)

// Output using the values above is as follows.

// (Note: rounding assumes at least two significant

// digits throughout the process.)

//

//   fryer, 0.3

//   canning, 0.21

//   sandwich, 0.15

//   ketchup, 0.1

printfn "Your breakpoint here."

Fuzzy Logic F# Reference Module: Fuzzy0

I want to post some more fuzzy logic examples, but first I want to devote a single post to containing the fuzzy logic core code. I could have done that using CodePlex or something, but that seemed too grandiose for such a small block of code. So I’ll place the code here, and if I make changes to it, I’ll post those changes here with a link back from the later blog post where I indicate the changes.

I’m calling this module “Fuzzy0” in anticipation of doing experiments using other models of fuzzy logic. As I’ve indicated, the techniques used in this module represent only a tiny fraction of the vast family of techniques in the domain of fuzzy engineering.

The code below is a cleanup and slight refactoring of the earlier examples. Of particular note, I have stuck with the paired height function/output function model, but have made it even more general. This makes it possible to add things like conjunction, disjunction, different defuzzification techniques, etc., by extending the code rather than changing it.

I’d also like to give a shout out to Alec Zorab, who posted a comment which helped me clean up the earlier code considerably and make it more readable.

Below is the fuzzy logic reference code for module Fuzzy0. Tomorrow I’ll post an example of its use that explores some extensions of earlier techniques. As always, all the code here is presented "as-is" and without warranty or implied fitness of any kind; use at your own risk.

(Note: updated 2010.09.11)

module Fuzzy0

// The input functions are trapezoids.

// (One is a triangle: a degenerate trapezoid.)

// The precomputations and closures

// make them look more complicated than

// they really are.

/// Infinite to the left.

let inMin x0 x1 =

  let m = 1.0/(x0-x1)

  let b = 1.0-x0*m 

  (function

    | x when x<=x0 -> 1.0

    | x when x<=x1 -> x*m+b

    | _ -> 0.0)

/// In the middle.

/// Simplification of the original

/// is courtesy of Alex Zorab.

/// (Ditto similar functions elsewhere.)

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)

/// Simplified definition for triangles.

let inTri xl xc xh =

  let ml = 1.0/(xc-xl)

  let mh = 1.0/(xc-xh)

  let bl = 1.0-xc*ml

  let bh = 1.0-xc*mh

  (function 

    | x when x<xl -> 0.0

    | x when x<xc -> x*ml+bl

    | x when x<=xh -> 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 

  (function 

    | x when x>=x1 -> 1.0

    | x when x>=x0 -> x*m+b

    | _ -> 0.0)

/// A constant height (infinite line).

let inConst h = (fun _->h)

// Modifier narrows towards the peak.

let very (f:float->float) = 

  (fun x ->

    let y = f x

    y*y)

// Modifier widens out from the peak.

let somewhat (f:float->float) = 

  (fun x ->

    let y = f x

    sqrt y)

/// Works like: 

/// List.map2 (fun f x->f x) fl al |> List.map min

/// but short-circuits on 0.0 for efficiency.

let conjoin =

  let rec f acc (fl:(float->float) list) (al:float list) =

    match fl with

    | [] -> acc

    | h::t ->

    match h al.Head with

    | 0.0 -> 0.0  // Short circuit.

    | n -> f (min n acc) t al.Tail 

  f 1.0

/// Output as a symmetric triangle.

/// This function returns the centroid and area.

let outSym xc dx h = 

  xc,dx*(2.0-h)*h   

/// Output as a trapzoid.

/// This function returns the centroid and area.

/// Can also be used to create 

/// asymmetric triangles.

let outTrap x0 x1 x2 x3 = 

  let x3x0 = x3+x0

  let dx1x0 = x1-x0

  let dx3x2 = x3-x2

  let dx3x0 = x3-x0

  (fun h ->

    let x0n = h*dx1x0+x0

    let x2n = h*dx3x2+x2

    let a = (dx3x0+x2n-x0n)*h/2.0

    // This is a quick approximation of

    // the centroid.  It can skew towards

    // the peak in some cases, which is OK.

    let c = (x3x0+x0n+x2n)/4.0

    c,a )

/// Output as a constant centroid 

/// and proportional area.

let outConst (c:float) (a:float) h = 

  c,a*h

/// Some simple, common functions

/// to help clean up the syntax.

/// Defuzzify by weighted centroid.

/// Note: will return NaN if all sets have zero area.

/// This is by design, since different implementations

/// may mandate different behavior in this situation.

let inline weightedCentroid xl =

  List.fold (fun (cc,aa)(c,a)->(cc+a*c,aa+a)) (0.0,0.0) xl

  ||> (/)

/// Maps a scalar onto list of functions.

/// Useful for multi-output rules.

let inline mapScalar xl h = 

  List.map (fun f->f h) xl

/// Fire a rule 1 to 1.

let inline fire x (inSet,outSet) =

  inSet x |> outSet

/// Fire a ruleset,

/// but don't defuzzify the result.

/// Allows for custom defuzzification.

let inline fireAll sets x = 

  List.map (fire x) sets 

/// Fire and defuzzify a ruleset.

/// Note: will return NaN if all sets have zero area.

/// This is by design, since different implementations

/// may mandate different behavior in this situation.

let inline fireAllDef sets x = 

  fireAll sets x |> weightedCentroid