;
; recognizer.scm -- pattern recognition
;
; Pattern recognition is dual to pattern matching!
; AKA the "dynamic Rete algorithm".
;
; When designing a rule engine, one is (eventually) faced with the task
; of determining which rules can be applied at some given point of the
; calculations. One can blindly try all of the rules, and see which
; ones fire. When there are more than a few dozen rules, this becomes
; impractical. This issue was observed, and resolved in the 1970's and
; 1980's, with the Rete algorithm: one organizes the set of rules into
; a Trie, which is then very easily and quickly walked, to determine
; which ones can fire.
;
; OpenCog and the AtomSpace do NOT (explicitly) implement Tries or Rete!
; However, the general (hyper-)graph structure of OpenCog Atoms already
; contains enough connectivity information to accomplish more or less
; the same thing: a kind-of "dynamic Rete", where rule-sets can be
; searched for, on-demand, at runtime.
;
; The core idea is that pattern recognition is dual to pattern matching.
; If we define "pattern matching" as the idea of finding all data that
; matches a pattern, then "pattern recognition" is the act of finding
; all patterns that match the data. In pattern matching, where a
; pattern has variables in it, one finds all groundings (concrete values
; for the variables) that cause the pattern expression to evaluate to
; "true". In pattern recognition, one has a single "grounding", and asks
; for all pattern expressions that evaluate to "true" when applied to
; this grounding.
;
; The Atomese construct for accomplishing this is the DualLink. It is
; roughly the opposite of the MeetLink, "opposite" in the cat-theory
; sense of reversing arrows. Its "rough", in that the type constraints
; that are possible in MeetLink are ignored by the DualLink.
;
; The example below is based on an AIML-like search, simply because
; this is easy to explain and demonstrate. Note that all AIML chatbots
; maintain a Trie of AIML rules, and so AIML is a "natural" example of
; pattern recognition. The Atomese DualLink is, however, a general
; pattern recognizer: it can be used in a general setting, not just
; for AIML-like structures.
;
; ---------------------------------------------------------------------
;
(use-modules (srfi srfi-1))
(use-modules (opencog))
; Two different pseudo-AIML rules:
; I * you --> I * you too
; I love * --> I like * a lot!
;
(QueryLink
(ListLink
(Concept "I") (Glob "$star") (Concept "you"))
(ListLink
(Concept "I") (Glob "$star") (Concept "you") (Concept "too")))
(QueryLink
(ListLink
(Concept "I")
(Concept "love")
(Glob "$star"))
(ListLink
(Concept "I")
(Concept "like")
(Glob "$star")
(Concept "a")
(Concept "lot!")))
; ---------------------------------------------------------------------
;; A pretend "sentence" that is the "input".
(define sent
(ListLink (Concept "I") (Concept "love") (Concept "you")))
;; Search for patterns that match the sentence. Both of the above
;; should match.
(cog-execute! (DualLink sent))
;; The above should return the below. Note how fragments of the above
;; QueryLink's are matched.
(SetLink
(ListLink
(Concept "I")
(Glob "$star")
(Concept "you")
)
(ListLink
(Concept "I")
(Concept "love")
(Glob "$star")
)
)
; ---------------------------------------------------------------------
;; Another sentence, but with adverbs. It will match one of the
;; patterns, but not the other.
(define adv-sent
(ListLink
(Concept "I")
(Concept "really")
(Concept "truly")
(Concept "love")
(Concept "you")))
;; Perform the search.
(cog-execute! (DualLink adv-sent))
; ---------------------------------------------------------------------
; At this point, one will typically want to know the full rule to which
; the dual is just a fragment of. That is, the DualLink just returns
; the antecedent of a rule, not the rule itself; one wants the full rule,
; so that it can be applied.
;
; This can be done in several ways: one could write pure scheme code
; (or C++ or python) to trace the incoming set of the antecedent and
; find every rule its embedded in. This isn't hard to do: just use the
; `cog-chase-link` utility. Alternately, one can write the entire
; thing in pure Atomese. This second option is explored below. There's
; no particularly strong reason to do it this way. It will seem a bit
; complicated, and will be slower than a pure-scheme solution. But its
; illustrative of what one can do with Atomese, so we do that here.
;
; To work up to the final, working example, several simpler expressions
; are constructed first.
; ------------------
(define (get-consequents ANTECEDENT)
"
get-consequents ANTECEDENT -- given the ANTECEDENT, return a set of
all of the consequents of a rule.
Example usage:
(get-consequents (List (Concept \"I\") (Glob \"$star\") (Concept \"you\")))
"
; Accept only consequents that are ListLink's
(cog-execute!
(MeetLink
(TypedVariable (Variable "$consequent") (Type "ListLink"))
(Quote (QueryLink ANTECEDENT (Unquote (Variable "$consequent"))))
)
)
)
; Try it!
; (get-consequents (List (Concept "I") (Glob "$star") (Concept "you")))
; ------------------
; The below takes the above MeetLink, and uses it to generate values
; that are then installed in place by a FilterLink. That is, the FilterLink
; re-assembles the rule from the antecedent and the consequent.
(define (get-rules-for-ante ANTECEDENT)
"
get-rules-for-ante ANTECEDENT -- given the ANTECEDENT, return a set
of all rules that can be applied to it.
Example usage:
(get-rules-for-ante (List (Concept \"I\") (Glob \"$star\") (Concept \"you\")))
"
; The MeetLink below returns all of the consequents.
; The TypedVariable filters out and rejects all consequents that
; are not ListLinks.
; The FilterLink reconstructs the rule, out of the antecedent and
; the consequent.
; The Quotes are used to avoid accidentally running the QueryLink
; that is being assembled.
(cog-execute!
(Filter
(Rule
(TypedVariable (Variable "$list") (Type "ListLink"))
(Variable "$list")
(Quote (Query ANTECEDENT (Unquote (Variable "$list")))))
(Meet
(Variable "$consequent")
(Quote (QueryLink ANTECEDENT (Unquote (Variable "$consequent")))))
))
)
; Try it!
; (get-rules-for-ante (List (Concept "I") (Glob "$star") (Concept "you")))
; ------------------
; The below takes the above rule generator, and turns it into a
; bona-fide rule recognizer. It does this by running the DualLink to
; find the antecedents, and then using a FilterLink to plug these into
; the rule generator.
(define (get-untyped-rules DATA)
"
get-untyped-rules DATA -- given the graph DATA, return a set of all
rules that can be applied to it.
Example usage:
(get-untyped-rules (List (Concept \"I\") (Concept \"love\") (Concept \"you\")))
"
(cog-execute!
(Filter
(Rule
(TypedVariable (Variable "$ante") (Type "ListLink"))
(Variable "$ante")
(Filter
(Rule
(TypedVariable (Variable "$list") (Type "ListLink"))
(Variable "$list")
(Quote (QueryLink
(Unquote (Variable "$ante"))
(Unquote (Variable "$list"))
)))
(MeetLink
(Variable "$consequent")
(Quote (QueryLink
(Unquote (Variable "$ante"))
(Unquote (Variable "$consequent"))))
)))
(Dual DATA)))
)
; Try it!
; (get-untyped-rules (List (Concept "I") (Concept "love") (Concept "you")))
; ---------------------------------------------------------------------
; To complete the example, one typically needs to run the rules after
; finding them. We do this below, in an ad-hoc fashion. The primary
; impediment is that each rule is wrapped with a SetLink, and needs to be
; unwrapped. You can see this wrapping in the "Try it!" result, above.
;
; ruleset is the unwrapped rules. Use cog-value->list to unwrap them.
(define (unwrap-rules RULES)
(fold
(lambda (s li) (cons (car (cog-value->list s)) li))
'()
(cog-value->list RULES)))
(define ruleset
(unwrap-rules
(get-untyped-rules (List (Concept "I") (Concept "love") (Concept "you")))))
(map cog-execute! ruleset)
; When the above code is executed, you will get back a bunch of
; sentences: that's because the AtomSpace already contains a bunch of
; sentences in it, and the rule-set will find ALL of them, and get
; applied to all of them. To avoid this behavior, you need to tag
; the one sentence you are interested in in some way, e.g. by using
; a link to connect it to `(AnchorNode "the current sentence")` and
; then including the AnchorNode in each AIML rule.
;
;-------------------------------------------------------
; A pattern with two globs in it.
; The types of the globs are constrained, because, if not constrained,
; the globs can sometimes pick up on parts of the various patterns
; created above. We really want them to only pick up on the "sentences"
; (strings of Concepts).
(define a-love-b
(QueryLink
(VariableList
(TypedVariable (Glob "$A") (Type "ConceptNode"))
(TypedVariable (Glob "$B") (Type "ConceptNode")))
(ListLink
(Glob "$A")
(Concept "loves")
(Glob "$B"))
(ListLink
(Concept "I'm")
(Concept "sure")
(Concept "that")
(Glob "$A")
(Concept "loves")
(Glob "$B"))))
(define mary-n-joe
(List (Concept "Mary") (Concept "loves") (Concept "Joe")))
; Try it! Not much different, here:
(cog-execute! (Dual mary-n-joe))
; Because this rule includes a variable typing section, the above above
; (naively-constructed) mechanisms will choke: the typing restrictions
; cause a mis-match. Thus, we repeat the above tools, this time, with
; a typing section.
; ------------------
; The below is just like `get-consequents` above, but for typed rules.
; Utility, from which the other parts are made. Similar to
; `get-consequents`, above, except that the `cog-execute!` step
; is skipped. So, this only defines a MeetLink.
(define (pattern-getter ANTECEDENT)
(MeetLink
(VariableList
(TypedVariable (Variable "$vardecl")
(TypeChoice ; three different kinds of typedecls are possible.
(Type "VariableNode")
(Type "TypedVariableLink")
(Type "VariableList")))
(TypedVariable (Variable "$consequent") (Type "ListLink")))
(Quote (QueryLink
(Unquote (Variable "$vardecl"))
ANTECEDENT
(Unquote (Variable "$consequent"))))
)
)
(define (get-conseq-typed ANTECEDENT)
"
get-conseq-typed ANTECEDENT -- given the ANTECEDENT, return a set of
all of the consequents of a rule.
Example usage:
(get-conseq-typed (List (Glob \"$A\") (Concept \"loves\") (Glob \"$B\")))
"
(cog-execute! (pattern-getter ANTECEDENT))
)
; Try it!
; (get-conseq-typed (List (Glob "$A") (Concept "loves") (Glob "$B")))
; ------------------
; The below is just like `get-rules-for-ante`, except that its for typed rules.
(define (rule-getter ANTECEDENT)
; The MeetLink returns all of the vardecls and consequents.
; The TypedVariable filters out and rejects all consequents that
; are not ListLinks.
; The FilterLink reconstructs the rule, out of the antecedent and
; the consequent.
; The Quotes are used to avoid accidentally running the QueryLink
; that is being assembled.
(Filter
(Rule
(VariableList
(Variable "$decls")
(Variable "$sequent"))
(List (Variable "$decls") (Variable "$sequent"))
(Quote (Query
(Unquote (Variable "$decls"))
ANTECEDENT
(Unquote (Variable "$sequent")))))
(pattern-getter ANTECEDENT))
)
(define (get-typed-rules-for-ante ANTECEDENT)
"
get-typed-rules-for-ante ANTECEDENT -- given the ANTECEDENT, return a set
of all rules (with type declarations in them) that can be applied to it.
Example usage:
(get-typed-rules-for-ante (List (Glob \"$A\") (Concept \"loves\") (Glob \"$B\")))
"
(cog-execute! (rule-getter ANTECEDENT))
)
; Try it!
; (get-typed-rules-for-ante (List (Glob "$A") (Concept "loves") (Glob "$B")))
; ---------------------------------------------------------------------
; The below is just like `get-untyped-rules` above, except its for
; typed rules.
(define (rule-recognizer DATA)
(Filter
(Rule
(TypedVariable (Variable "$ante") (Type "ListLink"))
(Variable "$ante")
(rule-getter (Unquote (Variable "$ante"))))
(Dual DATA))
)
(define (get-typed-rules DATA)
"
get-typed-rules DATA -- given the graph DATA, return a set of all
rules that (that have type declarations) that can be applied to it.
Example usage:
(get-typed-rules (List (Concept \"I\") (Concept \"love\") (Concept \"you\")))
"
(cog-execute! (rule-recognizer DATA))
)
; Try it!
; (get-typed-rules (List (Concept "Mary") (Concept "loves") (Concept "Joe")))
;
; Just as before, unwrap the rules from the multiple nested SetLinks
; that get wedged in. Finally, execute the resulting rules!
(define ruleset
(unwrap-rules
(get-typed-rules (List (Concept "Mary") (Concept "loves") (Concept "Joe")))))
; Try it! Ta-DAHHH!
(map cog-execute! ruleset)
; At last, we get the expected response:
(SetLink
(ListLink
(ConceptNode "I'm")
(ConceptNode "sure")
(ConceptNode "that")
(ConceptNode "Mary")
(ConceptNode "loves")
(ConceptNode "Joe")))
; ---------------------------------------------------------------------
; And now ... some simple, cheap, cheesy glue to implement a simple
; AIML-like system. To actually use this, copy this file, and edit it
; to remove the example sentences (they'll pollute the output) and add
; more rules, in the format similar to the above. Make sure that the
; rules are typed; this is using the typed variant of the above
; examples.
; Give a string sentence SENT, generate a rule-driven reply.
; Example: (aiml-reply "Anne loves Richard")
(define (aiml-reply SENT)
; Split a string into words.
; Example: (split-sentence "I love you")
(define (split-sentence SENT)
(ListLink
(map (lambda (word) (Concept word)) (string-split SENT #\ ))))
; Get the result of applying rules.
; Example: (get-aiml-response "I love you")
(define (get-aiml-response SENT)
(define ruleset
(unwrap-rules (get-typed-rules (split-sentence SENT))))
(map cog-execute! ruleset)
)
; Convert a ListLink of Nodes into a scheme list of strings
; Add a padding blank to the end.
(define (atoms-to-strings NODELIST)
(fold-right
(lambda (s li) (cons (string-append (cog-name s) " ") li))
'()
(cog-value->list NODELIST)))
; Concatenate a list of strings into one string.
(define (make-sent NODELIST)
(string-concatenate (atoms-to-strings NODELIST)))
; Create a list of reply sentences.
; Example: (make-reply "I love you")
(define (make-reply SENT)
(map make-sent
(cog-value->list (car (get-aiml-response SENT)))))
; Now, actually do stuff. Push and pop the AtomSpace, to avoid
; polluting it with sentences. The push and pop here is a hack;
; a more elegant solution is to use anchors to point at the
; current sentence, and have the rules look for it there.
(define reply "")
(begin
(cog-push-atomspace)
(set! reply (make-reply SENT))
(cog-pop-atomspace)
reply)
)
; ---------------------------------------------------------------------
*unspecified*