Here’s a version with simple certainty factors, which are based on categories. It seeks to prove hypotheses until it finds one that is at least “Likely.” I changed some of the names to be more consistent with common usage. I also cleaned up the F# a bit.

Standard disclaimers and caveats apply: a weekend fun project, not thoroughly tested, use at your own risk.

open System

// See previous post for additional comments.
// Formatted for blog width.

// Certainty factors based on categories.

type Certainty = 
  | Impossible = 0
  | Disproven  = 1
  | Unlikely   = 2
  | Possible   = 3
  | Likely     = 4 
  | Proven     = 5
  | Certain    = 6
  
// Likely and Unlikely define the boundaries for
// acceptance and rejection.
  
let Likely (c) = c>=Certainty.Likely

let Unlikely (c) = c<=Certainty.Unlikely

// Custom Min and Max.

let Min c0 c1 = 
  match (c0<c1) with 
    | true -> c0 
    | false -> c1
          
let Max c0 c1 = 
  match (c0>c1) with 
    | true -> c0 
    | false -> c1


// I cleaned up the Consider functions quite a bit.
          
let ConsiderBase s (b:Lazy<Certainty>) =
  printfn "Considering <-- %s" s
  printfn "Concluding  --> %s is %s" s (b.Value.ToString())
  
  
let Consider s (b:Lazy<Certainty>) = lazy ( 
  ConsiderBase s b
  b.Value)


let ConsiderImmediate s (b:Lazy<Certainty>) =
  ConsiderBase s b
  b
 
  
// Conjunction functions converted to certainty.
  
let Conjoin a (b:unit->Certainty) =  
  match Unlikely(a) with 
    | true -> a
    | false -> Min a (b())


let rec ConjunctionPossible (l:Lazy<Certainty> list) =
  match l with
    | [] -> Certainty.Certain
    | h::t -> 
        match h.IsValueCreated with
          | false -> ConjunctionPossible(t)
          | true -> 
              Conjoin 
                h.Value 
                (fun unit -> ConjunctionPossible(t))


let rec ConjunctionEval (l:Lazy<Certainty> list) =
  match l with
    | [] -> Certainty.Certain
    | h::t -> 
        Conjoin 
          h.Value 
          (fun unit -> ConjunctionEval(t))


let Conjunction (l:Lazy<Certainty> list) = lazy (
  let possible = ConjunctionPossible(l)
  match Unlikely(possible) with
    | true -> possible
    | false -> ConjunctionEval(l))
 
  
// Disjunction functions converted to certainty.
  
let Disjoin a (b:unit->Certainty) = 
  match Likely(a) with 
    | true -> a
    | false -> Max a (b())
  
let rec DisjunctionPossible (l:Lazy<Certainty> list) =
  match l with
    | [] -> Certainty.Impossible
    | h::t -> 
        match h.IsValueCreated with
          | false -> Certainty.Certain
          | true -> 
              Disjoin 
                h.Value 
                (fun unit -> DisjunctionPossible(t))


let rec DisjunctionEval (l:Lazy<Certainty> list) =
  match l with
    | [] -> Certainty.Impossible
    | h::t -> 
        Disjoin 
          (h.Value) 
          (fun unit -> DisjunctionEval(t))


let Disjunction (l:Lazy<Certainty> list) = lazy (
  let possible = DisjunctionPossible(l)
  match Unlikely(possible) with
    | true -> possible
    | false -> DisjunctionEval(l))
 
  
// This function will evaluate all hypotheses.
  
let rec Maximum (l:Lazy<Certainty> list) = lazy (
  match l with
    | [] -> Certainty.Impossible
    | h::t -> Max h.Value (Maximum(t)).Value)
    

// Sample data.

let black = 
  Consider "black" (lazy Certainty.Possible) 

let blue = 
  ConsiderImmediate "blue" (lazy Certainty.Likely)

let orange = 
  Consider "orange" (lazy Certainty.Unlikely)

let white =  
  Consider "white" (lazy Certainty.Likely)

let blackAndOrange = 
  Consider 
    "blackAndOrange" 
    (Conjunction [ 
      black; 
      orange ])

let blackAndOrangeOrBlue = 
  Consider 
    "blackAndOrangeOrBlue" 
    (Disjunction [ 
      blackAndOrange; 
      blue ]) 

let whiteAndBlack =   
  Consider 
    "whiteAndBlack" 
    (Conjunction [ 
      white; 
      black ]) 

let color =  
  ConsiderImmediate 
    "colorIsKnown" 
    (Disjunction [ 
      blackAndOrange; 
      blackAndOrangeOrBlue; 
      whiteAndBlack ]) 
      
Console.ReadLine() |> ignore

Looking at the tiny expert system in the previous post reveals some obvious problems. Perhaps worst among them, the system will continue to ask for values even when it is obvious that a conjunction will fail. Most of these problems could be solved by the clever use of intermediate hypotheses and by paying careful attention to the ordering of the hypotheses. However, there’s a better way: construct a tiny inference engine.

Before I show that, let me say some things about what this is not and what it is. First, this is not necessarily the best way to build an inference engine; it is not even necessarily the best way to build a toy inference engine. Second, it is not a compendium of F# design patterns or best practices. Third, it is not thoroughly checked for quality or errors, it is a bit of weekend fun – use it at your own risk. Here’s what it is: it was a fun exercise in learning some things about F#. In particular, it shows how F# can easily be used as a framework for constructing domain and application-specific languages.

The tiny inference engine is made up of three things:

Consider and ConsiderImmediate – functions which define and instantiate hyptheses. Note that these are functionally very simple; most of the code in them is for readability and reporting.

ConjoinPossible, ConjoinEval, and Conjoin – functions which combine hypotheses conjunctively (i.e. using “and”). The first two functions are helpers. ConjoinPossible determines whether a conjunction is still possible given the current state of the evidence. ConjoinEval performs an actual conjunction. Conjoin groups the previous functions into a neat package.

DisjoinPossible, DisjoinEval, and Disjoin – equivalents of the conjunctive functions which combine hypotheses disjunctively (i.e. using “or”).

There is also a small sample set of rules which reason about the color of a thing. Rather than query the user, I hard-coded the values for the root hypotheses. This simplifies testing. Also, please note that the code is specially formatted to fit the narrow blog window.

// Note: formatted for blog width.

// Lazy evaluation of an hypothesis.
// Everything except the return
// is just for information.
let Consider s (b:Lazy<bool>) = lazy ( 
  printf "Considering: "
  printfn s
  match b.Value with 
    | false -> printf "Rejecting: "
    | true -> printf "Accepting: "
  printfn s
  b.Value)

// Immediate evaluation of an hypothesis.
// Everything except the return
// is just for information.
let ConsiderImmediate s (b:Lazy<bool>) =
  printf "Considering: "
  printfn s
  match b.Value with 
    | false -> printf "Rejecting: "
    | true -> printf "Accepting: "
  printfn s
  b

// This set of functions handles conjunction.

// True on all true or unknown.
let rec ConjoinPossible (l:Lazy<bool> list) =
  match l with
    | [] -> true
    | h::t -> 
        if (h.IsValueCreated) 
          then (h.Value && ConjoinPossible(t)) 
          else ConjoinPossible(t)

// Conjoin with short-circuit on false.
let rec ConjoinEval (l:Lazy<bool> list) =
  match l with
    | [] -> true
    | h::t -> h.Value && ConjoinEval(t)

// Conjoin if possible.
let rec Conjoin (l:Lazy<bool> list) = lazy (
  ConjoinPossible(l) &&
  ConjoinEval(l))

// This set of functions handles disjunction.

// True on at least one true or unknown.
let rec DisjoinPossible (l:Lazy<bool> list) =
  match l with
    | [] -> false
    | h::t -> 
        if (h.IsValueCreated) 
          then (h.Value || DisjoinPossible(t)) 
          else true

// Disjoin with short-circuit on true.
let rec DisjoinEval (l:Lazy<bool> list) =
  match l with
    | [] -> false
    | h::t -> h.Value || DisjoinEval(t)

// Disjoin if possible.
let rec Disjoin (l:Lazy<bool> list) = lazy (
  DisjoinPossible(l) &&
  DisjoinEval(l))

// Here are some test hypotheses.

// This first block contains hard coded values.
// In real life, these would be input data.
// They are hard-coded here to simplify testing.

let black = 
  Consider "black" (lazy true) 

let blue = 
  ConsiderImmediate "blue" (lazy true)

let orange = 
  Consider "orange" (lazy false)

let white =  
  Consider "white" (lazy true)

// This second block is the logic.

let blackAndOrange = 
  Consider 
    "blackAndOrange" 
    (Conjoin [ 
      black; 
      orange ])

let blackAndOrangeOrBlue = 
  Consider 
    "blackAndOrangeOrBlue" 
    (Disjoin [ 
      blackAndOrange; 
      blue ]) 

let whiteAndBlack =   
  Consider 
    "whiteAndBlack" 
    (Conjoin [ 
      white; 
      black ]) 

let color =  
  ConsiderImmediate 
    "color" 
    (Disjoin [ 
      blackAndOrange; 
      blackAndOrangeOrBlue; 
      whiteAndBlack ]) 
      
// Run the system.

open System

Console.ReadLine() |> ignore

So what’s next? I’m not sure. For one thing, I’d like to add certainty factors. This may entail a more complex record type. In the interests of exercise particular F# features, I will likely base this on records or discriminated unions rather than classes. Stay tuned.

Bit of a gap, what with holidays, learning some XNA, learning some F#, etc.

As a restart, I present for your amusement a tiny expert system written in F# using lazy evaluation. The entire thing is written declaratively, with the exception of a bit of syntactic sugar in the IO (GetResponse and PrintResult). It mirrors the kind of simple expert system examples typically found in entry-level Prolog books, etc.

open System

let GetResponse q = 
  printf q
  printf " "
  let rtn = (Console.ReadKey().KeyChar='y')
  printfn ""
  rtn

let PrintResult s = 
  printfn s
  true
  
let black = lazy (
  GetResponse "Does the animal have black color?")
  
let fins = lazy (
  GetResponse "Does the animal have fins?")
  
let orange = lazy (
  GetResponse "Does the animal have orange color?")

let spots = lazy (
  GetResponse "Does the animal have spots?")

let stripes = lazy (
  GetResponse "Does the animal have stripes?")

let white = lazy (
  GetResponse "Does the animal have white color?")
  
let blackAndOrange = lazy (
  black.Value &&
  orange.Value &&
  PrintResult("(Asserting: black and orange.)"))
  
let blackAndWhite = lazy (
  black.Value &&
  white.Value &&
  PrintResult("(Asserting: black and white.)"))
  
let isAFish = lazy (
  fins.Value &&
  PrintResult("(Asserting: is a fish.)"))
  
let dalmation = lazy (
  spots.Value &&
  blackAndWhite.Value &&
  PrintResult("The animal is a dalmation."))
  
let leopard = lazy (
  spots.Value &&
  blackAndOrange.Value &&
  PrintResult("The animal is a leopard."))
  
let tiger = lazy (
  stripes.Value &&
  blackAndOrange.Value &&
  PrintResult("The animal is a tiger."))
  
let zebra = lazy (
  stripes.Value &&
  blackAndWhite.Value &&
  not isAFish.Value &&
  PrintResult("The animal is a zebra."))
  
let zebraFish = lazy (
  stripes.Value &&
  blackAndWhite.Value &&
  isAFish.Value &&
  PrintResult("The animal is a zebra fish."))
  
let animal = 
  dalmation.Value ||
  leopard.Value ||
  tiger.Value ||
  zebra.Value ||
  zebraFish.Value ||
  PrintResult("Must be a sasquatch!")

Console.ReadLine() |> ignore