TechNeilogy

Mixins Simplify Composition in Scala

2012-01-27T18:32:00.000-08:00

Scala has a nifty feature called “traits.” A trait is a means of encapsulating methodsand fields that behaves in some ways like an interface, and in other ways likean abstract class. Like an interface orabstract class, a trait can declare methods and fields that must later bedefined in some concrete class. Like anabstract class, but unlike an interface, a trait can also supply default bodiesand values for those methods and fields. Unlike a class, however, a trait cannot have constructor parameters. Here is a simple trait that specifies aniterator:

trait MyIter [A] {

def next(): A

def hasNext: Boolean

}

In the first of these roles, traits can be used just liketraditional interfaces: as a way of specifying the external behavior of anobject without saying anything about its implementation. In the second of these roles, traits can beused like abstract base classes, supplying both declarations anddefinitions.

However – and this is the really cool part – since traitsare not classes, multiple traits can be specified for a single object withoutviolating single inheritance constraints. So, like interfaces, multiple traits can contribute to a classdeclaration, but unlike either interfaces or single base classes, multipletraits can also contribute to a class definition. This is sometimes called “mixin”inheritance, because the capabilities are “mixed into” other types.

The example here develops a simple set of iterator traitsand classes. Iterators were chosenbecause they are a simple construct which can nevertheless illustrate somepowerful mixin concepts. Of course, the standard Scala librarycontains a much more sophisticated set of iterator traits and classes, and you’llwant to use those rather than mine for real-world programming. In particular, to keep things simple, Iignore covariance and contravariance, which can beexplicitly controlled in Scala types.

(And as always, thecode and information here are presented "as-is" and without warrantyor implied fitness of any kind; use it at your own risk.)

(The code is presented in fragments; a complete listing isat the bottom.)

Recalling the simple iterator example from above:

trait MyIter [A] {

def next(): A

def hasNext: Boolean

}

This trait is parameterized on the iterated type, the “[]”brackets delineating type parameters in Scala. Also, the methods follow the standard Scala practice for methods withoutarguments: if the method modifies the object, parentheses are used, if it doesnot modify the object, the parentheses are omitted.

In this case, the iterator supplies only declarations, andso is used in an interface role. (Infact, it resembles the actual Iterator trait from Scala.) We could supply functionality via anothertrait or concrete class, but we’ll actually do it using an abstract class. The abstract class below defines iterationacross a range of integers, and delegates the conversion from integer toiterated type to its derived classes using the abstract function“current.” Inheritors can get basiciteration capability simply by defining this function.

abstract class MyCursorIter[A] (

protected val first: Int,

protected val last: Int) extends MyIter[A] {

protected var cursor = first - 1

protected def current: A

def next() = {

if (hasNext) {

cursor += 1

current

}

else throw new Exception("Iteration past end.")

}

def hasNext = cursor <last

}

Note that first trait or the base class is mixed in usingthe “extends” keyword; subsequent traits are mixed in using the “with” keyword.

Once you have an iterator, you can use it to do all sorts ofwonderful things. But perhaps the mostwonderful of all is the higher order function: “fold.” Fold is a good candidate for the second roleof traits: defining methods and values. Below is a definition of a fold trait as applied to the “MyIter” trait:

trait MyFold[A] {

this: MyIter[A] =>

@tailrec

final def fold[B] (acc: B, f:(B,A)=> B): B = {

if (hasNext) {

fold(f(acc,next()),f)

} else acc

}

The curious-looking line “this: MyIter[A]=>“ tells the compiler that this trait will only be applied to types thatalso support the “MyIter[A]” trait. This is what allows you to use members “hasNext” and “next()” from that trait. “@tailrec” on thefold function tells the Scala compiler that the function should be madetail-recursive, and to warn you at compile time if that is not possible. What follows is a standard fold function thattakes an initial result “acc” (for accumulator), and steps through theelements passing on the result of applying the function “f” to the previousresult and each element, finally returning the last result.

Fold is like the Swiss Army Knife of higher order functionsin that it can be used to implement a whole range of other higher orderfunctions. The fragment below shows acouple of other mixins which use fold. The first computes the length of aniterated sequence and the second converts an iterated sequence to a list. Note the use of the “this: … =>” constructto inform the compiler that these traits extend types with the fold trait. And note also the use of the “_” in “this: MyFold[_] =>” in MyLength whichindicates that the type parameter is not important for this definition. Also note that both functions consume theiterator, leaving it empty.

trait MyLength {

this: MyFold[_] =>

def length() = {

fold(0, (b: Int, _) => b + 1)

}

trait MyToList[A] {

this: MyFold[A] =>

def toList() =

fold(Nil, (b: List[A], a: A) => a::b).reverse

}

And, for convenience, here is a trait that mixes a resetfunction into the “MyCursorIter” class. If an iterator can be made resettable,functions can be written that consume it without rendering it useless forfurther computation.

trait MyReset {

this: MyCursorIter[_] =>

def reset() = cursor = first - 1

}

At last, time for the first concrete implementation. And here it is, “MyStringIter,”a character iterator across strings:

class MyStringIter (s: String)

extends MyCursorIter[Char](0,s.length - 1)

with MyReset

with MyFold[Char]

with MyLength

with MyToList[Char] {

protected def current = s(cursor)

}

And the test:

object Test00 {

def main(args:Array[String]): Unit = {

// String example.

val msi = new MyStringIter("This is a test.")

println(msi.toList())

msi.reset()

println(msi.length())

println("Your breakpoint here.")

}

But wait! There’smore! In Scala you can use all thesetraits and classes to cobble together types on the fly. The extended test below illustrates this bydefining, with the test function itself, an ad-hoc iterator across integerranges.

object Test00 {

def main(args:Array[String]): Unit = {

// String example.

val msi = new MyStringIter("This is a test.")

println(msi.toList())

msi.reset()

println(msi.length())

// Range example.

val msr =

new MyCursorIter[Int](0,9)

with MyReset

with MyFold[Int]

with MyToList[Int]

{ protected def current =cursor }

println(msr.toList())

msr.reset()

// Error! MyLength is not mixed-in to msr.

// println(msr.length())

println("Your breakpoint here.")

}

Now isn’t that cool?

-Neil

Here is the full listing:

* Use of this software is governed by

* the following license:

* The MIT License (MIT)

*http://www.opensource.org/licenses/mit-license.php

* THE SOFTWARE IS PROVIDED "AS IS",WITHOUT

* WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,

* INCLUDING BUT NOT LIMITED TO THE WARRANTIES

* OF MERCHANTABILITY, FITNESS FOR A PARTICULAR

* PURPOSE AND NONINFRINGEMENT. IN NO EVENT

* SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE

* LIABLE FOR ANY CLAIM, DAMAGES OR OTHER

* LIABILITY, WHETHER IN AN ACTION OF CONTRACT,

* TORT OR OTHERWISE, ARISING FROM, OUT OF

* OR IN CONNECTION WITH THE SOFTWARE OR THEUSE

* OR OTHER DEALINGS IN THE SOFTWARE.

packagecom.techneilogy.test00

import annotation.tailrec

trait MyIter [A] {

def next(): A

def hasNext: Boolean

}

abstract class MyCursorIter[A] (

protected val first: Int,

protected val last: Int) extends MyIter[A] {

protected var cursor = first - 1

protected def current: A

def next() = {

if (hasNext) {

cursor += 1

current

}

else throw new Exception("Iteration past end.")

}

def hasNext = cursor <last

}

trait MyFold[A] {

this: MyIter[A] =>

@tailrec

final def fold[B] (acc: B, f:(B,A)=> B): B = {

if (hasNext) {

fold(f(acc,next()),f)

} else acc

}

trait MyLength {

this: MyFold[_] =>

def length() = {

fold(0, (b: Int, _) => b + 1)

}

trait MyToList[A] {

this: MyFold[A] =>

def toList() =

fold(Nil, (b: List[A], a: A) => a::b).reverse

}

trait MyReset {

this: MyCursorIter[_] =>

def reset() = cursor = first - 1

}

class MyStringIter (s: String)

extends MyCursorIter[Char](0,s.length - 1)

with MyReset

with MyFold[Char]

with MyLength

with MyToList[Char] {

protected def current = s(cursor)

}

object Test00 {

def main(args:Array[String]): Unit = {

// String example.

val msi = new MyStringIter("This is a test.")

println(msi.toList())

msi.reset()

println(msi.length())

// Range example.

val msr =

new MyCursorIter[Int](0,9)

with MyReset

with MyFold[Int]

with MyToList[Int]

{ protected def current =cursor }

println(msr.toList())

msr.reset()

// Error! MyLength is not mixed-in to msr.

// println(msr.length())

println("Your breakpoint here.")

}

F# vs. Scala, My Take at Year Two

2012-01-26T08:35:00.000-08:00

I spent a lot of time over the last couple of years learning F#. Over the last six months, I’ve spent most of my time learning and working in Scala. During part of both those times, I was working on the same set of code, ported to both languages. So, though this topic has been covered before, I thought I’d add my few observations from that experience to the great F# vs. Scala debate.

1) From the standpoint of most programmers, the choice of F# vs. Scala is probably determined by a single external factor: whether one is targeting the .NET ecosystem or the Java ecosystem. So the real-world debate is less likely to be F# vs. Scala than it is to be F# vs. C# or Scala vs. Java.

2) If you know F#, you already know all the really hard stuff you need to know about Scala, and vice versa. Now I’m not saying there’s 100% overlap between the two languages; each has features and quirks that the other lacks. But if you’ve reasonably mastered either, you’ve already gotten into the functional/mixed paradigm mindset. You’ve scaled the cliffs of type inference, case classes, pattern matching, first-class functions, currying, continuations, monads, etc. To move from F# to Scala or vice versa, you may have to learn moderately different ways to express those ideas, but you don’t have to make the climb all over.

Now the more technical stuff:

3) F# syntax is austere and a clean break with the curly brace world, whereas Scala retains much of the curly brace look and feel (while significantly cleaning it up). This was a deliberate decision on the part of the designers of Scala to ease the transition from Java. The result depends on your viewpoint: F# code is a more succinct if you’re used to reading it, but Scala is a little friendlier for newcomers.

4) Both languages are multi-paradigm, but F# favors functional programming whereas Scala favors object-oriented programming. This is not intended as a comment on the capabilities of the two languages, but rather on the “feel.” Both are clearly multi-paradigm, it’s just that on an FP to OOP scale of 0 – 9, F# feels more like a 4, and Scala feels more like a 6.

5) Scala programming rests on a foundation of traits, mixins, and the explicit management of types. Programmers making either the transition Java -> Scala, or C# -> F# -> Scala, will need to spend time mastering these concepts in order to take full advantage of Scala’s capabilities. (F# programmers from more academic backgrounds will already be more familiar with these things.)

6) F#’s higher-order libraries feel a little more pragmatic than do Scala’s. It’s not that you can do something in F# that you can’t do in Scala, it’s just that I’m often able to find a more precise higher-ordered function quicker in the F# documentation than in the Scala documentation. (To be fair to Scala, the libraries are evolving, and tend to get cleaner in each version.)

7) If you’re a .NET programmer without much open-source experience, getting started using Scala is likely to be both terrifying and exhilarating. What I mean is: if you do .NET programming, you have Visual Studio, and if you have Visual Studio, you have F#, and the F# you have just works – there, out-of-the box, batteries included. To do Scala, on the other hand, you’re going to have to put together a toolkit for yourself, sometimes pulling resources from various open-source concerns. But there are a couple of pieces of good news to temper this: first, Scala is much easier in this regard than much open-source software I’ve encountered; second, the inventors of Scala have started a concern called Typesafe to help centralize these resources (see sidebar links under Scala).

8) The community experience is excellent in both cases. Both the F# and the Scala communities are filled with excellent programmers who are passionate about the discipline. The users and committers of the two languages are their greatest assets.

I’ll end with two metaphors, the first about F# and Scala themselves, and the second about the two communities:

F# and Scala remind me of the cases of convergent evolution in the biological world. They have evolved in different ecosystems, but similar selection pressure has resulted in similar outcomes. And some of those pressures are among the most important in all of computing: correctness, concurrency, distributed computing, and maintainability.

And lastly, the F# and Scala communities are less like two rival groups of barbarians storming the same castle than they are like one group of barbarians temporarily divided so they can storm two different castles. (And storm them for their own good, lol.)

-Neil

New Year's Resolution: More Blogging

2012-01-02T09:21:00.000-08:00

I hope to get back to this blog soon, in fact, it's one of my New Year's resolutions!

In the meantime, here's a thought.

It's really easy to write external DSLs using s-expression languages. A decent parser can be hand written in a few hours, and the eval process is well understood and documented. (See for example Design Concepts in Programming Languages by Turbak, et al., or "Abelson and Sussman" on the sidebar of this blog.)

But all those parentheses!

Well, if your language works line-by-line, and every line is a cons, you can easily strip away at least one layer of parentheses by simply assuming the entire line is a cons (unless an outer parenthesis really is found).

For example, here's how it would look in a pretend language:

(new: client bob)

  (set: phone 555-5555)

  (set: acct-balance 1000)

  (validate!)

(/new:)

new: client bob

  set: phone 555-5555

  set: acct-balance 1000

  validate!

/new:

Now isn't that better?

Happy New Year, Neil

F# Enters the TIOBE Top 20!

2011-08-04T10:24:00.000-07:00

For the first time, F# has entered the TIOBE Top 20!

The TIOBE index rates programming language popularity based on a number of criteria.

This is certainly a feather in the cap of F#, and all those who have worked to promote the language over the last year deserve congratulations. But now is not the time for the F# community to rest on its laurels. Let's make Top 10 the new goal!

-Neil

F# User-Defined Numeric Literals

2011-07-05T10:38:00.000-07:00

Today’s blog is about something most F# programmers have perhaps never encountered: user-defined numeric literals. I won’t go into too much detail; the available documentation does a much better job than I could:

From the F# specification.

Reference manual page.

F# Power Pack. (Source code file q.fs in the math section as of this posting.)

Basically, user-defined numeric literals allow a programmer to define a new numeric type based on suffix of a literal -- similar to built-in numeric literals. (For example, instances of the built-in numeric literal type uint32 can be written as: “42u.”)

User-defined numeric literals allow the definition of new types by replacing the suffix (“u” in the uint32 example), with any of the characters Q, R, Z, I, N, or G. For example, you could write something that looks like this:

let x = 425Q

The programmer supplies a module that determines how the literals are interpreted. The name of the module must be “NumericLiteral,” followed by the suffix it controls (e.g. “NumericLiteralG”). This module must define several functions that determine how numbers of various lengths are handled. You can read about the details in the sources above, but there are five main functions:

FromZero – Called when a zero is encountered (e.g. 0Q).
FromOne – Called when a one is encountered.
FromInt32 – Numbers from 2 to Int32.MaxValue.
FromInt64 – Numbers from Int32.MaxValue+1 to Int64.MaxValue.
FromString – Even bigger numbers.

The “smallest” function that can process a number is the one that is called, and a function must exist for the proper range. For instance, if you write “42Q,” a FromInt32 function must exist, and it is the one called.

Here is a more complete example. It allows for numeric literals which translate binary representations into uint32. This is not particularly useful, since F# already defines the 0b* binary literal form, but it will do as a sample. (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.)

/// Numeric literal module for 32-bit unsigned

/// binary numbers.

module NumericLiteralZ =

  let inline FromZero() = 0u

  let inline FromOne() = 1u

  let inline FromString (s:string) =

    let rec f (acc:uint32) i (s:string) =

      match i>=s.Length with

      | true -> acc

      | _ ->

      match s.[i] with

      | '0' -> f (acc*2u) (i+1) s

      | '1' -> f (acc*2u+1u) (i+1)s

      | _ -> failwith "Non-binary digit."

    f 0u 0 s

  let inline FromInt32 (n:int) =

    FromString(n.ToString())

  let inline FromInt64 (n:int64) =

     FromString(n.ToString())

// Tests.

let n0 = 0Z

let n4 = 0000100Z

let n5 = 101Z

let nMax = 11111111111111111111111111111111Z

// For reference purposes, here is the

// existing binary syntax; use it in the

// real world instead of my class above.

let n37 = 0b100101u

printfn "Your breakpoint here."

But I think this is the sort of thing that must be used with some caution. With only six suffixes available (Q, R, Z, I, N, and G), the potential for collision is high. Also, since this is an uncommon language feature, it is likely to confuse many users who encounter it for the first time.

More on Significant Whitespace (in F#, Python, Lua, and Ruby)

2011-03-01T10:11:00.000-08:00

Since I want to add it to my coding “Room of Requirement,” I decided to keep working on the indentation processor a bit and make it more general. So here is a version that uses an interface to do dependency injection. (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.)

There are a couple of things to note:

1) The indentation comparison is done through a function on the interface. This allows the interface to encapsulate *all* the information about the indentation. This has a number of benefits. As shown in the example below, it allows some types of data structures to act as their own indentation stack. Also, in more sophisticated versions, it would allow for custom processing of indentation based on context (e.g. multi-line argument lists, embedded multi-line strings, etc.).

2) I left out runtime validity checks in a few spots, leaving it up to the framework to throw an exception. In a real life implementation, some sort of custom exceptions might be better, so I’ve marked the spots with comments.

Since I am currently learning Python, Lua, and Ruby, I’m also including transliterations of the F# version into these languages. Since I am a relative newcomer to them, I apologize for any spots where I may have violated particular language idioms or best practices.

Of the three, the Python version looks the closest to the F# version, in large part because both languages use a block structure based on significant whitespace. The code has been tested in Python 3.2 and IronPython 2.6, but may work in earlier versions of either or IronPython 2.7.

For the Lua version, I chose to use the Lua object model described by Roberto Ierusalimschy in Programming in Lua. Lua does not have a native object type, and so objects must be implemented using associative tables. The way this is done is fascinating, and well worth reading up on even if you’re not planning on using Lua in the immediate future. It will make you a better programmer. The code was tested in Lua 5.1.4.

For the Ruby version, I did manage to use a couple of interesting Ruby-specific string routines. It was tested in Ruby 1.9.2 and IronRuby 0.9.

Last, I apologize for any problems in the formatting and/or syntax highlighting of the Lua, Python, and Ruby; I’m still getting tools for blogging in those languages.

F#:

open System

/// Callback handler for IndentOMatic.

type IIndentHandler =

  /// Adds a sibling.

  abstract Add:string->int->IIndentHandler

  /// Compares to the current indent level.

  abstract Cmp:string->int->int

  /// Pops to the parent.

  abstract Pop:unit->IIndentHandler

  /// Pushes a new child.

  abstract Push:string->int->IIndentHandler

/// Rudimentary indentation processor.

module IndentOMatic =

  /// Converts a string to a string, indent pair.

  let private stringToTag (s:string) =

    let rec leading l i (s:string) =

      match i>=l with

      | true -> i

      | _ ->

        match s.Chars(i) with

        | ' ' -> leading l (i+1) s

        | _ -> i

    let i = leading s.Length 0 s

    s.Substring(i),i

  /// Process a string and indent.

  let rec private proc0 (ih:IIndentHandler) s i =

    /// Pop the stack, looking for a parent

    /// or sibling.

    let rec scanUp (ih:IIndentHandler) =

      match ih.Cmp s i with

      | n when n<0 -> scanUp (ih.Pop())

      | 0 -> ih

      | _ ->

        // Custom exception here, if required.

        failwith "No matching unindent."

    match ih.Cmp s i with

    | n when n<0 -> proc0 (scanUp ih) s i

    | 0 -> ih.Add s i

    | _ -> ih.Push s i

  /// Call to process a string.

  let proc ih s =

    let t,i = stringToTag s

    proc0 ih t i

// Test.

/// Tree node that implements IIndentHandler.

type IHTestNode (parent:IHTestNode option,

                 tag:string,

                 indent:int) =

  /// Child branches.

  let mutable children:IHTestNode list = []

  /// Add a child.

  member private this.AddChild s i =

    let child = IHTestNode(Some(this),s,i)

    children <- child::children

    child :>IIndentHandler

  /// This does any remaining processing

  /// for an ongoing node stack,

  /// and returns the root.

  member this.Eol () =

    children <- List.rev children

    match parent with

    | None -> this

    | Some(p) -> p.Eol()

  /// Print the tree.

  member this.Print () =

    if indent>=0 then

      printfn "%s%s" (String(' ',indent)) tag

    children |> List.iter (fun (n:IHTestNode)->n.Print())

  /// IIndentHandler members.

  /// (See IIndentHandler documentation.)

  interface IIndentHandler with

    member this.Add s i =

      children <- List.rev children

      // Note: your parent=null test/exception here.

      parent.Value.AddChild s i

    member this.Cmp _ i =

      i - indent

    member this.Pop () =

      children <- List.rev children

      // Note: your parent=null test/exception here.

      parent.Value:>IIndentHandler

    member this.Push s i =

      this.AddChild s i

// Generate some test data.

let test =

  seq {

    for i in [0..1] do

      yield String.Format("{0}",i)

      for j in [0..1] do

        yield String.Format(" {0}{1}",i,j)

        for k in [0..3] do

          yield String.Format("   {0}{1}{2}",i,j,k)

//Generate and print a tree.

((Seq.fold

    IndentOMatic.proc

    (IHTestNode(None,"root",-1):>IIndentHandler)

    test):?>IHTestNode).Eol().Print()

printfn ""

printfn "Your breakpoint here."

Python:

# Rudimentary indentation processor.
class IndentOMatic():

    # Converts a string to a string, indent pair.
    @staticmethod
    def __string_to_tag(s):
        i = 0
        l = len(s)
        while i<l:
            if s[i]!=' ': break
            i += 1
        return (s[i:],i)

    # Process a string and indent. 
    @staticmethod
    def __proc0(ih,s,i):
        # Pop the stack, looking for a parent
        # or sibling.
        def __scan_up(ih):
            cmp = ih.cmp(i)
            if cmp<0:
                return __scan_up(ih.pop())
            elif cmp==0:
                return ih
            else:
                # Custom exception here, if required.
                raise Exception("No matching unindent.")
        cmp = ih.cmp(i)
        if cmp<0:
            return IndentOMatic.__proc0(__scan_up(ih),s,i)
        elif cmp==0:
            return ih.add(s,i)
        else:
            return ih.push(s,i)

    # Call to process a string.
    @staticmethod
    def proc(ih,s):
            (t,i) = IndentOMatic.__string_to_tag(s)
            return IndentOMatic.__proc0(ih,t,i)


# Tree node that implements the proper functions.
class IHTestNode ():

  def __init__(self,parent,tag,indent):
      self.parent = parent
      self.tag = tag
      self.indent = indent
      self.children = []

  # Add a child.
  def __add_child(self,s,i):
      child = IHTestNode(self,s,i)
      self.children.append(child)
      return child

  # This does any remaining processing
  # for an ongoing node stack,
  # and returns the root.
  def eol (self):
    if self.parent==None:
        return self
    else:
        return self.parent.eol()

  # Standard overload.
  def __str__(self):
      return self.tag.rjust(self.indent+len(self.tag))

  # Recursive print.
  def print_me(self):
      print(self)
      for child in self.children:
          child.print_me()

  # Adds a sibling.
  def add(self,s,i):
      # Note: your parent=None test/exception here.
      return self.parent.__add_child(s,i)

  # Compares to the current indent level.
  def cmp(self,i):
      return i-self.indent

  # Pops to the parent.
  def pop(self):
      # Note: your parent=None test/exception here.
      return self.parent

  # Pushes a new child.
  def push(self,s,i):
      return self.__add_child(s,i)


# Test.

def test():    
    for i in range(0,2):      
        yield "{0}".format(i)
        for j in range(0,2):     
            yield " {0}{1}".format(i,j)
            for k in range(0,4):      
                yield "   {0}{1}{2}".format(i,j,k)

print("Begin")

ihtn = IHTestNode(None,"Test",-1)

for x in test():
    ihtn = IndentOMatic.proc(ihtn,x)

ihtn = ihtn.eol()

print("End")

ihtn.print_me()

Lua:

-- Note:
-- I'm a newcomer to Lua;
-- I apologize for any bad practices.

-- Note:
-- The way OOP works in Lua is elegant,
-- but can be a little confusing at first.
-- For an explanation, see the chapter 
-- on OOP in "Programming in Lua" by
-- Roberto Ierusalimschy.

-- IndentOMatic class.
IndentOMatic = {

  string_to_tag = function (s)
    local i = 1 -- Lua indexes are one-based.
    local l = s:len()
    while i<=l do
      if s:sub(i,i)~=" " then break end
      i = i+1
    end
    return { tag=s:sub(i,-1), indent=i-1 } 
  end, -- string_to_tag
  
  proc_0 = function (ih,s,i)
    function scan_up (ih)
      local cmp = ih:cmp(i)
      if cmp<0 then
        return scan_up(ih:pop())
      elseif cmp==0 then
        return ih
      else
        -- Custom exception here, if required.
        error("No matching unindent.")
      end
    end -- scan_up
    local cmp = ih:cmp(i)
    if cmp<0 then
      return IndentOMatic.proc_0(scan_up(ih),s,i)
    elseif cmp==0 then
       return ih:add(s,i)
    else
     return ih:push(s,i)
    end
  end, -- proc_0
  
  proc = function (ih,s)
    local ti = IndentOMatic.string_to_tag(s)
    return IndentOMatic.proc_0(ih,ti.tag,ti.indent)
  end
  
} -- IndentOMatic


-- IndentHandler class.
IndentHandler = {

  -- "Instance" constructor.
  new = function (self,p,t,i)
    local o = {}
    o.parent = p
    o.tag = t
    o.indent = i
    o.children = {}
    setmetatable(o,self)
    self.__index = self
    return o
  end, -- new
 
  add_child = function (self,s,i)
    local child = IndentHandler:new(self,s,i)
    self.children[#self.children+1] = child
    return child
  end, -- add_child
  
  eol = function (self)
    if self.parent then
      return self.parent:eol()
    else
      return self
    end
  end, -- eol
  
  print_me = function (self)
    function spaces (i)
      local s = ""
      while i>0 do
         s = s.." "
         i = i-1
      end
      return s
    end
    print(spaces(self.indent)..self.tag)
    for i=1, #self.children do
      self.children[i]:print_me()
    end
  end, -- print_me

  add = function (self,s,i)
    -- Custom parent null check here, if required.
    return self.parent:add_child(s,i)
  end, -- add
  
  cmp = function (self,i)
    return i-self.indent
  end, -- cmp
  
  pop = function (self)
    -- Custom parent null check here, if required.
    return self.parent
  end, -- pop
  
  push = function (self,s,i)
   return self:add_child(s,i)
  end -- push
  
} -- IndentHandler


e = IndentHandler:new(nil,"root",-1)

for i = 0,1 do
  e = IndentOMatic.proc(
        e,string.format("%d",i))
  for j = 0,1 do
    e = IndentOMatic.proc(
          e,string.format(" %d%d",i,j))
    for k = 0,3 do
      e = IndentOMatic.proc(
          e,string.format("   %d%d%d",i,j,k))
    end
  end
end

e = e:eol()
e:print_me()

Ruby:

class IndentOMatic

  def IndentOMatic.string_to_tag (s)
    i = 0
    s.each_char {|x| if x!=' ' then break else i+=1 end}
    [s[i,s.length],i]
  end
  
  def IndentOMatic.scan_up (ih,i)
    cmp = ih.cmp(i)
    if cmp<0 then
      return IndentOMatic.scan_up(ih.pop(),i)
    elsif cmp==0 
      return ih
    else
      raise "No matching unindent."
    end
  end
    
  def IndentOMatic.proc0 (ih, s, i)
    cmp = ih.cmp(i)
    if cmp<0 then
      return IndentOMatic.proc0(
        IndentOMatic.scan_up(ih,i),s,i)
    elif cmp==0
      return ih.add(s,i)
    else
      return ih.push(s,i)
    end
  end

  def IndentOMatic.proc (ih, s)
    t,i = IndentOMatic.string_to_tag(s)
    proc0(ih,t,i)
  end
  
end # IndentOMatic


class IndentProcessor

  def initialize (parent,tag,indent)
    @parent = parent 
    @tag = tag 
    @indent = indent 
    @children = []  
  end
  
  def add_child (s, i)
    child = IndentProcessor.new(self,s,i)
    @children << child
    child
  end
  
  def eol ()
    if @parent==nil then
      return self
    else
      return @parent.eol()
    end
  end
  
  def print_me ()
    if @indent>=0 then
      puts (" "*@indent)<<@tag
    end
    @children.each {|c| c.print_me() }
  end
  
  def add (s, i)
    # Note: your parent=None test/exception here.
    @parent.add_child(s,i)
  end
  
  def cmp (i)
    i-@indent   
  end
  
  def pop ()
    # Note: your parent=None test/exception here.
    @parent
  end
  
  def push (s, i)
    add_child(s,i)
  end

end # IndentProcessor


ih = IndentProcessor.new(nil,"root",-1)

ih = IndentOMatic.proc(ih,"a")
ih = IndentOMatic.proc(ih,"  b")
ih = IndentOMatic.proc(ih,"    c")
ih = IndentOMatic.proc(ih,"    d")
ih = IndentOMatic.proc(ih,"  e")

ih = ih.eol()

ih.print_me()

Significant Whitespace, DSLs, and You (in F#)

2011-02-26T06:24:00.000-08:00

Today’s post shows some simple code for teasing out the structure of a text file based on its indentation.

A trend in computer science is for computer languages to rely more on significant whitespace. Of course, that is true of F#, but Python has introduced the concept to an even wider audience. Significant whitespace and structure are also important in the design of domain-specific languages, since these constructs help reduce visual clutter.

But it pays not to be too strict. For example, forcing indentation and other structures to be at specific tab stops is likely to be a source of irritation as well as readability. What is needed is an adaptable system where – if the structure naively looks right, it gets interpreted right by the parser.

The code below presents on part of a toolkit for doing that. It takes input a line at a time, and decides whether each new line is a child at new level of indentation, a sibling of the current level, or represents a “pop” upwards to a parent level. The exact indentation at each level is unimportant, and is set by the first sibling. Pops back upwards must be to a previously encountered level.

Of course, a lot of things are missing. For example, in some languages, individual line indentation is not sufficient; some knowledge of context is required. And the code below is not really packaged very well; in real use, some sort of encapsulation in a class might be more appropriate. And as with any code, it could be refactored and perhaps simplified in a number of ways.

But it shows one basic technique. (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.)

(FWIW, the test sample is some actual Python code from a “toy” expert system I wrote to help me learn Python.)

open System

/// Rudimentary indentation processor.

module IndentOMatic =

  // These three functions stand in for

  // real-world functionality.

  /// Add a sibling item.

  let add s i =

    printfn ""

    printf "Add : %i %s%s " i (String('-',i)) s

  /// Pop a level.

  let pop () = printf "^"

  /// Push a child item.

  let push s i =

    printfn ""

    printf "Push: %i %s%s " i (String('-',i)) s

  /// Convert a string to a string*int,

  /// where the string is the string minus

  /// leading spaces and the int is the

  /// number of spaces.

  let private stringToTag (s:string) =

    let rec leading l i (s:string) =

      match i>=l with

      | true -> i

      | _ ->

        match s.Chars(i) with

        | ' ' -> leading l (i+1) s

        | _ -> i

    let i = leading s.Length 0 s

    s.Substring(i),i

  /// Process a string.

  let rec private proc0 (nl:int list) s i =

    /// Pop the stack, looking for a parent

    /// or sibling.

    let rec scanUp = function

      | [] -> failwith "Stack underflow."

      | h::t ->

      match i=h with

      | true -> h::t

      | _ ->

      match i>h with

      | true -> failwith "No matching unindent."

      | _ ->

        pop()

        scanUp t

    match nl with

    | [] -> failwith "Stack underflow."

    | h::t ->

    match i=h with

    | true ->

      add s i

nl

    | _ ->

      match i>h with

      | true ->

        push s i

        i::nl

      | false -> proc0 (scanUp nl) s i

  /// Call to process a string.

  let proc nl s =

    let t,i = stringToTag s

    proc0 nl t i

// Test it.

let test =

    // Some Python code from a "toy"

    // expert system.

    "class Not():";

    "    def __init__(self,rule):";

    "        self.rule = rule";

    "    def prove(self,tryProve):";

    "        p = self.rule.prove(tryProve)";

    "        if p==None:";

    "            return p";

    "        else:";

    "            return not p";

let x = Seq.fold IndentOMatic.proc [-1] test

printfn ""

printfn ""

printfn "Your breakpoint here."

The output looks something like this:

Push: 0 class Not():

Push: 4 ----def __init__(self,rule):

Push: 8 --------self.rule = rule ^

Add : 4 ----def prove(self,tryProve):

Push: 8 --------p = self.rule.prove(tryProve)

Add : 8 --------if p==None:

Push: 12 ------------return p ^

Add : 8 --------else:

Push: 12 ------------return not p

Your breakpoint here.

Oops! Correction to Post Dated August 8, 2010

2011-02-18T12:32:00.000-08:00

Oops! I found a couple of bugs in the code listed in the blog post titled: Segment Tree in F#. The bugs are in the "findCollect" and "findIter" functions, and they're really rather glaringly obvious (essentially different versions of the same bug). It looks like a “my-brain-was-out-to-lunch” error as I was transcribing the algorithm either from my head or from pseudo-code. In any case, it can be caught by a simple unit test or even code review, so I’m embarrassed that it got into the blog. My humblest apologies.

In order to avoid repeating the error, I’m thoroughly testing my correction, and I’ll post it when that testing is done. I’ll also post a better test example (that would have revealed this error).

In the meantime, the fix is quite simple, so readers may want to try figuring it out on their own. (Hint: try searching for values completely outside the range of the tree. This will force the bug to occur.)

-Neil

My Dinner with Haskell

2011-02-07T13:03:00.000-08:00

It’s impossible to go very far into either the F# world or the world of domain-specific languages (DSLs) without encountering Haskell. It seems like all the F# gurus are also Haskell gurus, or at least Haskell aficionados, and a lot of people use Haskell for prototyping new languages (including DSLs). Any search for materials on F# or DSLs likewise leads to information on Haskell.

So I decided to learn me some Haskell.

The first thing I did was to get a working build of the GHC (Glasgow Haskell Compiler) by following the appropriate links at the official Haskell site. Next, I found some learning materials, including Real-World Haskell, Learn You a Haskell for Great Good, Haskell Wikibook, Planet Haskell, and Erik Meijer's excellent Channel 9 series. (The latter is worth watching for the shirts alone!)

And then, a couple of days ago, I got to work learning. And so far…

…so good. This is a really fun language, and fairly easy to learn if you already have some experience in F#. At least, knowing F# gets you past the initial strangeness of concepts like currying, pattern matching, etc. In fact, knowing F# is a tiny bit of an impediment because the syntax is so similar, the differences are difficult to remember. But on balance, knowing F# has helped a bunch. The two languages aren’t exactly siblings, but they are cousins, and I think learning the more formal environment of Haskell will help me with the more pragmatic environment of F#.

In order to illustrate the two together, below I present “A tiny corner of Lisp…” in both F# and in Haskell. This being a little fragment of Lisp functionality coded as identically as possible in the two languages. 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. (And since I don’t yet have anything that can syntax highlight Haskell, I deliberately did not syntax highlight the F#.)

// A tiny corner of Lisp in F#.

type Node =
  | Atom of string
  | Cons of Node*Node
  | Nil

let car = function
  | Cons(h,_) -> h
  | _ -> failwith "Invalid 'car' target."

let cdr = function
  | Cons(_,t) -> t
  | _ -> failwith "Invalid 'cdr' target."

let rec append nCar nCdr =
  match nCar with
  | Cons(h,t) -> Cons(h, append t nCdr)
  | Nil -> nCdr
  | _ -> failwith "Invalid 'append' target(s)."


// Examples.

let a0 = Atom "a" // a
let c0 = Cons(a0,(Cons((Atom "b"),Nil))) // (a b)
let c1 = append c0 c0 // (a b a b)
let c2 = append c1 a0 // (a b a b . a)

-- A tiny corner of Lisp in Haskell.

data Node = Atom String
          | Cons Node Node
          | Nil
    deriving (Show)

car :: Node -> Node
car (Cons h _) = h
car _ = error "Invalid 'car' target."

cdr :: Node -> Node
cdr (Cons _ t) = t
cdr _ = error "Invalid 'cdr' target."

append :: Node -> Node -> Node
append (Cons h t) nCdr = (Cons h (append t nCdr))
append Nil nCdr = nCdr 
append _ _ = error "Invalid 'append' target(s)."


-- Examples.

a0 = Atom "a" -- a
c0 = Cons a0 (Cons (Atom "b") Nil) -- (a b)
c1 = append c0 c0 -- (a b a b)
c2 = append c1 a0 -- (a b a b . a)

So get out there and learn you a Haskell for great good!

-Neil

Project Euler #1 - One Problem, Three Solutions, Seven Languages

2011-01-18T06:33:00.000-08:00

I haven’t posted here in a long time, and I apologize for that. No particular reason, but all good: programming in F#, learning lots of new programming stuff, enjoying the fall and winter holiday season (including hand-making some Christmas gifts), etc.

As I mentioned, one of the things I’ve been doing is learning new programming skills. I ignored F# during its early history, and the past year has shown me that was a mistake. So I decided to take a look at some of the other things I’ve been ignoring. That led me into various spots, including: Lua, Python, Ruby, MongoDB, MySQL, PostgresQL, Silverlight 4, SVN, Haskell, NetBeans, revisiting Scheme, the world of Visual Studio extensions, etc.

There’s a popular programming book by Bruce Tate, titled “Seven Languages in Seven Weeks.” In that spirit, I’d like to present something similar here: three views of Project Euler, problem number one, in seven languages. Some of these languages I’ve worked in for a long time; some of them I’ve just learned, but here goes. (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 is F#. Of all the languages listed here, F# is my favorite. Not by a wide margin, perhaps, but my favorite nonetheless. I think this is because of the vision of its creators: to build a language based on thoughtful consideration of all that has come before, both academic and pragmatic. At this, it succeeds brilliantly. (And no, Don Syme did not pay me to say this, lol.)

// Naive Implementation,

// based on problem statement.

// Illustrates aggregate operators

// and pipes.

let euler_1_naive a b bound =

  seq {1..bound-1}

  |> Seq.filter (fun i->((i%a=0)||(i%b=0)))

  |> Seq.sum

// Sums stepped ranges.

// Illustrates aggregate operators

// and pipes.

let euler_1_iteration a b bound =

  (seq {a..a..bound-1} |> Seq.sum)+

  (seq {b..b..bound-1} |> Seq.sum)-

  (seq {a*b..a*b..bound-1} |> Seq.sum)

// Numeric (one possible factoring).

// Illustrates the use of nested functions,

// closures and immutable parameters.

let euler_1_numeric a b bound =

  let b1 = bound-1

  let f n =

    let c = b1/n

    c*(c+1)/2*n

    (f a)+(f b)-(f (a*b))

Next is Python. Python is an interesting language; it embodies a lot of characteristics that make it fun and easy to program in: orthogonality, lack of syntactic fluff, etc. On the other hand, it is a very businesslike language with a lot of excellent libraries available. If I were Java and C#, I’d watch my back.

# Python 3.1.3 and NetBeans w/Python plug-in.

def euler_1_naive (a,b,bound):
    """Naive Implementation,
       based on problem statement.
       Illustrates comprehensions
       and implicit booleans."""
    return sum(
      i for i in range(1,bound)
        if (not ((i%a) and (i%b))))


def euler_1_iteration (a,b,bound):
    """Sums stepped ranges.
       Illustrates aggregate operators."""
    return sum(range(a,bound,a))+\
           sum(range(b,bound,b))-\
           sum(range(a*b,bound,a*b))


def euler_1_numeric (a,b,bound):
    """Numeric (one possible factoring).
       Illustrates the use of nested functions
       and closures."""
    bound -= 1
    def f (n):
        """Compute sum of n-divisible."""
        c = int(bound/n)
        return int(c*(c+1)/2)*n
    return f(a)+f(b)-f(a*b)

And here is Ruby. What to say about Ruby? Superficially, it strikes one as incoherent and arbitrary. But a closer look shows this to be a mistake. What looked like incoherence and randomness is really richness and a wonderful idiosyncrasy. Ruby is a complex, Raku bowl of a language, which reflects the mind of its creator, Yukihiro Matsumoto, and records all the incidents and accidents of its history. Of all the languages here, it is the one that draws the most passion from the programmers who use it, and I can see why. There’s a lot to be said for a language in which you can do something five times by coding “5.times {…}”

# Ruby 1.9.2 and NetBeans w/Ruby plug-in.

# Naive Implementation,
# based on problem statement.
# Illustrates filtering.
def euler_1_naive (a,b,bound)
  ((0...bound).find_all{
      |i|(i%a==0)||(i%b==0)}).reduce(:+)
end


# Sums stepped ranges.
# Illustrates aggregate operators.
def euler_1_iteration (a,b,bound)
  (a...bound).step(a).reduce(:+)+
  (b...bound).step(b).reduce(:+)-
  (a*b...bound).step(a*b).reduce(:+)
end


# Numeric (one possible factoring).
# Illustrates the use of lambdas
# and closures."""
def euler_1_numeric (a,b,bound)
  bound -= 1
  #Compute sum of n-divisible.
  f = lambda {|n|
    c = bound/n
    c*(c+1)/2*n
  }
  f.call(a)+f.call(b)-f.call(a*b)
end

Lua, like Ruby and F#, reflects the visions of its creators. Like Python, it is simple and orthogonal. So simple and orthogonal, in fact, that it has only one non-value type: an associative table. Everything else – objects, lists, arrays, stacks, etc. – must be built using those tables. Lua’s simplicity and speed, coupled with the fact that it is implemented in a highly portable subset of C, make Lua a great choice for new processors, small machines, embedded scripting and similar environments. Think of it as a FORTH for the new millennium. I wish GPU shader languages looked like Lua.

function euler1Naive (a,b,bound)
  acc = 0
  for i=0,bound-1 do
    if (i%3==0) or (i%5==0) then 
      acc = acc+i 
    end
  end
  return acc
end


function euler1Iterative (a,b,bound)
  bound = bound-1
  function f(n) 
    acc = 0
    for i=n,bound,n do
      acc = acc+i
    end
    return acc
  end
  return f(a)+f(b)-f(a*b)
end


function euler1Numeric (a,b,bound)
  bound = bound-1
  function f(n) 
    c = math.floor(bound/n)
    return math.floor(c*(c+1)/2)*n
  end
  return f(a)+f(b)-f(a*b)
end

Good old Java, C#, and C/C++; the three tireless workhorses of modern computing. When programmed procedurally, all three are so similar that I will show only a single example: the naïve implementation in Java. Of course, the reasons why a programmer might prefer one of these languages over the others are real and important, but are simply beyond the scope of a snippet. In most cases it has to do with platform, ecosystem, and considerations of speed vs. safety. (In this example, and in the C# case below, I have omitted the enclosing class definition for brevity.)

public static int euler_1_naive (
    int a,
    int b,
    int bound)
{
    int sum = 0;
    for (int i=1;i<bound;i++)
        if (((i%a)==0)||((i%b)==0))
           sum += i;
    return sum;
}

Many procedural languages are growing to become more functional. To illustrate that, here is an example in C#, which makes us of a locally defined delegate.

// C# 4.0 and Visual Studio 2010.

// Sums stepped ranges.

public static int Euler_1_iteration (

  int a,

  int b,

  int bound)

  Func<int,int,int> f =

    (sum,n) => {

      for (int i=n;i<bound;i+=n)

        sum+=i;

      return sum; };

  return f(f(-f(0,a*b),b),a);

C++0X also adds functional features and other modern constructs to the C++ language. The example below shows the definition of a lambda and the use of the “auto” keyword (a great boon to readability). The lambda syntax appears a bit arcane and robotic, but then, everything about C and C++ is a bit arcane and robot. *Which is exactly what programmers like about it.* (And if you really, *really* like that kind of thing, you might want to try FORTH.)

// Numeric (one possible factoring).

// Illustrates the use of lambdas, auto

// and closures.

int euler_1_numeric (

  int a,

  int b,

  int bound)

  bound -= 1;

  auto f = [bound] (int n) -> int

    int c = bound / n;

    return c*(c+1)/2*n;

};

  return f(a)+f(b)-f(a*b);

Last, here are a couple of examples that use template-based metaprogramming in C++. In case you haven’t encountered that before, it’s basically a way of tricking the compiler into running a program at *compile time* that leaves a correct value or structure in the compiled code. In these examples, the correct Project Euler #1 value is left in the enumeration value RET. Template-based metaprogramming can be a bit hard to wrap your mind around at first, and the examples here are not especially reflective of how it might be useful in the real world. Suffice to say that it can be a powerful technique for creating complex data structures and increasing runtime efficiency (for example, by permitting constant folding and similar techniques in ways that go beyond even optimizing compilers).

// Template metaprogram 1.

// Sums stepped ranges.

// Illustrates partial template

// instantiation.

template<int i, int acc, int n>

struct SRSum

  enum {

    RET=SRSum<i,acc+i,n-1>::RET+acc

};

};

template<int i, int acc>

struct SRSum<i,acc,0>

  enum { RET=acc };

};

template<int a, int b, int bound>

struct Euler1Iterate

  enum {

    RET=(SRSum<a,0,(bound-1)/a>::RET)+

        (SRSum<b,0,(bound-1)/b>::RET)-

        (SRSum<(a*b),0,(bound-1)/(a*b)>::RET)

};

};

// Template metaprogram 2.

// Numeric.

template<int n, int bound>

struct NSum

private: enum { C=(bound-1)/n };

public: enum { RET=C*(C+1)/2*n };

};

template<int a, int b, int bound>

struct Euler1Numeric

  enum {

    RET=NSum<a,bound>::RET+

        NSum<b,bound>::RET-

        NSum<(a*b),bound>::RET

};

};

// Test both.

int _tmain(int argc, _TCHAR* argv[])

  return (Euler1Iterate<3,5,1000>::RET+

          Euler1Numeric<3,5,1000>::RET)/2;

Finally, a short word about benchmarks. The compiled versions (C/C++/C#/Java/F#) all ran a lot faster than the scripting language versions (Lua/Python/Ruby). That was no surprise. What was surprising, however, was just how fast the scripted versions were – even given the startup time. Plenty fast enough for almost anything other than data or numeric intensive programs, and certainly fast enough to handle most user tasks. Of the three scripting languages, Lua lived up to its reputation as the fastest, but Ruby and Python weren’t far behind (Ruby was slightly faster than Python).

And that’s it: one problem, three solutions, seven languages.

-Neil

p.s. I apologize for not syntax highlighting several of the samples. I have a VS2008 add-in that will do it, but I don’t know how to do it in NetBeans.

If Programming Languages Were Television Shows

2011-01-17T09:32:00.000-08:00

I’m working on a more substantial post that compares several programming languages on a single problem. In the meantime, I give you something frivolous; my take on…

If Programming Languages Were Television Shows

F# – Mythbusters. We don't just explain the functional programming myths, we put them to the test. (Am I missing an eyebrow?)

Haskell – The Saturday-afternoon calculus course from the local community college on the public access channel.

Fortran – An old movie, a perennial favorite with classic actors, and the credits arranged in a matrix.

Java – Something on a business channel with a scrolling stock ticker and announcers who wear kakis and blue button-downs.

C# – Just like Java, but with fancier graphics on the stock ticker and announcers who wear power ties.

Python – Financial advice for the small investor. It seems sound, but which way will the market trend?

C/C++ – Some PBS hippie show about growing and canning your own vegetables. Who needs garbage collection when you can compost?

Lua – A late-night foreign art film in black and white by a visionary director. Deep, but will it find enough sponsors to go prime time?

Ruby – Star Trek. Geeky, gadgety, and tough on newcomers, but a fiercely loyal fan base will keep this series in syndication for a while. Beam me up, Matz!

FORTH – The Woodwright’s Shop. Watch a guy make handmade furniture using handmade tools. Be careful of splinters.

Assembly Language - A test pattern.

COBOL – Something on the radio your parents or grandparents used to listen to.

(Sorry, COBOL geeks, I couldn't resist that last one, lol. We love you anyway.)

-Neil

F# Computation Expressions: Basic Data Retrieval Mechanics

2010-10-03T07:57:00.000-07:00

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

2010-10-01T11:45:00.000-07:00

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

2010-09-27T12:46:00.000-07:00

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.

2010-09-26T17:50:00.000-07:00

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

// 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

2010-09-26T11:50:00.000-07:00

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

2010-09-17T16:16:00.000-07:00

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

2010-09-16T11:59:00.000-07:00

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

2010-09-13T13:05:00.000-07:00

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>) =

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

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

  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

2010-09-11T10:51:00.000-07:00

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

2010-09-04T07:32:00.000-07:00

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

2010-09-03T07:10:00.000-07:00

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

F#, Fuzzy Logic, WPF, and Tomatoes!

2010-08-30T06:55:00.000-07:00

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()