;


;? (prediction 1000 *tnoise* *MYF* *MYrt* *MYans* *intercept* *flail* 34 .9 .12)
;((2.2825219213372225 0.8712201214551573 2.2805549009111505 0.8622860001152304 2.5435756582886233 0.88 3.0010679395398485 0.804 2.877735958215894 0.88) 
;(2.527724054710839 0.8660316269555351 2.3765863129279654 0.8322893956620042 3.003691657301336 0.586203812268628 2.659512672618731 0.804 2.691345318650561 0.88) 
;(2.97688216774599 0.6526953643486675 2.373005712299652 0.8055038561543372 3.1168693673597576 0.5050339947764386 2.508793289888122 0.804 2.466559428036153 0.88))

(defvar *sentence*) (defvar *goal*) (defvar *hold*) (defvar *retrieval*)
(defvar sent1) (defvar sent2) (defvar sent3)(defvar sent4)
(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)
(defvar *encoding*)
(setf *encoding* 0.2)
(defvar *mismatch*)
(setf *mismatch* .1)
(setf *no* 0.65)
(setf *yes* .65)
(defparameter *intercept* 0.85)
(defvar *myrt*)
(defvar *myans*)
(setf *myrt* .3)
(setf *myans* .2)
(defvar *flail*)
(setf *flail* 0.80)
(defvar *myf*)
(setf *myf* .3)
(defvar *tnoise*)
(setf *tnoise* .05)
(defvar *slip* .12)
(defvar *goal-val* 34)
(defvar *text* t)
(defvar *graphic* nil)
(defvar *v* nil)
(defvar *overlay* nil)
(defvar *runs* 1)
(defvar *p-plause* .9)

(defvar *latency-data-r82* '((2.16	2.395	2.5875	3	2.86)
(2.6025	2.3175	2.96	2.665	2.69)
(2.8975	2.3525	3.16	2.5475	2.43)))

(defvar *accuracy-data-r82* '((0.1425	0.22	0.0825	0.18	0.11)
(0.1625	0.4075	0.105	0.2025	0.135)
(0.28	0.55	0.135	0.205	0.16)))
   
(defvar *WWW-interface*)

(setf  *WWW-interface* 
      '((:heading "Reder 1982" 2)
        (:table)
        
        (:table)
        "Intercept: " (:string :sy *intercept*  .85)   (:new-row)
        "Slip probability: "     (:string :sy *slip*  .12)   (:new-row)
        "Goal value, G: "          (:string :sy *goal-val*  34)  (:new-row)
        "Guess latency: "          (:string :sy *flail*  .8)     (:new-row)
        "Probability of plausible: " (:string :sy *p-plause* .9)     (:new-row)
        "Number of runs (20 - 500): "                        (:string :sy *runs* 20)     (:new-row)
        (:table-end)
        
        (:table)
        (:checkbox "Trace (NOT recomended, see below)" :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-r82 nil (list *latency-data-r82* *accuracy-data-r82*))")
        
        (:new-para)
        
        (:button "Run model" "(if (and (numberp *intercept*) (numberp *slip*)
                                       (numberp *goal-val*) (numberp *flail*)
                                       (numberp *runs*) (numberp *p-plause*)
                                       )
                                   (display-r82  (prediction (min 500 (max 20 *runs*)) *tnoise* *MYF* *MYrt* *MYans* *intercept* *flail* *goal-val* *p-plause* *slip*) (list *latency-data-r82* *accuracy-data-r82*))
                                   
                                   (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 2 minutes for 20 runs of the model"
        (:new-line)
        "- The trace of 20 runs is approximatly 2M bytes (1500 pages) in size"
        (:new-para)))


(defun display-r82 (model exp)
  (when model 
    (format *standard-output* "~%~%Parameters for run: (~S ~S ~S ~S ~S ~s)~%" 
             *intercept* *slip* *goal-val* *flail* *p-plause* (min 1000 (max *runs* 20))))

  (when *text*
    
      (when model
        (format *standard-output* "~%ACT-R Latency~%Condition                             Delay~%               Immediate     20 minutes    2 days~%")
        (dotimes (i 5)
          (format *standard-output* "~18a~4,2f          ~4,2f        ~4,2f~%" (case i 
                                                                           (0 "Recognize Old")
                                                                           (1 "Plausible Old")
                                                                           (2 "Recognize New")
                                                                           (3 "Plausible New")
                                                                           (4 "Implausible"))
                  (nth i (first (first model)))
                  (nth i (second (first model)))
                  (nth i (third (first model)))
                  ))
        (format *standard-output* "~%ACT-R Accuracy~%Condition                             Delay~%               Immediate     20 minutes    2 days~%")
        (dotimes (i 5)
          (format *standard-output* "~18a~4,2f          ~4,2f        ~4,2f~%" (case i 
                                                                           (0 "Recognize Old")
                                                                           (1 "Plausible Old")
                                                                           (2 "Recognize New")
                                                                           (3 "Plausible New")
                                                                           (4 "Implausible"))
                  (nth i (first (second model)))
                  (nth i (second (second model)))
                  (nth i (third (second model)))
                  ))

        )

      (when (or (null model) *overlay*)
        (format *standard-output* "~%Experimental Latency~%Condition                       Delay~%               Immediate     20 minutes    2 days~%")
        (dotimes (i 5)
          (format *standard-output* "~18a~4,2f          ~4,2f        ~4,2f~%" (case i 
                                                                           (0 "Recognize Old")
                                                                           (1 "Plausible Old")
                                                                           (2 "Recognize New")
                                                                           (3 "Plausible New")
                                                                           (4 "Implausible"))
                  (nth i (first (first exp)))
                  (nth i (second (first exp)))
                  (nth i (third (first exp)))
                  ))
        (format *standard-output* "~%Experimental Accuracy~%Condition                      Delay~%               Immediate     20 minutes    2 days~%")
        (dotimes (i 5)
          (format *standard-output* "~18a~4,2f          ~4,2f        ~4,2f~%" (case i 
                                                                           (0 "Recognize Old")
                                                                           (1 "Plausible Old")
                                                                           (2 "Recognize New")
                                                                           (3 "Plausible New")
                                                                           (4 "Implausible"))
                  (nth i (first (second exp)))
                  (nth i (second (second exp)))
                  (nth i (third (second 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 = 500 
        height = 400> 
        <PARAM name=\"title\" value=\"Reder 1982\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"4\">
        <PARAM name=\"ymax\" value=\"3.4\">
        <PARAM name=\"ymin\" value=\"2.0\">
        <PARAM name=\"numxlabels\" value=\"5\">
        <PARAM name=\"xlabels\" value=\" ;Immed;20 Min;2 days; ;\">
        <PARAM name=\"widestxlabel\" value=\"WWWWWW\">
        <PARAM name=\"longestline\" value=\"3\">
        <PARAM name=\"numlines\" value=\"~s\">
        <PARAM name=\"yspacing\" value=\".2\">
        <PARAM name=\"ydiv\" value=\".1\">
        <PARAM name=\"xname\" value=\"Delay\">
        <PARAM name=\"yname\" value=\"Latency\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"xval0\" value=\"1;2;3;\">
        <PARAM name=\"lcolor1\" value=\"1\">
        <PARAM name=\"lstyle1\" value=\"~s\">
        <PARAM name=\"xval1\" value=\"1;2;3;\">
        <PARAM name=\"lcolor2\" value=\"2\">
        <PARAM name=\"lstyle2\" value=\"~s\">
        <PARAM name=\"xval2\" value=\"1;2;3;\">
        <PARAM name=\"lcolor3\" value=\"3\">
        <PARAM name=\"lstyle3\" value=\"~s\">
        <PARAM name=\"xval3\" value=\"1;2;3;\">
        <PARAM name=\"lcolor4\" value=\"4\">
        <PARAM name=\"lstyle4\" value=\"~s\">
        <PARAM name=\"xval4\" value=\"1;2;3;\">
        <PARAM name=\"yval0\" value=\"~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"yval1\" value=\"~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"yval2\" value=\"~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"yval3\" value=\"~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"yval4\" value=\"~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"name0\" value=\"~a Recognize Old\">
        <PARAM name=\"name1\" value=\"~a Plausible Old\">
        <PARAM name=\"name2\" value=\"~a Recognize New\">
        <PARAM name=\"name3\" value=\"~a Plausible New\">
        <PARAM name=\"name4\" value=\"~a Implausible\">
       "
        

            (if (and model *overlay*) 10 5)
            
            (if model 2 6553)
            (if model 2 6553)
            (if model 2 6553)
            (if model 2 6553)
            (if model 2 6553)
            
            (nth 0 (nth 0 (first (if model model exp))))
            (nth 0 (nth 1 (first (if model model exp))))
            (nth 0 (nth 2 (first (if model model exp))))
            (nth 1 (nth 0 (first (if model model exp))))
            (nth 1 (nth 1 (first (if model model exp))))
            (nth 1 (nth 2 (first (if model model exp))))
            (nth 2 (nth 0 (first (if model model exp))))
            (nth 2 (nth 1 (first (if model model exp))))
            (nth 2 (nth 2 (first (if model model exp))))
            (nth 3 (nth 0 (first (if model model exp))))
            (nth 3 (nth 1 (first (if model model exp))))
            (nth 3 (nth 2 (first (if model model exp))))
            (nth 4 (nth 0 (first (if model model exp))))
            (nth 4 (nth 1 (first (if model model exp))))
            (nth 4 (nth 2 (first (if model model exp))))
            
            
            (if model "ACT-R" "Experimental")
            (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=\"lcolor5\" value=\"0\">
        <PARAM name=\"lstyle5\" value=\"6553\">
        <PARAM name=\"xval5\" value=\"1;2;3;\">
        <PARAM name=\"lcolor6\" value=\"1\">
        <PARAM name=\"lstyle6\" value=\"6553\">
        <PARAM name=\"xval6\" value=\"1;2;3;\">
        <PARAM name=\"lcolor7\" value=\"2\">
        <PARAM name=\"lstyle7\" value=\"6553\">
        <PARAM name=\"xval7\" value=\"1;2;3;\">
        <PARAM name=\"lcolor8\" value=\"3\">
        <PARAM name=\"lstyle8\" value=\"6553\">
        <PARAM name=\"xval8\" value=\"1;2;3;\">
        <PARAM name=\"lcolor9\" value=\"4\">
        <PARAM name=\"lstyle9\" value=\"6553\">
        <PARAM name=\"xval9\" value=\"1;2;3;\">
        <PARAM name=\"yval5\" value=\"~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"yval6\" value=\"~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"yval7\" value=\"~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"yval8\" value=\"~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"yval9\" value=\"~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"name5\" value=\"Experimental Recognize Old\">
        <PARAM name=\"name6\" value=\"Experimental Plausible Old\">
        <PARAM name=\"name7\" value=\"Experimental Recognize New\">
        <PARAM name=\"name8\" value=\"Experimental Plausible New\">
        <PARAM name=\"name9\" value=\"Experimental Implausible\">
         "
                (nth 0 (nth 0 (first exp)))
            (nth 0 (nth 1 (first exp)))
            (nth 0 (nth 2 (first exp)))
            (nth 1 (nth 0 (first exp)))
            (nth 1 (nth 1 (first exp)))
            (nth 1 (nth 2 (first exp)))
            (nth 2 (nth 0 (first exp)))
            (nth 2 (nth 1 (first exp)))
            (nth 2 (nth 2 (first exp)))
            (nth 3 (nth 0 (first exp)))
            (nth 3 (nth 1 (first exp)))
            (nth 3 (nth 2 (first exp)))
            (nth 4 (nth 0 (first exp)))
            (nth 4 (nth 1 (first exp)))
            (nth 4 (nth 2 (first 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>")

(format *standard-output* " 
        <applet 
        code = \"DansGraphs.class\" 
        width = 500 
        height = 400> 
        <PARAM name=\"title\" value=\"Reder 1982\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"4\">
        <PARAM name=\"ymax\" value=\"0.6\">
        <PARAM name=\"ymin\" value=\"0.0\">
        <PARAM name=\"numxlabels\" value=\"5\">
        <PARAM name=\"xlabels\" value=\" ;Immed;20 Min;2 days; ;\">
        <PARAM name=\"widestxlabel\" value=\"WWWWWW\">
        <PARAM name=\"longestline\" value=\"3\">
        <PARAM name=\"numlines\" value=\"~s\">
        <PARAM name=\"yspacing\" value=\".1\">
        <PARAM name=\"ydiv\" value=\".05\">
        <PARAM name=\"xname\" value=\"Delay\">
        <PARAM name=\"yname\" value=\"Accuracy\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"xval0\" value=\"1;2;3;\">
        <PARAM name=\"lcolor1\" value=\"1\">
        <PARAM name=\"lstyle1\" value=\"~s\">
        <PARAM name=\"xval1\" value=\"1;2;3;\">
        <PARAM name=\"lcolor2\" value=\"2\">
        <PARAM name=\"lstyle2\" value=\"~s\">
        <PARAM name=\"xval2\" value=\"1;2;3;\">
        <PARAM name=\"lcolor3\" value=\"3\">
        <PARAM name=\"lstyle3\" value=\"~s\">
        <PARAM name=\"xval3\" value=\"1;2;3;\">
        <PARAM name=\"lcolor4\" value=\"4\">
        <PARAM name=\"lstyle4\" value=\"~s\">
        <PARAM name=\"xval4\" value=\"1;2;3;\">
        <PARAM name=\"yval0\" value=\"~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"yval1\" value=\"~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"yval2\" value=\"~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"yval3\" value=\"~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"yval4\" value=\"~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"name0\" value=\"~a Recognize Old\">
        <PARAM name=\"name1\" value=\"~a Plausible Old\">
        <PARAM name=\"name2\" value=\"~a Recognize New\">
        <PARAM name=\"name3\" value=\"~a Plausible New\">
        <PARAM name=\"name4\" value=\"~a Implausible\">
       "
        

            (if (and model *overlay*) 10 5)
            
            (if model 2 6553)
            (if model 2 6553)
            (if model 2 6553)
            (if model 2 6553)
            (if model 2 6553)
            
            (nth 0 (nth 0 (second (if model model exp))))
            (nth 0 (nth 1 (second (if model model exp))))
            (nth 0 (nth 2 (second (if model model exp))))
            (nth 1 (nth 0 (second (if model model exp))))
            (nth 1 (nth 1 (second (if model model exp))))
            (nth 1 (nth 2 (second (if model model exp))))
            (nth 2 (nth 0 (second (if model model exp))))
            (nth 2 (nth 1 (second (if model model exp))))
            (nth 2 (nth 2 (second (if model model exp))))
            (nth 3 (nth 0 (second (if model model exp))))
            (nth 3 (nth 1 (second (if model model exp))))
            (nth 3 (nth 2 (second (if model model exp))))
            (nth 4 (nth 0 (second (if model model exp))))
            (nth 4 (nth 1 (second (if model model exp))))
            (nth 4 (nth 2 (second (if model model exp))))
            
            
            (if model "ACT-R" "Experimental")
            (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=\"lcolor5\" value=\"0\">
        <PARAM name=\"lstyle5\" value=\"6553\">
        <PARAM name=\"xval5\" value=\"1;2;3;\">
        <PARAM name=\"lcolor6\" value=\"1\">
        <PARAM name=\"lstyle6\" value=\"6553\">
        <PARAM name=\"xval6\" value=\"1;2;3;\">
        <PARAM name=\"lcolor7\" value=\"2\">
        <PARAM name=\"lstyle7\" value=\"6553\">
        <PARAM name=\"xval7\" value=\"1;2;3;\">
        <PARAM name=\"lcolor8\" value=\"3\">
        <PARAM name=\"lstyle8\" value=\"6553\">
        <PARAM name=\"xval8\" value=\"1;2;3;\">
        <PARAM name=\"lcolor9\" value=\"4\">
        <PARAM name=\"lstyle9\" value=\"6553\">
        <PARAM name=\"xval9\" value=\"1;2;3;\">
        <PARAM name=\"yval5\" value=\"~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"yval6\" value=\"~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"yval7\" value=\"~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"yval8\" value=\"~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"yval9\" value=\"~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"name5\" value=\"Experimental Recognize Old\">
        <PARAM name=\"name6\" value=\"Experimental Plausible Old\">
        <PARAM name=\"name7\" value=\"Experimental Recognize New\">
        <PARAM name=\"name8\" value=\"Experimental Plausible New\">
        <PARAM name=\"name9\" value=\"Experimental Implausible\">
         "
                (nth 0 (nth 0 (second exp)))
            (nth 0 (nth 1 (second exp)))
            (nth 0 (nth 2 (second exp)))
            (nth 1 (nth 0 (second exp)))
            (nth 1 (nth 1 (second exp)))
            (nth 1 (nth 2 (second exp)))
            (nth 2 (nth 0 (second exp)))
            (nth 2 (nth 1 (second exp)))
            (nth 2 (nth 2 (second exp)))
            (nth 3 (nth 0 (second exp)))
            (nth 3 (nth 1 (second exp)))
            (nth 3 (nth 2 (second exp)))
            (nth 4 (nth 0 (second exp)))
            (nth 4 (nth 1 (second exp)))
            (nth 4 (nth 2 (second 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 Reder(1982)
(defun do-experiment (study test sign time ret)
    (let (hold) (reset) (eval `(sgp :v ,*v* :er t))
         (spp retrieve-sentence :r 0.5)
         (spp begin-comprehend :r 1.0)
         (spp start-recognition :r 0.5)
         (spp try-retrieval :r 0.5)
         (spp try-plausibility :r 1.0)
         (do ((temp study (cdr temp)))
             ((null temp) nil)
           (setf *sentence* (car temp))
           (setf *goal* 'goal)
           (mod-chunk goal word nil type nil link nil link-type nil
                      task Comprehend past nil meaning nil)
           (goal-focus goal)
           (run)) (uniform-ias 6)
         (do ((temp test (cdr temp))
              (temp1 '(yes yes no yes no) (cdr temp1))
              (temp2 '(.5 1 .5 1 1) (cdr temp2))
              (result nil (cond ((equal *response* (car temp1)) (cons (- *time* hold) result))
                                (t (cons nil result)))))
             ((null  temp) (reverse result))
         (eval `(spp try-retrieval :r ,(- 1.5 (car temp2))))
         (eval`(spp try-plausibility :r ,(car temp2)))
         (cond ((and ret (equal (car temp2) 1)) 
                (spp try-retrieval :r 1)(spp try-plausibility :r 0.5)(setf *plaus* t))
               ((equal (car temp2) .5) (setf *plaus* nil))
               (t (setf *plaus* t)))
           (setf *time* time) 
           (setf hold *time*)
           (setf *sentence* (car temp))
           (setf *goal* 'goal1)
           (mod-chunk goal1 struct nil response Yes state Start struct-test nil word nil)
           (goal-focus goal1) 
           (setf *hold* *sentence*)
         (setf *retrieval* t)
           (run))))


(defun run-n (study test time  ret n plaus)
  (let (result)
    (do ((count 0 (1+ count))
         (r1 nil (cond ((numberp (first result)) (cons (first result) r1)) (t r1)))
         (r2 nil (cond ((numberp (second result)) (cons (second result) r2)) (t r2)))
         (r3 nil (cond ((numberp (third result)) (cons (third result) r3)) (t r3)))
         (r4 nil (cond ((numberp (fourth result)) (cons (fourth result) r4)) (t r4)))
         (r5 nil (cond ((numberp (fifth result)) (cons (fifth result) r5)) (t r5))))
        ((equal count n)  (plausibility (append (average r1 n) (average r2 n) 
                                                (average r3 n) (average r4 n)(average r5 n))
                                        plaus ret))
      (setf result (do-experiment study test nil time ret)))))

(defun plausibility (lis plausibility ret)
  (list (first lis) (second lis) (third lis) 
        (cond (ret (+ (second lis) 
                      (* plausibility (- 1 (second lis)))))
              (t (* 1 plausibility)))
        (fifth lis) (sixth lis) (seventh lis)(* 1 plausibility)
        (ninth lis) 1))
        

(defun utility (results G slip)
  (let* ((acc-pres (fourth results))
        (acc-not (eighth results))
        (mix-pres (+ (* acc-pres (- 1 slip)) (* (- 1 acc-pres) slip)))
        (mix-not (+ (* acc-not (- 1 slip)) (* (- 1 acc-not) slip)))
        (implaus (+ (* (tenth results) (- 1 slip)) (* (- 1 (tenth results)) slip)))
        (time (/ (+ (third results) (seventh results) (ninth results) (ninth results)) 4))
        (accuracy (/ (+ mix-pres mix-not implaus implaus) 4)))
;    (print (list acc-pres acc-not mix-pres mix-not implaus time accuracy))
    (- (* g accuracy) time)))


(defun prediction (n tnoise F rt ans intercept flail G plaus slip)
  (setf slip (- 1 slip))
  
  (setf *tnoise* tnoise)
  (setf *myrt* rt) (setf *myans* ans) (setf *myf* f)
    (setf *no* (- intercept .20))
(setf *yes* (- intercept .20))    
  (setf *flail* flail)

  (let* ((d120a (run-n *study* *test* 120 t n plaus))
         (d120b (run-n *study* *test* 120 nil n plaus))
         (dif120(- (utility d120a G slip)
                   (utility d120b G slip)))
         (e120 (/ 1 (+ 1 (exp (- (/ dif120 *tnoise*))))))
        (d120 (mapcar #'(lambda (x y) (+ (* e120 x) (* (- 1 e120) y))) d120a d120b))
        (d1200a  (run-n *study* *test* 1200 t n plaus))
        (d1200b (run-n *study* *test* 1200 nil n plaus))
         (dif1200 (- (utility d1200a G slip)
                   (utility d1200b G slip)))
         (e1200 (/ 1 (+ 1 (exp (- (/ dif1200 *tnoise*))))))
        (d1200 (mapcar #'(lambda (x y) (+ (* e1200 x) (* (- 1 e1200) y)))  d1200a d1200b))
        (d5000a (run-n *study* *test* 5000 t n plaus))
        (d5000b (run-n *study* *test* 5000 nil n plaus))
         (dif5000 (- (utility d5000a G slip)
                   (utility d5000b G slip)))
         (e5000 (/ 1 (+ 1 (exp (- (/ dif5000 *tnoise*))))))
        (d5000 (mapcar #'(lambda (x y) (+ (* e5000 x) (* (- 1 e5000) y)))  d5000a d5000b)))
;    (list (report d120 (- 1 slip)) (report d1200 (- 1 slip)) (report d5000 (- 1 slip)))
    (list (list (report-lat d120) (report-lat d1200) (report-lat d5000))
          (list (report-prob d120 (- 1 slip)) (report-prob d1200 (- 1 slip)) (report-prob d5000 (- 1 slip))))

           ))

(defun report-lat (lis)
  (list (first lis) 
        (third lis) 
        (fifth lis) 
        (seventh lis) 
        (ninth lis)))

(defun report-prob (lis slip)
  (list (probability (second lis) slip)
        (probability (fourth lis) slip)
        (probability (sixth lis) slip)
        (probability (eighth lis) slip)
        (probability (tenth lis) slip)))

(defun probability (p slip) (+ (* p slip) (* (- 1 p) (- 1 slip))))
        
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; The ACT-R model

(clearall)
(setf *assoc* '((ate *eat*) (consumed *eat*)))
(eval `(sgp :era t :lf ,*myf* :bll .5 :rt ,*myrt* :ans ,*myans*))

(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)(sentence1 isa chunk)
        (chased isa chunk) (verb isa chunk) (aux-test isa chunk) (vp1 isa chunk)
        (cat isa chunk) (noun isa chunk)(head 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
  =syntactic-chunk2>
      isa syntactic-chunk
      referent sent
      role arg1
      child =np
      parent =sent
  =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
  =syntactic-chunk2>
     isa syntactic-chunk
     referent pp
     role head
     child =np
     parent =pp
  =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 try-retrieval-again
   =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)

(spp try-retrieval-again :r 0.75)


(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*)))