;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<pre><xmp>
;;;
;;; ACT-R/PM model of the menu selection experiment
;;;
;;; to run the model call
;;; (run-sim-menuexp n)
;;; where n is the number of runs

(defvar *exp*)
(defvar *response*)
(defvar *start-time*)
(defvar *protocol-result*)
(defvar *num-corr*)
(defvar *v*)
(defvar *text*)
(defvar *graphic*)
(defvar *overlay*)
(defvar *attend*)
(defvar *intercept*)
(defvar *runs*)

(defvar *menu*)

(setf *exp* nil)
(setf *response* nil)
(setf *start-time* nil)
(setf *protocol-result* nil)
(setf *num-corr* 0)
(setf *v* nil)
(setf *text* t)
(setf *graphic* nil)
(setf *overlay* nil)
(setf *attend* .185)
(setf *intercept* .927)
(setf *runs* 1)

(defparameter *numbers-menuexp* '("1" "2" "3" "4" "5" "6" "7" "8" "9"))
(defparameter *letters-menuexp* '("A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" 
                    "N" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z"))

(defparameter *nilsen-data*  '(1000 975 1050 1175 1250 1400 1450 1575 1700))

(defparameter *same-menuexp-data*  '(1090 1060 1160 1349 1426 1474 1527 1634 1738))
(defparameter *diff-menuexp-data* '(1058 1035 1137 1273 1341 1368 1491 1519 1603))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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 "Menu Selection Experiment model" 2)
         (:table)
        (:table)
        
        "Attention time (s) (min .05): "   (:string :sy *attend*   .185)    (:new-row)
        "Intercept time (s) (min .75): "   (:string :sy *intercept*  .927)  (:new-row)       
        "Number of runs(1-100): "  (:string :sy *runs*    10)
        (:table-end)
         (:table)
        (:checkbox "Trace" :sy *v*  nil) (:new-row)
        (: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)
        (:heading "Model not currently available" 2)
#|        (:button "Show Experiment Results" "(display-menuexp (list *nilsen-data* *same-menuexp-data* *diff-menuexp-data*) nil)")
       
        (:new-para)
        
        
        (:button "Run model" "(if (and (numberp *attend*) (numberp *intercept*) 
                                        (numberp *runs*))
                                  (progn (format t \"what ???~%\") (run-sim-menuexp (min 100 (max 1 *runs*))))
                                  (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 3 minutes for 10 runs of the model"
        (:new-line)
        "- The trace of 10 runs is approximatly 500k (300 pages) in size"
  |#      (:new-para)))






(defstruct stimulus-menuexp
  target
  length
  targetpos
  targtype
  backtype
  user-log)

(defclass exp-menuexp (dialog)
  ((text1 :accessor text1
         :initform (make-instance 'static-text-dialog-item
                     :view-font '("courier" 17 :bold)))
   )
  (:default-initargs
    :view-size     #@(300 300)
    :window-title "Experiment"))

(defclass actr-menuexp (static-text-dialog-item)
  ((open-p :accessor open-p :initform nil)
   (contents :accessor contents :initform nil)
   (submenus :accessor submenus :initform nil))
  (:default-initargs
    :dialog-item-text "  "
    :view-font '("Courier" 18 :bold)
    :view-size (make-point 100 18)))



(defun p2xy-menuexp (p)
  (list (point-h p) (point-v p)))

(defun get-time-menuexp ()
  (if *actr-enabled-p*
    (actr-time)
    (get-internal-real-time)))


(defmethod view-draw-contents :after ((item actr-menuexp))
  (let ((item-position (view-position item))
        (item-size (view-size item)))
    (rlet ((rect :rect))
      (rset rect rect.topleft item-position)
      (rset rect rect.bottomright
            (add-points item-position item-size))
      (when *exp*
          (frame-rect *exp* rect)))))

(defmethod view-click-event-handler ((item exp-menuexp) where)
  (declare (ignore where))
  (call-next-method )
  )

(defmethod view-click-event-handler ((item actr-menuexp) where)
  (declare (ignore where))
  
  (without-interrupts 
   
   ;(inspect item)

   (setf (open-p item) (not (open-p item)))
   
    

    
    (if (null (open-p item))
     (progn (dolist (i (submenus item))
       (remove-subviews *exp* i))
     (setf (submenus item) nil)
     (setf *response* (vector (read-from-string (dialog-item-text item) )
                              (- (get-time-menuexp)
                                 *start-time*)))
     )
    (progn
     (dolist (x (submenus item))
       (add-subviews *exp* x))
     (when *actr-enabled-p* 
       (pm-proc-display ))
    
     )))
  (event-dispatch 0))





(defmethod window-close-event-handler ((self exp-menuexp))
  (call-next-method)
  (setf *exp* nil))

(defun 2str-menuexp (x &optional y)
  (cond (y
         (format nil "~a~a" x y))
        (t
         (format nil "~a" x))))

(defun 2atm-menuexp (x)
  (read-from-string x))

(defun explode (atm)
  (let ((str (2str-menuexp atm))
        (ans nil))
    (dotimes (i (length str))
      (push (2atm-menuexp (subseq str i (1+ i))) ans))
    (reverse ans)))



(defun event-menuexp ()
  (setf *response* nil)
  
  (event-dispatch 0)
  (when *actr-enabled-p* 
    (pm-proc-display)
    (pm-run 9.0))
  (while (not *response*)
    (event-dispatch 0))
  
)




(defun menu-present-menuexp (targ lis)
  (when *actr-enabled-p*
    (wmfocus goal)
    (pm-reset)
    ;(setf *linepos-style* 'old)
    (pm-set-params :optimize-visual nil :visual-attention-latency (max 0 (- *attend* .05)))
    (sgp-fct (list :era t :ct t :lt t :ot t :bll .5 :v *v*))
    (parameters-fct 'found-target (list :a (max 0 (- *intercept* .777)) :effort (max 0 (- *intercept* .777))))

    (pm-start-hand-at-mouse))
  (setf *start-time* (get-time-menuexp))
  (when (null *exp*)
    (setf *exp* (make-instance 'exp-menuexp))
    (pm-install-window *exp*))
  (window-select *exp*)
  (let* ((sym nil))
    (eval-enqueue 
     (dolist (i (subviews *exp*))
      (remove-subviews *exp* i)))
    (setf sym (make-instance 'actr-menuexp
                :dialog-item-text (format nil "    ~a" targ)))
    (setf (contents sym) (mapcar #'(lambda (x) (format nil " ~a" x)) lis))
    (add-subviews *exp* sym)
    (setf *menu* sym)
    (let ((pos (p2xy-menuexp (view-position sym)))
           (size (p2xy-menuexp (view-size sym)))
           (new-sym nil))
       (dotimes (i (length (contents sym)))
                       (setf new-sym 
                             (make-instance 'actr-menuexp
                               :dialog-item-text (nth i (contents sym))
                               :view-nick-name i
                               :view-position (make-point (car pos) (+ (cadr pos) (* (1+ i) 
                                                                                     (1+ (cadr size)))))))
                       ;(add-subviews *exp* new-sym)
                       (push new-sym (submenus sym))))
       
    (eval-enqueue (movemouse-nonrpm (local-to-global *exp* (view-position sym)) )))
    (event-dispatch)
    )
               
(defun randset-menuexp (lis length)
  (let ((index 0)(result nil))
  (do ((count length (1- count)))
      ((zerop count) result)
    (setq index (random (length lis)))
    (setq result (cons (nth index lis) result))
    (setq lis (remove (nth index lis)lis :count 1)))))
               


(defun rnd-set-menuexp (lis length targ pos)
  (let ((ans nil)
        (r nil)
        (tmp lis))
    (dotimes (i length)
      (cond ((equal i pos)
             (push targ ans))
            (t
             (setf r (nth (random (length tmp)) tmp))
             (push r ans)
             (setf tmp (remove r tmp :test 'equal)))))
    (reverse ans)))

(defun run-sim-menuexp (runs)
  (setf *actr-enabled-p* t)
  (experiment-menuexp runs))

(defun experiment-menuexp (&optional n)
  (let ((len '(9)) ; 3 6
        (targ '('num 'let))
        (back '('num )) ; 'let
        (count 0)
        (condlis nil))
    (setf *protocol-result* nil)
    (setf *num-corr* 0)
    (loop
      (incf count)
      (setf condlis nil)
      (dolist (i len)
        (dotimes (j i)
          (dolist (k targ)
            (dolist (l back)
              (push (list i k l j) condlis)))))
      (setf condlis (randset-menuexp condlis (length condlis)))
      
      (reset)

      (dolist (i condlis)
        (eval `(trial-menuexp ,@i)))
      (if (and n (equal count n)) (return))
      (if (not *actr-enabled-p*)
        (message-dialog (format nil "Finished Block ~a.  Score: ~a" count (* *num-corr* 10))))
      ))
  (display-menuexp (analysis-menuexp *protocol-result*) t))

(defun trial-menuexp (len targtype backtype pos)
  (let (
        (target nil)
        (lis nil))
    
    (cond ((equal targtype 'num)
           (cond ((equal backtype 'num)
                  
                  (setf target (nth (random (length *numbers-menuexp*)) *numbers-menuexp*))
                  (setf lis (rnd-set-menuexp (remove target *numbers-menuexp*) len target pos)))
                 (t
                  
                  (setf target (nth (random (length *numbers-menuexp*)) *numbers-menuexp*))
                  (setf lis (rnd-set-menuexp *letters-menuexp* len target pos)))))
          (t
           (cond ((equal backtype 'num)
                  
                  (setf target (nth (random (length *letters-menuexp*)) *letters-menuexp*))
                  (setf lis (rnd-set-menuexp *numbers-menuexp* len target pos)))
                 (t
                  
                  (setf target (nth (random (length *letters-menuexp*)) *letters-menuexp*))
                  (setf lis (rnd-set-menuexp (remove target *letters-menuexp*) len target pos))))))
    
    (menu-present-menuexp target lis)
    
    (event-menuexp)

    (dolist (i (subviews *exp*))
      (remove-subviews *exp* i))
    
    (window-close *exp*)
    (setf *exp* nil)
    
    (push (make-stimulus-menuexp
           :target (read-from-string target)
           :length len
           :targetpos pos
           :targtype targtype
           :backtype backtype
           :user-log *response*)
          *protocol-result*)))


(defun choose-feature-menuexp (x)

         (nth (random (length x)) x))

(defun movemouse-nonrpm (pos)
  (without-interrupts
   (ccl::%put-point (%int-to-ptr #$MTemp) pos)
   (ccl::%put-point (%int-to-ptr #$RawMouse) pos)
   (%put-word (%int-to-ptr #$CrsrNew) -1)
))

(defun analysis-menuexp (data)
  (let ((res (make-array '(2 9 2) :initial-element 0.0))
        (l1 nil)
        (l2 nil))
    (dolist (x data)
      (when (equal (stimulus-menuexp-target x) (aref (stimulus-menuexp-user-log x) 0))
        
            
        
          (if (equal (stimulus-menuexp-targtype x) (stimulus-menuexp-backtype x))
            (progn
              (incf (aref res 0 (stimulus-menuexp-targetpos x) 0))
              (incf (aref res 0 (stimulus-menuexp-targetpos x) 1) (aref (stimulus-menuexp-user-log x) 1)))
            (progn
              (incf (aref res 1 (stimulus-menuexp-targetpos x) 0))
              (incf (aref res 1 (stimulus-menuexp-targetpos x) 1) (aref (stimulus-menuexp-user-log x) 1))))))
    (dotimes (i 2)
      (dotimes (j 9)
        (unless (= 0 (aref res i j 0))
          (setf (aref res i j 1) (/ (aref res i j 1) (aref res i j 0))))))

    (dotimes (i 9)
      (push (* 1000 (aref res 0 i 1)) l1)
      (push (* 1000 (aref res 1 i 1)) l2))

    (list (reverse l1) (reverse l1) (reverse l2))))

(defun simulate-mouse-move-menuexp (loc)
  (movemouse-nonrpm (local-to-global *exp* (make-point (chunk-slot-value-fct loc 'screen-x)(chunk-slot-value-fct loc 'screen-y))) )
  (while (not (equal (view-mouse-position *exp* ) (make-point (chunk-slot-value-fct loc 'screen-x)(chunk-slot-value-fct loc 'screen-y))))))


(defun simulate-click-menuexp (loc)
  (view-click-event-handler *menu* (make-point (chunk-slot-value-fct loc 'screen-x)(chunk-slot-value-fct loc 'screen-y))))


(defun display-menuexp (data sim)
  (when sim
    (format *standard-output* "~%~%Parameters for run: (~S ~S ~S)"
            *attend* *intercept* *runs*))
  
  (when *text*
    (format *standard-output* "~%~%~a data:~%" (if sim "Simulation" "Experimental"))
    
    (format *standard-output* "~%                              RT (ms)~%")
    (format *standard-output* "Position    Nilsen Exp.     Same Background       Different Background~%")
    
    (dotimes (i 9)
      (format *standard-output* "~D            ~6,1f              ~6,1F                   ~6,1F~%" (+ 1 i) 
              (nth i (first data)) (nth i (second data)) (nth i (third data))))
    
    
    
    (when (and sim *overlay*)
      (format *standard-output* "~%~%Experimental data:~%")
      
      (format *standard-output* "~%                              RT (ms)~%")
      (format *standard-output* "Position    Nilsen Exp.     Same Background       Different Background~%")
      
      (dotimes (i 9)
        (format *standard-output* "~D            ~6,1f              ~6,1F                   ~6,1F~%" (+ 1 i) 
                (nth i *nilsen-data*)  (nth i  *same-menuexp-data*) (nth i  *diff-menuexp-data*)))
        
        )
      
      (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 = 500> 

        <PARAM name=\"title\" value=\"Data for Nilsen Experiemnt\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"9\">
        <PARAM name=\"ymax\" value=\"1900\">
        <PARAM name=\"ymin\" value=\"900\">
        <PARAM name=\"xspacing\" value=\"1\">
        <PARAM name=\"longestline\" value=\"9\">
        <PARAM name=\"numlines\" value=\"~S\">
        <PARAM name=\"ydiv\" value=\"50\">
        <PARAM name=\"yspacing\" value=\"100\">
        <PARAM name=\"xval0\" value=\"1;2;3;4;5;6;7;8;9;\">
        <PARAM name=\"xname\" value=\"Item Position\">
        <PARAM name=\"yname\" value=\"Selection Time (ms)\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"name0\" value=\"~a\">
        " 
            (if (and sim *overlay*) 2 1)
            (if sim 2 6553)
            (if sim "Simulation Data" "Experiment Data"))
    
    (format *standard-output* "<PARAM name=\"yval0\" value=\"")
    (dotimes (i 9)
      (format *standard-output* "~5,1f;" (nth i (first data))))
    (format *standard-output* "\">")
    
    
    (when (and *overlay* sim)
      (format *standard-output* "
        <PARAM name=\"lcolor1\" value=\"0\">
        <PARAM name=\"lstyle1\" value=\"6553\">
        <PARAM name=\"xval1\" value=\"1;2;3;4;5;6;7;8;9;\">
        <PARAM name=\"name1\" value=\"Experimental Data\">
        ")
      
      (format *standard-output* "<PARAM name=\"yval1\" value=\"")
      (dotimes (i 9)
        (format *standard-output* "~5,1f;" (nth i *nilsen-data*)))
      (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>")
    
    (format *standard-output* " 
        <applet 
        code = \"DansGraphs.class\" 
        width = 500 
        height = 500> 

        <PARAM name=\"title\" value=\"Data for Menu Experiemnt\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"9\">
        <PARAM name=\"ymax\" value=\"1900\">
        <PARAM name=\"ymin\" value=\"900\">
        <PARAM name=\"xspacing\" value=\"1\">
        <PARAM name=\"longestline\" value=\"9\">
        <PARAM name=\"numlines\" value=\"~S\">
        <PARAM name=\"ydiv\" value=\"50\">
        <PARAM name=\"yspacing\" value=\"100\">
        <PARAM name=\"xval0\" value=\"1;2;3;4;5;6;7;8;9;\">
        <PARAM name=\"xval1\" value=\"1;2;3;4;5;6;7;8;9;\">
        <PARAM name=\"xname\" value=\"Item Position\">
        <PARAM name=\"yname\" value=\"Selection Time (ms)\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"lcolor1\" value=\"1\">
        <PARAM name=\"lstyle1\" value=\"~s\">
        <PARAM name=\"name0\" value=\"~a\">
       <PARAM name=\"name1\" value=\"~a\">
        " 
            (if (and sim *overlay*) 4 2)
            (if sim 2 6553)(if sim 2 6553)
            (if sim "Simulation Data same background" "Experiment Data same background")
            (if sim "Simulation Data different background" "Experiment Data different background"))
    
    (format *standard-output* "<PARAM name=\"yval0\" value=\"")
    (dotimes (i 9)
      (format *standard-output* "~5,1f;" (nth i (second data))))
    (format *standard-output* "\">")
    
    (format *standard-output* "<PARAM name=\"yval1\" value=\"")
    (dotimes (i 9)
      (format *standard-output* "~5,1f;" (nth i (third data))))
    (format *standard-output* "\">")
    
    
    (when (and *overlay* sim)
      (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;\">
        <PARAM name=\"name2\" value=\"Experimental Data same background\">
        <PARAM name=\"lcolor3\" value=\"1\">
        <PARAM name=\"lstyle3\" value=\"6553\">
        <PARAM name=\"xval3\" value=\"1;2;3;4;5;6;7;8;9;\">
        <PARAM name=\"name3\" value=\"Experimental Data different background\">
        ")
      
      (format *standard-output* "<PARAM name=\"yval2\" value=\"")
      (dotimes (i 9)
        (format *standard-output* "~5,1f;" (nth i *same-menuexp-data*)))
      (format *standard-output* "\">")
      (format *standard-output* "<PARAM name=\"yval3\" value=\"")
      (dotimes (i 9)
        (format *standard-output* "~5,1f;" (nth i *diff-menuexp-data*)))
      (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>")))





;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</xmp><pre><a name="model">
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</a>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; The ACT-R model

(clearall)

(sgp-fct (list :era t :ct t :lt t :ot t :bll .5 :v *v*))


(chunk-type find-target target targ-feat object status pos looks search)

(chunk-type click location)


(pm-add-types-and-chunks)

(addwm (goal isa find-target)
       (find isa chunk))

(goal-focus goal)
    
(p get-target
   =goal>
    isa find-target
    target nil
    object nil
   =loc>
    isa visual-location
    attended nil
    time now
    screen-x highest
    screen-y lowest
   =state>
      isa module-state
      module :vision
      modality free
==>

!send-command! :vision move-attention :location =loc
   =goal>
    object find
    )


(p see-feature
   =goal>
    isa find-target
    object find
    target nil

   =obj>
    isa visual-object
    value =val
    time now
==>
   =obj>
    status "attended"
   =goal>
    target =val
    object =obj)

(p choose-feature
   =goal>
    isa find-target
    target =val
    targ-feat nil
    object =obj
   =obj>
    isa visual-object
    value =val
    screen-pos =loc
  =vobj>
    isa abstract-object
    value =val
    line-pos =lis

   
   !bind! =feat (choose-feature-menuexp =lis)
==>

!output! (moving mouse to =loc feature =feat)

!eval! (simulate-mouse-move-menuexp =loc)

=newgoal>
  isa click
  location =loc

=goal>
    looks 0
    targ-feat =feat
    object nil
    search nil

!push! =newgoal)

(parameters choose-feature :effort .22)

(p click-mouse
   =goal>
     isa click
     location =loc


==>
   !eval! (simulate-click-menuexp =loc)

!pop!
)

(parameters  click-mouse :r 1.0)





(p hunt-feature
   =goal>
   isa find-target
   looks =looks
   targ-feat =feat
   search nil


    =loc>
      isa visual-location
      time now
      attended nil
      line-pos =feat
      screen-y lowest

    =state>
      isa module-state
      module :vision
      modality free

==>

!send-command! :vision move-attention :location =loc 

!eval! (simulate-mouse-move-menuexp =loc)
    =goal>
      looks (!eval! (1+ =looks))
      
 !output! (LOCATION =loc)
)

(parameters hunt-feature :effort .05 :r .5)




(p found-target
   =goal>
    isa find-target
    target =targ
    looks =looks
    - looks 0

   =obj>
    isa visual-object
    time now
    status nil
    screen-pos =pos
    value =targ

    =state>
      isa module-state
      module :vision
      modality free

==>
   !output! ("~a)" =looks)
   =goal>
    isa find-target
    target "done"

    =newgoal>
    isa click
    location =pos

!push! =newgoal
)

(parameters-fct 'found-target (list :a (max 0 (- *intercept* .777)) :effort (max 0 (- *intercept* .777))))

(p done
   =goal>
    isa find-target
    target "done"

   =state>
      isa module-state
      module :motor
      modality free
     
==>

   =goal>
      target nil
      object nil
      targ-feat nil
   
 !pop!    )