Monday, March 22, 2010

Semantic Net Search 0.1

Here is the latest; a step towards deep search.

I decided to implement the search using an auxiliary class. This allows the network itself to remain more pure, with details such as the transitivity of links being a function of the search rather than the structure. (The epistemological implications of this are intriguing.)

I did augment the network with a dictionary which stores a table of the last item in a relationship keyed by the first item and the link. This is for efficiency only; it could also have been accomplished using the existing Find function.

Lastly, my first attempt at a search function is rather grim, messy, and imperative. It works, but I’m not proud of it. I tried to construct a version based on continuations, but it defeated my resolve to get something that at least worked posted to the blog today. Watch for a cleaner, more functional version in the next blog post or two. Until then, consider it an example of an anti-pattern, lol.

As always, no warranties or implied fitness. Use at your own risk. I rushed to post this, so there may be bugs.

Library:
module SemanticNet

open System.Collections.Generic


// I'm a fool for syntactic sugar.
type internal Rel = string*string*string
type internal RelHash = HashSet<Rel>
type internal RelDict = Dictionary<string,RelHash>
type internal FinderVal = bool*(RelHash option)
type internal RelChain = Dictionary<(string*string),HashSet<string>>



// Computation expression builder for finds.
type internal RelFinder () =

// "let!" function.
member this.Bind (((b,h):FinderVal),
(f:FinderVal->FinderVal)) =
match b with
| true -> f (b,h)
| _ -> (b,h)

// "return" function.
member this.Return bh = bh



// Holds the relationships.
type Graph () =

// Holds all the relationships.
let relHash = new RelHash()

// Holds all the relationships as chains.
// Supports deep search.
let relChain = new RelChain()

// Maps a node in each position
// to the relationships for that node.
let n0ToRelHash = new RelDict()
let n1ToRelHash = new RelDict()
let n2ToRelHash = new RelDict()

// Computation expression builder for finds.
let relFinder = RelFinder()

// Internal function for finds.
let relFinderComp (d:RelDict)
(so:string option)
(bhi:FinderVal) =
match so with
| None -> bhi
| Some(s) ->
match d.TryGetValue s with
| (true,h) ->
match bhi with
// Copy the first hash found.
| (true,None) -> (true,Some(RelHash(h)))
| (true,Some(hi)) ->
hi.IntersectWith(h)
(true,Some(hi))
| _ -> failwith "Internal program error."
| _ -> (false,None)

// // For a slightly more efficient first call,
// // this can be used.
//
// let relFinderCompFst (d:RelDict)
// (so:string option) =
// match so with
// | None -> (true,None)
// | Some(s) ->
// match d.TryGetValue s with
// | (true,h) -> (true,Some(RelHash(h)))
// | _ -> (false,None)

// Add a relationship to a dictionary.
let tryAddRel (d:RelDict) k r =
match d.TryGetValue k with
| (true,h) ->
h.Add r |> ignore
| _ ->
let h = new RelHash()
h.Add r |> ignore
d.Add(k,h)

// Add a relationship to the chain dictionary.
let tryAddRelChain (s0,s1,s2) =
(match relChain.TryGetValue((s0,s1)) with
| (true,h) -> h
| _ ->
let h = HashSet<string>()
relChain.Add((s0,s1),h)
h).Add s2 |> ignore

// Remove a relationship from a dictionary.
let tryRemoveRel (d:RelDict) k r =
match d.TryGetValue k with
| (true,h) ->
let rmv = h.Remove r
// Clean up empty entries.
if (h.Count=0) then d.Remove k |> ignore
//rmv
| _ -> ()

// Add a relationship to the chain dictionary.
let tryRemoveRelChain (s0,s1,s2) =
match relChain.TryGetValue((s0,s1)) with
| (true,h) ->
let rmv = h.Remove s2
// Clean up empty entries.
if (h.Count=0) then relChain.Remove((s0,s1)) |> ignore
//rmv
| _ -> ()

// Add a relationship.
member this.Add r =
match relHash.Add r with
| false -> ()
| _ ->
let (s0,s1,s2) = r
tryAddRelChain (s0,s1,s2) |> ignore
tryAddRel n0ToRelHash s0 r
tryAddRel n1ToRelHash s1 r
tryAddRel n2ToRelHash s1 r

// Add a bunch of relationships.
member this.Add (e:IEnumerable<Rel>) =
for r in e do
this.Add r

// Return a hash of all relationships.
member this.All =
RelHash(relHash)

// Return true if a relationship exists.
member this.Exists r =
relHash.Contains r

// Return a hash option of the matched relationships.
// Note: Uses string option; None acts as a wildcard in Find.
member this.Find (s0,s1,s2) =
match
(relFinder {
// // See note above.
// let! r0 = relFinderCompFst n0ToRelHash s0
let! r0 = relFinderComp n0ToRelHash s0 (true,None)
let! r1 = relFinderComp n1ToRelHash s1 r0
return relFinderComp n2ToRelHash s2 r1 }) with
// Three wildcards.
| (true,None) -> Some(RelHash(relHash))
// Something found.
| (true,h) -> h
// Nothing found.
| _ -> None

// Return a hash option of the matched conclusions.
// More efficient than Find(s0,s1,s2) with wildcard.
member this.Find (s0,s1) =
relChain.TryGetValue((s0,s1))

// Return a hash option of the matched relationships.
// Note: Uses strings; explicit wildcard.
member this.FindW w (s0,s1,s2) =
this.Find (
(if s0=w then None else Some(s0)),
(if s1=w then None else Some(s1)),
(if s2=w then None else Some(s2)))

// Remove a relationship.
member this.Remove r =
match relHash.Remove r with
| true ->
let (s0,s1,s2) = r
tryRemoveRelChain (s0,s1,s2)
tryRemoveRel n0ToRelHash s0 r
tryRemoveRel n1ToRelHash s1 r
tryRemoveRel n2ToRelHash s2 r
| _ -> ()

// Remove a bunch of relationships.
member this.Remove (e:IEnumerable<Rel>) =
for r in e do
this.Remove r

// + operator adds a relationship, returns graph.
static member (+) ((g:Graph),(r:Rel)) =
g.Add r
g

// - operator removes a relationship, returns graph.
static member (-) ((g:Graph),(r:Rel)) =
g.Remove r
g



// Abstract interface for a searcher.
[<AbstractClass>]
type SearcherBase () =
//abstract member Search: Graph -> Rel -> bool
abstract member Search: Graph -> Rel -> Rel list



// A simple searcher.
type SimpleSearcher () =
inherit SearcherBase()

// Used to prevent cycling.
let tested = new HashSet<string>()

// Indicates transitive links.
let transitive =
let transHash = new HashSet<string>()
transHash.Add "isA" |> ignore
transHash.Add "hasA" |> ignore
(fun s -> transHash.Contains(s))

// Search internal.
let rec searchDeep (gs:Graph) ((s0,s1,s2):Rel) =
match tested.Add(s0) with
| false -> None
| true ->
match gs.Exists (s0,s1,s2) with
| true -> Some([(s0,s1,s2)])
| _ ->
match gs.Find(s0,s1) with
| (false,_) -> None
| (_,h) ->
let mutable e = h.GetEnumerator()
let mutable l = true
let mutable rtn = None
while l && (e.MoveNext()) do
match searchDeep gs (e.Current,s1,s2) with
| None -> ()
| Some(l1) ->
l <- false
rtn <- Some((s0,s1,e.Current)::l1)
rtn

// Search interface.
override this.Search (gs:Graph) (r:Rel) =
let (_,s1,_) = r
match transitive s1 with
| true ->
tested.Clear()
match searchDeep gs r with
| None -> []
| Some(l) -> l
| _ ->
match gs.Exists r with
| true -> [r]
| _ -> []


Test:
open SemanticNet

// Create a graph and
// add some relationships.

let g =
Graph() +
("mammal","isA", "animal") +
("insect","isA", "animal") +
("dog", "isA", "mammal") +
("flea", "isA", "insect") +
("dog", "isA", "pet") +
("dog", "hasA", "tag") +
("chow", "isA", "dog") +
("dog", "scratches", "flea") +
("flea", "scratches", "itch") +
("cat", "isA", "pet")

let simpleSearch = (SimpleSearcher()).Search g

// Search.

let l0 = simpleSearch ("chow","isA", "dog")
let l1 = simpleSearch ("chow","isA", "animal")
let l2 = simpleSearch ("chow","isA", "sasquatch")
let l3 = simpleSearch ("dog", "scratches","itch")
let l4 = simpleSearch ("flea", "isA", "animal")
let l5 = simpleSearch ("flea", "isA", "mammal")

printfn "All done!"

Sunday, March 21, 2010

Yet Another Semantic Network

I know I keep complaining about being tired of building semantic networks in F#, but here’s another one. This one, I hope, is the most F#-like yet. I even managed to use a computation expression! Next up, I’ll add better search capabilities.

As always, no warranties or implied fitness; use at your own risk. Formatted for blog width.

Code:
module SemanticNet

open System.Collections.Generic


// I'm a fool for syntactic sugar.
type internal Rel = string*string*string
type internal RelHash = HashSet<Rel>
type internal RelDict = Dictionary<string,RelHash>
type internal FinderVal = bool*(RelHash option)


// Holds the relationships.
type Graph () =

// Holds all the relationships.
let relHash = new RelHash()

// Maps a node in each position
// to the relationships for that node.
let n0ToRelHash = new RelDict()
let n1ToRelHash = new RelDict()
let n2ToRelHash = new RelDict()

// Computation expression builder for finds.
let relFinder = RelFinder()

// Internal function for finds.
let relFinderComp (d:RelDict)
(so:string option)
(bhi:FinderVal) =
match so with
| None -> bhi
| Some(s) ->
match d.TryGetValue s with
| (true,h) ->
match bhi with
// Copy the first hash found.
| (true,None) -> (true,Some(RelHash(h)))
| (true,Some(hi)) ->
hi.IntersectWith(h)
(true,Some(hi))
| _ -> failwith "Internal program error."
| _ -> (false,None)

// // For a slightly more efficient first call,
// // this can be used.
//
// let relFinderCompFst (d:RelDict)
// (so:string option) =
// match so with
// | None -> (true,None)
// | Some(s) ->
// match d.TryGetValue s with
// | (true,h) -> (true,Some(RelHash(h)))
// | _ -> (false,None)

// Add a relationship to a dictionary.
let tryAddRel (d:RelDict) k r =
match d.TryGetValue k with
| (true,h) ->
h.Add r |> ignore
| _ ->
let h = new RelHash()
h.Add r |> ignore
d.Add(k,h)

// Remove a relationship from a dictionary.
let tryRemoveRel (d:RelDict) k r =
match d.TryGetValue k with
| (true,h) ->
let rmv = h.Remove r
// Clean up empty hash tables.
if (h.Count=0) then d.Remove k |> ignore
rmv
| _ -> false

// Add a relationship.
member this.Add r =
match relHash.Add r with
| false -> r
| _ ->
let (s0,s1,s2) = r
tryAddRel n0ToRelHash s0 r
tryAddRel n1ToRelHash s1 r
tryAddRel n2ToRelHash s1 r
r

// Add a bunch of relationships.
member this.Add (e:IEnumerable<Rel>) =
for r in e do
this.Add r |> ignore

// Return a hash of all relationships.
member this.All =
RelHash(relHash)

// Return true if a relationship exists.
member this.Exists r =
relHash.Contains r

// Return a hash option of the matched relationships.
// Note: Uses string option; None acts as a wildcard in Find.
member this.Find (s0,s1,s2) =
match
(relFinder {
// // See note above.
// let! r0 = relFinderCompFst n0ToRelHash s0
let! r0 = relFinderComp n0ToRelHash s0 (true,None)
let! r1 = relFinderComp n1ToRelHash s1 r0
return relFinderComp n2ToRelHash s2 r1 }) with
// Three wildcards.
| (true,None) -> Some(RelHash(relHash))
// Something found.
| (true,h) -> h
// Nothing found.
| _ -> None

// Return a hash option of the matched relationships.
// Note: Uses strings; explicit wildcard.
member this.FindW w (s0,s1,s2) =
this.Find (
(if s0=w then None else Some(s0)),
(if s1=w then None else Some(s1)),
(if s2=w then None else Some(s2)))

// Remove a relationship.
member this.Remove r =
match relHash.Remove r with
| true ->
let (s0,s1,s2) = r
tryRemoveRel n0ToRelHash s0 r |> ignore
tryRemoveRel n1ToRelHash s1 r |> ignore
tryRemoveRel n2ToRelHash s2 r |> ignore
true
| _ -> false

// Remove a bunch of relationships.
member this.Remove (e:IEnumerable<Rel>) =
for r in e do
this.Remove r |> ignore

// + operator adds a relationship, returns graph.
static member (+) ((g:Graph),(r:Rel)) =
g.Add r |> ignore
g

// - operator removes a relationship, returns graph.
static member (-) ((g:Graph),(r:Rel)) =
g.Remove r |> ignore
g


// Computation expression builder for finds.
and internal RelFinder () =

// "let!" function.
member this.Bind (((b,h):FinderVal),
(f:FinderVal->FinderVal)) =
match b with
| true -> f (b,h)
| _ -> (b,h)

// "return" function.
member this.Return bh = bh



And test:
open SemanticNet

let g0 = Graph()

// Add some relationships.

g0 +
("mammal","isA", "animal") +
("dog", "isA", "mammal") +
("dog", "isA", "pet") +
("dog", "hasA","tag") +
("cat", "isA", "pet") |> ignore

// Sundry experiments.

let h0 = g0.Find(None,(Some "isA"),(Some "pet"))
let h1 = g0.Find((Some "dog"),None,None)

g0 - ("cat","isA","pet") |> ignore

let h2 = g0.Find(None,(Some "isA"),(Some "pet"))

g0 + ("cat","isA","pet") |> ignore

let h3 = g0.Find(None,(Some "isA"),(Some "pet"))

let b0 = g0.Exists("cat","isA","pet")
let b1 = g0.Exists("tiger","isA","pet")

let find = g0.FindW ""

let h4 = find("dog","","")

if h4.IsSome then g0.Remove h4.Value

let h5 = find("dog","","")

printfn "All done!"

Tuesday, March 16, 2010

Latest Semantic Net Experiment

Here it is, the latest and most complex experiment. I'm not sure I'll keep going with this. So far, it does what I intended it to do, but the implementation is shaping up to be way more object-oriented and way less functional than I wanted. And since the whole point here is to learn F# (and especially its use in creating custom languages), I think I may try something else for a change. Perhaps a unification system?

As usual, presented as a learning exercise without warranty or implied fitness; use at your own risk. Also as usual, formatted for the blog window (I have a twin horror of code wrap and horizontal scrolling, lol.)

Main module (test code below):

module SemanticNet

open System.Collections.Generic


let internal findOrNew<'k,'v> (ff:'k->bool*'v)
(fn:unit->'v)
(fa:'k*'v->unit)
(k:'k) =
match ff k with
| (true,v) -> v
| (false,_) ->
let v = fn()
fa(k,v)
v


let internal findOrNewD<'k,'v> (d:Dictionary<'k,'v>)
(fn:unit->'v)
(k:'k) =
findOrNew d.TryGetValue fn d.Add k


let internal findOrNone<'k,'v> (ff:'k->bool*'v)
(k:'k) =
match ff k with
| (true,v) -> Some(v)
| _ -> None


let internal findOrNoneD<'k,'v> (d:Dictionary<'k,'v>)
(k:'k) =
findOrNone d.TryGetValue k



type Entity (graph:Graph, key:string) =
member this.Graph = graph
member this.Key = key



and Link (graph:Graph, key:string) =
inherit Entity(graph,key)



and LinksOut (nodeIn:Node, link:Link) =

let nodesOut = new Dictionary<string,Node>()

let newNodeOut nodeKey =
let nodeOut:Node = nodeIn.Graph.Node nodeKey
nodeOut.AddIn link.Key nodeIn
nodeOut

member this.Node (nodeOutKey:string) =
findOrNewD nodesOut
(fun()->(newNodeOut nodeOutKey))
nodeOutKey // Node

member this.Nodes (nodeOutKeys:string list) =
match nodeOutKeys with
| [] -> nodeIn.Graph
| h::t ->
this.Node h |> ignore
this.Nodes t

member this.TestWrite (p:string->unit) =
p (" "+link.Key+"\n")
for node in nodesOut.Values do
p (" "+node.Key+"\n")

static member (+) ((this:LinksOut),
(nodeKey:string)) =
(this.Node nodeKey).Graph

static member (+) ((this:LinksOut),
(nodeKeys:string list)) =
this.Nodes nodeKeys



and LinksIn (nodeOut:Node, link:Link) =

let nodesIn = new Dictionary<string,Node>()

member internal this.Node (nodeIn:Node) =
if not (nodesIn.ContainsKey nodeIn.Key) then
nodesIn.Add(nodeIn.Key,nodeIn)



and Node (graph:Graph, key:string) =
inherit Entity(graph,key)

let linksOut = new Dictionary<string,LinksOut>()
let linksIn = new Dictionary<string,LinksIn>()

member internal this.AddIn (linkInKey:string) (nodeIn:Node) =
((findOrNewD linksIn
(fun()->(graph.LinksIn this linkInKey))
linkInKey).Node nodeIn) |> ignore

member this.Link (linkOutKey:string) =
findOrNewD linksOut
(fun()->(graph.LinksOut this linkOutKey))
linkOutKey // Links

member this.Links ((linkOutKey:string),(nodeOutKeys:string list)) =
(findOrNewD linksOut
(fun()->(graph.LinksOut this linkOutKey))
linkOutKey).Nodes nodeOutKeys |> ignore
this // Node

member this.TestWrite (p:string->unit) =
p (key+"\n")
for links in linksOut.Values do
links.TestWrite p

static member (+) ((this:Node),
(linkOutKey:string)) =
this.Link linkOutKey

static member (+) ((this:Node),
(linkNodeOut:string*string list)) =
this.Links linkNodeOut



and Graph () =

let links = new Dictionary<string,Link>()
let nodes = new Dictionary<string,Node>()

member internal this.Link linkKey =
findOrNewD links
(fun()->Link(this,linkKey)) linkKey // Link

member internal this.LinksIn node linkKey =
LinksIn(node,(this.Link linkKey))

member internal this.LinksOut node linkKey =
LinksOut(node,(this.Link linkKey))

member this.Node nodeKey =
findOrNewD nodes
(fun()->Node(this,nodeKey))
nodeKey // Node

member this.TestWrite (p:string->unit) =
for node in nodes.Values do
node.TestWrite p

static member (+) ((this:Graph),(nodeKey:string)) =
this.Node nodeKey



Test code:

open System 
open SemanticNet


let g = Graph()

g+"dog"+
("isA",["canine";"man's best friend";"pet"])+
("hasA",["leash";"collar"]) |> ignore

g+"mammal"+"isA"+"animal" |> ignore
g+"canine"+"isA"+"mammal" |> ignore
g+"man's best friend"+"isA"+"dog" |> ignore

g.TestWrite (fun s->Console.Write(s))

Console.ReadLine() |> ignore

Friday, March 12, 2010

Data-Driven Semantic Network

Here's a super-simple version of a basic semantic network using only strings. There's not much it couldn't be extended to do. However, using only strings in this way is likely to be sub-optimal. For example, when we follow a link from one node to another, in order to go any further we have to do a second lookup, etc.

But I have to say I'm not as displeased with the look and feel of the string version as I had thought I would be, so I think this is the version I'll extend.

Standard disclaimers: as-is, no warranty or implied fitness, use at your own risk.
open System.Collections.Generic 


type Rel () =

let store =
new Dictionary<string,Dictionary<string,HashSet<string>>>()

member private this.TryAdd
((n0,l,n1):string*string*string) =
let d =
match store.TryGetValue n0 with
| (true,d0) -> d0
| (false,_) ->
let d0 = new Dictionary<string,HashSet<string>>()
store.Add(n0,d0)
d0
let h =
match d.TryGetValue l with
| (true,h0) -> h0
| (false,_) ->
let h0 = new HashSet<string>()
d.Add(l,h0)
h0
h.Add n1 |> ignore

static member (+=)
((r:Rel),((nln):string*string*string)) =
r.TryAdd nln
r


let r = Rel()

r += ("mammal","isA","animal") |> ignore
r += ("dog","isA","mammal") |> ignore
r += ("spot","isA","dog") += ("spot","isA","pet") |> ignore

Reified Semantic Network

Continuing on the path of using classic A.I. tutorial examples to teach myself F#, here is an example using semantic networks. So I created a system in which basic semantic nodes and links can be reified into object instances.

This approach has its pluses and minuses.

On the plus side, F# operator definition makes for a very clean, declarative semantic program. The fact that nodes and links have become instances also makes the code fairly straightforward and efficient.

On the minus side, extending the system at runtime would entail the use of reflection. Also, there is not simple repository for the entities that we can treat as a first class entity, meaning that things like reflection become more difficult and may entail reflection.

So, before going any further and adding things like search, I’ll present this version and then follow up with a version in which entities are represented as data. Then, I’ll pick one and move forward.

Standard disclaimer: presented without warranty or implied suitability of any kind, use at your own risk. And, as always, this is formatted for my narrow blog window, and I present it as a learning exercise, not necessarily either the best way to do F# or the best way to do A.I.
open System.Collections.Generic 


[<AbstractClass>]
type Entity (key:string) =

member this.Key = key



type Link (key:string) =
inherit Entity(key)



type Node (key:string) =
inherit Entity(key)

let links = new Dictionary<Link,HashSet<Node>>()
let props = new Dictionary<Node,HashSet<Node>>()

member private this.TryAdd<'a>
(d:Dictionary<'a,HashSet<Node>>) a =
match d.TryGetValue a with
| (false,_) ->
let h = new HashSet<Node>()
d.Add(a,h)
h
| (true,h) -> h

member private this.TrySub<'a>
(d:Dictionary<'a,HashSet<Node>>) a n =
match d.TryGetValue a with
| (false,_) -> false
| (true,h) ->
let rtn = h.Remove n
if (h.Count=0) then
h.Clear()
d.Remove(a) |> ignore
true

member private this.TryClear<'a>
(d:Dictionary<'a,HashSet<Node>>) a =
match d.TryGetValue a with
| (false,_) -> false
| (true,h) ->
h.Clear()
d.Remove(a) |> ignore
true

member private this.Add ((l,n):Link*Node) =
(this.TryAdd links l).Add n |> ignore
this

member private this.Add ((l:Link),(nl:Node list)) =
match nl with
| [] -> this
| h::t ->
(this.TryAdd links l).Add h |> ignore
this.Add(l,t)

member private this.Add ((n0,n1):Node*Node) =
(this.TryAdd props n0).Add n1 |> ignore
this

member private this.Sub ((l,n):Link*Node) =
this.TrySub links l n |> ignore
this

member private this.Sub ((n0,n1):Node*Node) =
this.TrySub props n0 n1 |> ignore
this

member private this.Sub (l:Link) =
this.TryClear links l |> ignore
this

member private this.Sub (n:Node) =
this.TryClear props n |> ignore
this

static member (+=) ((n:Node),(ln:Link*Node)) =
n.Add ln

static member (+=)
((n:Node),((l,nl):Link*(Node list))) =
n.Add(l,nl)

static member (+=) ((n:Node),(nn:Node*Node)) =
n.Add nn

static member (-=) ((n:Node),(ln:Link*Node)) =
n.Sub ln

static member (-=) ((n:Node),(nn:Node*Node)) =
n.Sub nn

static member (-=) ((n:Node),(l:Link)) =
n.Sub l

static member (-=) ((n0:Node),(n1:Node)) =
n0.Sub n1



let isA = Link "isA"
let hasA = Link "hasA"

let animal = Node "animal"
let canine = Node "dog"
let color = Node "color"
let gray = Node "gray"
let mammal = Node "mammal"
let name = Node "name"
let pet = Node "pet"
let spot = Node "spot"
let tail = Node "tail"
let wine = Node "wine"
let white = Node "white"
let wolfie = Node "wolfie"

white += (isA,[color;name;wine]) |> ignore

white -= (isA,name) -= (isA,wine) |> ignore

gray += (isA,color) |> ignore

mammal += (isA,animal) |> ignore

canine += (isA,mammal) += (hasA,tail) |> ignore

spot
+= (isA,canine)
+= (color,white)
+= (isA,pet) |> ignore

wolfie += (isA,canine) |> ignore
wolfie += (color,gray+=(isA,color)) |> ignore

Sunday, March 7, 2010

Here's Something Surprising

One of the most fun things about F# is the surprises it holds. For example, I learned that one can "banana clip" a function on input to another function. I'd like to say it was unexpected, but I learned about it by coming up with the idea and then trying it to see whether it would work. Still I was surprised that it did work. I don't really know of any good application for which this is "just right," but I'll keep looking.

Here's a minimal example using options, but it also works with parameterized patterns, etc.

let f (|A|_|) =
match None with
| A -> printfn "Some()"
| _ -> printfn "None"

f (fun _ -> None)
f (fun _ -> Some())



(Standard disclaimers, no warranties, etc.)

Friday, March 5, 2010

Next Step in the Tiny Expert System?

Here, just for fun, is the bare beginning of a tiny expert system using active patterns. I have no clue how it will progress from here.

(As always, standard disclaimers apply, use at your own risk, etc.)

open System  // For query ReadKey only.


/// <summary>Query helper.</summary>
let rec internal GetQuery q =
printf "%s (y/n) " q
let key = Console.ReadKey().KeyChar
printfn ""
match key with
| 'y' | 'Y' -> Some()
| 'n' | 'N' -> None
| _ -> GetQuery q

let black = lazy ( GetQuery ("Is it a black?") )
let orange = lazy ( GetQuery ("Is it a orange?") )
let white = lazy ( GetQuery ("Is it a white?") )

let (|Black|_|) _ = black.Value
let (|Orange|_|) _ = orange.Value
let (|White|_|) _ = white.Value

let x a =
match a with
| Black & Orange -> a+" is a tiger."
| Black & White -> a+" is a zebra."
| _ -> a+" is a sasquatch."

let y a =
match a with
| Black & Orange -> a+" is a tiger."
| Black & White -> a+" is a zebra."
| _ -> a+" is a sasquatch."


printfn "%s" (x "Rover")
printfn "%s" (y "Rover")

Console.ReadLine() |> ignore

Recap of Tiny Expert System

Before I move on, let me post a re-do of the the original lazy-evaluated style tiny expert system, incorporating all I've learned about F# over the last couple of weeks. I like this approach. It's a little less sophisticated than the object-oriented versions, but it embodies what I find attractive about F#: simple, direct code that looks like what it does.

(Again, standard disclaimers apply, use at your own risk, etc.)

type Query =
| Yes
| No
| Unknown


let Conjoin q0 q1 =
match q0 with
| Query.No -> Query.No
| Query.Yes -> q1
| _ -> match q1 with
| Query.No -> Query.No
| _ -> Query.Unknown


let Disjoin q0 q1 =
match q0 with
| Query.Yes -> Query.Yes
| Query.No -> q1
| _ -> match q1 with
| Query.Yes -> Query.Yes
| _ -> Query.Unknown


let Negate q0 =
match q0 with
| Query.Yes -> Query.No
| Query.No -> Query.Yes
| _ -> q0


let rec Junction (fc:Query->Query->Query)
(ft:Query->bool)
(lq:Lazy<Query> list) =
match lq with
| [] -> Query.Unknown
| h::[] -> h.Value
| h::t ->
match ft h.Value with
| true -> h.Value
| _ -> fc h.Value
(Junction fc ft t)


let rec Conjunction (lq:Lazy<Query> list) =
Junction Conjoin (fun h->h=Query.No) lq


let rec Disjunction (lq:Lazy<Query> list) =
Junction Disjoin (fun h->h=Query.Yes) lq


let rec All (lq:Lazy<Query> list) =
Junction Disjoin (fun h->false) lq


let rec Not (lq:Lazy<Query>) = lazy (
Negate lq.Value)


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


let black = lazy ( GetQuery "Is it black?" )
let orangeColor = lazy ( GetQuery "Is it orange?" )
let white = lazy ( GetQuery "Is it white?" )

let orange = lazy (
Disjunction [
orangeColor;
lazy ( GetQuery "Is it an orange?" )])

let blackAndWhite = lazy (
Conjunction [
black;
white])

let blackAndOrange = lazy (
Conjunction [
black;
orange])

let blackAndWhiteAndOrange = lazy (
Conjunction [
black;
white;
orange])

let blackAndWhiteOnly = lazy (
Conjunction [
blackAndWhite;
(Not orange)])

let blackAndOrangeOnly = lazy (
Conjunction [
blackAndOrange;
(Not white)])

let color = lazy (
All [
blackAndWhite;
blackAndOrange;
blackAndWhiteAndOrange;
blackAndWhiteOnly;
blackAndOrangeOnly])


color.Value |> ignore


Thursday, March 4, 2010

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

Monday, March 1, 2010

Here’s today’s installment. With this version, I am moving away from a declarative style in the code in favor of objects. This make it simpler to add things like intelligent ordering of proof tests, etc. I did manage to keep the case logic delcarative.

This simple beginning doesn’t yet add very much to previous versions. In fact, it's a temporary step back before hopefully moving forward again. I post it now in case the enhancements are delayed. A few of things that I should point out are:

1) This version adds the concept of proven certainty vs. estimated certainty. This will facilitate later enhancements using estimated results to order queries, etc.

2) I have temporarily removed the idea of short circuiting on anything less than the most extreme certainties (Impossible, Certain). This will be re-added later.

3) I have temporarily removed the ability to continue searching on a disjunction until the most certain hypothesis is proven; it now stops on the first hypothesis proven. This will be re-added later.

4) I added back the ability to query the user for a Boolean.

As always, there is no exhaustive quality control on this; use it at your own risk.

open System


///<summary>Query helper.</summary>
let internal GetBoolean q =
printf "%s " q
let key = Console.ReadKey().KeyChar
printfn ""
(key='y')||(key='t')|| (key='Y')||(key='T')


///<summary>Degree of certainty.</summary>
type Certainty =
| Impossible = 0
| Disproven = 1
| Unlikely = 2
| Possible = 3
| Likely = 4
| Proven = 5
| Certain = 6


///<summary>Minimum (Certainty).</summary>
let Min c0 c1 =
match (c0<c1) with
| true -> c0
| false -> c1


///<summary>Maximum (Certainty).</summary>
let Max c0 c1 =
match (c0>c1) with
| true -> c0
| false -> c1


///<summary>Nature of the proof.</summary>
type Proof =
| Estimated = 0
| Known = 1


///<summary>Evidence for an hypothesis.</summary>
type Evidence = {
Certainty : Certainty;
Proof : Proof; }


///<summary>Most certain evidence.</summary>
let MostCertain e0 e1 =
match (e0.Certainty>=e1.Certainty) with
| true -> e0
| false -> e1


///<summary>Returns the best of two evidences.</summary>
let Best e0 e1 =
match e0.Proof with
| Proof.Known ->
match e1.Proof with
| Proof.Known -> MostCertain e0 e1
| _ -> e0
| _ ->
match e1.Proof with
| Proof.Known -> e1
| _ -> MostCertain e0 e1


///<summary>Hypothesis base.</summary>
[<AbstractClass>]
type Hypothesis (name:string) =

let mutable evidence = {
Certainty=Certainty.Impossible;
Proof=Proof.Estimated }

member this.Name = name

member this.Evidence = evidence

member this.Certainty
with get() = evidence.Certainty
and set c = evidence <- { Certainty=c;
Proof=Proof.Known }

member this.Proof with get() = evidence.Proof

abstract Prove : unit->Evidence


///<summary>A constant fact.</summary>
type Fact (name:string,
certainty:Certainty) =
inherit Hypothesis (name)

do (base.Certainty<-certainty)

override this.Prove () = base.Evidence


///<summary>A boolean-queried fact.</summary>
type QueryBoolean (name:string,
query:string) =
inherit Hypothesis (name)

override this.Prove () =
match base.Evidence.Proof with
| Proof.Known -> base.Evidence
| _ ->
base.Certainty <-
match GetBoolean(query) with
| true -> Certainty.Certain
| false -> Certainty.Impossible
base.Evidence


///<summary>Compound hypothesis.</summary>
[<AbstractClass>]
type HypothesisCompound (name:string,
antecedents:Hypothesis list) =
inherit Hypothesis (name)


///<summary>Conjunctive hypothesis.</summary>
type Conjunction (name:string,
antecedents:Hypothesis list) =
inherit HypothesisCompound (name,
antecedents)

member private this.prove (l:Hypothesis list) =
match l with
| [] -> Certainty.Certain
| h::[] -> h.Prove().Certainty
| h::t ->
match h.Prove().Certainty with
| Certainty.Impossible -> Certainty.Impossible
| c -> Min c (this.prove(t))

override this.Prove () =
match base.Evidence.Proof with
| Proof.Known -> base.Evidence
| _ ->
base.Certainty <- this.prove antecedents
base.Evidence


///<summary>Disjunctive hypothesis.</summary>
type Disjunction (name:string,
antecedents:Hypothesis list) =
inherit HypothesisCompound (name,
antecedents)

member private this.prove (l:Hypothesis list) =
match l with
| [] -> Certainty.Certain
| h::[] -> h.Prove().Certainty
| h::t ->
match h.Prove().Certainty with
| Certainty.Certain -> Certainty.Certain
| c -> Max c (this.prove(t))

override this.Prove () =
match base.Evidence.Proof with
| Proof.Known -> base.Evidence
| _ ->
base.Certainty <- this.prove antecedents
base.Evidence


// Tests.

let f0 = Fact("f0", Certainty.Certain)
let f1 = Fact("f1", Certainty.Certain)
let f2 = Fact("f2", Certainty.Certain)

let q0 = QueryBoolean("q0", "Is it q0?")
let q1 = QueryBoolean("q1", "Is it q1?")
let q2 = QueryBoolean("q2", "Is it q2?")

let c0 = Conjunction("c0", [ f0; q0 ])
let c1 = Conjunction("c1", [ f1; q1 ])
let c2 = Conjunction("c2", [ f2; q2 ])

let c01 = Conjunction("c01", [ c0; c1 ])

let d0 = Disjunction("d0", [ c01; c2 ])

let x0 = d0.Prove()

printfn "%s %s"
(x0.Certainty.ToString())
(x0.Proof.ToString())

Console.ReadLine() |> ignore

Saturday, February 27, 2010

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.

Friday, February 26, 2010

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

Monday, October 5, 2009

Here's a first cut at another Halloween poem. I reserve the right to revise it.

Their Woods

There in the dark
Everything seemed older than me
My uncle, my cousins, the woods
But especially the woods

After a day of fishing at the creek
We gathered on the road to the barn
At the place by the henhouse
Where it forked and went down
To the pond in the woods

A small expedition
Launched at night
To carry the bait trap
Down to the pond
Where the crawdads
Would keep fresh

I didn’t want them to go without me
I was worried they might come back changed
Bonded in some way I could not know
Or caught and replaced by monsters
And I would never know

But I was scared
And the white circle of light
From the hissing gas lantern
Seemed too small and fragile
To keep back the woods and the dark

Or perhaps I was afraid
That they might change
Down there in the woods
And I would not

So I stayed behind
And I’ll never know
What the pond was like
In the woods that night
And whether they changed

Thursday, October 1, 2009

For a Departed Swimming Pool

The man we hired to fill the old pool
Got the backhoe through the fence, but
To get his dump truck into the yard
Had to uproot a burning bush
Which proved to have a nest of bumble bees
In its roots

And now they swarm there
Awaiting Diaspora from the from the only home
They’ve ever known
A world of shade and green
Become a wasteland of mud and straw

Milling about not enraged but hapless
Longing for the promised land
Waiting for their Moses
To lead them across the dirt filled pool
Away from pharaoh and his backhoe

But until they depart
We must go quietly
And put on our shoes
As though crossing holy ground

Tuesday, September 29, 2009

Here's a Halloween poem, a bit early.

The Dark Orchard

I used to live in a old house
Perhaps sixty or seventy years old
From the 1910’s or 1920’s
And it had an orchard

Almost as old and gone to seed
Almost as long
Grown up with low limbs
And brush, and small trees
The ground was spongy with
Rotting apples
Smelling of
Rotting Cider
Full of the sound of
Wasps

There was a hostility about the place
As though, having been abandoned by Man
Man was no longer welcome

And the trees seemed to watch
And to whisper among themselves
As though waiting
For some Man to go there alone
In the dark
Or in a storm

To the point where
I worried for the deer
That browsed there at night
That the trees might sense them
And decide to get in
A bit of practice

Monday, September 28, 2009

I've been studying to have my poetic license renewed, so I will post a series of poems. The first has two versions, because I can't decide which I like the best. The first version has a quality like transliterated haiku, which I like, but the second version flows better:

Embrace

I saw a glove
Stomped into the parking lot
Of an old warehouse

The fingers spread like wings
At first I thought
It was a bird

It grasped the asphalt
To its palm
The way a dead bird
Clutches the earth
To its breast


(Alternate Version)

I saw a glove
Stomped into the parking lot
Of an old warehouse

At first I thought
It was a bird

The fingers spread like wings
And grasped the asphalt
To its palm

The way a dead bird
Clutches the earth
To its breast

Monday, July 6, 2009

Pause

Code to follow soon. In this meantime, this copied from a letter to a friend:

The hamburgers on the fourth were good, but the fireworks were somewhat rained out. Small loss, though, since various neighbors let off fireworks all summer long every year, and there's still a lot of summer left.

This morning I am mourning the loss of five ripening green peppers, which met an untimely end last night at the paws of a raccoon. He ate most of two fancy Italian peppers, but only picked and scattered the three common green peppers (presumably they were beneath his taste). The miscreant in question is well-known in the neighborhood; he cruises through periodically like a biker hoodlum in a 1950’s film, wreaking all sorts of havoc with the innocent townsfolk. To this point, however, he has largely confined his attention to chewing and scattering small plastic objects, etc., and has left the plants alone.

It’s an interesting comment on the universe that one of the first acts of incipient intelligence in the animal kingdom is apparently the desire to pull Halloween-style pranks characteristic of a small-town hood. I’m not certain it bodes well. Perhaps not, but perhaps so, since not a few delinquents do go on to become productive, upstanding members of the community. In any case, as in so many things in the universe, we see the large mirrored in the small, the universal in the particular.

So I am able to recover some of the loss of increase of my garden by reflecting on the idea that I have exchanged five peppers for a good story. Was it worth it? Well, I think I would rather have traded one pepper for not quite as good a story. But life is about extracting meaning from events, and not the converse (which is art).

I hope in the meantime, however, that raccoon doesn't get his hands on fireworks...

-Neil

Tuesday, June 30, 2009

Enumerators for Dependency Injection

A situation came up where I needed to select elements based on dependency injection. The elements were portions of a larger bitmap that were being used as tiles in a 2D graphics engine. Selection might be sequential, random, fixed, etc., but needed to be hidden from downstream processes. In particular, I needed to inject not the enumerators themselves, but enumerator factories.

At first I was going to use a custom interface. After some thought, however, I decided that the .NET IEnumerator<> interface fit the bill nicely. Technically an enumeration is some kind of ordered or unordered sequence from a collection. But a randomized sequence fits that bill, and it’s not too much of stretch to think of an infinitely looping sequence as an enumerator. (For example, think of the original collection as specifying the set of allowable items of an infinite sequence.)

So I came up the following helper functions:
static IEnumerator<TOutput> MakeEnumerator <TInput,TOutput,TState> (
TInput inputIn,
TState stateIn,
Func<TInput,TState,TState> funcMoveNext,
Func<TInput,TState,bool> funcMovedNextOk,
Func<TInput,TState,TOutput> funcCurrent)
{
while (true)
{
stateIn = funcMoveNext(inputIn,stateIn);

if (!funcMovedNextOk (inputIn,stateIn))
break;

yield return funcCurrent(inputIn,stateIn);
}
}


static Func<TInput,IEnumerator<TOutput>> MakeEnumeratorFunc <TInput,TOutput,TState> (
TState stateIn,
Func<TInput,TState,TState> funcMoveNext,
Func<TInput,TState,bool> funcMovedNextOk,
Func<TInput,TState,TOutput> funcCurrent)
{
return
(i)=> (
MakeEnumerator(
i,
stateIn,
funcMoveNext,
funcMovedNextOk,
funcCurrent));
}

The first helper is a generic enumerator builder that takes three functions and a state which control the enumeration. The functions transition from state to state, determine whether a transition has exhausted the enumerator, and select an enumerated item. (I separated the move next functionality and inverted its typical order because it makes things a lot more convenient.)

The second helper uses this first helper to build an enumerator factory function.

Below shows how this could be used to build an enumerator factory for canonical list enumeration. (You wouldn’t want to use these functions for this in a typical scenario; the traditional way would suffice there. They are mainly useful in dependency injection situations.)

Func<List<int>,IEnumerator<int>> xMakeEnumeratorFunc =
MakeEnumeratorFunc<List<int>,int,int>(
-1,
(i,s)=>(s+1),
(i,s)=>(s<i.Count),
(i,s)=>(i[s]));

List<int> xList = new List<int>() { 1, 3, 5, 7 };

IEnumerator<int> xEnumerator = xMakeEnumeratorFunc(xList);

// Inject xEnumerator here.

Fun, func, function!

(Tomorrow: I find a situation where a tradition boolean MoveNext is superior and post the overloaded functions.)

-Neil

Thursday, June 11, 2009

Enumerating Bits

OK, so the enumerating the set of subsets of non-zero bits is not a common task. But what about enumerating the set of non-zero bits in an integer? That’s something that tends to happen at least one or twice in any large project. Here’s how that can be done use a related function.

Given an integer (i), the least significant non-zero bit (b) can be found using this equation:

b = (i & -i)

(This is discussed as equation (37) in Donald Knuth’s The Art of Computer Programming, Volume 4, pre-fascicle 1A, page 8.)

It is easy to turn this into a loop which enumerates the bits in an integer:
while (xInteger>0)
{
int xBit = (xInteger & -xInteger);
xInteger &= ~xBit;
// Do something with xBit here.
}

(This is probably a case where one wouldn’t want to use a generic “yield return” enumerator, since if one is working at this level of detail, efficiency is probably the main concern.)

This can also be made to work in C# with unsigned integers by using various types of casting. But if efficiency is paramount, pay attention to the generated MSIL, since casting at some points generates more efficient code than does casting at other points.

Tests in release mode show that this construct is nearly four times faster in C# (.NET 3.5 version) than is shifting! But it looks arcane at first glance, so be sure to document the code well.

Tuesday, June 9, 2009

Power Set of a Bitmask

Here’s a cute trick for enumerating the power set of an integer bitmask. It’s based on equation (84) in Donald Knuth’s The Art of Computer Programming, Volume 4, pre-fascicle 1A, page 18, available in an "alpha test" version at:

http://www-cs-faculty.stanford.edu/~knuth/taocp.html

The idea is that, given a subset (x) of a mask (M) the next largest lexicographic subset (x') is:

x’ = (x – M) & M

Combined with the C# "yield return" statement, this allows a simple enumeration of the power set of a mask. You simply seed the subset with zero, and iterate until it is once again zero.

public static IEnumerable<int> PowerSet (
int maskIn)
{
int xSet = 0;

do
{
yield return xSet;
xSet = (xSet - maskIn) & maskIn;
}
while (xSet!=0);
}

For example, calling PowerSet(0x19) returns an enumerator which yields (in binary):

00000
00001
01000
01001
10000
10001
11000
11001


I can’t think of a specific use for it right off hand, but if a project uses enough bit manipulation, I’m sure something would arise.

Code Generator Oddity

The following is a exerpted example of my implementation of a well-known permutation algorithm. Note the code generation oddity flagged by the comment. This occurs in .NET 3.5 and Visual C# 2008. I leave the solution to the mystery to readers who like to disassemble and read MSIL, and think about what the JIT compiler may do to it.

protected static void Permute <TDatum> (
int beginIn,
int endIn,
TDatum[] dataIn,
Action<TDatum[]> dataActionIn)
where TDatum : IComparable
{
TDatum xDatumBegin;

if ((endIn-beginIn)<=1)
{
dataActionIn(dataIn);
}
else
{
Permute(
beginIn+1,
endIn,
dataIn,
dataActionIn);

for (int i=beginIn+1; i<endIn; i++)
{
xDatumBegin = dataIn[beginIn];

dataIn[beginIn] = dataIn[i];
dataIn[i] = xDatumBegin;

Permute(
beginIn+1,
endIn,
dataIn,
dataActionIn);

// Believe it or not, the compiler/loader
// will optimize the first block below
// to be almost 10% faster than the second.

#if thisIsFasterInDotNet
xDatumBegin = dataIn[beginIn];
dataIn[beginIn] = dataIn[i];
dataIn[i] = xDatumBegin;
#else
dataIn[i] = dataIn[beginIn];
dataIn[beginIn] = xDatumBegin;
#endif
}
}
}

Sunday, May 24, 2009

Zen Dream

Here’s something I once posted in a newsgroup.

Last night, I was practicing with some water-colors and I painted a series of concentric black and white circles, kind of like an archery target. Later, while I was asleep, I dreamt I was in a store. I saw that there were bows and arrows for sale, and I realized I had a consuming desire to practice archery. I picked out a bow, but I couldn’t find any arrows. Then I realized that they were haphazardly scattered about the floor, intermixed with long-handled paintbrushes. The arrows were missing feathers, and then other difficulties began to intervene, until I despaired of ever putting to together a decent archery set.

Then I woke up and realized I wasn’t interested in archery at all; I wanted to paint.

I had intended to end this story with the Zen saying "The skilled archer does not aim for the center of the target,” but I wanted to look it up in Yahoo to see if I could find the original reference. The first Yahoo hit I found was a newsgroup thread where I had quoted it earlier without reference. And if that's not some kind of koan, I don't know what is.

Monday, April 27, 2009

LINQ

It would not take even a Dr. Watson to notice that this blog has been idle for over a year. It might, however, take a Sherlock Holmes to discern the reason why. So I will sum it up with a word:

LINQ

Shortly after the last post, I began playing around with the new version of Microsoft Visual Studio, which included LINQ and all the new lambda programming goodies. I realized they made obsolete many of the issues I had discussed in the previous entry.

Concurrently, I decided to port a professional expert system engine I wrote and maintain to the new version of Visual Studio. It was written mainly in C++, with .NET interface code in C#. As I went along, I found myself thinking: “Perhaps I should just re-write the whole engine from scratch, using the newest C# technology.”

And so I did. And interspersed with other projects, etc., it took the better part of nine months to complete the engine, and another couple of months to work out the kinks and get it hooked up to the external components (UI, etc.). It was a lot of fun, but it did interfere with my blogging, to say the least.

In retrospect, it was a good decision. I learned the new lambda elements of C# in a way that would have been tough using a less whole-hearted approach. I also learned possibly more than I ever wanted to know about C# generics, lol. I want to share some of the things I discovered in subsequent posts in this blog, but for now I’ll just share what I consider the most important discovery:

Every programmer, it seems, hates exception handling, and I am no exception. So, when I started the re-write, I decided that I would, for once in my exception handling life, be good and pay attention to it from the ground up. So I started my re-write by crafting a set of classes to let me handle and pass exceptions and returns. They were not intended to replace the existing .NET exception handling, but rather to work hand in glove with it. Also, I began a discipline of handing errors and exceptions fully and correctly in the code at the exact moment I was writing the code. No more “I’ll save error handling for a rainy day.” It took a few weeks, but it stuck; it’s now a habit and I don’t fear error handling any longer.

Best programming discovery I ever made.

Thursday, March 20, 2008

Hierarchical vs. Relational

Some Thoughts About Hierarchical vs. Relational Representation
Part 1 – Rationale

As a rule of thumb, I like to design things so that each instance has three possible representations: in-memory object, hierarchical (e.g. XML), and relational. This tends to work out well because these are the three media of exchange in most computer architecture. Thus, in-memory for quick manipulation, hierarchical for static storage and communication via remoting or clipboard, and relational for dynamic storage.

This tends to work seamlessly except in one particular area: referenced objects (i.e. indexed objects in relational systems). Which is unfortunate, because referenced objects are a key paradigm in most computer languages and are the backbone of relational databases. This problem of coordinating referenced objects comes up in virtually every large program or code library, from e-commerce databases, to 3D graphics systems, to spreadsheets, etc.

I’ve tried several generic solutions to this problem. Most worked, but most became unwieldy as the code grew and special cases were considered. Because of this, I’ve decided to accept the fact that generic solutions here are difficult, and decided that instead, hope lies in the design patterns approach.

So, over the course of the next few blog entries, I will be presenting a series of design patterns aimed at tackling this problem. I don’t presume to think that any of these techniques are novel. The point is to arrange a series of rules-of-thumb and ad-hoc solutions into a more coherent set of design patterns.

-Neil

Saturday, January 12, 2008

Pine Board is Flawed

The pine board I was planning on using to make my first goban turned out to be irredeemably flawed on the bottom side. So I guess it’s back the attic floor with that one, and I’ll start with trying to make a goban from cherry! Maybe the value of the wood will drive me to do a good job, lol.

Wednesday, January 9, 2008

Opening Game Study


One thing I’ve noticed in my play against SmartGo is that my closed moyo tend to develop too early. So, although I securely capture some area, I allow SmartGo to capture large segments of the remaining board and so I get crushed.

My game is too “chunky” and lacks the “integrated” look one sees in most games.

At first I wondered whether this was because of the computer style of play vs. a human style of play; was I learning bad habits? However, I decided it must be because I was not fully developing the opening game before proceeding to closed moyo.

To that end (or beginning, lol), I bought “In the Beginning” by Ikuro Ishigure. I have to say that with just one day of reading, it has solved a lot of the problems I was having with the opening. The example here, though riddled with mistakes and lacking good joseki, does show more of an integrated pattern. And, though I got stomped in mid game, I did do significantly better through the opening game than I have been (based on computer analysis of the game).

-Neil

p.s. And I retrieved the pine board for goban number 1 from the attic flooring (yes, I did replace it with other boards, lol). I still need to mark it for size and decide on how to cut it for minimal warping.