### Program  analogy.soar
### Started  5 Aug 93
### Version  18 Nov 94, based on analogy.soar v. 1 Nov 94 -- original by rmy
### NB:      nnpscm version  -- conversion by John Rieman
### Version  5 Dec 94, some concessions to improving the trace in NNPSCM -- rmy
###   Soar 7 ...
### Version  19 Jan 96, picked up Soar 7 demo from distribution, minor
###   corrections -- rmy

### Program to do simple 'deliberate analogy' for figuring out how to launch
### a program on the Mac, given that one or two specific ones are known.

### This version developed specifically for the purposes of the one-day
### Soar tutorial given by Frank Ritter and Richard Young.  A set of
### Macintosh files containing OHP slides together with exercises and
### other handouts (either describing just this program, else covering
### the whole one-day tutorial) can be obtained by contacting
###	ritter@psychology.nottingham.ac.uk

### Note that I have used state-elaboration rules instead of operators in many
### places, probably to a far greater extent than is justified in terms of
### cognitive modelling, but it shortens the program and perhaps makes its
### behaviour easier to follow.

### Correspondingly, there are several highly specific monitoring rules 
### present, which we would not normally expect to see in this kind of
### program.

### ======================================================================
### DECLARATIONS, INITIALISATIONS, ETC.
### ======================================================================

### This format is specifically for monitoring the Imagine-Task space

# syntax won't work in nnpscm -jr
#trace-format -object -add p perform "%id (perform%ifdef[ %v[type] %v[alias]])"

### All right, so for NNPSCM we do the following, which is intended
### for watch 0 format, might be a little weird in anything else:

format-watch -stack -add s {%right[6,%dc]: %rsd[   ]==>S: %cs
        %rsd[   ]}

sp {monitor*problem-space*nnpscm
  (state <s> ^problem-space (<p> ^name <n>))
  -->
  (write |   P: | <p> | (| <n> |)|)}

sp {monitor*problem-space*imagine-task
  (state <s> ^problem-space <p>)
  (<p> ^type imaginary ^alias imagine-task)
  -->
  (write | type = imaginary  alias = imagine-task|)}


### Ask what program to launch

sp {preamble*ask-program-to-launch
  (state <g> ^name perform)
  (<g> ^task <t>)
	(<t> ^feature <f2>)
	(<f2> ^fname arg1)
  -->
  (write (crlf) |What program to launch? [cg,word,draw,xl] |)
  (<f2> ^fvalue (accept))}


### ======================================================================
### PERFORM SPACE
### ======================================================================

### -- Initialisation --

sp {perform*initialise*gps
  (state <g> ^superstate nil)
  -->
  (<p> ^name perform)
  (<g> ^name perform ^problem-space <p>)}

sp {perform*initialise*state
  (state <g> ^name perform)
  -->
  (<g> ^task <t>)
	(<t> ^feature <f1> + <f1> &, <f2> + <f2> &)
	(<f1> ^fname effect ^fvalue launch)
	(<f2> ^fname arg1)}


### -- Termination --

### Kludgy-detect when a program has been successfully launched

sp {perform*task*terminate
  (state <g> ^problem-space.name perform)
  (<g> ^task <t>)
	(<t> ^feature <f1> <f2>)
	(<f1> ^fname effect ^fvalue launch)
	(<f2> ^fname arg1   ^fvalue <prog>)
  (<g> ^simulation <sim>)
  (<sim> ^status running ^object <prog>)
  -->
  (write (crlf) |** Yeah, the program is running!|)
  (halt)}


### -- Performing actions --

### If there's ever an Action attribute on the state, then perform the
### action.

### Issues about how to know when an action has been completed,
### what happens if there is more than one action proposed, and so on,
### are beyond the scope of this demonstation program (and hopefully will
### not arise).

### Propose a perform operator

sp {perform*perform*propose
  (state <g> ^problem-space.name perform)
  (<g> ^action <a>)
  -->
  (<o> ^name perform ^action <a>)
  (<g> ^operator <o>)}


### Performing the double-click action

sp {perform*perform*double-click*perform
  (state <g> ^problem-space.name perform ^operator <o>)
  (<o> ^name perform ^action <a>)
  (<a> ^movement double-click ^object <obj>)
  -->
  (<g> ^motor <m>)
  (<m> ^movement double-click ^object <obj>)
  (write (crlf) |** User double-clicks on object | <obj>)}


### -- Kludgy simulation of Mac launching programs --

### The following rule would be more elegant if it knew what objects
### were 'isa' program

sp {perform*simulate*launch*program
  (state <g> ^problem-space.name perform ^operator.name <oname>)
  (<g> ^motor <m>)
  (<m> ^movement double-click ^object <obj> ^object << CG Word Draw XL >>)
  -->
  (<g> ^simulation <sim>)
  (<sim> ^status running ^object <obj>)
  (write (crlf) |** Mac now has program | <obj> | running|)}


### -- Just for testing --

### Just for testing, the following hand-written chunk proposes the action
### of double-clicking on a program to be launched.  Commented out.

#
#sp {perform*task*action*double-click-to-launch
#  (state <g> ^problem-space.name perform)
#  (<g> ^task <t>)
#	(<t> ^feature <f1> <f2>)
#	(<f1> ^fname effect ^fvalue launch)
#	(<f2> ^fname arg1   ^fvalue <prog>)
#  -->
#  (<g> ^action <a>)
#  (<a> ^movement double-click ^object <prog>)}
#

### Monitor ^task and ^action on the state

sp {perform*monitor*state*task
  (state <g> ^problem-space.name perform)
  (<g> ^task <t>)
	(<t> ^feature <f1> {<> <f1> <f2>})
	(<f1> ^fname effect ^fvalue <effect>)
	(<f2> ^fname arg1   ^fvalue <prog>)
  -->
  (write (crlf) |State has ^task: effect=| <effect> | arg1=| <prog>)}

sp {perform*monitor*state*action
  (state <g> ^problem-space.name perform)
  (<g> ^action <a>)
	(<a> ^movement <move> ^object <obj>)
  -->
  (write (crlf) |State has ^action: | <move> | | <obj>)}


### ======================================================================
### ACTION-PROPOSAL SPACE
### ======================================================================

### This is where we drop down to when no action is proposed in the Perform
### space for a given task.  The impasse shows up as a State-No-Change.

### -- Initialise --

### Check that there's a task but no action  ... Oh no!!  That's going to
### give rise to self-undermining chunks.  For now, check just that there's
### a task, we'll assume no action.

sp {action-proposal*initialise
  (state <g> ^superstate <sg> ^impasse no-change ^attribute state)
  (<sg> ^problem-space.name perform)
  (<sg> ^task <t>)
  -->
  (<g> ^problem-space <p>)
  (<p> ^name action-proposal)}


### -- Assumed knowledge --

### Here we hand-code the assumed knowledge about how to launch Word or Draw
### by double-clicking.  When used, this will give rise to specific chunks
### back in the Perform space.

### If the task is to launch Word or Draw, then propose an action to
### double-click.

sp {action-proposal*double-click-to-launch
  (state <g> ^problem-space.name action-proposal ^superstate <sg>)
  (<sg> ^task <t>)
	(<t> ^feature <f1> <f2>)
	(<f1> ^fname effect ^fvalue launch)
	(<f2> ^fname arg1   ^fvalue <prog> ^fvalue << Word Draw >>)
  -->
  (<sg> ^action <a>)
  (<a> ^movement double-click ^object <prog>)}


### -- Use analogy --

### The only "method" we have is to try using analogy.  We'll do this by
### proposing the use-analogy operator, which will implement in its own space.

sp {action-proposal*use-analogy*propose
  (state <g> ^problem-space.name action-proposal)
  -->
  (<o> ^name use-analogy)
  (<g> ^operator <o>)}


### ======================================================================
### USE-ANALOGY SPACE
### ======================================================================

### This space arise from an Operator No-Change below the Use-analogy
### operator.  The logic embodied in this space is as follows:
###
### (1) If the task involves some Effect on some Object Y
### (2) where the Object is of a known Class
### (3) and we can recall other members X of that Class
### (4) then we imagine the task of achieving that Effect on object X
### (5) we replace X by a *general descriptor* of Y
### (6) and return that as the recommended action.


### -- Initialise --

sp {use-analogy*initialise
  (state <g> ^superstate <sg> ^impasse no-change ^attribute operator)
  (<sg> ^operator.name use-analogy ^superstate <sss>)
  -->
  (<g> ^problem-space <p>)
  (<p> ^name use-analogy)
  (<g> ^task-state <sss>)}


### -- The method --

### Recognise the applicability of the method (= step 1)

sp {use-analogy*analogy-1*recognise
  (state <g> ^problem-space.name use-analogy)
  (<g> ^task-state.task <t>)
	(<t> ^feature <f1> <f2>)
	(<f1> ^fname effect ^fvalue <effect>)
	(<f2> ^fname arg1   ^fvalue <obj>)
  -->
  (<g> ^analogy-method analogy-1)}


### Attempt to recall other members of the same object class (= (2) & (3)).
### Note that this part is being handled very crudely.  Since we don't have
### a justified representation of categorial knowledge, we're simply going
### to map directly from program -> Word and Draw.

### I ought properly to be doing this with operators (for recall, etc.),
### but since this part is all monotonic and elaborative, I'm using plain
### old elaborations.

### Get the class of the object (= step 2)  (NB specialised for CG or XL)
### NB Notice how the first two clauses in this and subsequent rules are
###	separated off, to give a standard beginning saying "Hey! We're
###	applying the analogy-1 method".

sp {use-analogy*analogy-1*get-object-class*CG-XL
  (state <g> ^problem-space.name use-analogy)
  (<g> ^analogy-method analogy-1)
  (<g> ^task-state.task <t>)
	(<t> ^feature <f2>)
	(<f2> ^fname arg1   ^fvalue << CG XL >>)
  -->
  (<g> ^object-class program)}


### Recall other members of that class [program] (= step 3)

sp {use-analogy*analogy-1*recall-members*program
  (state <g> ^problem-space.name use-analogy)
  (<g> ^analogy-method analogy-1)
  (<g> ^object-class program)
  -->
  (<g> ^class-member Word + Word =, Draw + Draw =, XL + XL =)}
				# Note that the items are made indifferent


### -- Imagining the task -- (= step 4)

### Now the fun starts.  For a given ^class-member, we imagine the task
### which is the given task applied to the class-member.  We do this via
### an operator, because it is going to be important to do the actual
### imagining in a subgoal which closely resembles the top context.

sp {use-analogy*analogy-1*imagine-task*propose
  (state <g> ^problem-space.name use-analogy)
  (<g> ^analogy-method analogy-1)
  (<g> ^object-class <class> ^class-member <member> -^imagined-action)
  (<g> ^task-state.task <t>)
	(<t> ^feature <f1>)
	(<f1> ^fname effect ^fvalue <effect>)
  -->
  (<o> ^name imagine-task ^task <imag-t>)
	(<imag-t> ^feature <f1> + <f1> &, <if2> + <if2> &)
	(<if2> ^fname arg1 ^fvalue <member>)
  (<g> ^operator <o>)}

### Monitor the imagine-task operator

sp {use-analogy*imagine-task*monitor
  (state <g> ^problem-space.name use-analogy ^operator <o>)
  (<o> ^name imagine-task ^task <imag-t>)
	(<imag-t> ^feature <f1> <f2>)
	(<f1> ^fname effect ^fvalue <effect>)
	(<f2> ^fname arg1 ^fvalue <member>)
  -->
  (write | [| <effect> | | <member> |]|)}


### The imagine-task operator is of course implemented in its own space
### (see below).  When it "returns" it will *either* have an ^action marked
### on it, or else a ^fail.  We terminate the operator in either case, with
### appropriate responses:

### For a ^fail, reject the class-member and terminate the operator

sp {use-analogy*analogy-1*imagine-task*fail*reject-member
  (state <g> ^problem-space.name use-analogy ^operator <o>)
  (<g> ^analogy-method analogy-1)
  (<o> ^name imagine-task ^task <imag-t> ^fail)
 	(<imag-t> ^feature <if2>)
 	(<if2> ^fname arg1 ^fvalue <member>)
  (<g> ^class-member <member>)
  -->
  (<g> ^class-member <member> -)}

sp {use-analogy*analogy-1*imagine-task*fail*terminate
  (state <g> ^problem-space.name use-analogy ^operator <o>)
  (<g> ^analogy-method analogy-1)
  (<o> ^name imagine-task ^fail)
  -->
  (<g> ^operator <o> @)}


### For an ^action, copy it onto the state and terminate the operator

sp {use-analogy*analogy-1*imagine-task*action*terminate
  (state <g> ^problem-space.name use-analogy ^operator <o>)
  (<g> ^analogy-method analogy-1)
  (<o> ^name imagine-task ^action <a>)
  -->
  (<g> ^imagined-action <a>)
  (<g> ^operator <o> @)}


### -- Making the substitution -- (step 5)

### We now have an ^imagined-action on the state.  We turn this into a
### ^analogised-action by substituting Y for X everywhere it occurs.  It's
### a bit ad-hoc, but we'll do this by means of a second-level copy:

### First, set up a blank analogised-action

sp {use-analogy*analogy-1*substitute*analogised-action
  (state <g> ^problem-space.name use-analogy)
  (<g> ^analogy-method analogy-1)
  (<g> ^imagined-action <a>)
  -->
  (<g> ^analogised-action <aa>)}


### Then for each attribute, if the value is different to the ^class-member
### then simply copy it, but if it's the same then substitute the original
### object

sp {use-analogy*analogy-1*substitute*copy
  (state <g> ^problem-space.name use-analogy)
  (<g> ^analogy-method analogy-1)
  (<g> ^imagined-action <a> ^analogised-action <aa> ^class-member <member>)
  (<a> ^<attr> {<val> <> <member>})
  -->
  (<aa> ^<attr> <val>)}

sp {use-analogy*analogy-1*substitute*substitute
  (state <g> ^problem-space.name use-analogy)
  (<g> ^analogy-method analogy-1)
  (<g> ^imagined-action <a> ^analogised-action <aa> ^class-member <member>)
  (<a> ^<attr> <member>)
  (<g> ^task-state.task <t>)
	(<t> ^feature <f2>)
	(<f2> ^fname arg1 ^fvalue <obj>)
  -->
  (<aa> ^<attr> <obj>)}


### -- Finally, return the analogised-action to the super-state -- (step 6)

### These rules acknowledge that there is a problem with the timing
### of chunking if we return the action before it is fully built.

sp {use-analogy*analogy-1*recommend-analogised-action*ready
  (state <g> ^problem-space.name use-analogy)
  (<g> ^analogy-method analogy-1)
  (<g> ^analogised-action <aa>)
  (<aa> ^<attr> <val>)
  -->
  (<g> ^recommend ready)}

sp {use-analogy*analogy-1*recommend-analogised-action*recommend
  (state <g> ^problem-space.name use-analogy)
  (<g> ^analogy-method analogy-1)
  (<g> ^task-state <ts> ^analogised-action <aa> ^recommend ready)
  -->
  (<ts> ^action <aa>)}


### Now some monitoring rules to follow the progress of the analogy method

sp {use-analogy*analogy-1*monitor*state*simple-attribute
  (state <g> ^problem-space.name use-analogy)
  (<g> ^{<attr> << analogy-method object-class class-member >> } <val>)
  -->
  (write (crlf) |Use-analogy state has | <attr> | = | <val>)}

sp {use-analogy*analogy-1*monitor*state*action
  (state <g> ^problem-space.name use-analogy)
  (<g> ^{<action> << imagined-action analogised-action >> } <a>)
  (<a> ^movement <move> ^object <obj>)
  -->
  (write (crlf) |Use-analogy state has | <action> |: | <move> | | <obj>)}


### ======================================================================
### IMAGINE-TASK SPACE
### ======================================================================

### The implementation space for the imagine-task operator, which is of
### course triggered by the Operator No-Change, is made to look in crucial
### respects much like the top, Perform space, so that any immediate
### knowledge we have about doing the task can apply (in imagination).


### -- Initialise --

sp {imagine-task*initialise
  (state <g> ^superstate <sg> ^impasse no-change ^attribute operator)
  (<sg> ^operator (<so> ^name imagine-task))
  -->
  (<g> ^problem-space <p>)
  (<p> ^name perform ^type imaginary ^alias imagine-task)
  (<g> ^superoperator <so>)}


### Copy the task onto the state

sp {imagine-task*initialise*state
  (state <g> ^problem-space.alias imagine-task)
  (<g> ^superoperator.task <t>)
  -->
  (<g> ^task <t>)}


### -- Imagine doing the task --

### At this point, any knowledge about how to do the task will apply. 
### If we succeed, an ^action will appear on the state, so we simply copy
### it onto the operator as a way of returning the result.

sp {imagine-task*return*action
  (state <g> ^problem-space.alias imagine-task)
  (<g> ^action <a> ^superoperator <so>)
  -->
  (<so> ^action <a>)}


### ======================================================================
### IMAGINE-TASK-FAIL SPACE
### ======================================================================


### If we *fail* to imagine doing the task, then we will impasse out of
### the Imagine-Task space, through the Action-Proposal space, and into
### what would be a recursive call on Use-Analogy.  We need to catch that
### and mark a ^fail on the (super-super-) superoperator.

### It's a fine point as to whether or not the failure should be chunked.
### For now we don't, probably more interesting not to.

### It would be cleaner Soar practice to set up an initial problem space and
### and state, at least, before passing back the ^fail.  But this is the only
### think we ever do in this space, and what the heck, let's keep it simple!

sp {imagine-task-fail*mark-fail
  (state <g> ^superstate <sg> ^impasse no-change ^attribute operator 
             ^quiescence t)
  (<sg> ^operator.name use-analogy ^superstate <ssg>)
  (<ssg> ^problem-space.alias imagine-task ^superoperator <ssso>)
  -->
  (<ssso> ^fail fail)}

sp {imagine-task-fail*monitor
  (state <g> ^superstate <sg> ^impasse no-change ^attribute operator)
  (<sg> ^operator.name use-analogy ^superstate <ssg>)
  (<ssg> ^problem-space.alias imagine-task)
  -->
  (write (crlf) |Fail: we don't know how to do the imagined task|)}

### ======================================================================
### EOF
### ======================================================================