;;;


;;;
;;; ACT-R/PM 4.0 model of the subitizing task
;;; 
;;; to run the model call
;;; (run-sim-subitize n)
;;;
;;; where n is the number of runs

(defvar *exp* nil)
(defvar *response* nil)
(defvar *start-time* nil)
(defvar *r-time* nil)
(defvar *mode* nil)
(defvar *lis* nil)
(defvar *v*)
(defvar *runs*)
(defvar *text*)
(defvar *graphic*)
(defvar *overlay*)
(defvar *random-times*)
(defvar *attention*)


(setf *exp* nil)
(setf *response* nil)
(setf *start-time* nil)
(setf *r-time* nil)
(setf *mode* nil)
(setf *lis* nil)
(setf *v* nil)
(setf *runs* 1)
(setf *text* t)
(setf *graphic* nil)
(setf *overlay* nil)
(setf *random-times* nil)
(setf *attention* .185)

(defparameter *subitizing-data* (make-array '(10) :initial-contents '( .6 .65 .7 .86 1.12 1.5 1.79 2.13 2.15 2.58)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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 "Subitizing Experiment Model" 2)
        (:table)
        
        (:table)
        "Move attention time: "      (:string :sy *attention*      .185)  (:new-row)
        "Number of runs (1-20): "      (:string :sy *runs*        1)  (:new-row)
        (:checkbox "Randomness in attention times" :sy *random-times*  nil)  
        (: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" "(output-subitize *subitizing-data* nil)")
       
        (:new-para)
        (:button "Run model" "(if (and (numberp *runs*) (numberp *attention*))
                                  
                                  (run-sim-subitize (min 20 (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 less than 1 minute for 1 run of the model"
        (:new-line)
        "- The trace of 1 run is approximatly 20k (15 pages) in size"
  |#      (:new-para)))



(defclass exp-subitize (dialog)
  ((text1 :accessor text1
          :initform (make-instance 'static-text-dialog-item
                      :view-font '("courier" 17 :bold)))
   (text2 :accessor text2
          :initform (make-instance 'static-text-dialog-item
                      :view-font '("courier" 17 :bold)))
   (text3 :accessor text3
          :initform (make-instance 'static-text-dialog-item
                      :view-font '("courier" 17 :bold)))
   (text4 :accessor text4
          :initform (make-instance 'static-text-dialog-item
                      :view-font '("courier" 17 :bold)))
   (text5 :accessor text5
          :initform (make-instance 'static-text-dialog-item
                      :view-font '("courier" 17 :bold)))
   (text6 :accessor text6
          :initform (make-instance 'static-text-dialog-item
                      :view-font '("courier" 17 :bold)))
   (text7 :accessor text7
          :initform (make-instance 'static-text-dialog-item
                      :view-font '("courier" 17 :bold)))
   (text8 :accessor text8
          :initform (make-instance 'static-text-dialog-item
                      :view-font '("courier" 17 :bold)))
   (text9 :accessor text9
          :initform (make-instance 'static-text-dialog-item
                      :view-font '("courier" 17 :bold)))
   (text10 :accessor text10
          :initform (make-instance 'static-text-dialog-item
                      :view-font '("courier" 17 :bold))))
  (:default-initargs
    :view-size     #@(300 300)
    :window-title "Experiment"))

(defmethod view-key-event-handler ((self exp-subitize) char)
  
  (setf *r-time* (- (actr-time) *start-time*))
  
  (cond ((equal char #\newline)
         (setf *response* 'newline))
        ((equal char #\space)
         (setf *response* 'space))
        ((equal char #\.)
         (setf *response* 'period))
        (t
         (setf *response* (read-from-string (string char)))))
  (cond ((equal *mode* 'anykey)
         (point-present-subitize  (car *lis*))
         (setf *mode* '(0 1 2 3 4 5 6 7 8 9))
         (setf *response* nil)
         (setf *start-time* (actr-time))
         )
        ((or (eq *response* 'j) (member *response* *mode*))
         (window-close *exp*)
         )))

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


(defun present-subitize  (stimulus)
  (when (null *exp*)
    (setf *exp* (make-instance 'exp-subitize )))
  (pm-install-window *exp*)
  (let* ((lis (listp stimulus))
         (size (p2xy (view-size *exp*)))
         (width (car size))
         (height (cadr size))
         (stimlen nil))
    (cond (lis
           (setf lis (cdr stimulus))
           (setf stimulus (car stimulus)))
          (t
           (setf stimlen (string-width stimulus '("courier" 17 :bold)))))
    (set-dialog-item-text (text2 *exp*) "")
    (set-dialog-item-text (text3 *exp*) "")
    (set-dialog-item-text (text4 *exp*) "")
    (when lis 
        
          (dotimes (i (length lis))
            (setf stimlen (string-width (nth i lis) '("courier" 17 :bold)))
            (eval `(set-view-position (,(read-from-string (format nil "text~a" (+ i 2))) ,*exp*)
                                      ,(xy2p-subitize (floor (- (/ width 2) (/ stimlen 2)))
                                                      (floor (+ (/ height 2) (* 17 (1+ i)) -10)))))
            (eval `(set-view-size (,(read-from-string (format nil "text~a" (+ i 2))) ,*exp*) 
                                  ,(xy2p-subitize (+ stimlen 10) 17)))
            (eval `(set-dialog-item-text (,(read-from-string (format nil "text~a" (+ i 2))) ,*exp*)
                                         ,(nth i lis)))
            )
          (setf stimlen (* (string-width stimulus '("courier" 17 :bold)))))
    (set-view-position (text1 *exp*) 
                       (xy2p-subitize (floor (- (/ width 2) (/ stimlen 2)))
                                      (floor (- (/ height 2) 10))))
    (set-view-size (text1 *exp*) (xy2p-subitize (+ stimlen 10) 17))
    (set-dialog-item-text (text1 *exp*) stimulus)
    (add-subviews *exp* (text1 *exp*) (text2 *exp*) (text3 *exp*) (text4 *exp*))
    (view-draw-contents *exp*)
    (event-dispatch)
    (when *actr-enabled-p* (pm-proc-screen))
    ))

(defun near-subitize  (xlis ylis)
  (or (< (abs (- (first xlis) (first ylis))) 20)
      (< (abs (- (second xlis) (second ylis))) 20)))

(defun point-present-subitize  (n)
  (when (and (> n 0) (<= n 10))
    (if (null *exp*)
        (setf *exp* (make-instance 'exp-subitize )))
    (pm-install-window *exp*)
    (set-pen-pattern *exp* *white-pattern*)
    (paint-rect *exp* 0 (view-size *exp*))
    (set-pen-pattern *exp* *black-pattern*)
    (let* ((x-max (- (first (p2xy (view-size *exp*))) 50))
           (y-max (- (second (p2xy (view-size *exp*))) 50))
           (sub nil)
           (i 0)
           (p nil)
           (lis nil)
           )
      (loop
        (incf i)
        (when (> i 10000) 
          (setf i 0)
          (setf lis nil))
        (if (equal (length lis) n) (return))
        (setf p (list (+ 20 (random x-max)) (+ 20 (random y-max))))
        (if (not (member p lis :test 'near-subitize )) (push p lis))
        )
      (dolist (i (subviews *exp*))
        (remove-subviews *exp* i))
      (dotimes (i n)
        (setf sub (eval (eval `(list (read-from-string (format nil "text~a" ,(1+ i))) ,*exp*))))
        (set-view-position sub (xy2p-subitize (car (nth i lis)) (cadr (nth i lis))))
        (set-view-size sub (xy2p-subitize 20 17))
        (set-dialog-item-text sub "o")
        (add-subviews *exp* sub)
        )
      (view-draw-contents *exp*)
      (event-dispatch)
      (if *actr-enabled-p* (pm-proc-screen))
      )))
#|                 
(defun setup-subitize  ()
  (let* ((d (make-instance 'dialog
              :window-title "Experiment Setup"
              :view-size #@(310 200)))
         (number-txt (make-instance 'static-text-dialog-item
                       :view-position #@(10 10)
                       :dialog-item-text "Enter the number of items to be displayed:"))
         (number-inp (make-instance 'editable-text-dialog-item
                       :view-position #@(10 35)
                       :view-size #@(200 16)))
         (order-txt (make-instance 'static-text-dialog-item
                      :view-position #@(10 60)
                      :dialog-item-text "Order of presentation:"))
         (o1 (make-instance 'radio-button-dialog-item
               :view-position #@(160 60)
               :radio-button-cluster 'order
               :dialog-item-text "given"))
         (o2 (make-instance 'radio-button-dialog-item
               :view-position #@(220 60)
               :radio-button-cluster 'order
               :dialog-item-text "random"))
         (subj-txt (make-instance 'static-text-dialog-item
                     :view-position #@(10 85)
                     :dialog-item-text "Subject:"))
         (s1 (make-instance 'radio-button-dialog-item
               :view-position #@(80 85)
               :radio-button-cluster 'subj
               :dialog-item-text "ACT-R"))
         (s2 (make-instance 'radio-button-dialog-item
               :view-position #@(150 85)
               :radio-button-cluster 'subj
               :dialog-item-text "human"))
         
         
         (trace-txt (make-instance 'static-text-dialog-item
                      :view-position #@(10 130)
                      :dialog-item-text "Tracing:"))
         (t1 (make-instance 'radio-button-dialog-item
               :view-position #@(80 130)
               :radio-button-cluster 'trace
               :dialog-item-text "off"))
         (t2 (make-instance 'radio-button-dialog-item
               :view-position #@(150 130)
               :radio-button-cluster 'trace
               :dialog-item-text "on"))
         (stop nil)
         (b (make-instance 'button-dialog-item
              :view-position #@(120 160)
              :default-button t
              :dialog-item-text "   OK   "
              :dialog-item-action 
              #'(lambda (x) x (setf stop t)))))
    (add-subviews d number-txt number-inp order-txt o1 o2 subj-txt s1 s2 
                   trace-txt t1 t2 b)
    (view-draw-contents d)
    (event-dispatch)
    (loop
      (if (radio-button-pushed-p s2) (setf *actr-enabled-p* nil)
          (setf *actr-enabled-p* t))
      
      (if (radio-button-pushed-p t2) (setf *print-viewed* t)
          (setf *print-viewed* nil))
      (when (and stop (not (equal (dialog-item-text number-inp) "")))
        (window-close d)
        (setf *lis* (read-from-string (format nil "(~a)" (dialog-item-text number-inp))))
        (return (eval (read-from-string (format nil "(experiment-subitize '(~a) ~a)" 
                                                (dialog-item-text number-inp)
                                                (if (radio-button-pushed-p o2)
                                                    ''rnd ""))))))
      )))
|#
               
(defun randset-subitize (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 set-params-subitize ()
  (sgp-fct (list :era t :v *v* :blc 1.5))
  (set-pm-params-mth *mp* (list :visual-attention-latency (- *attention* .05) :randomize-time *random-times*))
  )

(defun experiment-subitize (num)
  (setf *exp* nil)
  (setf *lis* (list num))
  (reset)
  (pm-reset)
  (set-params-subitize)
  
   (present-subitize  '("Quickly count the items"
                        "then press the number"
                        "Press any key to start"))
  (setf *mode* 'anykey)
  (setf *start-time* (actr-time))
  (pm-run 30))


(defun xy2p-subitize (x y)
  (make-point x y))

(defun run-sim-subitize (n)
  (setf *actr-enabled-p* t)
  (let ((results (make-array '(10) :initial-element 0.0)))
    (dotimes (i n)
      (dotimes (j 10)
        
        (experiment-subitize (1+ j))
        
        (incf (aref results j) *r-time*)
        
        ))
    (dotimes (i 10 results)
      (setf (aref results i) (/ (aref results i) n)))
    (output-subitize results t)))


(defun output-subitize (data simulation)
   
     (when simulation 
       (format *standard-output* "~%~%Parameters for run: (~S ~S ~S)~%~%" 
               *attention* *runs* *random-times*))
     
     (when *text*
       (format *standard-output* "~a Data:~%~%Number of Items    RT~%" (if simulation "Simulation" "Experimental"))
       
       (dotimes (i 10)
         (format *standard-output* "~S                ~4,2f~%" (1+ i) (aref data i)))

       (when (and simulation *overlay*)
         (format *standard-output* "Experimental Data:~%~%Number of Items    RT~%")
         
         (dotimes (i 10)
           (format *standard-output* "~S                ~4,2f~%" (1+ i) (aref *subitizing-data* i)))))
     
     (when *graphic*
       
       (format *standard-output* " 
         <applet 
        code = \"DansGraphs.class\" 
        width = 400 
        height = 500> 
        <PARAM name=\"title\" value=\"Subitizing Experiment\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"10\">
        <PARAM name=\"ymax\" value=\"3.0\">
        <PARAM name=\"ymin\" value=\"0\">
        <PARAM name=\"longestline\" value=\"10\">
        <PARAM name=\"numlines\" value=\"~S\">
        <PARAM name=\"xspacing\" value=\"1\">
        <PARAM name=\"ydiv\" value=\".5\">
        <PARAM name=\"yspacing\" value=\"1\">
        <PARAM name=\"xval0\" value=\"1;2;3;4;5;6;7;8;9;10;\">
        <PARAM name=\"xname\" value=\"Number of Items\">
        <PARAM name=\"yname\" value=\"RT (sec)\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"name0\" value=\"~a\">"
               (if (and simulation *overlay*) 2 1) 
               (if simulation 2 6553)
              (if simulation "Simulation" "Experimental"))
       
       (format *standard-output* "<PARAM name=\"yval0\" value=\"")
       
       
       (dotimes (i 10)
         (format *standard-output* "~6,4f;" (aref data i)))
       (format *standard-output* "\">")
       
       
       (when (and *overlay* simulation)
         (format *standard-output* "
        <PARAM name=\"xval1\" value=\"1;2;3;4;5;6;7;8;9;10;\">
        <PARAM name=\"name1\" value=\"Experimental\">
        <PARAM name=\"lcolor1\" value=\"0\">
        <PARAM name=\"lstyle1\" value=\"6553\">
        <PARAM name=\"yval1\" value=\"")
         
         (dotimes (i 10)
           (format *standard-output* "~s;" (aref *subitizing-data* i)))
         (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>")))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; The ACT-R/PM model

(clearall)
(pm-add-types-and-chunks)



(WMEType integer value)
(WMEType addition-fact arg1 arg2 sum)
(WMEType multiplication-fact arg1 arg2 product)

(addwm
 (ZERO ISA INTEGER VALUE 0) (ONE ISA INTEGER VALUE 1) (TWO ISA INTEGER VALUE 2)
 (THREE ISA INTEGER VALUE 3) (FOUR ISA INTEGER VALUE 4)
 (FIVE ISA INTEGER VALUE 5) (SIX ISA INTEGER VALUE 6)
 (SEVEN ISA INTEGER VALUE 7) (EIGHT ISA INTEGER VALUE 8)
 (NINE ISA INTEGER VALUE 9) (TEN ISA INTEGER VALUE 10)
 (ELEVEN ISA INTEGER VALUE 11) (TWELVE ISA INTEGER VALUE 12)
 (THIRTEEN ISA INTEGER VALUE 13) (FOURTEEN ISA INTEGER VALUE 14)
 (FIFTEEN ISA INTEGER VALUE 15) (SIXTEEN ISA INTEGER VALUE 16)
 (SEVENTEEN ISA INTEGER VALUE 17) (EIGHTEEN ISA INTEGER VALUE 18)
 (NINETEEN ISA INTEGER VALUE 19) (TWENTY ISA INTEGER VALUE 20)
 
 (ZERO+ZERO ISA ADDITION-FACT ARG1 ZERO ARG2 ZERO SUM ZERO)
 (ZERO+ONE ISA ADDITION-FACT ARG1 ZERO ARG2 ONE SUM ONE)
 (ZERO+TWO ISA ADDITION-FACT ARG1 ZERO ARG2 TWO SUM TWO)
 (ZERO+THREE ISA ADDITION-FACT ARG1 ZERO ARG2 THREE SUM THREE)
 (ZERO+FOUR ISA ADDITION-FACT ARG1 ZERO ARG2 FOUR SUM FOUR)
 (ZERO+FIVE ISA ADDITION-FACT ARG1 ZERO ARG2 FIVE SUM FIVE)
 (ZERO+SIX ISA ADDITION-FACT ARG1 ZERO ARG2 SIX SUM SIX)
 (ZERO+SEVEN ISA ADDITION-FACT ARG1 ZERO ARG2 SEVEN SUM SEVEN)
 (ZERO+EIGHT ISA ADDITION-FACT ARG1 ZERO ARG2 EIGHT SUM EIGHT)
 (ZERO+NINE ISA ADDITION-FACT ARG1 ZERO ARG2 NINE SUM NINE)
 (ONE+ZERO ISA ADDITION-FACT ARG1 ONE ARG2 ZERO SUM ONE)
 (ONE+ONE ISA ADDITION-FACT ARG1 ONE ARG2 ONE SUM TWO)
 (ONE+TWO ISA ADDITION-FACT ARG1 ONE ARG2 TWO SUM THREE)
 (ONE+THREE ISA ADDITION-FACT ARG1 ONE ARG2 THREE SUM FOUR)
 (ONE+FOUR ISA ADDITION-FACT ARG1 ONE ARG2 FOUR SUM FIVE)
 (ONE+FIVE ISA ADDITION-FACT ARG1 ONE ARG2 FIVE SUM SIX)
 (ONE+SIX ISA ADDITION-FACT ARG1 ONE ARG2 SIX SUM SEVEN)
 (ONE+SEVEN ISA ADDITION-FACT ARG1 ONE ARG2 SEVEN SUM EIGHT)
 (ONE+EIGHT ISA ADDITION-FACT ARG1 ONE ARG2 EIGHT SUM NINE)
 (ONE+NINE ISA ADDITION-FACT ARG1 ONE ARG2 NINE SUM TEN)
 (TWO+ZERO ISA ADDITION-FACT ARG1 TWO ARG2 ZERO SUM TWO)
 (TWO+ONE ISA ADDITION-FACT ARG1 TWO ARG2 ONE SUM THREE)
 (TWO+TWO ISA ADDITION-FACT ARG1 TWO ARG2 TWO SUM FOUR)
 (TWO+THREE ISA ADDITION-FACT ARG1 TWO ARG2 THREE SUM FIVE)
 (TWO+FOUR ISA ADDITION-FACT ARG1 TWO ARG2 FOUR SUM SIX)
 (TWO+FIVE ISA ADDITION-FACT ARG1 TWO ARG2 FIVE SUM SEVEN)
 (TWO+SIX ISA ADDITION-FACT ARG1 TWO ARG2 SIX SUM EIGHT)
 (TWO+SEVEN ISA ADDITION-FACT ARG1 TWO ARG2 SEVEN SUM NINE)
 (TWO+EIGHT ISA ADDITION-FACT ARG1 TWO ARG2 EIGHT SUM TEN)
 (TWO+NINE ISA ADDITION-FACT ARG1 TWO ARG2 NINE SUM ELEVEN)
 (THREE+ZERO ISA ADDITION-FACT ARG1 THREE ARG2 ZERO SUM THREE)
 (THREE+ONE ISA ADDITION-FACT ARG1 THREE ARG2 ONE SUM FOUR)
 (THREE+TWO ISA ADDITION-FACT ARG1 THREE ARG2 TWO SUM FIVE)
 (THREE+THREE ISA ADDITION-FACT ARG1 THREE ARG2 THREE SUM SIX)
 (THREE+FOUR ISA ADDITION-FACT ARG1 THREE ARG2 FOUR SUM SEVEN)
 (THREE+FIVE ISA ADDITION-FACT ARG1 THREE ARG2 FIVE SUM EIGHT)
 (THREE+SIX ISA ADDITION-FACT ARG1 THREE ARG2 SIX SUM NINE)
 (THREE+SEVEN ISA ADDITION-FACT ARG1 THREE ARG2 SEVEN SUM TEN)
 (THREE+EIGHT ISA ADDITION-FACT ARG1 THREE ARG2 EIGHT SUM ELEVEN)
 (THREE+NINE ISA ADDITION-FACT ARG1 THREE ARG2 NINE SUM TWELVE)
 (FOUR+ZERO ISA ADDITION-FACT ARG1 FOUR ARG2 ZERO SUM FOUR)
 (FOUR+ONE ISA ADDITION-FACT ARG1 FOUR ARG2 ONE SUM FIVE)
 (FOUR+TWO ISA ADDITION-FACT ARG1 FOUR ARG2 TWO SUM SIX)
 (FOUR+THREE ISA ADDITION-FACT ARG1 FOUR ARG2 THREE SUM SEVEN)
 (FOUR+FOUR ISA ADDITION-FACT ARG1 FOUR ARG2 FOUR SUM EIGHT)
 (FOUR+FIVE ISA ADDITION-FACT ARG1 FOUR ARG2 FIVE SUM NINE)
 (FOUR+SIX ISA ADDITION-FACT ARG1 FOUR ARG2 SIX SUM TEN)
 (FOUR+SEVEN ISA ADDITION-FACT ARG1 FOUR ARG2 SEVEN SUM ELEVEN)
 (FOUR+EIGHT ISA ADDITION-FACT ARG1 FOUR ARG2 EIGHT SUM TWELVE)
 (FOUR+NINE ISA ADDITION-FACT ARG1 FOUR ARG2 NINE SUM THIRTEEN)
 (FIVE+ZERO ISA ADDITION-FACT ARG1 FIVE ARG2 ZERO SUM FIVE)
 (FIVE+ONE ISA ADDITION-FACT ARG1 FIVE ARG2 ONE SUM SIX)
 (FIVE+TWO ISA ADDITION-FACT ARG1 FIVE ARG2 TWO SUM SEVEN)
 (FIVE+THREE ISA ADDITION-FACT ARG1 FIVE ARG2 THREE SUM EIGHT)
 (FIVE+FOUR ISA ADDITION-FACT ARG1 FIVE ARG2 FOUR SUM NINE)
 (FIVE+FIVE ISA ADDITION-FACT ARG1 FIVE ARG2 FIVE SUM TEN)
 (FIVE+SIX ISA ADDITION-FACT ARG1 FIVE ARG2 SIX SUM ELEVEN)
 (FIVE+SEVEN ISA ADDITION-FACT ARG1 FIVE ARG2 SEVEN SUM TWELVE)
 (FIVE+EIGHT ISA ADDITION-FACT ARG1 FIVE ARG2 EIGHT SUM THIRTEEN)
 (FIVE+NINE ISA ADDITION-FACT ARG1 FIVE ARG2 NINE SUM FOURTEEN)
 (SIX+ZERO ISA ADDITION-FACT ARG1 SIX ARG2 ZERO SUM SIX)
 (SIX+ONE ISA ADDITION-FACT ARG1 SIX ARG2 ONE SUM SEVEN)
 (SIX+TWO ISA ADDITION-FACT ARG1 SIX ARG2 TWO SUM EIGHT)
 (SIX+THREE ISA ADDITION-FACT ARG1 SIX ARG2 THREE SUM NINE)
 (SIX+FOUR ISA ADDITION-FACT ARG1 SIX ARG2 FOUR SUM TEN)
 (SIX+FIVE ISA ADDITION-FACT ARG1 SIX ARG2 FIVE SUM ELEVEN)
 (SIX+SIX ISA ADDITION-FACT ARG1 SIX ARG2 SIX SUM TWELVE)
 (SIX+SEVEN ISA ADDITION-FACT ARG1 SIX ARG2 SEVEN SUM THIRTEEN)
 (SIX+EIGHT ISA ADDITION-FACT ARG1 SIX ARG2 EIGHT SUM FOURTEEN)
 (SIX+NINE ISA ADDITION-FACT ARG1 SIX ARG2 NINE SUM FIFTEEN)
 (SEVEN+ZERO ISA ADDITION-FACT ARG1 SEVEN ARG2 ZERO SUM SEVEN)
 (SEVEN+ONE ISA ADDITION-FACT ARG1 SEVEN ARG2 ONE SUM EIGHT)
 (SEVEN+TWO ISA ADDITION-FACT ARG1 SEVEN ARG2 TWO SUM NINE)
 (SEVEN+THREE ISA ADDITION-FACT ARG1 SEVEN ARG2 THREE SUM TEN)
 (SEVEN+FOUR ISA ADDITION-FACT ARG1 SEVEN ARG2 FOUR SUM ELEVEN)
 (SEVEN+FIVE ISA ADDITION-FACT ARG1 SEVEN ARG2 FIVE SUM TWELVE)
 (SEVEN+SIX ISA ADDITION-FACT ARG1 SEVEN ARG2 SIX SUM THIRTEEN)
 (SEVEN+SEVEN ISA ADDITION-FACT ARG1 SEVEN ARG2 SEVEN SUM FOURTEEN)
 (SEVEN+EIGHT ISA ADDITION-FACT ARG1 SEVEN ARG2 EIGHT SUM FIFTEEN)
 (SEVEN+NINE ISA ADDITION-FACT ARG1 SEVEN ARG2 NINE SUM SIXTEEN)
 (EIGHT+ZERO ISA ADDITION-FACT ARG1 EIGHT ARG2 ZERO SUM EIGHT)
 (EIGHT+ONE ISA ADDITION-FACT ARG1 EIGHT ARG2 ONE SUM NINE)
 (EIGHT+TWO ISA ADDITION-FACT ARG1 EIGHT ARG2 TWO SUM TEN)
 (EIGHT+THREE ISA ADDITION-FACT ARG1 EIGHT ARG2 THREE SUM ELEVEN)
 (EIGHT+FOUR ISA ADDITION-FACT ARG1 EIGHT ARG2 FOUR SUM TWELVE)
 (EIGHT+FIVE ISA ADDITION-FACT ARG1 EIGHT ARG2 FIVE SUM THIRTEEN)
 (EIGHT+SIX ISA ADDITION-FACT ARG1 EIGHT ARG2 SIX SUM FOURTEEN)
 (EIGHT+SEVEN ISA ADDITION-FACT ARG1 EIGHT ARG2 SEVEN SUM FIFTEEN)
 (EIGHT+EIGHT ISA ADDITION-FACT ARG1 EIGHT ARG2 EIGHT SUM SIXTEEN)
 (EIGHT+NINE ISA ADDITION-FACT ARG1 EIGHT ARG2 NINE SUM SEVENTEEN)
 (NINE+ZERO ISA ADDITION-FACT ARG1 NINE ARG2 ZERO SUM NINE)
 (NINE+ONE ISA ADDITION-FACT ARG1 NINE ARG2 ONE SUM TEN)
 (NINE+TWO ISA ADDITION-FACT ARG1 NINE ARG2 TWO SUM ELEVEN)
 (NINE+THREE ISA ADDITION-FACT ARG1 NINE ARG2 THREE SUM TWELVE)
 (NINE+FOUR ISA ADDITION-FACT ARG1 NINE ARG2 FOUR SUM THIRTEEN)
 (NINE+FIVE ISA ADDITION-FACT ARG1 NINE ARG2 FIVE SUM FOURTEEN)
 (NINE+SIX ISA ADDITION-FACT ARG1 NINE ARG2 SIX SUM FIFTEEN)
 (NINE+SEVEN ISA ADDITION-FACT ARG1 NINE ARG2 SEVEN SUM SIXTEEN)
 (NINE+EIGHT ISA ADDITION-FACT ARG1 NINE ARG2 EIGHT SUM SEVENTEEN)
 (NINE+NINE ISA ADDITION-FACT ARG1 NINE ARG2 NINE SUM EIGHTEEN)
 )


(sgp-fct (list :era t :v *v*))

(WMEType count-things object count position instructions)

(addwm (goal isa count-things))
(wmfocus goal)


(p read-instructions
   =goal>
      isa count-things
      instructions nil
   =loc>
    isa visual-location
    attended nil
    time now
   =state1>
      isa module-state
      module :vision
      modality free
   =state2>
      isa module-state
      module :motor
      modality free
==>
   !output! ("loc: (~a)~&" =loc)
   !send-command! :motor press-key "k"
   =newgoal>
      isa count-things
      instructions t
!focus-on! =newgoal)

(p start
   =goal>
      isa count-things
      instructions t
      object nil
      position nil
      count nil
   =loc>
    isa visual-location
    attended nil
    time now
   =state1>
      isa module-state
      module :vision
      modality free
   =state2>
      isa module-state
      module :motor
      modality free
==>
   !output! ("loc: (~a)~&" =loc)
   !send-command! :vision move-attention :location =loc  :scale count
  =goal>
    position =loc
    count zero)

(parameters start :r .8)

(P only-three
   =goal>
      ISA         count-things
      count       zero
   =obj>
      isa         triplet
      time now
      
==>
   =goal>
      count       three
      object      nil
)

(P only-two
   =goal>
      ISA         count-things
      count       zero
   =obj>
      isa         pair
      time now
      
==>
   =goal>
      count       two
      object      nil
)

(P only-one
   =goal>
      ISA         count-things
      count       zero
   =obj>
      isa         point
      time now
      
==>
   =goal>
      count       one
      object      nil
)

(P done
   =goal>
      ISA         count-things
      object      nil
      count       =count
   =count>
      ISA         integer
      value       =val
   =state>
      isa module-state
      module :vision
      modality free
   =state2>
      isa module-state
      module :motor
      modality free
==>
   ;to avoid timing problems with the different keys in ACT-R/PM
   ; just use a single key to respond 

   !send-command! :motor press-key "j"

   !output! (reported =val objects)

   =goal>
      object      nil
      count       nil
      position    nil
)

(parameters done :r 0.5 :a 0)

(P one-more
   =goal>
      ISA         count-things
      count       =count
-     count       zero
   =loc>
    isa visual-location
    attended nil
    time now
   =state>
      isa module-state
      module :vision
      modality free
   =state2>
      isa module-state
      module :motor
      modality free
   =addition-fact>
      ISA         addition-fact
      arg1        =count
      arg2        one
      sum         =new
==>
   !output! ("loc: (~a)~&" =loc)
   !send-command! :vision move-attention :location =loc
   =goal>
      count       =new
)

;(parameters one-more :effort .2)