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!"