### 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
### Converted to Soar 7 by unknown hand
### Some minor cleaning up, RMY 3 Mar 96
### Some minor cleaning up and move to 7.0.4, 2-Nov-96 -FER

### 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.

### Note that this program does NOT want the default rules loaded.

### 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@psyc.nott.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.
### ======================================================================

source soar-menu.tcl

## For safty, excise -all
excise -all

## this makes chunk firings print
watch -chunks -print
## default is not to print chunks as learned!
watch learning -print

## this will always take the first choice
indifferent-selection -first

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

### 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

## the non TK version
if {[info commands tk]==""} {
sp {preamble*ask-program-to-launch
  (state <s> ^name perform)
  (<s> ^task <t>)
	(<t> ^feature <f2>)
	(<f2> ^fname arg1)
  -->
  (write (crlf) |What program to launch? [cg, word, draw, xl] |)
  (<f2> ^fvalue (accept))}
}

## the tk version
if {[info commands tk]!=""} {
sp {preamble*ask-big-hand-pos
  (state <s> ^name perform)
  (<s> ^task <t>)
	(<t> ^feature <f2>)
	(<f2> ^fname arg1)
  -->
  (write (crlf) |Where is the big hand? |)
  (<f2> ^fvalue 
       (tcl |soar-menu "Where is the big hand?" {1 2 3 4 5 6 7 8 9 10 11 12}|))}
}

if {[info commands tk]!=""} {
sp {preamble*ask-little-hand-pos
  (state <s> ^name perform)
  (<s> ^task <t>)
	(<t> ^feature <f2>)
	(<f2> ^fname arg2)
  -->
  (write (crlf) |Where is the little hand? |)
  (<f2> ^fvalue 
       (tcl |soar-menu "Where is the little hand?" {1 2 3 4 5 6 7 8 9 10 11 12}|))}
}

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

### -- Initialisation --

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

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


### -- 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 <s> ^problem-space.name perform)
  (<s> ^action <a>)
  -->
  (<o> ^name perform ^action <a>)
  (<s> ^operator <o>)}


### Performing the double-click action

sp {perform*perform*read-big*perform
  (state <s> ^problem-space.name perform ^operator <o>)
  (<o> ^name perform ^action <a>)
  (<a> ^movement read ^object <obj>)
  -->
  (<s> ^motor <m>)
  (<m> ^movement read ^object <obj>)
  (write (crlf) |** User reads the | <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*read*big-hand
  (state <s> ^problem-space <ps> ^operator.name <oname>)
  (<ps> ^name perform) 
  (<s> ^motor <m>)
  (<m> ^movement read ^object <obj> ^object << |1| |2| |3| |4| |5| |6| |7| |8| |9| |10| |11| |12| >>)
  -->
  (<s> ^simulation <sim>)
  (<sim> ^status running ^object <obj>)
  (write (crlf) |** User knows the hour is | <obj> | on the clock|)
  (<ps> ^name perform - little-hand +)}


### -- 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 <s> ^problem-space.name perform)
#  (<s> ^task <t>)
#	(<t> ^feature <f1> <f2>)
#	(<f1> ^fname effect ^fvalue launch)
#	(<f2> ^fname arg1   ^fvalue <prog>)
#  -->
#  (<s> ^action <a>)
#  (<a> ^movement double-click ^object <prog>)}
#

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

sp {perform*monitor*state*task
  (state <s> ^problem-space.name perform)
  (<s> ^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 <s> ^problem-space.name perform)
  (<s> ^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 <s> ^superstate <ss> ^impasse no-change ^attribute state)
  (<ss> ^problem-space.name perform)
  (<ss> ^task <t>)
  -->
  (<s> ^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*read-big-hand
  (state <s> ^problem-space.name action-proposal ^superstate <ss>)
  (<ss> ^task <t>)
	(<t> ^feature <f1> <f2>)
	(<f1> ^fname effect ^fvalue time)
	(<f2> ^fname arg1   ^fvalue <number> ^fvalue |1| )
  -->
  (<ss> ^action <a>)
  (<a> ^movement read ^object <number>)}


### -- 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 <s> ^problem-space.name action-proposal)
  -->
  (<o> ^name use-analogy)
  (<s> ^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 <s> ^superstate <ss> ^impasse no-change ^attribute operator)
  (<ss> ^operator.name use-analogy ^superstate <sss>)
  -->
  (<s> ^problem-space <p>)
  (<p> ^name use-analogy)
  (<s> ^task-state <sss>)}


### -- The method --

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

sp {use-analogy*analogy-1*recognise
  (state <s> ^problem-space.name use-analogy)
  (<s> ^task-state.task <t>)
	(<t> ^feature <f1> <f2>)
	(<f1> ^fname effect ^fvalue <effect>)
	(<f2> ^fname arg1   ^fvalue <obj>)
  -->
  (<s> ^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 <s> ^problem-space.name use-analogy)
  (<s> ^analogy-method analogy-1)
  ;
  (<s> ^task-state.task <t>)
	(<t> ^feature <f2>)
	(<f2> ^fname arg1   ^fvalue << |2| |3| |4| |5| |6| |7| |8| |9| |10| |11| |12| >>)
  -->
  (<s> ^object-class program)}


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

sp {use-analogy*analogy-1*recall-members*program
  (state <s> ^problem-space.name use-analogy)
  (<s> ^analogy-method analogy-1)
  ;
  (<s> ^object-class program)
  -->
  (<s> ^class-member |1| + |1| =, |2| + |2| =, |3| + |3| =, |4| + |4| =, |5| + |5| =, |6| + |6| =, |7| + |7| =, |8| + |8| =, |9| + |9| =, |10| + |10| =, |11| + |11| =, |12| + |12| =)}
				# 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 <s> ^problem-space.name use-analogy)
  (<s> ^analogy-method analogy-1)
  ;
  (<s> ^object-class <class> ^class-member <member> -^imagined-action)
  (<s> ^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>)
  (<s> ^operator <o>)}

### Monitor the imagine-task operator

sp {use-analogy*imagine-task*monitor
  (state <s> ^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 <s> ^problem-space.name use-analogy ^operator <o>)
  (<s> ^analogy-method analogy-1)
  ;
  (<o> ^name imagine-task ^task <imag-t> ^fail)
 	(<imag-t> ^feature <if2>)
 	(<if2> ^fname arg1 ^fvalue <member>)
  (<s> ^class-member <member>)
  -->
  (<s> ^class-member <member> -)}

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


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

sp {use-analogy*analogy-1*imagine-task*action*terminate
  (state <s> ^problem-space.name use-analogy ^operator <o>)
  (<s> ^analogy-method analogy-1)
  ;
  (<o> ^name imagine-task ^action <a>)
  -->
  (<s> ^imagined-action <a>)
  (<s> ^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 <s> ^problem-space.name use-analogy)
  (<s> ^analogy-method analogy-1)
  ;
  (<s> ^imagined-action <a>)
  -->
  (<s> ^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 <s> ^problem-space.name use-analogy)
  (<s> ^analogy-method analogy-1)
  ;
  (<s> ^imagined-action <a> ^analogised-action <aa> ^class-member <member>)
  (<a> ^<attr> {<val> <> <member>})
  -->
  (<aa> ^<attr> <val>)}

sp {use-analogy*analogy-1*substitute*substitute
  (state <s> ^problem-space.name use-analogy)
  (<s> ^analogy-method analogy-1)
  ;
  (<s> ^imagined-action <a> ^analogised-action <aa> ^class-member <member>)
  (<a> ^<attr> <member>)
  ;
  (<s> ^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 <s> ^problem-space.name use-analogy)
  (<s> ^analogy-method analogy-1)
  ;
  (<s> ^analogised-action <aa>)
  (<aa> ^<attr> <val>)
  -->
  (<s> ^recommend ready)}

sp {use-analogy*analogy-1*recommend-analogised-action*recommend
  (state <s> ^problem-space.name use-analogy)
  (<s> ^analogy-method analogy-1)
  ;
  (<s> ^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 <s> ^problem-space.name use-analogy)
  (<s> ^{<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 <s> ^problem-space.name use-analogy)
  (<s> ^{<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 <s> ^superstate <ss> ^impasse no-change ^attribute operator)
  (<ss> ^operator (<so> ^name imagine-task))
  -->
  (<s> ^problem-space <p>)
  (<p> ^name perform ^type imaginary ^alias imagine-task)
  (<s> ^superoperator <so>)}


### Copy the task onto the state

sp {imagine-task*initialise*state
  (state <s> ^problem-space.alias imagine-task)
  (<s> ^superoperator.task <t>)
  -->
  (<s> ^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 <s> ^problem-space.alias imagine-task)
  (<s> ^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 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 <s> ^superstate <ss> ^impasse no-change ^attribute operator
             ^quiescence t)
  (<ss> ^operator.name use-analogy ^superstate <sss>)
  (<sss> ^problem-space.alias imagine-task ^superoperator <ssso>)
  -->
  (<ssso> ^fail fail)}

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

### ======================================================================
### Little hand time telling section
### ======================================================================

sp {little-hand*tell-time*1
(state <s> ^problem-space <p> ^task <tsk>)
   (<p> ^name little-hand)
   (<tsk> ^feature <ft>)
   (<ft> ^fname arg2)
   (<ft> ^fvalue |1|)
   -->
   (write (crlf) |** The minutes are 5| (crlf))
   (<p> ^name little-hand - complete +)}

sp {little-hand*tell-time*2
(state <s> ^problem-space <p> ^task <tsk>)
   (<p> ^name little-hand)
   (<tsk> ^feature <ft>)
   (<ft> ^fname arg2)
   (<ft> ^fvalue |2|)
   -->
   (write (crlf) |** The minutes are 10| (crlf))
   (<p> ^name little-hand - complete +)}

sp {little-hand*tell-time*3
(state <s> ^problem-space <p> ^task <tsk>)
   (<p> ^name little-hand)
   (<tsk> ^feature <ft>)
   (<ft> ^fname arg2)
   (<ft> ^fvalue |3|)
   -->
   (write (crlf) |** The minutes are 15| (crlf))
   (<p> ^name little-hand - complete +)}

sp {little-hand*tell-time*4
(state <s> ^problem-space <p> ^task <tsk>)
   (<p> ^name little-hand)
   (<tsk> ^feature <ft>)
   (<ft> ^fname arg2)
   (<ft> ^fvalue |4|)
   -->
   (write (crlf) |** The minutes are 20| (crlf))
   (<p> ^name little-hand - complete +)}

sp {little-hand*tell-time*5
(state <s> ^problem-space <p> ^task <tsk>)
   (<p> ^name little-hand)
   (<tsk> ^feature <ft>)
   (<ft> ^fname arg2)
   (<ft> ^fvalue |5|)
   -->
   (write (crlf) |** The minutes are 25| (crlf))
   (<p> ^name little-hand - complete +)}

sp {little-hand*tell-time*6
(state <s> ^problem-space <p> ^task <tsk>)
   (<p> ^name little-hand)
   (<tsk> ^feature <ft>)
   (<ft> ^fname arg2)
   (<ft> ^fvalue |6|)
   -->
   (write (crlf) |** The minutes are 30| (crlf))
   (<p> ^name little-hand - complete +)}

sp {little-hand*tell-time*7
(state <s> ^problem-space <p> ^task <tsk>)
   (<p> ^name little-hand)
   (<tsk> ^feature <ft>)
   (<ft> ^fname arg2)
   (<ft> ^fvalue |7|)
   -->
   (write (crlf) |** The minutes are 35| (crlf))
   (<p> ^name little-hand - complete +)}

sp {little-hand*tell-time*8
(state <s> ^problem-space <p> ^task <tsk>)
   (<p> ^name little-hand)
   (<tsk> ^feature <ft>)
   (<ft> ^fname arg2)
   (<ft> ^fvalue |8|)
   -->
   (write (crlf) |** The minutes are 40| (crlf))
   (<p> ^name little-hand - complete +)}

sp {little-hand*tell-time*9
(state <s> ^problem-space <p> ^task <tsk>)
   (<p> ^name little-hand)
   (<tsk> ^feature <ft>)
   (<ft> ^fname arg2)
   (<ft> ^fvalue |9|)
   -->
   (write (crlf) |** The minutes are 45| (crlf))
   (<p> ^name little-hand - complete +)}

sp {little-hand*tell-time*10
(state <s> ^problem-space <p> ^task <tsk>)
   (<p> ^name little-hand)
   (<tsk> ^feature <ft>)
   (<ft> ^fname arg2)
   (<ft> ^fvalue |10|)
   -->
   (write (crlf) |** The minutes are 50| (crlf))
   (<p> ^name little-hand - complete +)}

sp {little-hand*tell-time*11
(state <s> ^problem-space <p> ^task <tsk>)
   (<p> ^name little-hand)
   (<tsk> ^feature <ft>)
   (<ft> ^fname arg2)
   (<ft> ^fvalue |11|)
   -->
   (write (crlf) |** The minutes are 55| (crlf))
   (<p> ^name little-hand - complete +)}

sp {little-hand*tell-time*12
   (state <s> ^problem-space <p> ^task <tsk>)
   (<p> ^name little-hand)
   (<tsk> ^feature <ft>)
   (<ft> ^fname arg2)
   (<ft> ^fvalue |12|)
   -->
   (write (crlf) |** The minutes are 0| (crlf))
   (<p> ^name little-hand - complete +)}

sp {terminate*the*whole*lot
   (state <s> ^problem-space.name complete)
-->
  (halt)}

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