## Monday, September 13, 2010

### Basic F# Computation Expressions Using Yield and Combine

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

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

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

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

Here is the output from a typical session:

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

`// Joins values asserted by Yield, using a `
`// supplied combining function.`
`type Join (fCombine) =`
`  member this.Combine (a:Lazy<bool>,b:unit->Lazy<bool>) = `
`    fCombine a b`
`  member this.Delay (f:unit->Lazy<bool>) =`
`    f`
`  member this.Return (a:Lazy<bool>) = `
`    a`
`  member this.Yield (a:Lazy<bool>) = `
`    a`
`  member this.Yield (a:unit->Lazy<bool>) = `
`    a()`
` `
`// Define conjunction and disjunction with short-circuiting.`
`let conjoin = Join(fun a b->Lazy(fun()->a.Value&&b().Value))`
`let disjoin = Join(fun a b->Lazy(fun()->a.Value||b().Value))`
` `
` `
`// Syntax helper to query for a boolean.`
`let query s =`
`  (fun () ->`
`    printf "%s " s`
`    let q =`
`      ("yY").IndexOf(`
`        System.Console.ReadKey().KeyChar)`
`          <>(-1)`
`    printfn ""`
`    q)`
` `
`// Syntax helper to assert a lazy boolean.`
`let conclude s b =`
`  printfn "%s" s`
`  Lazy(fun()->b)`
` `
` `
`// Basic facts.`
` `
`let black = `
`  Lazy<bool>(query "Is the animal all or partly black?")`
`let orange = `
`  Lazy<bool>(query "Is the animal all or partly orange?")`
`let white = `
`  Lazy<bool>(query "Is the animal all or partly white?")`
` `
`let spotted = `
`  Lazy<bool>(query "Is the animal spotted?")`
`let striped = `
`  Lazy<bool>(query "Is the animal striped?")`
` `
`// Intermediate hypotheses.`
` `
`let blackAndWhite = conjoin {`
`  yield black`
`  return white`
`}`
` `
`let blackAndOrange = conjoin {`
`  yield black`
`  return orange`
`}`
` `
`// Output hypotheses (i.e. animals).`
` `
`let tiger = conjoin {`
`  yield blackAndOrange`
`  yield striped`
`  return conclude "It's a tiger." true`
`} `
` `
`let zebra = conjoin {`
`  yield blackAndWhite`
`  yield striped`
`  return conclude "It's a zebra." true`
`} `
` `
`let leopard = conjoin {`
`  yield blackAndOrange`
`  yield spotted`
`  return conclude "It's a leopard." true`
`} `
` `
`let dalmation = conjoin {`
`  yield blackAndWhite`
`  yield spotted`
`  return conclude "It's a dalmation." true`
`} `
` `
`// Root hypothesis.`
`let animal = disjoin {`
`  yield tiger`
`  yield zebra`
`  yield leopard`
`  yield dalmation `
`  return conclude "It must be a sasquatch!" false`
`}`
` `
` `
`// Run the engine.`
`let isKnownAnimal = animal().Value `
` `
`printfn "Your breakpoint here."`