;;;<pre><xmp>
#|

It's a new model with just the noise parameter (defined like the others)

Here's the subject data:



Blocks 2 and 3 currently print out for the model, but you don't have to
show them.


|#

(defparameter *subject-data-cue2* '((.3 .27 .43) (.5 .18 .32)))

(defvar c1 '((big blank triangle no) (small blank triangle yes) 
             (small) (small) 1))
(defvar c2 '((small shaded triangle yes) (big shaded square no) 
             (small triangle) (small triangle) 2))
(defvar c3 '((small blank square no) (big blank triangle yes) 
             (small triangle) (triangle) 3))
(defvar c4 '((big blank square no) (small shaded square yes) 
             (small shaded) (small shaded) 4))
(defvar c5 '((big blank square no) (small shaded triangle yes) 
             (small shaded triangle) (small shaded triangle) 5))
(defvar c6 '((small shaded square yes) (big blank triangle no) 
             (small shaded triangle) (small shaded) 6))
(defvar c7 '((big shaded triangle yes) (small blank triangle no) 
             (small shaded) (shaded) 7))
(defvar c8 '((small blank triangle no) (big shaded square yes) 
             (small shaded triangle) (shaded) 8))
(defvar c9 '((big shaded triangle yes) (small blank square no) 
             (small shaded triangle) (shaded triangle) 9))



(defvar stim nil)

(defvar *r-log* nil)
(defvar *r-lis* nil)

(defvar *cell* nil)
(defvar *cell-right* nil)
(defvar *cell-wrong* nil)
(defvar *right-lis* nil)
(defvar *wrong-lis* nil)
(defvar *right-log* nil)
(defvar *wrong-log* nil)
(defvar *testing* nil)

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


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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 "Concept Formation Task Model" 2)
        
        (:new-para)

        (:table)
        
        (:table)
        "t: "   (:string :sy *egn* 1.10)             (:new-row)
        "Number of runs (20 - 500): "         (:string :sy *runs* 100)
        
         (: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-cue2 *subject-data-cue2* nil)")
        (:new-para)
        (:button "Run model" " 

                               (if (and (numberp *runs*) (numberp *egn*) )
                                 (progn (setf *egn* (* *egn* *egn* pi pi 1/6))
                                    (setf *v* nil) 
                                    (doit-cue2 (min 500 (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 1 minute for 100 runs of the model"
        (:new-para)))




;McD & MacW
(defun reset-stim-cue2 ()
  (setf c1 '((big blank triangle no) (small blank triangle yes) 
             (small) (small) 1))
  (setf c2 '((small shaded triangle yes) (big shaded square no) 
             (small triangle) (small triangle) 2))
  (setf c3 '((small blank square no) (big blank triangle yes) 
             (small triangle) (triangle) 3))
  (setf c4 '((big blank square no) (small shaded square yes) 
             (small shaded) (small shaded) 4))
  (setf c5 '((big blank square no) (small shaded triangle yes) 
             (small shaded triangle) (small shaded triangle) 5))
  (setf c6 '((small shaded square yes) (big blank triangle no) 
             (small shaded triangle) (small shaded) 6))
  (setf c7 '((big shaded triangle yes) (small blank triangle no) 
             (small shaded) (shaded) 7))
  (setf c8 '((small blank triangle no) (big shaded square yes) 
             (small shaded triangle) (shaded) 8))
  (setf c9 '((big shaded triangle yes) (small blank square no) 
             (small shaded triangle) (shaded triangle) 9))
  
  (setf stim nil)
  (dotimes (i 20) (push c1 stim) (push c2 stim) (push c4 stim))
  (dotimes (i 15) (push c5 stim))
  (dotimes (i 8) (push c9 stim))
  (dotimes (i 5) (push c3 stim) (push c6 stim) (push c7 stim))
  (dotimes (i 2) (push c8 stim)))


(defun randset-cue2 (lis length)
  (let ((index 0)(result nil)(newlis lis))
  (do ((count length (1- count)))
      ((zerop count) result)
    (if (null newlis) (setf newlis lis))
    (setq index (random (length newlis)))
    (setq result (cons (nth index newlis) result))
    (setq newlis (remove (nth index newlis) newlis :count 1)))))

(defun avg-cue2 (lis)
  (setf lis (remove nil lis))
  (/ (apply '+ lis) (length lis)))

(defun log-avg-cue2 (log)
  (let ((ans nil))
    (dolist (i (transpose-cue2 log))
      (push (mapcar 'avg-cue2 (transpose-cue2 i)) ans))
    (reverse ans)))

(defun transpose-cue2 (lis)
  (let ((ans nil))
    (dotimes (i (length (car lis)))
      (push (mapcar #'(lambda (x) (nth i x)) lis) ans))
    (reverse ans)))


(defun my-/-cue2 (x y)
  (if (zerop y) 0
      (/ x y)))

(defun trial-cue2 ()
  (let ((temp nil))
    (setf temp (randset-cue2 stim 50)) ;300?
    (dolist (i temp)
      (setf *cell* (fifth i))
      (clear-dm)
      (set-dm-fct (list (list 'goal 'isa 'learn
                          'poss (mapcar 'string (third i))
                          'corr (mapcar 'string (fourth i)))))
      (goal-focus goal)
      (run))))

(defun test-cue2 ()
  (let ((temp (randset-cue2 (list c1 c2 c3 c4 c5 c6 c7 c8 c9) 9)))
    (setf *testing* t)
    (sgp :pl nil)
    (dolist (i temp)
      (setf *cell* (fifth i))
      (clear-dm )
      (set-dm-fct (list (list 'goal 'isa 'learn
                              'poss (mapcar 'string (third i))
                              'corr (mapcar 'string (fourth i)))))
      (goal-focus goal)
      (run))
    
    (setf *testing* nil)
    (sgp :pl t)))

(defun experiment-cue2 ()
  (reset)
  (setf *right-lis* nil)
  (setf *wrong-lis* nil)
  (setf *r-lis* nil)
  (dotimes (i 4) ;4=Trials 1&2,3&4,5&6,7&8
    (trial-cue2)
    (setf *cell-right* (copy-list '(0 0 0 0 0 0 0 0 0)))
    (setf *cell-wrong* (copy-list '(0 0 0 0 0 0 0 0 0)))
    (test-cue2)
    (no-output (push (spp :r) *r-lis*))
    (push *cell-right* *right-lis*)
    (push *cell-wrong* *wrong-lis*)
    )
  (setf *right-lis* (reverse *right-lis*))
  (setf *wrong-lis* (reverse *wrong-lis*)))


(defun doit-cue2 (n)
 
    
    (setf *r-log* nil)
    (setf *right-log* nil)
    (setf *wrong-log* nil)
    (reset-stim-cue2)
    
    (dotimes (i n)
      
      (experiment-cue2)
      (push *r-lis* *r-log*)
      (push *right-lis* *right-log*)
      (push *wrong-lis* *wrong-log*)
      )
    (setf *r-log* (reverse *r-log*))
     
    (output-cue2 (list (cells2cues-cue2 0) (cells2cues-cue2 3)) t))

(defun output-cue2 (data sim)
  (when *text*
    (format *standard-output* "~a Data:~%~%" (if sim "Simulation" "Experimental"))
    (format *standard-output* "            Block~%")
    (format *standard-output* "          1       4~%")
    (format *standard-output* "Shading  ~4,2f    ~4,2f~%" (first (first data)) (first (second data)))
    (format *standard-output* "Shape    ~4,2f    ~4,2f~%" (second (first data)) (second (second data)))
    (format *standard-output* "Size     ~4,2f    ~4,2f~%~%" (third (first data)) (third (second data)))
    (when (and sim *overlay*)
      (format *standard-output* "Experimental Data:~%~%" )
      (format *standard-output* "            Block~%")
      (format *standard-output* "          1       4~%")
      (format *standard-output* "Shading  ~4,2f    ~4,2f~%" (first (first *subject-data-cue2*)) (first (second *subject-data-cue2*)))
      (format *standard-output* "Shape    ~4,2f    ~4,2f~%" (second (first *subject-data-cue2*)) (second (second *subject-data-cue2*)))
      (format *standard-output* "Size     ~4,2f    ~4,2f~%~%" (third (first *subject-data-cue2*)) (third (second *subject-data-cue2*)))))

  (when *graphic*
    (format *standard-output* " 
      <applet 
      code = \"DansGraphs.class\" 
      width = 400 
      height = 450> 
      
      <PARAM name=\"title\" value=\"Data for Cue Experiment\">
      <PARAM name=\"longestline\" value=\"3\">
      <PARAM name=\"numlines\" value=\"~S\">
      <PARAM name=\"xmin\" value=\"0\">
      <PARAM name=\"xmax\" value=\"2\">
      <PARAM name=\"ymax\" value=\"1.00\">
      <PARAM name=\"ymin\" value=\"0\">
      <PARAM name=\"ydiv\" value=\".05\">
      <PARAM name=\"yspacing\" value=\".10\">
      <PARAM name=\"numxlabels\" value=\"5\">
        <PARAM name=\"xlabels\" value=\" ;1; ;4; ;\">
        <PARAM name=\"widestxlabel\" value=\"WW\">
         <PARAM name=\"lcolor0\" value=\"0\">
      <PARAM name=\"lstyle0\" value=\"~s\">
      <PARAM name=\"xval0\" value=\".5;1.5;\">
      <PARAM name=\"name0\" value=\"~a data Shading Cue\">
      <PARAM name=\"lcolor1\" value=\"1\">
      <PARAM name=\"lstyle1\" value=\"~s\">
      <PARAM name=\"xval1\" value=\".5;1.5;\">
      <PARAM name=\"name1\" value=\"~a data Shape Cue\">
      <PARAM name=\"lcolor2\" value=\"2\">
      <PARAM name=\"lstyle2\" value=\"~s\">
      <PARAM name=\"xval2\" value=\".5;1.5;\">
      <PARAM name=\"name2\" value=\"~a data Size Cue\">
      <PARAM name=\"xname\" value=\"Block\">
      <PARAM name=\"yname\" value=\"Cue Use\">"
            (if (and sim *overlay*) 6 3)
            (if sim 2 6553)
            (if sim "Simulation" "Experimental")
            (if sim 2 6553)
            (if sim "Simulation" "Experimental")
            (if sim 2 6553)
            (if sim "Simulation" "Experimental"))

    
    (format *standard-output*
            "<PARAM name=\"yval0\" value=\"~4,2f;~4,2f;\">
         <PARAM name=\"yval1\" value=\"~4,2f;~4,2f;\">
         <PARAM name=\"yval2\" value=\"~4,2f;~4,2f;\">"
            (first (first data)) (first (second data))
            (second (first data)) (second (second data))
            (third (first data)) (third (second data))
            )
      
    
    (when (and sim *overlay*)
      (format *standard-output* "
      <PARAM name=\"lcolor3\" value=\"0\">
        <PARAM name=\"lstyle3\" value=\"6553\">
      <PARAM name=\"xval3\" value=\".5;1.5;\">
      <PARAM name=\"name3\" value=\"Experimental data Shading Cue\">
      <PARAM name=\"lcolor4\" value=\"1\">
      <PARAM name=\"lstyle4\" value=\"6553\">
      <PARAM name=\"xval4\" value=\".5;1.5;\">
      <PARAM name=\"name4\" value=\"Experimental data Shape Cue\">
      <PARAM name=\"lcolor5\" value=\"2\">
      <PARAM name=\"lstyle5\" value=\"6553\">
      <PARAM name=\"xval5\" value=\".5;1.5;\">
      <PARAM name=\"name5\" value=\"Experimental data Size Cue\">
      ")
     
      (format *standard-output*
            "<PARAM name=\"yval3\" value=\"~4,2f;~4,2f;\">
         <PARAM name=\"yval4\" value=\"~4,2f;~4,2f;\">
         <PARAM name=\"yval5\" value=\"~4,2f;~4,2f;\">"
            (first (first *subject-data-cue2*)) (first (second *subject-data-cue2*))
            (second (first *subject-data-cue2*)) (second (second *subject-data-cue2*))
            (third (first *subject-data-cue2*)) (third (second *subject-data-cue2*))
            )
   

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

)
    

(compile (defun cells2cues-cue2 (j)
  (let* ((small .33)
         (shaded .33)
         (triangle .33)
         (r-ans (log-avg-cue2 *right-log*))
         (w-ans (log-avg-cue2 *wrong-log*))
         (subj-err nil)
         (cue-err nil)
         (diff nil)
         ;        (cue nil)
         (best 100)
         (bestlis nil)
         )
    (dotimes (i 3) (push (my-/-cue2 (nth i (nth j w-ans))
                               (+ (nth i (nth j w-ans)) (nth i (nth j r-ans)))) subj-err))
    (dotimes (i 3) (push (my-/-cue2 (nth (+ 3 i) (nth j w-ans))
                               (+ (nth (+ 3 i) (nth j w-ans)) (nth (+ 3 i) (nth j r-ans)))) subj-err))
    (dotimes (i 3) (push (my-/-cue2 (nth (+ 6 i) (nth j w-ans))
                               (+ (nth (+ 6 i) (nth j w-ans)) (nth (+ 6 i) (nth j r-ans)))) subj-err))
    (setf subj-err (reverse subj-err))
    (setf best 100)
    (dotimes (i 10000)
      (setf shaded (random 1.0))
      (setf small (random (- 1 small)))
      (setf triangle (- 1 small shaded))
      (setf cue-err (list 0 0 (/ small (+ small triangle))
                          0 0 (/ triangle (+ small shaded triangle))
                          (/ small (+ small shaded)) 
                          (/ (+ small triangle) (+ small shaded triangle)) 
                          (/ small (+ small shaded triangle))))
      (setf diff (apply '+ (mapcar #'(lambda (x y) (expt (- x y) 2)) cue-err subj-err)))
      (when (< diff best)
        (when (equal (floor (* diff 1000)) (floor (* best 1000))) 
          (setf bestlis (list shaded triangle small))
          (return))
        (setf best diff)
        (setf bestlis (list shaded triangle small))))
    bestlis)))

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

(clearall)

(sgp-fct (list :era t :pl t :lt nil :egn *egn* :v *v*))

(WMEType learn poss corr guess status)

(p pick-small
   =goal>
    isa learn
    poss =poss
    guess nil
   !eval! (member "SMALL" =poss :test 'equal)
==>
   =goal>
    guess "SMALL")

(parameters pick-small :r-alpha 1 :r-beta 1)

(p pick-shaded
   =goal>
    isa learn
    poss =poss
    guess nil
   !eval! (member "SHADED" =poss :test 'equal)
==>
   =goal>
    guess "SHADED")

(parameters pick-shaded :r-alpha 1 :r-beta 1)

(p pick-triangle
   =goal>
    isa learn
    poss =poss
    guess nil
   !eval! (member "TRIANGLE" =poss :test 'equal)
==>
   =goal>
    guess "TRIANGLE")

(parameters pick-triangle :r-alpha 1 :r-beta 1)

(p score-corr
   =goal>
    isa learn
    guess =g
    corr =corr
   !eval! (member =g =corr :test 'equal)
==>
   !eval! (if *testing* (incf (nth (1- *cell*) *cell-right*)))
   !pop!)

(parameters score-corr :success t)

(p score-incorr
   =goal>
    isa learn
    guess =g
    corr =corr
   !eval! (not (member =g =corr :test 'equal))
==>
   !eval! (if *testing* (incf (nth (1- *cell*) *cell-wrong*)))
   !pop!)

(parameters score-incorr :failure t)