;;;<pre><xmp>

(defparameter *counts-mal-nk* 
'(
((VNN AG1+ AI 1) 482) 
((VNN AG1* AI 1) 475) 
((VNN AG1- AI 1) 418) 
((VNN AG1* II 1) 381) 
((VNN AG1- AA 1) 378) 
((VNN AG1* AA 1) 361) 
((VNN AG1- II 1) 343) 
((NNV AG1+ AI 1) 314) 
((NNV AG2- IA 2) 308) 
((NNV AG2+ IA 2) 304) 
((NNV AG1* AI 1) 303) 
((NNV AG1- AI 1) 298) 
((NNV AG2* IA 2) 291) 
((VNN AG2- AI 1) 257) 
((VNN AG2* AI 1) 256) 
((VNN AG2+ AI 1) 217) 
((VNN AG1+ II 1) 199) 
((NNV AG1- AA 1) 198) 
((NNV AG1* AA 1) 195) 
((NNV AG2- AA 2) 192) 
((NNV AG1* II 1) 190) 
((NNV AG2* II 2) 183) 
((VNN AG1+ AA 1) 179) 
((NNV AG2- II 2) 179) 
((VNN AG1- IA 1) 179) 
((NNV AG1- II 1) 177) 
((NNV AG2* AA 2) 172) 
((VNN AG1+ IA 1) 159) 
((VNN AG1* IA 1) 140) 
((NNV AG1+ II 1) 116) 
((NNV AG2+ II 2) 103) 
((NNV AG2+ AA 2) 100) 
((VNN AG2- AA 1) 94) 
((VNN AG2* AA 1) 93) 
((VNN AG2* II 1) 91) 
((VNN AG2+ IA 1) 89) 
((NNV AG1* IA 2) 89) 
((VNN AG2- II 1) 88) 
((VNN AG2* IA 1) 83) 
((NNV AG1+ AA 1) 81) 
((NNV AG2+ AI 1) 77) 
((NNV AG1+ IA 2) 75) 
((NNV AG2* AI 1) 73) 
((NNV AG1- IA 2) 73) 
((NNV AG2- AI 1) 72) 
((VNN AG2- IA 1) 65) 
((VNN AG2+ II 1) 50) 
((VNN AG2+ AA 1) 48) 
))

(defvar *responses* nil)
(defvar *resp-lis* nil)
(defvar *r-log* nil)
(defvar bigbest nil)
(defvar *egn* 6.0)
(defvar *v* nil)
(defvar *text* t)
(defvar *graphic* nil)
(defvar *runs*)
(defvar *overlay* nil)
(defvar *cells*)

(defparameter *exp-results-mal-nk* '((0.05 0.68 0.25 ) (0.05 0.11 0.1 )))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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 "North Kona model" 2)
        
        (:new-para)

        (:table)
        
        (:table)
        "t: "   (:string :sy *egn* 1.91)             (:new-row)
        "Number of runs (10 - 100): "         (:string :sy *runs* 10)
        
         (: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-mal-nk *exp-results-mal-nk* nil)")
        (:new-para)
        (:button "Run model" " 

                               (if (and (numberp *runs*) (numberp *egn*) )
                                 (progn (setf *egn* (* *egn* *egn* pi pi 1/6))
                                     
                                    (doit-mal-nk (min 200 (max 10 *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 10 runs of the model"
        (:new-para)))


(defun output-data-mal-nk (data sim)
  (when sim
    (format *standard-output* "~%~%Parameters for run: (~S ~S)~%~%" (sqrt (/ *egn* 1/6 pi pi)) *runs*))
  (when  *text*
    (format *standard-output* "~%~%~A Average Results:~%" (if sim "Simulation" "Experimental"))
    (format *standard-output* "                 Percent Cue Use     Standard Error~%")
    (format *standard-output* "Agreement           ~4,3F                ~4,3F~%" (first (first data)) (first (second data)))
    (format *standard-output* "Word Order          ~4,3F                ~4,3F~%" (second (first data)) (second (second data)))
    (format *standard-output* "Animacy             ~4,3F                ~4,3F~%" (third (first data)) (third (second data)))
    (format *standard-output* "~%~%")
    (when (and sim *overlay*)
      (format *standard-output* "~%~%Experimental Average Results:~%" )
      (format *standard-output* "                 Percent Cue Use     Standard Error~%")
      (format *standard-output* "Agreement           ~4,3F                ~4,3F~%" (first (first *exp-results-mal-nk*)) (first (second *exp-results-mal-nk*)))
      (format *standard-output* "Word Order          ~4,3F                ~4,3F~%" (second (first *exp-results-mal-nk*)) (second (second *exp-results-mal-nk*)))
      (format *standard-output* "Animacy             ~4,3F                ~4,3F~%" (third (first *exp-results-mal-nk*)) (third (second *exp-results-mal-nk*)))
      (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 North Kona Experiemnt\">
        <PARAM name=\"longestline\" value=\"3\">
        <PARAM name=\"numlines\" value=\"~S\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"8\">
        <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=\"9\">
        <PARAM name=\"xlabels\" value=\" ;Agreement; ; ;Word Order; ; ;Animacy; ;\">
        <PARAM name=\"widestxlabel\" value=\"WWWWWWWWWW\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"xval0\" value=\"1;4;7;\">
        <PARAM name=\"name0\" value=\"~a data\">
        <PARAM name=\"yval0\" value=\"~4,3f;~4,3f;~4,3f;\">
        <PARAM name=\"xname\" value=\"Cue\">
        <PARAM name=\"yname\" value=\"Percent Cue Use\">"
            (if (and sim *overlay*) 8 4)
            (if sim 2 6553)
            (if sim "Simulation" "Experimental")
            (first (first data))
            (second (first data))
            (third (first data))
           )

    
      (format *standard-output*
        "<PARAM name=\"lcolor1\" value=\"1\">
         <PARAM name=\"lstyle1\" value=\"6553\">
         <PARAM name=\"xval1\" value=\"1;1;1;\">
         <PARAM name=\"yval1\" value=\"~4,3f;~4,3f;~4,3f;\">
         <PARAM name=\"lcolor2\" value=\"1\">
         <PARAM name=\"lstyle2\" value=\"6553\">
         <PARAM name=\"xval2\" value=\"4;4;4;\">
         <PARAM name=\"yval2\" value=\"~4,3f;~4,3f;~4,3f;\">
         <PARAM name=\"lcolor3\" value=\"1\">
         <PARAM name=\"lstyle3\" value=\"6553\">
         <PARAM name=\"xval3\" value=\"7;7;7;\">
         <PARAM name=\"name3\" value=\"error bars\">
         <PARAM name=\"yval3\" value=\"~4,3f;~4,3f;~4,3f;\">"
        (+ (first (first data)) (first (second data)))
        (first (first data))
        (- (first (first data)) (first (second data)))
        (+ (second (first data)) (second (second data)))
        (second (first data))
        (- (second (first data)) (second (second data)))
        (+ (third (first data)) (third (second data)))
        (third (first data))
        (- (third (first data)) (third (second data))))


              
    (when (and sim *overlay*)
      (format *standard-output* "
        <PARAM name=\"lcolor4\" value=\"0\">
        <PARAM name=\"lstyle4\" value=\"6553\">
        <PARAM name=\"xval4\" value=\"1;4;7;\">
        <PARAM name=\"name4\" value=\"Experimental data\">
        <PARAM name=\"yval4\" value=\"~4,3f;~4,3f;~4,3f;\">
        " 
              (first (first *exp-results-mal-nk*))
              (second (first *exp-results-mal-nk*))
              (third (first *exp-results-mal-nk*)))
      (format *standard-output*
        "<PARAM name=\"lcolor5\" value=\"1\">
         <PARAM name=\"lstyle5\" value=\"6553\">
         <PARAM name=\"xval5\" value=\"1;1;1;\">
         <PARAM name=\"yval5\" value=\"~4,3f;~4,3f;~4,3f;\">
         <PARAM name=\"lcolor6\" value=\"1\">
         <PARAM name=\"lstyle6\" value=\"6553\">
         <PARAM name=\"xval6\" value=\"4;4;4;\">
         <PARAM name=\"yval6\" value=\"~4,3f;~4,3f;~4,3f;\">
         <PARAM name=\"lcolor7\" value=\"1\">
         <PARAM name=\"lstyle7\" value=\"6553\">
         <PARAM name=\"xval7\" value=\"7;7;7;\">
          <PARAM name=\"yval7\" value=\"~4,3f;~4,3f;~4,3f;\">"
        (+ (first (first *exp-results-mal-nk*)) (first (second *exp-results-mal-nk*)))
        (first (first *exp-results-mal-nk*))
        (- (first (first *exp-results-mal-nk*)) (first (second *exp-results-mal-nk*)))
        (+ (second (first *exp-results-mal-nk*)) (second (second *exp-results-mal-nk*)))
        (second (first *exp-results-mal-nk*))
        (- (second (first *exp-results-mal-nk*)) (second (second *exp-results-mal-nk*)))
        (+ (third (first *exp-results-mal-nk*)) (third (second *exp-results-mal-nk*)))
        (third (first *exp-results-mal-nk*))
        (- (third (first *exp-results-mal-nk*)) (third (second *exp-results-mal-nk*)))))
      
    (format *standard-output* "
             <HR> Either your browser does not support JAVA or this graph has scrolled off the top of the display.~%
             </HR></applet>"))
  )

(defun create-n-stim-mal-nk (n)
  (let ((stim nil))
    (loop
      (setf stim (append stim (create-stim-mal-nk)))
      (if (> (length stim) n) (return)))
    (dotimes (i (- (length stim) n))
      (setf stim (cdr stim)))
    stim))

(defun create-stim-mal-nk ()
  (let ((stim nil))
    (dolist (i *counts-mal-nk*)
      (if (> (cadr i) (random 1000))
        (push (car i) stim)))
    stim))

;  (load "work:projects:mal:sh.actr")
(defun run-n-mal-nk (n)
  (setf *responses* nil)
  (dolist (i (create-n-stim-mal-nk n))
    (eval `(addwm ,(list 'goal 'isa 'choose 'stim-list i 'real (nth 3 i))))
    (wmfocus goal)
    (run)))

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

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

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

(defun doit-mal-nk (n)
  (let ((tmp nil))
    (setf bigbest nil)
  (dotimes (i n)
    (setf *r-log* nil)
    (setf *resp-lis* nil)
    ;(format t ".~%")
    ;(load "work:projects:mal:model:nk.actr")
    (reset)
    (setf tmp nil)
    (run-n-mal-nk 116)
    (push (no-output (spp :r)) tmp)
    (run-n-mal-nk 206)
    (push (no-output (spp :r)) tmp)
    (run-n-mal-nk 225)
    (push (no-output (spp :r)) tmp)
    (setf *resp-lis* (append *resp-lis* *responses*))
    (push (reverse tmp) *r-log*)
    (fill-cells-mal-nk  nil nil)
    (cells2cues-mal-nk)
    )
  (setf *r-log* (reverse *r-log*))
  (setf tmp nil)
  (dotimes (i (length (car *r-log*)))
    (push (log-avg-mal-nk (mapcar #'(lambda (x) (nth i x)) *r-log*)) tmp))
  (setf tmp (reverse tmp))
#|
  (dotimes (i (length (car *r-log*)))
    (format t "~%")
;    (format t "CHOOSE-BY-FIRST: ~a~&" (nth 0 (nth i tmp)))
    (format t "CHOOSE-BY-ORDER: ~a~&" (nth 0 (nth i tmp)))
    (format t "CHOOSE-BY-AGREE: ~a~&" (nth 1 (nth i tmp)))
    (format t "CHOOSE-BY-ANIM: ~a~&" (nth 2 (nth i tmp)))
    )
  (fill-cells-mal-nk  nil nil)
|#
#|
(format t "agree order anim~&")
(format t "avg: ~a~&" (mapcar #'(lambda (x) (float (/ (floor (* x 100)) 100)))
                         (list (avg-mal-nk (mapcar 'first bigbest))
                               (avg-mal-nk (mapcar 'second bigbest))
                               (avg-mal-nk (mapcar 'third bigbest)))))
(format t "se:  ~a~&" (mapcar #'(lambda (x) (float (/ (floor (* x 1000)) 1000)))
                         (list (se-mal-nk (mapcar 'first bigbest))
                               (se-mal-nk (mapcar 'second bigbest))
                               (se-mal-nk (mapcar 'third bigbest)))))
|#
(output-data-mal-nk (list (mapcar #'(lambda (x) (float (/ (floor (* x 100)) 100)))
                         (list (avg-mal-nk (mapcar 'first bigbest))
                               (avg-mal-nk (mapcar 'second bigbest))
                               (avg-mal-nk (mapcar 'third bigbest))))
                          (mapcar #'(lambda (x) (float (/ (floor (* x 1000)) 1000)))
                         (list (se-mal-nk (mapcar 'first bigbest))
                               (se-mal-nk (mapcar 'second bigbest))
                               (se-mal-nk (mapcar 'third bigbest))))) t)
))

(compile (defun cells2cues-mal-nk ()
  (let ((order .33)
        (agree .33)
        (anim .33)
        (cue-err nil)
        (subj-err (mapcar #'(lambda (x) (- 1 (avg-mal-nk x))) *cells*))
        (diff nil)
        (best 100)
        (bestlis nil)
        )
    (setf best 100)
    (dotimes (i 10000)
      (setf order (random 1.0))
      (setf agree (random (- 1 order)))
      (setf anim (- 1 order agree))
      (setf cue-err (list 0 0 (/ agree (+ agree anim))
                          0 0 (/ anim (+ agree order anim))
                          (/ agree (+ agree order)) 
                          (/ (+ agree anim) (+ agree order anim)) 
                          (/ agree (+ agree order anim))))
      (setf diff (apply '+ (mapcar #'(lambda (x y) (expt (- x y) 2)) cue-err subj-err)))
      (when (< diff best)
        (setf best diff)
        (setf bestlis (list agree order anim))))
(push bestlis bigbest)
;(format t "~a~&" best)
;(format t "agree order anim~&")
;(format t "~a~&" (mapcar #'(lambda (x) (float (/ (floor (* x 100)) 100))) bestlis))
)))

(defun sd-mal-nk (lis)
  (let ((m (/ (apply '+ lis) (length lis))))
    (sqrt (/ (apply '+ (mapcar #'(lambda (x) (expt (- x m) 2)) lis))
             (1- (length lis))))))

;standard error
(defun se-mal-nk (lis)
  (/ (sd-mal-nk lis) (sqrt (length lis))))


(defun cue2choice-mal-nk  (x)
  (cond ((equal x 'nnv) 0)
        ((equal x 'nvn) 2)
        ((equal x 'vnn) 1)
        ((equal x 'ag0) 0)
        ((equal x 'ag1+) 1)
        ((equal x 'ag1*) 1)
        ((equal x 'ag1-) 1)
        ((equal x 'ag2+) 2)
        ((equal x 'ag2*) 2)
        ((equal x 'ag2-) 2)
        ((equal x 'ai) 1)
        ((equal x 'ia) 2)
        ((equal x 'ii) 0)
        ((equal x 'aa) 0)
        (t 
         (print x)
         (break))))

; conf       over       med
;(order-vote agree-vote anim-vote choice corr sess subj) ans
(defun fill-cells-mal-nk  (sess subj)
  (setf *cells* (copy-tree (make-list 9)))
  (dolist (i *resp-lis*)
;    (if (equal (nth 7 i) 2)
    (if (or (null sess)
            (equal (nth 5 i) sess))
      (if (or (null subj)
              (equal (nth 6 i) subj))
    (cond ((zerop (nth 0 i)) ;order=conflict
           (if (zerop (nth 2 i)) ;animacy=medium
             (push (nth 4 i) (nth 0 *cells*)) ;4=corr, 3=choice
             (if (equal (nth 2 i) (nth 1 i))
               (push (nth 4 i) (nth 1 *cells*))
               (push (nth 4 i) (nth 2 *cells*)))))
          ((equal (nth 1 i) (nth 0 i))
           (if (zerop (nth 2 i)) ;animacy=medium
             (push (nth 4 i) (nth 3 *cells*))
             (if (equal (nth 2 i) (nth 1 i))
               (push (nth 4 i) (nth 4 *cells*))
               (push (nth 4 i) (nth 5 *cells*)))))
          (t
           (if (zerop (nth 2 i)) ;animacy=medium
             (push (nth 4 i) (nth 6 *cells*))
             (if (equal (nth 2 i) (nth 1 i))
               (push (nth 4 i) (nth 7 *cells*))
               (push (nth 4 i) (nth 8 *cells*))))))))
;)
)
#|
  (dotimes (i 3)
    (format t "~1,2f~c" (my-/ (count 0 (nth i *cells*)) (length (nth i *cells*))) #\tab))
  (format t "~&")
  (dotimes (i 3)
    (format t "~1,2f~c" (my-/ (count 0 (nth (+ 3 i) *cells*)) (length (nth (+ 3 i) *cells*))) #\tab))
  (format t "~&")
  (dotimes (i 3)
    (format t "~1,2f~c" (my-/ (count 0 (nth (+ 6 i) *cells*)) (length (nth (+ 6 i) *cells*))) #\tab))
  (format t "~&")
|#
)

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

(clearall)
(chunk-type choose stim-list real decision)

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

(p choose-by-order
   =goal>
    isa choose
    stim-list =list
    decision nil
   !eval! (intersection '(vnn nvn) =list)
==>
   =goal>
    decision (!eval! (if (member 'vnn =list) 1
                         (if (member 'nvn =list) 2)))
)

(parameters choose-by-order :r-alpha 1 :r-beta 1) ;1 3

(p choose-by-agreement
   =goal>
    isa choose
    stim-list =list
    decision nil
   !eval! (intersection '(ag1- ag1+ ag1* ag2- ag2+ ag2*) =list)
==>
   =goal>
    decision (!eval! (if (intersection '(ag1- ag1+ ag1*) =list) 1 2))
)

(parameters choose-by-agreement :r-alpha 1 :r-beta 1) ;1 2

(p choose-by-animacy
   =goal>
    isa choose
    stim-list =list
    decision nil
   !eval! (intersection '(ai ia) =list)
==>
   =goal>
    decision (!eval! (if (member 'ai =list) 1 2))
)

(parameters choose-by-animacy :r-alpha 1 :r-beta 1) ;2 2

(p right-choice
   =goal>
    isa choose
    stim-list =list
    decision =n
    real =n
==>
   !eval! (push (list (cue2choice-mal-nk  (first =list))
                      (cue2choice-mal-nk  (second =list))
                      (cue2choice-mal-nk  (third =list))
                      =n
                      1) *responses*)
   !pop!
)

(parameters right-choice :success t)

(p wrong-choice
   =goal>
    isa choose
    stim-list =list
    decision =n
    real =r
    !eval! (not (equal =n =r))
==>
   !eval! (push (list (cue2choice-mal-nk  (first =list))
                      (cue2choice-mal-nk  (second =list))
                      (cue2choice-mal-nk  (third =list))
                      =n
                      0) *responses*)
   !pop!
)

(parameters wrong-choice :failure t)