;;; File	proj/recognise/recognise.soar
;;; Started	1.4.93
;;; Version	5.4.93

;;; A general-purpose operator to generate a recognition chunk for an
;;; arbitrary Soar object.  It should be happy even with non-tree
;;; (i.e. converging and circular) structures, but see the Notes below.

;;; In order to help explore the space of possible designs, and indeed
;;; to show that such a space exists, this deliberately explores a
;;; different region of the design space than Joe Mertz's:
;;;	* This one is non-destructive (rather than destructive)
;;;	* It yields "flat", non-impassing recognition chunks
;;;	* It uses a counting technique to avoid partial recognition
;;;	* The recognition is hierarchical, but it handles the hierarchy
;;;		by elaborations rather than by impasses.

;;; The interface to the code is as follows:
;;; There is an operator named Assimilate, with an ^object attribute
;;; which is the object to be recognised.  The operator will acquire
;;; a ^symbol attribute, which is the recognition symbol.  As soon as
;;; the operator has the ^symbol, it is reconsidered, and the
;;; symbol can be picked up and used by the calling program.

;;; Here is an example call.  Just load the following rules in with
;;; the code and run it:
#|
(sp example*recognise
  (goal <g> ^name top-goal)
  -->
  (<o> ^name recognise ^object <x>)
  (<x> ^hi <hello> ^hot <dog>)
	(<hello> ^bam boo + boo &, foo + foo &, ^african violet ^food <f>)
		(<f> ^fish chips)
	(<dog> ^cool cat ^more <stuff>)
		(<stuff> ^yet again)
  (<g> ^operator <o>))

(sp example*done
  (goal ^name top-goal ^operator <o>)
  (<o> ^name recognise ^symbol <sym>)
  -->
  (write (crlf) |The recognition symbol is | <sym>)
  (halt))
|#

;;; The basic method is this:
;;;	1. If the object is a constant, return it as its own symbol.
;;;   Otherwise
;;;	2. Mark the object on the state as a node-to-be-recognised
;;;	3. For each such node, all identifiers in the top level of the
;;;		node are also marked as nodes-to-be-recognised, and as
;;;		dependents of the node
;;;	4. Count the number of Attribute-Value pairs in each node
;;;	5. At this point, recognition chunks fire.
;;;	6. If there isn't already a recognition chunk for the object,
;;;	   we impasse into the Recognise space:
;;;		6.1  For each node which does not yet have a symbol ...
;;;		6.2  Serially scan its Attributes and Values
;;;		6.3  Check that any dependents have their symbols
;;;		6.4  When the node is scanned, generate a new symbol for it
;;;	7. Once there is a symbol for the object, mark it on the operator.
;;;	8. Clean up: remove all the nodes from the state.

;;; The code below is organised according to this sketch of the algorithm
;;; and keyed to the step numbers.

;;; The algorithm is highly parallel.  For recognition, it propagates
;;; a wave of activity *down* the levels of the structure, followed by
;;; a wave of recognition-rule firings back *up* the structure.  When
;;; building chunks for a new object, there can be cross-firing and
;;; interdependence between the parallel streams.

;;; The algorithm is unusual in that, e.g. for recognising a new
;;; object, it handles a hierarchical structure (i.e. the object)
;;; within a single impasse. So learning bottom-up versus all-goals
;;; makes no difference.


;;; NOTES

;;; 1. On rule operator*recognise*dependent-as-node, the "not already
;;;    there" test is needed to prevent infinite loops with circular
;;;    structures.  It will not prevent multiple copies of a node at
;;;    the same level in the structure, but that does not matter.

;;; 2. With non-tree structures, there are some subtleties as to exactly
;;;    what constitutes the "same" structure for recognition purposes.
;;;    (Cf. EQ versus EQUAL in Lisp.)  I believe this to be the case: A
;;;    recognition chunk built for an object containing isomorphic (but not
;;;    identical) sub-structure at the top level of the object or some
;;;    sub-object will recognise the same object with identical
;;;    sub-structure, but not vice-versa.


;;; --- The RECOGNISE operator ---

;;; Terminate the operator once it has its ^symbol

(sp operator*recognise*terminate
  (goal <g> ^operator <o>)
  (<o> ^name recognise ^symbol)
  -->
  (<g> ^operator <o> @))


;;; Step 1. If the object is a constant, return it as its own symbol

(sp operator*recognise*constant
  :o-support
  (goal <g> ^operator <o>)
  (<o> ^name recognise ^object <x> -^object <=> <o>)
  -->
  (<o> ^symbol <x>))


;;; Step 2. Mark the object on the state as a node-to-be-recognised

(sp operator*recognise*object-as-node
  :o-support
  (goal <g> ^state <s> ^operator <o>)
  (<o> ^name recognise ^object <x> ^object <=> <o>)
  -->
  (<n> ^structure <x>)
  (<s> ^recognition-node <n> + <n> &)
  (<o> ^own-node <n>))


;;; Step 3. For each such node, all identifiers in the top level of the
;;;		node are also marked as nodes-to-be-recognised, and as
;;;		dependents of the node
;;;	provided they are not already there (see Notes above)

(sp operator*recognise*dependent-as-node
  (goal <g> ^state <s> ^operator.name recognise)
  (<s> ^recognition-node <n>)
  (<n> ^structure <w>)
  (<w> ^<att> {<val> <=> <s>})
 -{(<s>  ^recognition-node <xn>)
   (<xn> ^structure <val>)}
  -->
  (<nn> ^structure <val>)
  (<s> ^recognition-node <nn> + <nn> &))

(sp operator*recognise*dependent-as-dependent
  (goal <g> ^state <s> ^operator.name recognise)
  (<s> ^recognition-node <n>)
  (<n> ^structure <w>)
  (<w> ^<att> {<val> <=> <s>})
  (<s>  ^recognition-node <nn>)
  (<nn> ^structure <val>)
  -->
  (<n> ^dependent <nn> + <nn> &))


;;; Step 4. Count the number of Attribute-Value pairs in each node

(sp operator*recognise*count*initial-count
  (goal <g> ^state.recognition-node <n> ^operator.name recognise)
  (<n> -^count)
  -->
  (<n> ^count 0))			;(thank you, Bob D.)

(sp operator*recognise*count*all-avs
  (goal <g> ^state.recognition-node <n> ^operator.name recognise)
  (<n> ^structure <w>)
  (<w> ^<att> <val>)
  -->
  (<av> ^<att> <val>)
  (<n> ^a-v <av> + <av> =))

(sp operator*recognise*count*done
  (goal <g> ^state.recognition-node <n> ^operator.name recognise)
  -->
  (<n> ^a-v done + done <))

(sp operator*recognise*count*each-av
  (goal <g> ^state.recognition-node <n> ^operator.name recognise)
  (<n> ^count <c> ^a-v <av>)
  (<av> ^<att> <val>)
  -->
  (<n> ^a-v <av> - ^count <c> - (+ 1 <c>) +))


;;; Step 5. At this point, recognition chunks fire.

;;; Step 6. If there isn't already a recognition chunk for the object,
;;;		we impasse into the Recognise space, see below.

;;; Step 7. Once there is a symbol for the object, mark it on the operator

(sp operator*recognise*pickup-symbol
  (goal <g> ^state.recognition-node <n> ^operator <o>)
  (<o> ^name recognise ^own-node <n>)
  (<n> ^symbol <sym>)
  -->
  (<o> ^symbol <sym> ^own-node <n> -))


;;; Step 8. Clean up: remove all the nodes from the state

(sp operator*recognise*delete-node
  (goal <g> ^state <s> ^operator <o>)
  (<s> ^recognition-node <n>)
  (<o> ^name recognise ^symbol)
  -->
  (<s> ^recognition-node <n> -))


;;; --- The RECOGNISE implementation space ---

;;; Step 6 (cont). In the op-implementation subgoal:

;;; Initialise the subgoal with space, state and operator

(sp recognise*initialise
  (goal <g> ^impasse no-change ^attribute operator ^object <sg>)
  (<sg> ^state <ss> ^operator <so>)
  (<so> ^name recognise)
  -->
  (<p> ^name recognise)
  (<s> ^superstate <ss>)
  (<o> ^name build)
  (<g> ^problem-space <p> ^state <s> ^operator <o>))


;;; Step 6.1  For each node which does not yet have a symbol ...

(sp recognise*propose-scan-all
  (goal <g> ^problem-space.name recognise ^state <s> ^operator.name build)
  (<s> ^superstate.recognition-node <n>)
  -->
  (<nn> ^recognition-node <n> ^bead <b>)
  (<s> ^node <nn> + <nn> &))

(sp recognise*propose-scan-ok
  (goal <g> ^problem-space.name recognise ^state <s> ^operator.name build)
  (<s> ^node <nn>)
  -->
  (<nn> ^ok yes))

(sp recognise*propose-scan-duplicate
  (goal <g> ^problem-space.name recognise ^state <s> ^operator.name build)
  (<s> ^node <nn>)
  (<nn> ^recognition-node <n>)
  (<n> ^symbol <sym>)
  -->
  (<nn> ^duplicate yes))


;;; Step 6.2  Serially scan its Attributes and Values

(sp recognise*scan*all-a-v
  (goal <g> ^problem-space.name recognise ^state <s> ^operator.name build)
  (<s> ^node <nn>)
  (<nn> ^recognition-node.structure <w> ^ok yes -^duplicate yes)
  (<w> ^<att> <val>)
  -->
  (<ch> ^<att> <val>)
  (<nn> ^check <ch> + <ch> =))

(sp recognise*scan*default-done
  (goal <g> ^problem-space.name recognise ^state <s> ^operator.name build)
  (<s> ^node <nn>)
  (<nn> ^ok yes -^duplicate yes)
  -->
  (<nn> ^check done + done <))

#|
*** In some cases, the process will run a little faster if A-Vs with ***
*** V a constant, or if/when V is an identifier but has its symbol,  ***
*** are checked before the others.  Could add code to prefer these.  ***
|#


;;; Step 6.3  Check that any dependents have their symbols

(sp recognise*scan*check*constant
  (goal <g> ^problem-space.name recognise ^state <s> ^operator.name build)
  (<s> ^node <nn>)
  (<nn> ^check <ch> ^bead <b1>)
  (<ch> ^<att> <val> -^<att> <=> <s>)
  -->
  (<nn> ^bead <b1> - <b2> + ^check <ch> -))

(sp recognise*scan*check*identifier
  (goal <g> ^problem-space.name recognise ^state <s> ^operator.name build)
  (<s> ^node <nn>)
  (<nn> ^check <ch> ^bead <b1>)
  (<ch> ^<att> {<val> <=> <s>})
  (<nn> ^recognition-node.dependent <dep>)
  (<dep> ^structure <val> ^symbol <sym>)
  -->
  (<nn> ^bead <b1> - <b2> + ^check <ch> -))


;;; Step 6.4  When the node is scanned, generate a new symbol for it

(sp recognise*scan*done
  (goal <g> ^problem-space.name recognise ^state <s> ^operator.name build)
  (<s> ^node <nn>)
  (<nn> ^check done ^bead <b> ^recognition-node <n>)
  -->
  (<s> ^new-symbol-for <n> + <n> =))


;;; The actual assignment of the new symbol needs to be done serially,
;;; and with great care over timing.  The assignment of the symbol
;;; yields a recognition chunk which may fire immediately.  The chunk
;;; should not clash with any new symbol generated by this code.

(sp recognise*new-symbol*ok
  (goal <g> ^problem-space.name recognise ^state <s>)
  (<s> ^new-symbol-for <n>)
  -->
  (<s> ^new-symbol-ok <n>))

(sp recognise*new-symbol*duplicate
  (goal <g> ^problem-space.name recognise ^state <s>)
  (<s> ^new-symbol-for <n>)
  (<n> ^symbol)
  -->
  (<s> ^new-symbol-duplicate <n>))

(sp recognise*new-symbol*generate
  (goal <g> ^problem-space.name recognise ^state <s> ^operator.name build)
  (<s> ^new-symbol-for <n> ^new-symbol-ok <n> -^new-symbol-duplicate <n>)
  (<n> ^count <c> ^a-v done)
  -->
  (<n> ^symbol (make-constant-symbol recog-)))

(sp recognise*new-symbol*done
  (goal <g> ^problem-space.name recognise ^state <s> ^operator.name build)
  (<s> ^new-symbol-for <n>)
  (<n> ^symbol <sym>)
  -->
  (<s> ^new-symbol-for <n> -))