;<pre><xmp>
;?  (predictions *intercept* *mismatch* *tnoise* *factor* *read*)
;((1.2940443533050408 1.7636479342056421 2.010977607761386 1.4196172808823755 1.5636478438080628 1.717818291306652 1.7060045893806022 1.8356145022871382) 
;(2.2939939950867814 2.811415680635759 2.2759808734782365 2.7824698994341235 2.4962411817667016 3.0109953802688842 2.4737468275401895 2.9873891866762268))

(defvar *sentence*) (defvar *goal*) (defvar *hold*) (defparameter *retrieval* t)
(defvar *response*)
(defvar *assoc*)
(defvar *vars*)
(defvar *high*)
(defvar *low*)
(defvar *study*)
(defvar *test*)
(defvar *yes*)
(defvar *no*)
(setf *vars* nil)
(setf *assoc* nil)
(defvar *plaus*)
(defvar *read*)
(setf *read* 0.1)
(setf *plaus* nil)
(defparameter *intercept* 0.65)
(setf *no* .40)
(setf *yes* .40)
(defvar *mismatch*)
(setf *mismatch* .1)
(defvar *encoding*)
(setf *encoding* 0.2)
(defvar *snoise*)
(setf *tnoise* .05)
(defvar *factor*)
(setf *factor* 0.30)
(defvar *flail*)
(setf *flail* .8)

(defvar *text* t)
(defvar *graphic* nil)
(defvar *v* nil)
(defvar *overlay* nil)


(defvar *data-a74* '((1.2 1.75 1.9 1.45
                      1.55 1.75 1.75	1.8)
                     (2.25	2.8 2.3	2.75
                      2.55	2.95 2.55	2.95)))
                

(defvar *WWW-interface*)
(setf  *WWW-interface* 
      '((:heading "Anderson 1974" 2)
        (:table)
        
        (:table)
        "Latency Scale, F: "        (:string :sy *factor*  .30)   (:new-row)
        "Time to read a word: "   (:string :sy *read*  .10)  (:new-row)
        "Intercept parameter: "   (:string :sy *intercept*  .65)     (:new-row)
        "Utility noise, t: "     (:string :sy *tnoise* .05)     (:new-row)
        (:table-end)
        
        (:table)
        (:checkbox "Trace" :sy *v*  nil)  (:new-row)
        (:checkbox "Text output" :sy *text*  t) (:new-row)
        (:checkbox "Graphic output" :sy *graphic*  nil) (:new-row)
        (:checkbox "Show both simulation and experiment data" :sy *overlay*  nil) 
        (:table-end)
        
        (:table-end)
         
        
         (:new-para)
         
        (:button "Show Experimental Results" "(display-a74 nil *data-a74* )")
           
        (:new-para)
        
        (:button "Run model" "(if (and (numberp *factor*) (numberp *read*)
                                       (numberp *intercept*) (numberp *tnoise*)
                                       )
                                   (display-a74  (predictions *intercept* 0.1 *tnoise* *factor* *read*) *data-a74*)
                                   
                                   (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 about 1 minute to run the model"
        (:new-line)
        "- The trace of 1 run is approximatly 100 Kbytes (50 pages) in size"
        (:new-para)))


(defun display-a74 (model exp)
  (when model 
    (format *standard-output* "~%~%Parameters for run: (~S ~S ~S ~S)~%" 
            *factor* *read* *intercept* *tnoise* ))

  (when *text*
    (when model
      (format *standard-output* "~%ACT-R Latency (sec.)~%")
      (dotimes (i 2)
        (format *standard-output* (if (zerop i) " Immediate~%" " Delayed~%"))
        (dotimes (j 2)
          (format *standard-output* (if (zerop j) "   Active~%" "   Passive~%"))

          (format *standard-output* "     Active Target   ~4,3f~%" (nth (+ (* 2 j) 0) (nth i model)))
          (format *standard-output* "     Passive Target  ~4,3f~%" (nth (+ (* 2 j) 1) (nth i model)))
          (format *standard-output* "     Active Target   ~4,3f~%" (nth (+ (* 2 j) 4) (nth i model)))
          (format *standard-output* "     Passive Target  ~4,3f~%" (nth (+ (* 2 j) 5) (nth i model))))))
    (when (or (null model) *overlay*)
      (format *standard-output* "~%~%Experimental Latency (sec.)~%")
      (dotimes (i 2)
        (format *standard-output* (if (zerop i) " Immediate~%" " Delayed~%"))
        (dotimes (j 2)
          (format *standard-output* (if (zerop j) "   Active~%" "   Passive~%"))

          (format *standard-output* "     Active Target   ~4,3f~%" (nth (+ (* 2 j) 0) (nth i exp)))
          (format *standard-output* "     Passive Target  ~4,3f~%" (nth (+ (* 2 j) 1) (nth i exp)))
          (format *standard-output* "     Active Target   ~4,3f~%" (nth (+ (* 2 j) 4) (nth i exp)))
          (format *standard-output* "     Passive Target  ~4,3f~%" (nth (+ (* 2 j) 5) (nth i exp))))))

    (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 = 700 
        height = 600> 
        <PARAM name=\"title\" value=\"Anderson 1974\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"5\">
        <PARAM name=\"ymax\" value=\"3.0\">
        <PARAM name=\"ymin\" value=\"0.5\">
        <PARAM name=\"numxlabels\" value=\"6\">
        <PARAM name=\"xlabels\" value=\" ;Active Target;Passive Target;Active Foil;Passive Foil; ;\">
        <PARAM name=\"widestxlabel\" value=\"WWWWWWWWWWWWWW\">
        <PARAM name=\"longestline\" value=\"4\">
        <PARAM name=\"numlines\" value=\"~s\">
        <PARAM name=\"yspacing\" value=\".5\">
        <PARAM name=\"ydiv\" value=\".25\">
        <PARAM name=\"xname\" value=\"Probe Sentence\">
        <PARAM name=\"yname\" value=\"Latency\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"xval0\" value=\"1;2;3;4;\">
        <PARAM name=\"lcolor1\" value=\"1\">
        <PARAM name=\"lstyle1\" value=\"~s\">
        <PARAM name=\"xval1\" value=\"1;2;3;4;\">
        <PARAM name=\"lcolor2\" value=\"2\">
        <PARAM name=\"lstyle2\" value=\"~s\">
        <PARAM name=\"xval2\" value=\"1;2;3;4;\">
        <PARAM name=\"lcolor3\" value=\"3\">
        <PARAM name=\"lstyle3\" value=\"~s\">
        <PARAM name=\"xval3\" value=\"1;2;3;4;\">
        <PARAM name=\"yval0\" value=\"~4,3f;~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"yval1\" value=\"~4,3f;~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"yval2\" value=\"~4,3f;~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"yval3\" value=\"~4,3f;~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"name0\" value=\"~A Immediate Actives\">
        <PARAM name=\"name1\" value=\"~a Immediate Passives\">
        <PARAM name=\"name2\" value=\"~a Delayed Actives\">
        <PARAM name=\"name3\" value=\"~a Delayed Passives\">"
        

            (if (and model *overlay*) 8 4)
            (if model 2 2185)
            (if model 2 2185)
            (if model 2 2185)
            (if model 2 8737)
            (nth 0 (nth 0 (if model model exp)))
            (nth 1 (nth 0 (if model model exp)))
            (nth 4 (nth 0 (if model model exp)))
            (nth 5 (nth 0 (if model model exp)))
            (nth 2 (nth 0 (if model model exp)))
            (nth 3 (nth 0 (if model model exp)))
            (nth 6 (nth 0 (if model model exp)))
            (nth 7 (nth 0 (if model model exp)))
            (nth 0 (nth 1 (if model model exp)))
            (nth 1 (nth 1 (if model model exp)))
            (nth 4 (nth 1 (if model model exp)))
            (nth 5 (nth 1 (if model model exp)))
            (nth 2 (nth 1 (if model model exp)))
            (nth 3 (nth 1 (if model model exp)))
            (nth 6 (nth 1 (if model model exp)))
            (nth 7 (nth 1 (if model model exp)))
            
            (if model "ACT-R" "Experimental")
            (if model "ACT-R" "Experimental")
            (if model "ACT-R" "Experimental")
            (if model "ACT-R" "Experimental"))


    (when (and model *overlay*)
      (format *standard-output*
              "<PARAM name=\"lcolor4\" value=\"0\">
               <PARAM name=\"lstyle4\" value=\"2185\">
               <PARAM name=\"xval4\" value=\"1;2;3;4;\">
               <PARAM name=\"lcolor5\" value=\"1\">
               <PARAM name=\"lstyle5\" value=\"2185\">
               <PARAM name=\"xval5\" value=\"1;2;3;4;\">
               <PARAM name=\"lcolor6\" value=\"2\">
               <PARAM name=\"lstyle6\" value=\"2185\">
               <PARAM name=\"xval6\" value=\"1;2;3;4;\">
               <PARAM name=\"lcolor7\" value=\"3\">
               <PARAM name=\"lstyle7\" value=\"8737\">
               <PARAM name=\"xval7\" value=\"1;2;3;4;\">
               <PARAM name=\"yval4\" value=\"~4,3f;~4,3f;~4,3f;~4,3f;\">
               <PARAM name=\"yval5\" value=\"~4,3f;~4,3f;~4,3f;~4,3f;\">
               <PARAM name=\"yval6\" value=\"~4,3f;~4,3f;~4,3f;~4,3f;\">
               <PARAM name=\"yval7\" value=\"~4,3f;~4,3f;~4,3f;~4,3f;\">
               <PARAM name=\"name4\" value=\"Experimental Immediate Actives\">
               <PARAM name=\"name5\" value=\"Experimental Immediate Passives\">
               <PARAM name=\"name6\" value=\"Experimental Delayed Actives\">
               <PARAM name=\"name7\" value=\"Experimental Delayed Passives\">"
              
              (nth 0 (nth 0 exp))
              (nth 1 (nth 0 exp))
              (nth 4 (nth 0 exp))
              (nth 5 (nth 0 exp))
              (nth 2 (nth 0 exp))
              (nth 3 (nth 0 exp))
              (nth 6 (nth 0 exp))
              (nth 7 (nth 0 exp))
              (nth 0 (nth 1 exp))
              (nth 1 (nth 1 exp))
              (nth 4 (nth 1 exp))
              (nth 5 (nth 1 exp))
              (nth 2 (nth 1 exp))
              (nth 3 (nth 1 exp))
              (nth 6 (nth 1 exp))
              (nth 7 (nth 1 exp))))
    
    (format *standard-output* "
             <HR> Either your browser does not support JAVA or this graph has scrolled off the top of the display.~%
             </HR></applet>")))
          
               
;General functions
(defun read-word () 
   (eval `(mod-chunk ,*goal* word ,(or (pop *sentence*) 'eos))))

 (defun get-activation (item)
(caar (no-output (eval `(sdp ,item :activation)))))

(defun comprehend-sentence (sent)
         (setf *goal* 'goal)
         (mod-chunk goal word nil type nil link nil link-type nil
                      task Comprehend past nil meaning nil)
         (setf *sentence* sent)
         (setf *hold* *sentence*)
         (goal-focus goal)
         (run))

(defun average (lis &optional (n 1))
  (list (if lis (/ (apply '+ lis) (length lis)) nil)
        (/ (length lis) (* 1.0 n))))

(defun uniform-ias (val)
  (do ((temp (no-output (eval `(sdm context experiment))) (cdr temp)))
      ((null temp) nil)
      (set-ia-fct (list (list (chunk-slot-value-fct (car temp) 'child)
                          (car temp) val)
                        (list (chunk-slot-value-fct (car temp) 'parent)
                          (car temp) val)
                        (list (chunk-slot-value-fct (car temp) 'context)
                          (car temp) val)
                        (list (chunk-slot-value-fct (car temp) 'role)
                          (car temp) val)))))


(defun reset-sent () (setf *sentence* *hold*))

(defun encode-script (name script variable)
  (setf *vars* (cons variable *vars*))
  (setf *assoc* (cons (list variable variable) *assoc*))
  (eval `(add-dm (,name isa chunk) (,variable isa chunk)))
  (mapcar #'(lambda (x) (encode-triple x name)) script))

(defun encode-triple (triple context)
  (let* ((agent (encode-it (car triple) 'noun))
        (relation (encode-it (cadr triple) 'verb))
        (object (encode-it (caddr triple) 'noun))
        (proposition (gentemp "PROP"))
        (semantic-chunks
    (eval `(add-dm (,proposition isa proposition context ,context)
                   (,(gentemp "Semantic-chunk") isa semantic-chunk child ,agent parent ,proposition
                    role agent referent ,context)
                   (,(gentemp "Semantic-chunk") isa semantic-chunk child ,relation parent ,proposition
                    role relation referent ,context)
                   (,(gentemp "Semantic-chunk") isa semantic-chunk child ,object parent ,proposition
                    role object referent ,context)))))
    (eval `(set-ia (,agent ,proposition 10) (,relation ,proposition 10)
                   (,object ,proposition 10)))))


(defun encode-it (word type)
  (cond ((assoc word *assoc*) (second (assoc word *assoc*)))
        (t
  (let ((idea (gentemp (string word))))
    (setf *assoc* (cons (list word idea) *assoc*))
    (eval `(add-dm (,word isa chunk)
            (,idea isa chunk)
            (,(gentemp "LEX") isa lex-entry type ,type word ,word meaning ,idea)))
    idea))))

;to derive predictions for Anderson (1974)
(defun predictions (intercept mismatch noise latency word)
  (setf *no* (- intercept .20))
(setf *yes* (- intercept .20))
(setf *mismatch* mismatch)
(setf *encoding* .2)
(setf *snoise* noise)
(setf *factor* latency)
(setf *read* word)
  (let* ((div noise)
         (iv (mapcar 'car (do-immediate 1 nil nil)))
        (ip (mapcar 'car (do-immediate 1 nil t)))
        (tiv (/ (apply '+ iv) 8))
        (tip (/ (apply '+ ip) 8))
        (iprob (/ (exp (/ tip div)) (+ (exp (/ tip div))
                                               (exp (/ tiv div)))))
        (dv1 (mapcar 'car (do-delay 1 nil nil)))
        (dp1 (mapcar 'car (do-delay 1 nil t)))
        (tdv1 (/ (apply '+ dv1) 8))
        (tdp1 (/ (apply '+ dp1) 8))
        (dprob1 (/ (exp (/ tdp1 div)) (+ (exp (/ tdp1 div))
                                               (exp (/ tdv1 div))))))
    (do ((tiv iv (cdr tiv))
         (tip ip (cdr tip))
         (iresult nil (cons (+ (* iprob (car tiv)) (* (- 1 iprob) (car tip)))
                            iresult))
         (tdv1 dv1 (cdr tdv1))
         (tdp1 dp1 (cdr tdp1))
         (dresult1 nil (cons (+ (* dprob1 (car tdv1)) (* (- 1 dprob1) (car tdp1)))
                            dresult1)))
        ((null tiv) (list (reverse iresult) 
                          (reverse dresult1))))))

(defun do-experiment-present (sent1 sent2 sign flag)
  (let (hold) (reset) (eval `(sgp :v ,*v*))
       (if flag (spp retrieve-sentence :r .5)  (spp begin-comprehend :r .5))       
  (setf *sentence* sent1) (setf *goal* 'goal)
  (goal-focus goal)
  (run) 
  (setf *time* (+ 0 *time*) )(setf hold *time*)
  (setf *sentence* sent2) (setf *goal* 'goal1)
  (goal-focus goal1) (setf *hold* *sentence*)
   (run) 
  (- *time* hold)))

(defun do-immediate (n sign flag)
  (do ((count 0 (1+ count))
        (t1 nil (cons (do-experiment-present sent1 sent1 sign flag) t1))
        (t2 nil (cons (do-experiment-present sent1 sent4 sign flag) t2))
        (t3 nil (cons (do-experiment-present sent4 sent1 sign flag) t3))
        (t4 nil (cons (do-experiment-present sent4 sent4 sign flag) t4))
        (t5 nil (cons (do-experiment-present sent1 sent2 sign flag) t5))
        (t6 nil (cons (do-experiment-present sent1 sent3 sign flag) t6))
        (t7 nil (cons (do-experiment-present sent3 sent1 sign flag) t7))
        (t8 nil (cons (do-experiment-present sent3 sent4 sign flag) t8)))
    ((equal count n) (mapcar 'average (list t1 t2 t3 t4 t5 t6 t7 t8)))))

(defun rehearse-sentence (val)
  (do ((chunks (no-output (sdm isa syntactic-chunk)) (cdr chunks)))
      ((null chunks) nil)
    (eval `(sdp ,(car chunks) :references ,val))))

(defun do-experiment-delay (sent1 sent2 sign flag)
  (let (hold) (reset) (eval `(sgp :v ,*v*))
       (if flag (spp retrieve-sentence :r .5)  (spp begin-comprehend :r .5))
  (setf *sentence* sent1) (setf *goal* 'goal)
  (goal-focus goal)
  (run) (rehearse-sentence 3)
  (setf *time* (+ 120 *time*) )(setf hold *time*)
  (setf *sentence* sent2) (setf *goal* 'goal1)
  (goal-focus goal1) (setf *hold* *sentence*)
   (run) 
  (- *time* hold)))

(defun do-delay (n sign flag)
  (do ((count 0 (1+ count))
        (t1 nil (cons (do-experiment-delay sent1 sent1 sign flag) t1))
        (t2 nil (cons (do-experiment-delay sent1 sent4 sign flag) t2))
        (t3 nil (cons (do-experiment-delay sent4 sent1 sign flag) t3))
        (t4 nil (cons (do-experiment-delay sent4 sent4 sign flag) t4))
        (t5 nil (cons (do-experiment-delay sent1 sent2 sign flag) t5))
        (t6 nil (cons (do-experiment-delay sent1 sent3 sign flag) t6))
        (t7 nil (cons (do-experiment-delay sent3 sent1 sign flag) t7))
        (t8 nil (cons (do-experiment-delay sent3 sent4 sign flag) t8)))
    ((equal count n) (mapcar 'average (list t1 t2 t3 t4 t5 t6 t7 t8)))))

(defparameter sent1 '(Bob thanked the-hostess))
(defparameter sent2 '(The-hostess thanked Bob))
(defparameter sent3 '(Bob was thanked by the-hostess))
(defparameter sent4 '(The-hostess was thanked by Bob))
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</xmp><pre><a name="model">
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</a>
;;;
;;; The ACT-R model

(clearall)
(setf *assoc* '((ate *eat*) (consumed *eat*)))
(eval `(sgp :era t :lf ,*factor* :bll .5 :rt -1.5))

(chunk-type parse word type link link-type task past meaning)
(chunk-type proposition context)
(chunk-type match-props agent relation object context referent check response)
(chunk-type struct)
(chunk-type lex-entry word type meaning)
(chunk-type semantic-chunk child parent role referent context)
(chunk-type syntactic-chunk child parent role referent context)
(chunk-type respond response parent)
(chunk-type response opposite)
(chunk-type associate proposition agent relation object)
(chunk-type find-referent meaning agent relation object)
(chunk-type match-up struct response state struct-test word)

(add-dm (goal isa parse task comprehend) (retrieve isa chunk)
        (the-mouse isa chunk) (the-cat isa chunk) (switch isa chunk)
        (goal1 isa match-up response yes state start) (args isa chunk)
        (subject isa chunk) (role isa chunk) (start isa chunk)
        (bob isa chunk) (*bob* isa chunk) (bobby isa chunk) (again isa chunk)
        (dan-n isa lex-entry type noun word dan meaning *dan*)
        (danny-n isa lex-entry type noun word danny meaning *dan*)
        (dan isa chunk) (*dan* isa chunk) (danny isa chunk)
        (bob-n isa lex-entry type noun word bob meaning *bob*)
        (bobby-n isa lex-entry type noun word bobby meaning *bob*)
        (tom isa chunk) (*tom* isa chunk) (tommy isa chunk)
        (tom-n isa lex-entry type noun word tom meaning *tom*)
        (tommy-n isa lex-entry type noun word tommy meaning *tom*)
        (the-det isa lex-entry type det word the) (null isa chunk)
        (the-cat-n isa lex-entry type noun word the-cat meaning *cat*)
        (chased-v isa lex-entry type verb word chased meaning *chase*)
        (petted-v isa lex-entry type verb word petted meaning *pet*)
        (petted isa chunk) (*pet* isa chunk) (plaus isa chunk)
        (eat-v isa lex-entry type verb word ate meaning *eat*)
        (consume-v Isa lex-entry type verb word consumed meaning *eat*)
        (ate isa chunk)(consumed isa chunk) (*eat* isa chunk)
        (the-mouse-n isa lex-entry type noun word the-mouse meaning *mouse*)
        (by-prep isa lex-entry type prep word by) (comprehend isa chunk)
        (prep isa chunk) (by isa chunk) (pp isa chunk) (recognize isa chunk)
        (first-np isa chunk) (form isa chunk) (noun-match isa chunk)
        (yes isa response opposite no) (no isa response opposite yes)
        (*cat* isa chunk) (*chase* isa chunk) (*mouse* isa chunk)
        (was-aux isa lex-entry type aux word was) (subj-test isa chunk)
        (was isa chunk) (aux isa chunk) (needs-subj isa chunk)
        (mouse isa chunk) (eos isa chunk) (done isa chunk) (experiment isa chunk)
        (np isa chunk) (vp isa chunk) (sent isa chunk) (agent isa chunk) (object isa chunk)
        (relation isa chunk) (arg1 isa chunk) (arg2 isa chunk)
        (chased isa chunk) (verb isa chunk) (aux-test isa chunk) (vp1 isa chunk)
        (cat isa chunk) (noun isa chunk)(head isa chunk) (sentence1 isa chunk)
        (det isa chunk)(the isa chunk))

(encode-script 'r-script
                 '((p1 entered the-restaurant high)
                  (the-hostess seated p1 low)
                  (p1 ordered the-meal high)
                  (the-waiter delivered the-meal low)
                  (p1 ate the-meal high)
                  (p1 paid the-waiter low)
                  (p1 thanked the-hostess low)
                  (p1 left the-restaurant high)) 'p1)

(encode-script 'l-script
                  '((p2 entered the-laundromat high)
                    (p2 sorted the-clothes low)
                    (p2 found the-washer low)
                    (the-washer cleaned the-clothes high)
                    (p2 moved the-clothes low )
                    (the-dryer dried the-clothes high)
                    (p2 collected the-clothes low)
                    (p2 left the-laudromat high)) 'p2)

(setf *study* '((Bob entered the-restaurant)
                (Bob ordered the-meal)
                (the-waiter delivered the-meal)
                (Bob ate the-meal)))

(setf *test* '(                (Bob entered the-restaurant)
                (Bob ordered the-meal)
                (Bob left the-restaurant)
                (Bob paid the-waiter)
                (Bob delivered the-meal)

))
(sdp :references 1000 :creation-time -10000)

(no-output (do ((props (sdm isa proposition) (cdr props)))
    ((null props) nil)
    (eval `(sdp ,(car props) :references 1 :creation-time -10000))))
(goal-focus goal)

(p read-word
   =goal>
      isa parse
      word nil
==>
!eval! (read-word))

(eval `(spp read-word :effort ,*read*))

;productions for parsing
(p retrieve-type
   =goal>
      isa parse
      word =word
   -  word eos
      type nil
   =entry>
      isa lex-entry
      word =word
      type =type
==>
  =goal>
      type =type)

(p np-no-sent
   =goal>
      isa parse
      type noun
      word =word
      link nil
      meaning nil
   =lex>
      isa lex-entry
      word =word
      meaning =mean
==>
  =meaning>
      isa proposition
  =np>
      isa struct
  =sent>
      isa struct
  =semantic-chunk>
       isa semantic-chunk
       role agent
       parent =meaning
       child =mean
       context experiment
  =syntactic-chunk1>
      isa syntactic-chunk
      referent np
      role head
      child =word
      parent =np
      context sentence1
  =syntactic-chunk2>
      isa syntactic-chunk
      referent sent
      role arg1
      child =np
      parent =sent
      context sentence1
  =goal>
      word nil
      type nil
      link =np
      link-type np
      meaning =meaning
)

(p np-vp
   =goal>
      isa parse
      type noun
      word =word
      link =vp
      link-type vp
      meaning =meaning
  =lex>
     isa lex-entry
     word =word
     meaning =mean
==>
  =semantic-chunk>
     isa semantic-chunk
     role object
     child =mean
     parent =meaning
     context experiment
  =np>
      isa struct
  =syntactic-chunk1>
     isa syntactic-chunk
      referent np
      role head
      child =word
      parent =np
      context sentence1
  =syntactic-chunk2>
     isa syntactic-chunk
     referent vp
     role arg2
     child =np
     parent =vp
     context sentence1
  =goal>
      word nil
      type nil
      link =np
      link-type np
)

(p np-pp
   =goal>
      isa parse
      type noun 
      word =word
      link =pp
      link-type pp
      meaning =meaning
  =lex>
     isa lex-entry
     word =word
     meaning =mean
==>
  =semantic-chunk>
     isa semantic-chunk
     role agent
     parent =meaning
     child =mean
     context experiment
  =np>
      isa struct
  =syntactic-chunk1>
     isa syntactic-chunk
      referent np
      role head
      child =word
      parent =np
      context sentence1
  =syntactic-chunk2>
     isa syntactic-chunk
     referent pp
     role head
     child =np
     parent =pp
     context sentence1
  =goal>
      word nil
      type nil
      link =np
      link-type np
)

(p verb-attach
   =goal>
      isa parse
      type verb
      word =word
      link =vp1
      link-type vp1
      meaning =meaning
   =role1>
      isa semantic-chunk
      parent =meaning
      role agent
      child =noun
   =syntactic-chunk>
      isa syntactic-chunk
      child =vp1
      parent =parent
   =lex>
      isa lex-entry
      word =word
      meaning =mean
==>
   =semantic-chunk>
      isa semantic-chunk
      role relation
      parent =meaning
      child =mean
      context experiment
   =role1>
      role object
   =syntactic-chunk2>
      isa syntactic-chunk
      referent vp1
      role head
      child =word
      parent =vp1
      context sentence1
   =goal>
      link =parent
      link-type vp
      type nil
      word nil)


(p prep-sent
   =goal>
      isa parse
      type prep
      word =word
      link =vp
      link-type vp
==>
  =prepp>
      isa struct
  =syntactic-chunk1>
      isa syntactic-chunk
      referent pp
      role arg1
      child =word
      parent =prepp
      context sentence1
  =syntactic-chunk2>
      isa syntactic-chunk
      referent vp
      role arg2
      child =prepp
      parent =vp
      context sentence1
  =goal>
      word nil
      type nil
      link =prepp
      link-type pp
)


(p verb-np
   =goal>
      isa parse
      type verb
      word =word
      link =np
      link-type np
      meaning =meaning
   =orole>
      isa syntactic-chunk
      child =np
      parent =sent
   =lex>
      isa lex-entry
      word =word
      meaning =mean
==>
   =semantic-chunk>
      isa semantic-chunk
      role relation
      child =mean
      parent =meaning
      context experiment
   =vp>
      isa struct
   =vp1>
      isa struct
   =syntactic-chunk1>
      isa syntactic-chunk
      referent vp1
      role head
      child =word
      parent =vp1
      context sentence1
   =syntactic-chunk3>
      isa syntactic-chunk
      referent vp1
      role arg1
      child null
      parent =vp1
      context sentence1
  =syntactic-chunk2>
      isa syntactic-chunk
      referent sent
      role head
      child =vp
      parent =sent
      context sentence1
   =syntactic-chunk4>
      isa syntactic-chunk
      referent vp
      role head
      child =vp1
      parent =vp
      context sentence1
   =goal>
     link =vp
     word nil
     type nil
     link-type vp)

(p aux-vp
   =goal>
      isa parse
      type aux
      word =word
      link =np
      link-type np
      meaning =meaning
   =orole>
      isa syntactic-chunk
      child =np
      parent =sent
==>
  =vp>
     isa struct
  =vp1>
     isa struct
   =syntactic-chunk1>
      isa syntactic-chunk
      referent vp1
      role arg1
      child =word
      parent =vp1
      context sentence1
  =syntactic-chunk2>
      isa syntactic-chunk
      referent sent
      role head
      child =vp
      parent =sent
      context sentence1
  =syntactic-chunk3>
      isa syntactic-chunk
      referent vp
      role head
      child =vp1
      parent =vp
      context sentence1
   =goal>
     word nil
     type nil
     link =vp1
     link-type vp1
     past =word)

; productions for trying to find a situational referent
(p complete
  =goal>
     isa parse
     word eos
     task comprehend
     meaning =meaning
  =semantic-chunk1>
     isa semantic-chunk
     parent =meaning
     role agent
     child =agent
  =semantic-chunk2>
     isa semantic-chunk
     parent =meaning
     role relation
     child =relation
   =semantic-chunk3>
     isa semantic-chunk
     parent =meaning
     role object
     child =object
==>
=newgoal>
   isa find-referent
   agent =agent
   relation =relation
   object =object
!focus-on! =newgoal)

(p Find-Referent
   =goal>
      isa find-referent
      agent =agent
      relation =relation
      object =object
   =proposition>
      isa proposition
==>
=newgoal>
    isa associate
    proposition =proposition
      agent =agent
      relation =relation
      object =object
!focus-on! =newgoal)


(p Associate
   =goal>
     isa associate
     proposition =proposition
      agent =agent
      relation =relation
      object =object
  =proposition>
     isa proposition
  =semantic-chunk1>
     isa semantic-chunk
     parent =meaning
     role agent
     child =agent
     context experiment
     referent nil
  =semantic-chunk2>
     isa semantic-chunk
     parent =meaning
     role relation
     child =relation
     context experiment
     referent nil
   =semantic-chunk3>
     isa semantic-chunk
     parent =meaning
     role object
     child =object
     context experiment
     referent nil
==>
   =semantic-chunk1>
     referent =proposition
   =semantic-chunk2>
     referent =proposition
   =semantic-chunk3>
     referent =proposition
!pop!)

(p go-ahead
   =goal>
      isa find-referent
      agent =agent
      relation =relation
      object =object
  =semantic-chunk1>
     isa semantic-chunk
     parent =meaning
     role agent
     child =agent
     context experiment
     referent nil
  =semantic-chunk2>
     isa semantic-chunk
     parent =meaning
     role relation
     child =relation
     context experiment
     referent nil
   =semantic-chunk3>
     isa semantic-chunk
     parent =meaning
     role object
     child =object
     context experiment
     referent nil
==>
!pop!)

(spp go-ahead :r .5)

;productions that implement match of either proposition or situational referent

(p match-props
  =goal>
     isa parse
     word eos
     task recognize
     meaning =meaning
  =semantic-chunk1>
     isa semantic-chunk
     parent =meaning
     child =agent
     role agent
  =semantic-chunk2>
     isa semantic-chunk
     parent =meaning
     child =relation
     role relation
  =semantic-chunk3>
     isa semantic-chunk
     parent =meaning
     child =object
     role object
==>
  =newgoal>
     isa match-props
     agent =agent
     object =object
     relation =relation
     context experiment
!focus-on! =newgoal)

(p try-plausibility
   =goal>
      isa match-props
      context =context
      referent nil 
!eval!  *plaus*
   =mrole>
      isa semantic-chunk
      context =context
      referent =prop1
   =role>
       isa semantic-chunk
       parent =prop1
       referent =script
    =prop>
       isa proposition
       context =script
==>
!eval! (setf *plaus* nil)
   =goal>
      referent =prop
      context agent
      response yes
      check nil)

(p default-no
  =goal>
      isa match-props
==>
!eval! (setf *response* nil)
  =newgoal>
     isa respond
     response nil
     parent =goal
!focus-on! =newgoal)  

(spp default-no :r .25)


(p try-retrieval
   =goal>
      isa match-props
      context =context
      relation =relation
      referent nil
  =semantic-chunk>
      isa semantic-chunk
      parent =proposition
      role relation
      context =context
      referent =referent
!eval! *retrieval*
==>
   =goal>
      referent =proposition
      check nil
      context agent
      response yes)


(p check-agent
   =goal>
       isa match-props
       referent =referent
       context agent
       check nil
    =semantic-chunk>
       isa semantic-chunk
       parent =referent
       role agent
       child =term
==>
    =goal>
       check =term)


(p checked-agent
   =goal>
       isa match-props
       referent =referent
       context agent
       check =agent
       agent =agent
==>
    =goal>
       check nil
       context relation)

      
(p check-relation
   =goal>
       isa match-props
       referent =referent
       context relation
       check nil
    =semantic-chunk>
       isa semantic-chunk
       parent =referent
       role relation
       child =term
==>
    =goal>
       check =term)

(p checked-relation
   =goal>
       isa match-props
       referent =referent
       context relation
       check =relation
       relation =relation
==>
    =goal>
       check nil
       context object)

(p check-object
   =goal>
       isa match-props
       referent =referent
       context object
       check nil
    =semantic-chunk>
       isa semantic-chunk
       parent =referent
       role object
       child =term
==>
    =goal>
       check =term)

(p checked-object
   =goal>
       isa match-props
       referent =referent
       context object
       check =object
       object =object
       response =response
==>
=newgoal>
     isa respond
     response =response
     parent =goal
!focus-on! =newgoal)


(p fail-check-agent
   =goal>
       isa match-props
       context agent
       check =object
!eval! (not (member =object *vars*))   
==>
  =goal>
     check nil 
     context relation
     response no
) 

(EVAL `(spp fail-check-agent :r .5 :effort ,(+ 0.05 *mismatch*)))

(p variable-agent
   =goal>
       isa match-props
       context agent
       check =object
!eval! (member =object *vars*)   
==>
  =goal>
     check nil 
     context relation
) 

(p fail-check-relation
   =goal>
       isa match-props
       context relation
       check =object
!eval! (not (member =object *vars*))  
==>
  =goal>
     check nil 
     context object
     response no
) 

(eval `(spp fail-check-relation :r .5 :effort ,(+ 0.05 *mismatch*)))



(p variable-relation
   =goal>
       isa match-props
       context relation
       check =object
!eval! (member =object *vars*)  
==>
=goal>
     check nil
     context object)

(p fail-check-object
   =goal>
       isa match-props
       context object
       check =object
!eval!  (not (member =object *vars*))
==>
=newgoal>
     isa respond
     response no
     parent =goal
!focus-on! =newgoal)

(eval `(spp fail-check-object :r .5 :effort ,(+ 0.05 *mismatch*)))




(p variable-object
   =goal>
       isa match-props
       context object
       check =object
       response =response
!eval! (member =object *vars*)
==>
=newgoal>
     isa respond
     response =response
     parent =goal
!focus-on! =newgoal)

(p start-recognition
  =goal>
     isa match-up
     state start
     word nil
==>
!eval! (read-word))

(eval `(spp start-recognition :effort ,*encoding*))

;productions that choose between syntax matching and a comprehension strategy

(p retrieve-sentence
   =goal>
     isa match-up
     state start
     word =word
     struct nil
   =syntactic-chunk>
     isa syntactic-chunk
     role head
     referent =type
     child =word
     parent =np
==>
   =goal>
     struct =np
     struct-test =type)

(p begin-comprehend
   =goal>
     isa match-up
     word =word
==>
!eval! (reset-sent)
   =newgoal> 
      isa parse 
      task recognize
!eval! (setf *goal* =newgoal)
!focus-on! =newgoal)

;productions that implement syntactic matching

(p retrieve-again
   =goal>
     isa match-up
     state start
     word =word
     struct =struct
   - struct-test sent
   =syntactic-chunk>
     isa syntactic-chunk
     child =struct
     parent =parent
     referent =type
==>
   =goal>
     struct =parent
     struct-test =type)

(p retrieve-subject
   =goal>
      isa match-up
      state start
      struct =struct
      struct-test sent
   =syntactic-chunk0>
     isa syntactic-chunk
     referent sent
     role head
     child =vp
     parent =struct
  =syntactic-chunk1>
      isa syntactic-chunk
      referent sent
      role arg1
      child =subj
      parent =struct
  =syntactic-chunk2> 
      isa syntactic-chunk 
      referent np
      role head
      child =head
      parent =subj
==>
  =goal>
      struct =vp
      struct-test =head
      state subj-test)

(p subjects-match
   =goal>
      isa match-up
      state subj-test
      struct-test =noun
      word =noun
==>
   =goal>
      struct-test null
      state aux-test
!eval! (read-word))

(eval `(spp subjects-match :effort ,*read*))

(p subjects-mismatch
   =goal>
      isa match-up
      state subj-test
      struct-test =noun
   -  word =noun
      response =response
==>
   =goal>
      struct-test null
      state aux-test
      response no
!eval! (read-word))

(eval `(spp subjects-mismatch :effort ,*read*))

(p retrieve-aux
   =goal>
     isa match-up
     state aux-test
     struct-test null
     struct =struct
   =syntactic-chunk2>
     isa syntactic-chunk
     referent vp
     role head
     child =vp1
     parent =struct
   =syntactic-chunk3>
     isa syntactic-chunk
     referent vp1
     role arg1
     child =aux
     parent =vp1
==>
  =goal>
     state aux
     struct-test =aux)

(p aux-aux
   =goal>
      isa match-up
      state aux
      word =word
      struct-test =word
      struct =struct
==>
!eval! (read-word)
  =goal>
     struct-test null)

(eval `(spp aux-aux :effort ,*read*))


(p retrieve-verb
   =goal>
      isa match-up
     state aux
      - word was
      struct-test null
      response =response
      word =struct
==>
  =newgoal>
     isa respond
     response =response
     parent =goal
!focus-on! =newgoal)

(p aux-noaux-yes
   =goal>
      isa match-up
      state aux
    -  word was
      struct-test was
      response no
==>
  =goal>
     response yes
     struct-test null)

(eval `(spp aux-noaux-yes :effort ,(+ 0.05 *mismatch*)))

(p noaux-aux-yes
   =goal>
      isa match-up
     state aux
      word was
      struct-test null
      struct =struct
      response no
==>
!eval! (read-word)
  =goal>
     response yes) 

(eval `(spp noaux-aux-yes :effort ,(+ *mismatch* *read*)))

(p aux-noaux-no
   =goal>
      isa match-up
      state aux
    -  word was
      struct-test was
      response yes
      struct =struct
   =syntactic-chunk1>
      isa syntactic-chunk
      referent vp
      parent =struct
      child =vp1
      role head
    =syntactic-chunk2>
      isa syntactic-chunk
      referent vp1
      parent =vp1
      child =head
      role head
==>
  =goal>
     response no
     struct-test null)

(eval `(spp aux-noaux-no :effort ,(+ 0.05 *mismatch*)))

(p noaux-aux-no
   =goal>
      isa match-up
     state aux
      word was
      struct-test null
      struct =struct
      response yes
   =syntactic-chunk1>
      isa syntactic-chunk
      referent vp
      parent =struct
      child =vp1
      role head
    =syntactic-chunk2>
      isa syntactic-chunk
      referent vp1
      parent =vp1
      child =head
      role head
==>
!eval! (read-word)
  =goal>
     response no) 

(eval `(spp noaux-aux-no :effort ,(+ *mismatch* *read*)))
;response generation productions
  

(p respond-yes
  =goal>
     isa respond
     response yes
==>
!eval! (setf *response* 'yes)
!output! yes
!pop!)

(eval `(spp respond-yes :effort ,*yes*))

(p respond-no
  =goal>
     isa respond
     response no
!eval! (not *plaus*)
==>
!eval! (setf *response* 'no)
!output! no
!pop!)

(eval `(spp respond-no :effort ,*no*))

(p switch-plausibility
   =goal>
       isa respond
      - response yes
       parent =newgoal
!eval! (and *plaus* *retrieval*)
   =newgoal>
       isa match-props
==>
!eval! (setf *retrieval* nil)
  =newgoal>
       context experiment
       referent nil
       check nil
       response nil
!focus-on! =newgoal)

(spp switch-plausibility :r 1.0)

(p respond-no-ANYWAYS
  =goal>
     isa respond
     response no
!eval! *plaus*
==>
!eval! (setf *response* 'no)
!output! no
!pop!)

(eval `(spp respond-no-anyways :effort ,*no* :R 0.95))

(p guess-no
    =goal>
       isa respond
       response nil
!eval! (not *plaus*)
==>
!eval! (setf *response* 'no)
!output! no
!pop!)

(eval `(spp guess-no :effort ,(+ *flail* *no*)))

(p guess-yes
    =goal>
       isa respond
       response nil
!eval! (not *plaus*)
==>
!eval! (setf *response* 'yes)
!output! yes
!pop!)

(eval `(spp guess-yes :effort ,(+ *flail* *yes*)))