;;;;;;;;;;;;;;;;;;;;;;;;<pre><xmp>
;; This model will run equally well in raw ACT-R and in the ACT-R Environment.

;; To run the model, call the function demo
;; There are three parameters to pass to the demo function,
;; representing prefix, postfix, and the characters on the right of the equation

;; Prefix values may be nil, 2, 3, 4, or 5
;; Postfix values must be a list of 2 characters or nil.  The characters must be 2, 3, 4, or 5
;; RHS of equation must be a list of 2 characters or 4 characters, contingent on postfix
;; So, if Postfix is nil, RHS must be 4 characters
;;     if Postfix is 2 characters, RHS must be 2 characters

;; Example (demo nil '(2 3) '(2 3))


(setf *actr-enabled-p* t)

(defparameter *sim* .5)
(defparameter *visual* nil)
(defparameter *retrieved* nil)
(defparameter *productions* nil)

(defun gammafn (x)
  (* (expt x x) (exp (- x)) (sqrt (* 2 pi x)) (1+ (/ 1 (* 12 x)))))

(defparameter *exp* 3.67)
(defparameter *scale* 1.383)
(defparameter *ret-mag* .055) ;(/ 0.817 (gammafn *exp*)))
(defparameter *man-mag* .254) ;(/ 3.757 (gammafn *exp*)))
(defparameter *imag-mag* .127) ;(/ 1.871 (gammafn *exp*)))


(defvar *experiment-window* nil)
(defvar *response* nil)
(defvar *hold-time* nil)
(defparameter *graphic* nil)

(defparameter *v* nil)

(defvar *a*)
(defvar *b*)
(defvar *c*)

(defvar *WWW-interface*)

(setf  *WWW-interface* 
      '((:heading "fMRI Experiment 2" 2)
        (:heading "Parameters" 3)
        (:table)
        (:table)
        "latency scale, s:"         (:string :sy *scale*  1.383)  (:new-row)
        "exponent, a:"              (:string :sy *exp* 3.67)      (:new-row)
        "magnitude, M (retrieval):" (:string :sy *ret-mag* .055)  (:new-row)
        "magnitude, M (imaginal):"  (:string :sy *imag-mag* .127) (:new-row)
        "magnitude, M (manual):"    (:string :sy *man-mag* .254)         
        
        (:table-end)
        
        (:table)
        (:checkbox "Trace" :sy *v*  nil)                (:new-row)
        (:checkbox "Graphic output" :sy *graphic*  nil) (:new-row)
        (:table-end)
        (:table-end)
        
        (:new-para)
        
        (:heading "Equation" 3)
        (:table)
        (:table)
        "prefix: "           (:string :sy *a* "nil") (:new-row)
        "postfix: "          (:string :sy *b* "(2 3)") (:new-row)
        "right expression: " (:string :sy *c* "(2 3)")  
        (:table-end)
        (:table-end)
(:new-para)
"The values for the equation parameters allow you to specify the conditions of the trial presented to the model (see the paper for more details). The three parameters specify the prefix, postfix, and the characters on the right of the equation.  The prefix values may be nil, 2, 3, 4, or 5.  The postfix must be a list of 2 characters or nil, and the characters must be 2, 3, 4, or 5. The right expression must be a list of either 2 or 4 characters, contingent on the postfix.  So, if postfix is nil, right expression must be 4 characters and if postfix is 2 characters right expression must be 2 characters.  The default values specify the problem \"P 2 3 <-> 2 3\"."   


        (:new-para)
        (:button "Run model" "(if (and (numberp *scale*) (numberp *exp*)
                                       (numberp *ret-mag*) (numberp *man-mag*) 
                                       (numberp *imag-mag*))
                                 (demo *a* *b* *c*)
                                (format *standard-output* \"~%~%All parameters must be numbers.~%\"))")
        (:reset "Default values")
        (:button "Production Rules" "(let ((prods (no-output (pp))))
                                       (dolist (x prods)
                                         (pp-fct (list x))
                                         (spp-fct (list x))
                                         (format *standard-output* \"~%\")))")
        (:button "Chunk types" "(chunk-type)")
        (:button "Chunks" "(dm)")
        (:new-para)
         "TIME and SIZE:"
        (:new-para)
        "- It usually takes less than 1 minute to run the model"
        (:new-line)
        "- The trace of 1 run is approximatly 3k (2 pages) in size"
        (:use-actr5)))



(defun count-productions (x) (push *time* *productions*))

(defun transform (start val)
  (push *time* *visual*))

(defun average (x y) (/ (+ x y) 2))

(defun test-equation (eq)
  (princ "The equation is ")(princ eq) (terpri)
  (setf *visual* nil *retrieved* nil *productions* nil)
  (when (open-rpm-window? *experiment-window*)
    (close-rpm-window *experiment-window*))
  
  (setf *experiment-window* (make-rpm-window :visible nil ;; model probably doesn't work with t but a person can do it then
                                             :title "Equation Experiment"
                                             :width 300 :height 300))
  
  (if *actr-enabled-p* 
      (let ((goal (new-name "GOAL"))
            (result nil))
        (reset) 
        (add-dm-fct (list (cons goal `(isa goal step start answer list))))
        (goal-focus-fct  (list goal))
        (add-visual-items-to-rpm-window *experiment-window* 
                                        (make-static-text-for-rpm-window *experiment-window* 
                                                                         :x 25
                                                                         :y 150
                                                                         :width 275
                                                                         :text eq)) 
        
        (pm-install-device *experiment-window*)
        (pm-proc-display)
        (setf *response* nil)
        (setf *hold-time* nil)
        
        (pm-run 18.0)
        
        (push (list *response* (if *hold-time* (/ *hold-time* 1000.0))) result)
        
        (lose-focus)
        (remove-all-items-from-rpm-window *experiment-window*)
        (add-visual-items-to-rpm-window *experiment-window* 
                                        (make-static-text-for-rpm-window *experiment-window* 
                                                                         :x 25
                                                                         :y 150
                                                                         :width 275
                                                                         :text "X <-> ")) 
        
        (pm-proc-display)
        
        (do ((count 0 (1+ count))
             (steps '(first second third fourth) (cdr steps))
             (pos 75 (+ pos 50))
             (start-time (pm-get-time) (pm-get-time)))
            ((equal count 4) (generate (mapcar 'first (reverse result))
                                       (mapcar 'second (reverse result))
                                       (reverse *retrieved* )
                                       (reverse *visual*)))
          (eval `(mod-focus step go position ,(car steps)))
          
          (add-visual-items-to-rpm-window *experiment-window* 
                                          (make-static-text-for-rpm-window *experiment-window* 
                                                                           :x pos
                                                                           :y 150
                                                                           :width 25
                                                                           :text "*")) 
          
          (pm-proc-display)
          
          (setf *response* nil)
          (setf *hold-time* nil)
          (pm-run 1.5 :full-time t)
          
          
          (push (list *response* (if *hold-time* (/ (- *hold-time* start-time) 1000.0))) result)
          
          ))
    (let ((start-time nil))
      ;; for a person
      
      (add-visual-items-to-rpm-window *experiment-window* 
                                      (make-static-text-for-rpm-window *experiment-window* 
                                                                       :x 25
                                                                       :y 150
                                                                       :width 275
                                                                       :text eq)) 
      (setf *response* nil)
      (setf *hold-time* nil)
      (setf start-time (pm-get-time))
      (while (and (null *response*) (< (- (pm-get-time) start-time 18000)))
        (allow-event-manager *experiment-window*))
             
      (remove-all-items-from-rpm-window *experiment-window*)
      (add-visual-items-to-rpm-window *experiment-window* 
                                      (make-static-text-for-rpm-window *experiment-window* 
                                                                       :x 25
                                                                       :y 150
                                                                       :width 275
                                                                       :text "X <-> ")) 
      
        (dotimes (i 4)
          
          (add-visual-items-to-rpm-window *experiment-window* 
                                          (make-static-text-for-rpm-window *experiment-window* 
                                                                           :x (+ 75 (* i 50))
                                                                           :y 150
                                                                           :width 25
                                                                           :text "*")) 
          (sleep 1.5))))

    (close-rpm-window *experiment-window*))


#+:(or :mcl :allegro-ide) (defmethod rpm-window-key-event-handler ((win rpm-window) key)
      (setf *response* (string key))
      (setf *hold-time* (pm-get-time))
      )


(defmethod rpm-window-key-event-handler ((win virtual-window) key)
  (setf *response* (string key))
  (setf *hold-time* (pm-get-time)))


 
 
(defun demo (prefix postfix right)
  (let ((equation (cond ((not (legaltest prefix postfix right)) 'illegal)
                        (prefix (cond (postfix (format nil "~d P ~d ~d <-> ~d ~d"
                                                 prefix (first postfix) (second postfix)
                                                 (first right) (second right)))
                                      (t (format nil "~d P <-> ~d ~d ~d ~d" prefix
                                           (first right) (second right)
                                           (third right) (fourth right)))))
                        (postfix (format nil "P ~d ~d <-> ~d ~d" (first postfix) (second postfix)
                                   (first right) (second right)))
                        (t (format nil "P <-> ~d ~d ~d ~d" (first right) (second right)
                             (third right) (fourth right))))))
    (cond ((not (equal equation 'illegal)) (test-equation equation))
          (t (format t "Invalid equation.")))))

(defun legaltest (prefix postfix right)
  (and (or (and (= (length postfix) 2) (= (length right) 2))
           (and (= (length postfix) 0) (= (length right) 4)))
       (do ((temp (if prefix (cons prefix (append postfix right))
                    (append postfix right)) (cdr temp)))
           ((null temp) t)
         (cond ((not (member (car temp) '(2 3 4 5))) (return nil))))))




(defun generate (answer times ret imag)
  (let* ((imaginal (mapcar #'(lambda (x) (list (+ 3 x) .2)) imag))
         (rt (+ 3 (car times)))
         (retrieval (mapcar #'(lambda (x) (list (+ 3 (first x)) (second x))) ret))
         (manual (do ((temp (cddr times) (cdr temp))
                      (result (list (list (+ rt -.3 (second times)) .3)
                                    (list (- rt 0.4) .3))
                              (cons (list (+ (caar result) 1.5) .3) result)))
                     ((null temp) (reverse result))))
        (res (list nil nil nil)))
    (format t "~%The model's answer is ~{~a~} and it was generated in ~6,3f seconds~%~%" answer (- rt 3)) 
    (format t " Scan  Time(sec) Imaginal  Retrieval   Motor~%")
    
    (dotimes (scan 12)
      (let* ((mean (+ .75 (* scan 1.5)))
             (i (* *imag-mag* (bold-fn mean imaginal)))
             (r (* *ret-mag* (bold-fn mean retrieval)))
             (m (* *man-mag* (bold-fn mean manual))))
        (format t "~4d~10,3f~10,3f~10,3f~10,3f~%" (1+ scan) mean i r m) 
        (push i (first res))
        (push r (second res))
        (push m (third res))))
    (draw-graphs res)))

(defun draw-graphs (data)
  (unless *graphic* (format *standard-output* 
                        "~%</pre>If your browser supports JAVA, you 
                               can display the data in a graph by checking 
                               the Graphic output box on the interface page.<pre>~%~%"))
  (when *graphic*
    (format *standard-output* " 
        <applet 
        code = \"DansGraphs.class\" 
        width = 500 
        height = 400> 
        <PARAM name=\"title\" value=\"Model BOLD Response Predictions\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"18\">
        <PARAM name=\"ymax\" value=\"1.0\">
        <PARAM name=\"ymin\" value=\"0.0\">
        <PARAM name=\"longestline\" value=\"12\">
        <PARAM name=\"numlines\" value=\"3\">
        <PARAM name=\"xdiv\" value=\"1\">
        <PARAM name=\"xspacing\" value=\"5\">
        <PARAM name=\"ydiv\" value=\"0.1\">
        <PARAM name=\"yspacing\" value=\"0.2\">
        <PARAM name=\"xname\" value=\"Time (sec.)\">
        <PARAM name=\"yname\" value=\"Percent change\">
        <PARAM name=\"name0\" value=\"Imaginal\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lstyle0\" value=\"2\">
        <PARAM name=\"xval0\" value=\"0.75;2.25;3.75;5.25;6.75;8.25;9.75;11.25;12.75;14.25;15.75;17.25;\">
        <PARAM name=\"name1\" value=\"Retrieval\">
        <PARAM name=\"lcolor1\" value=\"1\">
        <PARAM name=\"lstyle1\" value=\"2\">
        <PARAM name=\"xval1\" value=\"0.75;2.25;3.75;5.25;6.75;8.25;9.75;11.25;12.75;14.25;15.75;17.25;\">
        <PARAM name=\"name2\" value=\"Manual\">
        <PARAM name=\"lcolor2\" value=\"2\">
        <PARAM name=\"lstyle2\" value=\"2\">
        <PARAM name=\"xval2\" value=\"0.75;2.25;3.75;5.25;6.75;8.25;9.75;11.25;12.75;14.25;15.75;17.25;\"> ")

      (dotimes (i 3) 
        (format *standard-output* "<PARAM name=\"yval~s\" value=\"" i)
        (dotimes (j 12)
          (format *standard-output* "~6,3f;" (nth (- 11 j) (nth i data))))
      
      (format *standard-output* "\">"))

    (format *standard-output* "
             <HR> Either your browser does not support JAVA or this graph has scrolled off the top of the display.~%
             </HR></applet>")))

(defun integrate (t1 t2 exp scale)
  (let* ((nt1 (/ t1 scale))
         (nt2 (/ t2 scale))
         (nt12 (/ (+ nt1 nt2) 2))
         (start (* (expt nt1 exp) (exp (- nt1))))
         (mid (* (expt nt12 exp) (exp (- nt12))))
         (end (* (expt nt2 exp) (exp (- nt2)))))
    (* (- nt2 nt1) .25 (+ start mid mid end))))

(defun sqr (x) (* x x))

(defun bold-fn (time lis)
  (do ((temp lis (cdr temp))
       (signal 0 (+ signal (calculate-bold time (caar temp) (cadar temp)))))
      ((or (null temp) (< time (caar temp))) (return signal))))

(defun calculate-bold (current past length)
  (integrate (- current past) (+ length (- current past))
             *exp* *scale*))

(defun assign-retrieval (arguments)
  "Assigns to the variable *retrieval-scheduler* the result and latency of the retrieval.
   The variable *retrieval* is also reset to nil waiting for the result."
  (let ((retrieval (if (first arguments)
                       (instantiation-variable *instantiation* (pop arguments))
                     *retrieval-scheduler*)))
    (signal-output *latency-trace* "Latency ~6,3F: ~A Retrieval" *latency* retrieval)
    (setf *retrieved* (push (list *time* *latency*) *retrieved*))
    (setf *retrieval* nil)
    (setf *retrieval-scheduler* (cons (+ *time* *latency*) retrieval))))


(defun string-similarity (string1 string2)
  (when (and (stringp string1) (stringp string2))
    (if (equal string1 string2) 
        *max-sim*
      *sim*)))

(defun lose-focus ()
  (setf (current-marker (vis-m *mp*)) nil)
  (setf (currently-attended (vis-m *mp*)) nil)
  )

(;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</xmp><pre><a name="model">
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</a>
;;;
;;; This section contains the ACT-R productions
;;; and memory definitions for the simulation

clear-all)
(pm-reset)
 
(sgp-fct (list :v *v* :esc t :lf .65 :ga 0.00))
 
(pm-set-params :visual-attention-latency .05)

(chunk-type goal answer step position arg1 arg2 first second third fourth)
(chunk-type invert operator action arg)
(chunk-type operator identity inverse)
(chunk-type fact relation arg1 arg2)
 
(add-dm (rule1 isa invert operator "5" action null)
        (rule2 isa invert operator "3" action flip)
        (rule3 isa invert operator "2" action exchange)
        (rule4 isa invert operator "4" action exchange)
        (rule5 isa invert operator arg action copy arg fourth)
        (rule6 isa invert operator operator action copy-exchange arg third)
        (first isa chunk) (second isa chunk)
        (third isa chunk) (fourth isa chunk)
        (arg-position isa fact relation position arg1 arguments arg2 even)
        (c2 isa operator identity "2" inverse "3")
        (c3 isa operator identity "3" inverse "2")
        (c4 isa operator identity "4" inverse "5")
        (c5 isa operator identity "5" inverse "4"))
 
 (setf *firing-hook-fn* #'count-productions)
 
(p start
   =goal>
      isa goal
      step start
==>
  +visual-location>
      isa visual-location
      value  "<->"
  =goal>
      step right)
 
(p right
   =goal>
      isa goal
      step right
   =visual-location>
      isa visual-location
      screen-x =x
==>
!bind! =x1 (+ =x 5)
!bind! =y (+ =x 25)
   +visual-location>
      Isa visual-location
     screen-x (within =x1 =y)
     attended nil
   =goal>
      step look-first)
 
(p look-first
   =goal>
      isa goal
      step look-first
   =visual-location>
      isa visual-location
==>
   +visual>
      ISA         visual-object
      screen-pos  =visual-location
   =goal>
      step encode-first)
 
 
(p encode-first
   =goal>
      isa goal
      step encode-first
      answer =answer
   =visual>
      isa text
      value =value
   =visual-location>
      isa visual-location
      screen-x =x
==>
!bind! =y (+ =x 20)
!eval! (transform 'encode =value)
   +visual-location>
      Isa visual-location
     screen-x (within =x =y)
     attended nil
   =goal>
      step look-second
      first  =value)
 
(spp encode-first :effort .15)
 
(p look-second
   =goal>
      isa goal
      step look-second
   =visual-location>
      isa visual-location
==>
   +visual>
      ISA         visual-object
      screen-pos  =visual-location
   =goal>
      step encode-second)
 
 
(p encode-second
   =goal>
      isa goal
      step encode-second
      answer =answer
   =visual>
      isa text
      value =value
   =visual-location>
      isa visual-location
      screen-x =x
==>
!eval! (transform 'encode =value)
!bind! =y (+ =x 20)
   +visual-location>
     Isa visual-location
     screen-x (within =x =y)
     attended nil
   =goal>
      step look-third
      second =value)
 
(spp encode-second :effort .15)
 
(p look-third
   =goal>
      isa goal
      step look-third
   =visual-location>
      isa visual-location
==>
   +visual>
      ISA         visual-object
      screen-pos  =visual-location
   =goal>
      step encode-third)
 
(p left-short
   =goal>
      isa goal
      step look-third
   =visual-location>
      isa error
==>
  +visual-location>
      isa visual-location
      value  "<->"
   =goal>
      step left)
 
 
(p encode-third
   =goal>
      isa goal
      step encode-third
      answer =answer
   =visual>
      isa text
      value =value
   =visual-location>
      isa visual-location
      screen-x =x
==>
!bind! =y (+ =x 20)
!eval! (transform 'encode =value)
   +visual-location>
     Isa visual-location
     screen-x (within =x =y)
     attended nil
   =goal>
      step look-fourth
      third =value)
 
(spp encode-third :effort .15)
 
(p look-fourth
   =goal>
      isa goal
      step look-fourth
   =visual-location>
      isa visual-location
==>
   +visual>
      ISA         visual-object
      screen-pos  =visual-location
   =goal>
      step encode-fourth)
 
 
 
(p encode-fourth
   =goal>
      isa goal
      step encode-fourth
      answer =answer
   =visual>
      isa text
      value =value
   =visual-location>
      isa visual-location
      screen-x =x
==>
!eval! (transform 'encode =value)
  +visual-location>
      isa visual-location
      value  "<->"
   =goal>
      step  left
      fourth =value)
 
(spp encode-fourth :effort .15)
 
 
 
(p check-for-P
   =goal>
      isa goal
      step left
   =visual-location>
      isa visual-location
      screen-x =x
==>
!bind! =x1 (- =x 1)
!bind! =y (- =x 25)
   +visual-location>
     Isa visual-location
     screen-x (within =y =x1)
     attended nil
   =goal>
      step check-for-P)
 
(p encode-for-P
   =goal>
      isa goal
      step check-for-P
   =visual-location>
      isa visual-location
==>
   =goal>
      step encode-for-P
   +visual>
      ISA         visual-object
      screen-pos  =visual-location)
 
(p process-P
   =goal>
      isa goal
      step encode-for-P
   =visual>
      isa text
      value "p"
   =visual-location>
      isa visual-location
      screen-x =x
==>
!eval! (transform 'encode 'P)
!bind! =x1 (- =x 1)
!bind! =y (- =x 25)
   +visual-location>
     Isa visual-location
     screen-x (within =y =x1)
     attended nil
=goal>
     step look-past-P)
 
(spp process-P :effort .15)
 
(p encode-fourth-left
   =goal>
      isa goal
      step encode-for-P
      answer =answer
   =visual-location>
      isa visual-location
      screen-x =x
   =visual>
      isa text
      value =value
   -  value "p"
==>
!eval! (transform 'encode =value)
+retrieval>
    isa invert
    operator arg
=goal>
    step invert-fourth)
 
(spp encode-fourth-left :effort .15)
 
(p invert-fourth
   =goal>
      isa goal
      step invert-fourth
   =visual-location>
      isa visual-location
      screen-x =x
   =visual>
      isa text
      value =value
   =retrieval>
      isa invert
      action copy
      arg fourth
==>
!eval! (transform 'encode =value)
!bind! =x1 (- =x 1)
!bind! =y (- =x 25)
   +visual-location>
     Isa visual-location
     screen-x (within =y =x1)
     attended nil
   =goal>
      step look-third-left
      fourth =value)
 
(spp invert-fourth :effort .15)
 
(p look-third-left
   =goal>
      isa goal
      step look-third-left
   =visual-location>
      isa visual-location
==>
   +visual>
      ISA         visual-object
      screen-pos  =visual-location
   =goal>
      step encode-third-left)
 
(p encode-third-left
   =goal>
      isa goal
      step encode-third-left
      answer =answer
   =visual>
      isa text
      value =value
==>
!eval! (transform 'encode =value)
+retrieval>
    isa invert
    operator operator
=goal>
    step invert-third)
 
(spp encode-third-left :effort .15)
 
(p copy-invert-third
   =goal>
      isa goal
      step invert-third
   =visual>
      isa text
      value =value
   =retrieval>
      isa invert
      action copy-exchange
      arg third
==>
+retrieval>
    isa operator
    identity =value
=goal>
    step copy-exchange-third)
 
(p exchange-third
   =goal>
      isa goal
      step copy-exchange-third
   =retrieval>
      isa operator
      identity =old
      inverse =value
==>
!eval! (transform =old =value)
   =goal>
      step left
      third =value)
 
(spp exchange-third :effort .15)
 
(p nothing-past-P
   =goal>
      isa goal
      step look-past-P
      answer =parent
   =visual-location>
      isa error
==>
  =goal>
      step wait
  +manual>
      ISA         press-key
      key         "1")
 
(p look-for-prefix
   =goal>
      isa goal
      step look-past-P
      answer =parent
   =visual-location>
      isa visual-location
==>
   +visual>
      ISA         visual-object
      screen-pos  =visual-location
   =goal>
      step encode-prefix)
 
 
(p encode-prefix
   =goal>
      isa goal
      step encode-prefix
   =visual>
      isa text
      value =op
==>
!eval! (transform 'encode =op)
  =goal>
     step transform-prefix
  +retrieval>
     isa invert
     operator =op)
 
(spp encode-prefix :effort .15)
 
(p null-transform
   =goal>
      isa goal
      step transform-prefix
   =retrieval>
      isa invert
      action null
==>
   =goal>
      step wait
  +manual>
      ISA         press-key
      key         "1")
 
(p flip-transform
   =goal>
      isa goal
      step transform-prefix
   =retrieval>
      isa invert
      action flip
==>
   +retrieval>
      isa fact
      relation position
      arg1 arguments
    =goal>
       step retrieve-position)
 
(p flip-position
   =goal>
      isa goal
      step retrieve-position
      second =arg1
      fourth =arg2
   =retrieval>
      isa fact
      arg2 even
==>
!eval! (transform =arg1 =arg2)
!eval! (transform =arg2 =arg1)
=goal>
   second =arg2
   fourth =arg1
      step wait
  +manual>
      ISA         press-key
      key         "1")
 
(spp flip-position :effort .3)
 
(p exchange-transform
   =goal>
      isa goal
      step transform-prefix
   =retrieval>
      isa invert
      action exchange
   =visual>
      isa text
      value =op
==>
   +retrieval>
      isa operator
      identity =op
   =goal>
      step retrieving-inverse)
 
 
(p retrieve-inverse
   =goal>
      isa goal
      step retrieving-inverse
   =retrieval>
      isa operator
      identity =val1
      inverse =val2
==>
=goal>
   step exchange-first
   arg1 =val1
   arg2 =val2)
 
(p skip-first-exchange    
   =goal>
     isa goal
     step exchange-first
     arg1 =arg1
     arg2 =arg2
   - first =arg1
   - first =arg2
     answer =parent
==>
   =goal>
    step exchange-third)

(p forward-first-exchange
  =goal>
    isa goal
    step exchange-first
    arg1 =arg1
    arg2 =arg2
    first =arg1
    answer =parent
==>
  !eval! (transform =arg1 =arg2)
  =goal>
    first =arg2
    step exchange-third)
 
(spp forward-first-exchange :effort .15)
 
(p reverse-first-exchange    
   =goal>
    isa goal
    step exchange-first
    arg1 =arg1
    arg2 =arg2
    first =arg2
    answer =parent
==>
   !eval! (transform =arg2 =arg1)
   =goal>
    first =arg1
    step exchange-third)

(spp reverse-first-exchange :effort .15)
 
(p skip-second-exchange
   =goal>
    isa goal
    step exchange-third
    arg1 =arg1
    arg2 =arg2
    - third =arg1
    - third =arg2
    answer =parent
==>
   =goal>      
    step wait
   +manual>
    ISA         press-key
    key         "1")

(p forward-second-exchange    
  =goal>
    isa goal
    step exchange-third
    arg1 =arg1
    arg2 =arg2
    third =arg1
    answer =parent
==>
  !eval! (transform =arg1 =arg2)
  =goal>
    step wait
    third =arg2
  +manual>
    ISA         press-key
    key         "1")
 
(spp forward-second-exchange :effort .15)
 
(p backward-second-exchange
  =goal>
    isa goal
    step exchange-third
    arg1 =arg1
    arg2 =arg2
    third =arg2
    answer =parent
==>
  !eval! (transform =arg2 =arg1)
  =goal>
    step wait
    third =arg1
  +manual>
    ISA         press-key
    key         "1")
 
(spp backward-second-exchange :effort .15)
 
(p retrieve-first
   =goal>
      isa goal
      step go
      position first
      first =arg
      answer =parent
==>
   =goal>
      step wait
  +manual>
      ISA         press-key
      key         =arg)
 
(p retrieve-second 
   =goal>
      isa goal
      step go
      position second
      second =arg
      answer =parent
==>
   =goal>
      step wait
  +manual>
      ISA         press-key
      key         =arg)
 
(p retrieve-third
   =goal>
      isa goal
      step go
      position third
      third =arg
      answer =parent
==>
   =goal>
      step wait
  +manual>
      ISA         press-key
      key         =arg)
 
(p retrieve-fourth
   =goal>
      isa goal
      step go
      position fourth
      fourth =arg
      answer =parent
==>
   =goal>
      step wait
  +manual>
      ISA         press-key
      key         =arg)