;;;<pre><xmp>


(defvar ac1 nil)
(defvar ac3 nil)
(defvar ac4 nil)
(defvar abc11 nil)
(defvar abc13 nil)
(defvar abc14 nil)
(defvar abc16 nil)
(defvar abc21 nil)
(defvar abc24 nil)
(defvar abc31 nil)
(defvar abc33 nil)
(defvar abc34 nil)
(defvar stim nil)
(defvar corr nil)
(defvar incorr nil)
(defvar abc-r-list nil)
(defvar b-curve nil)
(defvar b-curve-list nil)
(defvar a-curve nil)
(defvar a-curve-list nil)
(defvar *pick-a* nil)
(defvar *pick-b* nil)
(defvar *egn* 6.0)
(defvar *a-ra-1* 1)
(defvar *a-rb-1* 1)
(defvar *b-ra-1* 1)
(defvar *b-rb-1* 1)
(defvar *c-ra-1* 1)
(defvar *c-rb-1* 1)
(defvar *a-ra-2* 1)
(defvar *a-rb-2* 1)
(defvar *b-ra-2* 1)
(defvar *b-rb-2* 1)
(defvar *c-ra-2* 1)
(defvar *c-rb-2* 1)
(defvar *a-ra-3* 1)
(defvar *a-rb-3* 1)
(defvar *b-ra-3* 1)
(defvar *b-rb-3* 1)
(defvar *c-ra-3* 1)
(defvar *c-rb-3* 1)
(defvar *text* t)
(defvar *graphic* nil)
(defvar *runs*)
(defvar *overlay* nil)

(setf *b-ra-1* 2)
 

#|
	 A corr	 A incorr	A abs
C corr	 30	 0	        30
C incorr 40		
C abs	 30		
|#

(defparameter *exp-results-cue* '((0.095 0.048 0.095 0.238 0.333 0.429 0.190 0.381 0.333 0.286)
                                 (0.211 0.395 0.395 0.579 0.553 0.526 0.632 0.605 0.605 0.658)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; This section contains the interface for the WWW using the
;;; ACT-R on the Web application by Elmar Schwarz

(defvar *WWW-interface*)

(setf  *WWW-interface* 
      '((:heading "Our Experiment" 2)
        
        (:new-para)

        (:table)
        
        (:table)
        "t: "   (:string :sy *egn* 1.91)             (:new-row)
        "Number of runs (20 - 100): "         (:string :sy *runs* 20) (:new-row)
        "               "  "Agree" "Mark" "Animacy" (:new-row)
        "Pick-a R-alpha:" (:string :sy *a-ra-2* 2) (:string :sy *a-ra-3* 1) (:string :sy *a-ra-1* 2) (:new-row)
        "Pick-b R-alpha:" (:string :sy *b-ra-2* 2) (:string :sy *b-ra-3* 2) (:string :sy *b-ra-1* 1) (:new-row)
        "Pick-c R-alpha:" (:string :sy *c-ra-2* 1) (:string :sy *c-ra-3* 2) (:string :sy *c-ra-1* 2) (:new-row)
        "Pick-a R-beta :" (:string :sy *a-rb-2* 1) (:string :sy *a-rb-3* 1) (:string :sy *a-rb-1* 1) (:new-row)
        "Pick-b R-beta :" (:string :sy *b-rb-2* 1) (:string :sy *b-rb-3* 1) (:string :sy *b-rb-1* 1) (:new-row)
        "Pick-c R-beta :" (:string :sy *c-rb-2* 1) (:string :sy *c-rb-3* 1) (:string :sy *c-rb-1* 1) (:new-row)

        
         (:table-end)
        
        (:table)
        (:checkbox "Text output" :sy *text*  t)         (:new-row)
        (:checkbox "Graphic output " :sy *graphic*  nil) (:new-row)
        (:checkbox "Show simulation and experiment data on one graph" :sy *overlay*  nil) 
        (:table-end)
        
        (:table-end)
        
        (:new-para)
        (:button "Show Experiment Results" "(output-data-cue *exp-results-cue* nil)")
        (:new-para)
        (:button "Run model" " 

                               (if (and (numberp *runs*) (numberp *egn*) 
                                        (numberp *a-ra-1*)(numberp *a-ra-2*)(numberp *a-ra-3*)
                                        (numberp *b-ra-1*)(numberp *b-ra-2*)(numberp *b-ra-3*)
                                        (numberp *c-ra-1*)(numberp *c-ra-2*)(numberp *c-ra-3*)
                                        (numberp *a-rb-1*)(numberp *a-rb-2*)(numberp *a-rb-3*)
                                        (numberp *b-rb-1*)(numberp *b-rb-2*)(numberp *b-rb-3*)
                                        (numberp *c-rb-1*)(numberp *c-rb-2*)(numberp *c-rb-3*)

)
                                 (progn (setf *egn* (* *egn* *egn* pi pi 1/6))
                                     
                                    (doit-cue (min 200 (max 20 *runs*))))
                                 (format *standard-output* \"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:"
        (:new-para)
        "- It usually takes about 2 minutes for 20 runs of the model"
        (:new-para)))


(defun output-data-cue (data sim)
  (when sim
    (format *standard-output* "~%~%Parameters for run: (~S ~S)~%(~S ~S ~S~%~S ~S ~S~%~S ~S ~S~%~S ~S ~S~%~S ~S ~S~%~S ~S ~S~%)~%" 
            (sqrt (/ *egn* 1/6 pi pi)) *runs*
            *a-ra-1* *a-ra-2* *a-ra-3* 
            *b-ra-1* *b-ra-2* *b-ra-3* 
            *c-ra-1* *c-ra-2* *c-ra-3* 
            *a-rb-1* *a-rb-2* *a-rb-3* 
            *b-rb-1* *b-rb-2* *b-rb-3* 
            *c-rb-1* *c-rb-2* *c-rb-3* ))
  (when  *text*
    (format *standard-output* "~%~%~A Average Results:~%" (if sim "Simulation" "Experimental"))
    (format *standard-output* "Trial  Animacy Cue Use~%")
    (dotimes (i 10)
      (format *standard-output* " ~2s       ~4,3F~%" (1+ i)  (nth i (first data))))
    (format *standard-output* "~%Trial  Agree/Mark Cue Use~%")
    (dotimes (i 10)
      (format *standard-output* " ~2s       ~4,3F~%" (1+ i)  (nth i (second data))))
    (format *standard-output* "~%~%")
    (when (and sim *overlay*)
      (format *standard-output* "~%~%Experimental Average Results:~%")
      (format *standard-output* "Trial  Animacy Cue Use~%")
      (dotimes (i 10)
        (format *standard-output* " ~2s       ~4,3F~%" (1+ i)  (nth i (first *exp-results-cue*))))
      (format *standard-output* "~%Trial  Agree/Mark Cue Use~%")
      (dotimes (i 10)
        (format *standard-output* " ~2s       ~4,3F~%" (1+ i)  (nth i (second *exp-results-cue*))))
      
      (format *standard-output* "~%~%")
      )
    (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 = 400 
      height = 450> 
      
      <PARAM name=\"title\" value=\"Data for Our Experiment\">
      <PARAM name=\"longestline\" value=\"10\">
      <PARAM name=\"numlines\" value=\"~S\">
      <PARAM name=\"xmin\" value=\"0\">
      <PARAM name=\"xmax\" value=\"10\">
      <PARAM name=\"ymax\" value=\"1.00\">
      <PARAM name=\"ymin\" value=\"0\">
      <PARAM name=\"ydiv\" value=\".05\">
      <PARAM name=\"yspacing\" value=\".10\">
      <PARAM name=\"xspacing\" value=\"1\">
      <PARAM name=\"lcolor0\" value=\"0\">
      <PARAM name=\"lstyle0\" value=\"~s\">
      <PARAM name=\"xval0\" value=\"1;2;3;4;5;6;7;8;9;10;\">
      <PARAM name=\"name0\" value=\"~a data Animacy Cue\">
      <PARAM name=\"lcolor1\" value=\"2\">
      <PARAM name=\"lstyle1\" value=\"~s\">
      <PARAM name=\"xval1\" value=\"1;2;3;4;5;6;7;8;9;10;\">
      <PARAM name=\"name1\" value=\"~a data Agree/Mark Cue\">
      <PARAM name=\"xname\" value=\"Trial\">
      <PARAM name=\"yname\" value=\"Cue Use\">"
            (if (and sim *overlay*) 4 2)
            (if sim 2 6553)
            (if sim "Simulation" "Experimental")
            (if sim 2 6553)
            (if sim "Simulation" "Experimental"))

    
      (format *standard-output*
        "<PARAM name=\"yval0\" value=\"")
      (dotimes (i 10)
        (format *standard-output* "~4,3f;" (nth i (first data))))
      (format *standard-output*
          "\"><PARAM name=\"yval1\" value=\"")
      (dotimes (i 10)
        (format *standard-output* "~4,3f;" (nth i (second data))))
      (format *standard-output* 
              "\">")
   
    
    (when (and sim *overlay*)
      (format *standard-output* "
        <PARAM name=\"lcolor2\" value=\"0\">
      <PARAM name=\"lstyle2\" value=\"6553\">
      <PARAM name=\"xval2\" value=\"1;2;3;4;5;6;7;8;9;10;\">
      <PARAM name=\"name2\" value=\"Experimental data Animacy Cue\">
      <PARAM name=\"lcolor3\" value=\"2\">
      <PARAM name=\"lstyle3\" value=\"6553\">
      <PARAM name=\"xval3\" value=\"1;2;3;4;5;6;7;8;9;10;\">
      <PARAM name=\"name3\" value=\"Experimental data Agree/Mark Cue\">")
     
(format *standard-output*
        "<PARAM name=\"yval2\" value=\"")
      (dotimes (i 10)
        (format *standard-output* "~4,3f;" (nth i (first *exp-results-cue*))))
      (format *standard-output*
          "\"><PARAM name=\"yval3\" value=\"")
      (dotimes (i 10)
        (format *standard-output* "~4,3f;" (nth i (second *exp-results-cue*))))
      (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>"))
  )


;30 30 40 30
(defun train-ac-cue ()
  (setf *command-trace* nil)
  (let ((stim nil)
        (train nil)
        (goal nil)
        (r nil))
    (setf stim nil)
    (setf a-curve nil)
    (dotimes (i 30) (push ac1 stim)) ;15
    (dotimes (i 30) (push ac3 stim)) ;15
    (dotimes (i 40) (push ac4 stim)) ;20
    (loop
      (if (null stim) (return))
      (setf r (random (length stim)))
      (push (nth r stim) train)
      (setf stim (remove (nth r stim) stim :count 1))
      )
    (dolist (i train)
      (setf goal (gensym "GOAL"))
      (eval `(addwm (,goal isa learn a nil b nil c nil ans nil)))
      (eval `(wmfocus ,goal))
      (if (member 'a i) (eval `(modwme ,goal a correct)))
      (if (member 'c i) (eval `(modwme ,goal c correct)))
      (if (member 'not-a i) (eval `(modwme ,goal a incorrect)))
      (if (member 'not-c i) (eval `(modwme ,goal c incorrect)))
      (run)
      (if (and *pick-a* (equal i ac4)) (push *pick-a* a-curve))
      ))
    (push (reverse a-curve) a-curve-list)
)


#|
B corr			
C corr	15	0	0
C incorr8	0	5
C abs	0	0	0

B incorr			
C corr	5	0	0
C incorr2	0	0
C abs	0	0	0
			
B abs			
C corr	5	0	5
C incorr5	0	0
C abs	0	0	0
|#




(defun in-evenly-cue (main part)
  (let ((ans nil)
        (m (length main))
        (p (length part))
        (tmp part))
    (dotimes (i (length main))
      (if (and tmp (zerop (mod i (floor (/ m (- p 1))))))
        (push (pop tmp) ans))
      (push (nth i main) ans))
    (if (not (equal p (count (car part) ans :test 'equal)))
      (break))
    ans))

(defun train-abc-cue ()
  (setf *command-trace* nil)
  (let ((stim nil)
        (train nil)
        (goal nil)
        (tmp-lis nil)
        (bnotc nil)
        (i nil)
        (r nil))
    (setf stim nil)
    (setf b-curve nil)
    (dotimes (i 23) (push abc11 stim))
    (dotimes (i 23) (push abc13 stim))
    (dotimes (i 24) (push abc14 stim))
    (dotimes (i 10) (push abc16 bnotc)) ;
    (dotimes (i 13) (push abc21 stim))
    (dotimes (i 7) (push abc24 stim))
    (dotimes (i 15) (push abc31 stim))
    (dotimes (i 28) (push abc33 stim))
    (dotimes (i 27) (push abc34 stim))
    (loop
      (if (null stim) (return))
      (setf r (random (length stim)))
      (push (nth r stim) train)
      (setf stim (remove (nth r stim) stim :count 1))
      )
    (setf train (in-evenly-cue train bnotc))
    (dotimes (tmp (length train))
      (setf *pick-b* nil)
      (setf i (nth tmp train))
      (setf goal (gensym "GOAL"))
      (eval `(addwm (,goal isa learn a nil b nil c nil ans nil)))
      (eval `(wmfocus ,goal))
      (if (member 'a i) (eval `(modwme ,goal a correct)))
      (if (member 'b i) (eval `(modwme ,goal b correct)))
      (if (member 'c i) (eval `(modwme ,goal c correct)))
      (if (member 'not-a i) (eval `(modwme ,goal a incorrect)))
      (if (member 'not-b i) (eval `(modwme ,goal b incorrect)))
      (if (member 'not-c i) (eval `(modwme ,goal c incorrect)))
      (run)
      (when *pick-b* 
         (if (equal i abc16) (push *pick-b* b-curve))
        )
      (when (zerop (mod tmp 25))
        (push (spp :r) tmp-lis))
      )
    (push (reverse tmp-lis) abc-r-list)
    (push (reverse b-curve) b-curve-list)
    )
  (setf *command-trace* t)
)

(defun doit-cue (n)
(let ((total-res nil))
  (setf abc-r-list nil)
  (setf corr 0)
  (setf incorr 0)
  (setf ac1 '(A C))
  (setf ac3 '(C))
  (setf ac4 '(A NOT-C))
  (setf abc11 '(A B C))
  (setf abc13 '(B C))
  (setf abc14 '(A B NOT-C))
  (setf abc16 '(B NOT-C))
  
  (setf abc21 '(A NOT-B C))
  
  (setf abc24 '(A NOT-B NOT-C))
  
  (setf abc31 '(A C))
  (setf abc33 '(C))
  (setf abc34 '(A NOT-C))
  

  (dotimes (k 3)
    (let ((a-a (cond ((= k 0) *a-ra-1*)
                     ((= k 1) *a-ra-2*)
                     (t *a-ra-3*)))
          (b-a (cond ((= k 0) *b-ra-1*)
                     ((= k 1) *b-ra-2*)
                     (t *b-ra-3*)))
          (c-a (cond ((= k 0) *c-ra-1*)
                     ((= k 1) *c-ra-2*)
                     (t *c-ra-3*)))
          (a-b (cond ((= k 0) *a-rb-1*)
                     ((= k 1) *a-rb-2*)
                     (t *a-rb-3*)))
          (b-b (cond ((= k 0) *b-rb-1*)
                     ((= k 1) *b-rb-2*)
                     (t *b-rb-3*)))
          (c-b (cond ((= k 0) *c-rb-1*)
                     ((= k 1) *c-rb-2*)
                     (t *c-rb-3*))))
      (setf b-curve-list nil)

  (dotimes (i n)
    ;(format t ".")
    (reset)
    (spp-fct (list 'pick-c :r-alpha c-a :r-beta c-b))
    (spp-fct (list 'pick-b :r-alpha b-a :r-beta b-b))
    (spp-fct (list 'pick-a :r-alpha a-a :r-beta a-b))
    (sgp-fct (list :era t :pl t :ct nil :lt nil :ot nil :egn *egn* :v nil)) ; other up
    
  

    (setf corr 0)
    (setf incorr 0)
    (train-ac-cue)
    (train-abc-cue)
    )
;(format t "~&")



 (let ((res nil))
  (dotimes (i 10 )
    (push (avg-cue (mapcar #'(lambda (j) (nth i j)) b-curve-list)) res))
  
  (push (reverse res) total-res))
 ))
  (push (mapcar #'(lambda (x y) (/ (+ x y) 2)) (pop total-res) (pop total-res)) total-res)
  (output-data-cue (reverse total-res) t)))

(defun avg-cue (lis)
  (float (/ (apply '+ lis) (length lis))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</xmp><pre><a name="model">
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</a>
;;;
;;; This section contains the ACT-R model
;;;
;;;

(clearall)

(sgp-fct (list :era t :pl t :ct nil :lt nil :ot nil :egn *egn*)) ; other up

(chunk-type learn a b c ans guess)

(add-dm (correct isa chunk) 
        (incorrect isa chunk))

(p pick-a
   =goal>
    isa learn
    ans nil
    a =ans
==>
   !eval! (setf *pick-a* 1)
   =goal>
    guess correct
    ans =ans)

(spp-fct (list 'pick-a :r-alpha *a-ra-1* :r-beta *a-rb-1*))

(p pick-b
   =goal>
    isa learn
    ans nil
    b =ans
==>
   !eval! (setf *pick-b* 1)
   =goal>
    guess correct
    ans =ans)

(spp-fct (list 'pick-b :r-alpha *b-ra-1* :r-beta *b-rb-1*))

(p pick-c
   =goal>
    isa learn
    ans nil
    c =ans
==>
   !eval! (setf *pick-b* 0)
   !eval! (setf *pick-a* 0)
   =goal>
    guess correct
    ans =ans)

(spp-fct (list 'pick-c :r-alpha *c-ra-1* :r-beta *c-rb-1*))

(p score-corr
   =goal>
    isa learn
    ans =ans
    guess =ans
==>
   !eval! (incf corr)
   !pop!)

(parameters score-corr :success t)

(p score-incorr
   =goal>
    isa learn
    ans =ans
    guess =guess
   !eval! (not (equal =ans =guess))
==>
   !eval! (incf incorr)
  !pop!)

(parameters score-incorr :failure t)