TechNeilogy

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