TechNeilogy

Here is the next, and possibly final, installment in this series. It adds quite a bit, including the ability to estimate current certainty for an hypothesis without seeking further proof. However, it has moved quite far afield from my original intent.

I started this series hoping to learn a bit more about F#, and in particular, about F# as a platform for creating domain and application-specific systems. It was my first attempt at an F# program of more than a few lines. It had a good beginning, but as it grew up, it developed into something more conventionally object-oriented. Fortunately, I was able to learn a lot about the syntax and other basics of F#.

But the time has come to return, and seek some other feature of F# (just as “lazy” was the genesis of this series), and learn more about the F# way of doing things. In the meantime, here is the final installment. Standard caveats apply: not thoroughly error checked, use at your own risk, formatted for blog display, etc.

open System  // For query ReadKey only.


/// <summary>Ternary query value.</summary>   
type Query =
  | Yes
  | No
  | Unknown
    
    
/// <summary>Query helper.</summary>   
/// <remarks>Gets yes/no/unknown.</summary>   
let rec internal GetQuery q = 
  printf "%s (y/n/u) " q
  let key = Console.ReadKey().KeyChar
  printfn ""
  match key with 
    | 'y' | 'Y' -> Query.Yes
    | 'n' | 'N' -> Query.No
    | 'u' | 'U' -> Query.Unknown
    | _ -> GetQuery q
    
    
/// <summary>Degree of certainty.</summary>   
type Certainty = 
  | Impossible =   0
  | Unlikely   =  25
  | Possible   =  50
  | Likely     =  75 
  | Certain    = 100

    
/// <summary>Conjoin Certainty.</summary>   
let Conjoin (c0:Certainty)
            (c1:Certainty) = 
  match (c0<c1) with 
    | true  -> c0 
    | false -> c1
    
    
/// <summary>Disjoin Certainty.</summary>   
let Disjoin (c0:Certainty) 
            (c1:Certainty) = 
  match (c0>c1) with 
    | true  -> c0 
    | false -> c1
    
    
/// <summary>Nature of the proof.</summary>   
type Proof = 
  | Estimated = 0
  | Known     = 1

    
/// <summary>Conjoin Proof.</summary>   
let ConjoinProof (p0:Proof)
                 (p1:Proof) = 
  match p0 with 
    | Proof.Estimated -> p0 
    | _ -> p1
    
    
/// <summary>Evidence for an hypothesis.</summary>   
type Evidence = {
  Certainty : Certainty;
  Proof     : Proof; }
    
    
/// <summary>Hypothesis base.</summary>   
/// <param name="name">External name.</param>
/// <param name="priorEvidence">Prior Evidence value.</param>
[<AbstractClass>]
type Hypothesis (name:string,
                 priorEvidence:Evidence) =

  // Start with the prior certainty.
  let mutable evidence = priorEvidence

  // Name (e.g. user hypothesis).
  member this.Name = name
                       
  //  Get/set Certainty.
  member this.Certainty 
    with get() = evidence.Certainty
    and set c = 
      match (evidence.Proof) with
        | Proof.Known -> 
            raise <| new InvalidOperationException();
        | _ -> evidence <- 
                 { Certainty=c; 
                   Proof=Proof.Estimated }
                       
  //  Get/set Evidence.
  member this.Evidence 
    with get() = evidence
    and set e = 
      match (evidence.Proof) with
        | Proof.Known -> 
            raise <| new InvalidOperationException();
        | _ -> evidence <- e
                       
  //  Get/set Proof.
  member this.Proof 
    with get() = evidence.Proof
    and set p = 
      match (evidence.Proof) with
        | Proof.Known -> 
            raise <| new InvalidOperationException();
        | _ -> evidence <- 
                 { Certainty=evidence.Certainty; 
                   Proof=p }
  
  // Set the known certainty.
  member this.Conclude (c:Certainty) = 
    this.Certainty <- c
    this.Proof <- Proof.Known
    evidence
  
  // Update the proof status.
  member this.Update (c:Certainty,
                         p:Proof) = 
    this.Certainty <- c
    this.Proof <- p
    evidence
  
  // Update the estimated certainty.
  member this.Estimate (c:Certainty) = 
    this.Certainty <- c
    evidence
  
  // Compute an estimate.
  abstract GetEstimate : unit->Evidence
  default this.GetEstimate () = evidence
  
  // Compute proof value.
  abstract Prove : unit->Evidence


/// <summary>A constant fact.</summary>   
/// <param name="name">External name.</param>
/// <param name="certainty">Certainty.</param>
type Fact (name:string,
           certainty:Certainty) =
  inherit Hypothesis (name, 
                      { Certainty=certainty; 
                        Proof=Proof.Known })
  
  // This hypothesis is proven from the start.
  override this.Prove () = this.Evidence
    

/// <summary>A boolean-queried fact.</summary>   
/// <param name="name">External name.</param>
/// <param name="query">User question.</param>
/// <param name="priorCertainty">Certainty if unknown.</param>
type QueryBoolean (name:string,
                   query:string,
                   priorCertainty:Certainty) =
  inherit Hypothesis (name, 
                      { Certainty=priorCertainty; 
                        Proof=Proof.Estimated })
  
  // Proof is based on query:
  //   Yes -> Certain
  //   No -> Impossible
  //   Unknown -> Prior certainty.
  override this.Prove () = 
    match this.Evidence.Proof with
      | Proof.Known -> base.Evidence
      | _ -> this.Conclude
               (match GetQuery(query) with
                 | Query.Yes -> Certainty.Certain
                 | Query.No -> Certainty.Impossible
                 | _ -> this.Certainty)
    

/// <summary>Compound hypothesis.</summary>
/// <param name="name">External name.</param>
/// <param name="antecedents">List of antecedents.</param>
/// <param name="baseCertainty">Accumulator base certainty.</param>
/// <param name="combineCertainty">How to combine certainties.</param>
/// <param name="shortCircuitCertainty">High/low short circuit.</param>
[<AbstractClass>]
type HypothesisCompound (name:string,
                         antecedents:Hypothesis list,
                         baseCertainty:Certainty,
                         combineCertainty:Certainty->Certainty->Certainty,
                         shortCircuitCertainty:Certainty->bool) =
  inherit Hypothesis (name, 
                      { Certainty=Certainty.Possible; 
                        Proof=Proof.Estimated })

//  // Here is a tail-recursive version.
//  member private this.getEstimate c p (l:Hypothesis list) =
//    match l with
//      | [] -> (c, p)
//      | h::t  -> 
//          (h.GetEstimate() |> ignore)
//          this.getEstimate 
//            (combineCertainty c h.Certainty)
//            (ConjoinProof p h.Proof)
//            t
//              
//  override this.GetEstimate () = 
//    match this.Evidence.Proof with
//      | Proof.Known -> this.Evidence
//      | _ -> this.Update 
//               (this.getEstimate baseCertainty 
//                                 Proof.Known 
//                                 antecedents)
              
  // Compute an estimate.
  // Here is a fold version.
  // Note: if all antecedents are Known,
  //       combined certainty will be concluded.
  override this.GetEstimate () = 
    match this.Evidence.Proof with
      | Proof.Known -> this.Evidence
      | _ -> this.Update 
               (List.fold 
                 (fun acc (h:Hypothesis) -> 
                   h.GetEstimate() |> ignore
                   ((combineCertainty (fst acc) h.Certainty),
                    (ConjoinProof (snd acc) h.Proof))) 
                 (baseCertainty,Proof.Known) 
                 antecedents)
  
  // Tail-recursive helper.  
  member private this.prove c (l:Hypothesis list) =
    if shortCircuitCertainty c then c
    else  
      match l with
        | [] -> c
        | h::t -> 
            this.prove
              (combineCertainty c (h.Prove()).Certainty)
               t

  // Compute proof value.
  override this.Prove () =
    match this.Evidence.Proof with
      | Proof.Known -> this.Evidence
      | _ -> this.Conclude 
               (this.prove
                 baseCertainty
                 antecedents)


///<summary>Conjunctive hypothesis.</summary>   
type Conjunction (name:string,
                  antecedents:Hypothesis list,
                  certaintyCutoff:Certainty) =
  inherit HypothesisCompound (name,
                              antecedents,
                              Certainty.Certain,
                              Conjoin,
                              fun c -> c<=certaintyCutoff)
                              

///<summary>Disjunctive hypothesis.</summary>   
type Disjunction (name:string,
                  antecedents:Hypothesis list,
                  certaintyCutoff:Certainty) =
  inherit HypothesisCompound (name,
                              antecedents,
                              Certainty.Impossible,
                              Disjoin,
                              fun c -> c>=certaintyCutoff)


//// Test.

let black  = 
  QueryBoolean(
    "black",  
    "Is it black?", 
    Certainty.Possible)
    
let orange = 
  QueryBoolean(
    "orange", 
    "Is it orange?", 
    Certainty.Possible)
    
let read   = 
  QueryBoolean(
    "read",   
    "Is it read?", 
    Certainty.Possible)
    
let white  = 
  QueryBoolean(
    "white",  
    "Is it white?", 
    Certainty.Possible)

let spotted = 
  QueryBoolean(
    "spotted", 
    "Is it spotted?", 
    Certainty.Possible)
    
let striped = 
  QueryBoolean(
    "striped", 
    "Is it striped?", 
    Certainty.Possible)

let blackAndOrange = 
  Conjunction(
    "blackAndOrange", 
    [ black; orange ], 
    Certainty.Unlikely)
    
let blackAndWhite = 
  Conjunction(
    "blackAndWhite", 
    [ black; white ], 
    Certainty.Unlikely)

let dalmation = 
  Conjunction(
    "dalmation", 
    [ spotted; blackAndWhite ], 
    Certainty.Unlikely)
    
let leopard = 
  Conjunction(
    "leopard",
    [ spotted; blackAndOrange ], 
    Certainty.Unlikely)
    
let newspaper = 
  Conjunction(
    "newspaper",
    [ blackAndWhite; read ], 
    Certainty.Unlikely)
    
let tiger = 
  Conjunction(
    "tiger",
    [ striped; blackAndOrange ], 
    Certainty.Unlikely)
    
let zebra = 
  Conjunction(
    "zebra",
    [ striped; blackAndWhite ], 
    Certainty.Unlikely)

let animal = 
  Disjunction(
    "animal", 
    [ dalmation; leopard; tiger; zebra ], 
    Certainty.Certain)

let thing = 
  Disjunction(
    "thing", 
    [ animal; newspaper ], 
    Certainty.Certain)
   
let PrintEvidence (h:Hypothesis) =
  printfn
    "  %s = %s to be %s"
    h.Name
    (h.Evidence.Proof.ToString())
    (h.Certainty.ToString())
   
let PrintAllEvidence msg =
  printfn "%s" msg
  PrintEvidence dalmation
  PrintEvidence leopard  
  PrintEvidence newspaper  
  PrintEvidence tiger  
  PrintEvidence zebra  
  PrintEvidence animal
  printfn "%s" msg

black.Conclude Certainty.Certain |> ignore
white.Conclude Certainty.Certain |> ignore
read.Conclude  Certainty.Likely  |> ignore

thing.GetEstimate() |> ignore
  
PrintAllEvidence "After Estimate"

thing.Prove() |> ignore
  
PrintAllEvidence "After Prove"

Console.ReadLine() |> ignore