;;;<pre><xmp>

(defparameter *counts-mal-nh* 
'(
((VNN AG0 AI 1) 785) 
((NVN AG0 IA 2) 774) 
((NVN AG0 II 2) 411) 
((VNN AG0 AA 1) 409) 
((NVN AG0 AA 2) 400) 
((VNN AG0 II 1) 387) 
((VNN AG1* AI 1) 215) 
((NVN AG2* IA 2) 206) 
((VNN AG0 IA 2) 200) 
((NVN AG2- IA 2) 199) 
((NVN AG0 AI 1) 198) 
((NVN AG2- AA 2) 187) 
((VNN AG1* II 1) 186) 
((NVN AG2+ IA 2) 184) 
((VNN AG1- AI 1) 183) 
((VNN AG1* AA 1) 183) 
((VNN AG1+ AI 1) 179) 
((NVN AG2- II 2) 178) 
((VNN AG1- AA 1) 175) 
((VNN AG1- II 1) 163) 
((NVN AG2* AA 2) 149) 
((NVN AG2* II 2) 149) 
((NVN AG1* AI 1) 114) 
((VNN AG2- IA 2) 113) 
((NVN AG1- AI 1) 109) 
((VNN AG2* IA 2) 106) 
((NVN AG1+ AI 1) 103) 
((VNN AG2+ IA 2) 98) 
((VNN AG1- IA 1) 73) 
((VNN AG1+ II 1) 66) 
((NVN AG2* AI 2) 66) 
((NVN AG2+ AI 2) 66) 
((NVN AG1- II 1) 64) 
((NVN AG2+ AA 2) 63) 
((VNN AG1+ IA 1) 62) 
((NVN AG2- AI 2) 61) 
((VNN AG2- AA 2) 60) 
((NVN AG2+ II 2) 59) 
((NVN AG1* AA 1) 59) 
((VNN AG1* IA 1) 58) 
((VNN AG2- II 2) 58) 
((VNN AG2* AA 2) 51) 
((NVN AG1* II 1) 50) 
((VNN AG1+ AA 1) 49) 
((VNN AG2* II 2) 48) 
((NVN AG1* IA 1) 47) 
((VNN AG2- AI 2) 46) 
((NVN AG1- AA 1) 44) 
((NVN AG1+ IA 1) 33) 
((VNN AG2* AI 2) 30) 
((VNN AG2+ AI 2) 29) 
((NVN AG1- IA 1) 28) 
((NVN AG1+ AA 1) 23) 
((NVN AG1+ II 1) 14) 
((VNN AG2+ AA 2) 13) 
((VNN AG2+ II 2) 13) 
))

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

(defparameter *exp-results-mal-nh* '(( 0.07 0.79 0.13) (0.02 0.04 0.02 )))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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 Helvetica 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-nh *exp-results-mal-nh* nil)")
        (:new-para)
        (:button "Run model" " 

                               (if (and (numberp *runs*) (numberp *egn*) )
                                 (progn (setf *egn* (* *egn* *egn* pi pi 1/6))
                                     
                                    (doit-mal-nh (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-nh (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* "Word Order          ~4,3F                ~4,3F~%" (first (first data)) (first (second data)))
    (format *standard-output* "Agreement           ~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* "Word Order          ~4,3F                ~4,3F~%" (first (first *exp-results-mal-nh*)) (first (second *exp-results-mal-nh*)))
      (format *standard-output* "Agreement           ~4,3F                ~4,3F~%" (second (first *exp-results-mal-nh*)) (second (second *exp-results-mal-nh*)))
      (format *standard-output* "Animacy             ~4,3F                ~4,3F~%" (third (first *exp-results-mal-nh*)) (third (second *exp-results-mal-nh*)))
      (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 Helvetica 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=\" ;Word Order; ; ;Agreement; ; ;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-nh*))
              (second (first *exp-results-mal-nh*))
              (third (first *exp-results-mal-nh*)))
(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-nh*)) (first (second *exp-results-mal-nh*)))
        (first (first *exp-results-mal-nh*))
        (- (first (first *exp-results-mal-nh*)) (first (second *exp-results-mal-nh*)))
        (+ (second (first *exp-results-mal-nh*)) (second (second *exp-results-mal-nh*)))
        (second (first *exp-results-mal-nh*))
        (- (second (first *exp-results-mal-nh*)) (second (second *exp-results-mal-nh*)))
        (+ (third (first *exp-results-mal-nh*)) (third (second *exp-results-mal-nh*)))
        (third (first *exp-results-mal-nh*))
        (- (third (first *exp-results-mal-nh*)) (third (second *exp-results-mal-nh*))))
      )
      
    (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-nh (n)
  (let ((stim nil))
    (loop
      (setf stim (append stim (create-stim-mal-nh)))
      (if (> (length stim) n) (return)))
    (dotimes (i (- (length stim) n))
      (setf stim (cdr stim)))
    stim))

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

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

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

(defun sd-mal-nh (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-nh (lis)
  (/ (sd-mal-nh lis) (sqrt (length lis))))

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

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

(defun doit-mal-nh (n)
  (let ((tmp nil))
    (setf bigbest nil)
  (dotimes (i n)
    (setf *r-log* nil)
    (setf *resp-lis* nil)
;    (format t ".")
    ;(format t ".~%")
    ;(load "work:projects:mal:model:nh.actr")
    (reset)
    (sgp-fct (list :egn *egn* ))
    (setf tmp nil)
    (run-n-mal-nh 118)
    (push (no-output (spp :r)) tmp)
    (run-n-mal-nh 206)
    (push (no-output (spp :r)) tmp)
    (run-n-mal-nh 215)
    (setf *resp-lis* (append *resp-lis* *responses*))
    (push (no-output (spp :r)) tmp)
    (push (reverse tmp) *r-log*)
    (fill-cells-mal-nh nil nil)
    (cells2cues-mal-nh)
    )
  (setf *r-log* (reverse *r-log*))
  (setf tmp nil)
  (dotimes (i (length (car *r-log*)))
    (push (log-avg-mal-nh (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-nh nil nil)
|#
#|(format t "order agree anim~&")
(format t "avg: ~a~&" (mapcar #'(lambda (x) (float (/ (floor (* x 100)) 100)))
                         (list (avg-mal-nh (mapcar 'first bigbest))
                               (avg-mal-nh (mapcar 'second bigbest))
                               (avg-mal-nh (mapcar 'third bigbest)))))
(format t "se:  ~a~&" (mapcar #'(lambda (x) (float (/ (floor (* x 1000)) 1000)))
                         (list (se-mal-nh (mapcar 'first bigbest))
                               (se-mal-nh (mapcar 'second bigbest))
                               (se-mal-nh (mapcar 'third bigbest)))))

|#
(output-data-mal-nh (list (mapcar #'(lambda (x) (float (/ (floor (* x 100)) 100)))
                         (list (avg-mal-nh (mapcar 'first bigbest))
                               (avg-mal-nh (mapcar 'second bigbest))
                               (avg-mal-nh (mapcar 'third bigbest))))
                          (mapcar #'(lambda (x) (float (/ (floor (* x 1000)) 1000)))
                         (list (se-mal-nh (mapcar 'first bigbest))
                               (se-mal-nh (mapcar 'second bigbest))
                               (se-mal-nh (mapcar 'third bigbest))))) t)
))

(defun cue2choice-mal-nh (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))))

(defun my-/-mal-nh (x y)
  (if (or (null x) (null y))
    0
    (/ x y)))

; over       conf       med
;(order-vote agree-vote anim-vote choice corr sess subj) ans
(defun fill-cells-mal-nh (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 1 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 0 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 0 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 0 i))
               (push (nth 4 i) (nth 7 *cells*))
               (push (nth 4 i) (nth 8 *cells*))))))))
;)
)
#|
  (dotimes (i 3)
    (format t "~1,2f~c" (my-/-mal-nh (count 0 (nth i *cells*)) (length (nth i *cells*))) #\tab))
  (format t "~&")
  (dotimes (i 3)
    (format t "~1,2f~c" (my-/-mal-nh (count 0 (nth (+ 3 i) *cells*)) (length (nth (+ 3 i) *cells*))) #\tab))
  (format t "~&")
  (dotimes (i 3)
    (format t "~1,2f~c" (my-/-mal-nh (count 0 (nth (+ 6 i) *cells*)) (length (nth (+ 6 i) *cells*))) #\tab))
  (format t "~&")
|#)

(compile (defun cells2cues-mal-nh ()
  (let* ((order .33)
        (agree .33)
        (anim .33)
        (cue-err nil)
        (subj-err (mapcar #'(lambda (x) (- 1 (avg-mal-nh x))) *cells*))
        (diff nil)
;        (cue 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 (/ order (+ order anim))
                          0 0 (/ anim (+ order agree anim))
                          (/ order (+ order agree)) 
                          (/ (+ order anim) (+ order agree anim)) 
                          (/ order (+ order agree 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 order agree anim))))
(push bestlis bigbest)
;(format t "~a~&" best)
;(format t "order agree anim~&")
;(format t "~a~&" (mapcar #'(lambda (x) (float (/ (floor (* x 100)) 100))) bestlis))
)))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</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 7 :r-beta 3)
(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 6 :r-beta 4)
(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 8 :r-beta 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-nh (first =list))
                      (cue2choice-mal-nh (second =list))
                      (cue2choice-mal-nh (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-nh (first =list))
                      (cue2choice-mal-nh (second =list))
                      (cue2choice-mal-nh (third =list))
                      =n
                      0) *responses*)
   !pop!
)

(parameters wrong-choice :failure t)