;;;

;;;
;;; ACT-R 4.0 model of the
;;; visual search task
;;;
;;; to run the model call
;;; (predict-shiffrin n)
;;; where n is the number of runs

(defparameter *shiffrin-exp-data* 
  (make-array '(2 2 3 3) 
              :initial-contents '((((425 430 415) (0 0 0) (470 473 470)) 
                                   ((525 565 560) (0 0 0) (560 570 620)))
                                  (((445 445 490) (475 520 585) (490 640 800))
                                   ((555 530 590) (565 625 750) (655 900 1285))))))

(defparameter *shiffrin-numbers*
  '((n1 0 2       7           14       18)
    (n2 0 2 1      7 8 9 10       15 17)
    (n3 0 2 1      7 8 9       14 15  17)
    (n4 0 2    3   7 8 9       14       17)
    (n5 0 2 1  3     8      13    15     19)
    (n6 0 2 1  3     8 9 10    14 15     19)
    (n7 0 2 1  7 14 17)
    (n8 0 2 1  3 7 8 9 10 14 15  18)
    (n9 0 2 1  3 7 8 9 14 15  17)))

(defparameter *shiffrin-letters* 
  '((B 0 1      5   7   9 12 14 15  19)
    (C 0 1  3             10 15  19)
    (D 0 1      5   7     12 14 15  19)
    (F 0 1  3         8   10 19)
    (G 0 1  3           9 10 14 15  19)
    (H 0    3       7 8 9 10 14 18)
    (J 0             7     10 14 15  17)
    (K 0     3     6   8   10 13 19)
    (L 0     3             10 15  19)
    (M 0     3 4   6 7     10 14 18)
    (N 0     3 4     7     10 13 14 18)
    (P 0 1  3       7 8 9 10 19)
    (Q 0 1  3       7     10 13 14 15  19)
    (R 0 1  3       7 8 9 10 13 19)
    (S 0 1  3         8 9 14 15  18)
    (T 0 1      5         12 18)
    (V 0     3     6       10 11 18)
    (W 0     3       7     10 11 13 14 18)
    (X 0       4   6       11 13 18)
    (Y 0       4   6       12 18)
    (Z 0 1        6       11 15  18)))

(defvar *screen*)
(defvar *seen*)
(defvar *v*)
(defvar *runs*)
(defvar *overlay*)
(defvar *text*)
(defvar *graphic*)
(defvar *lf*)
(defvar *response-time*)

(setf *lf* .339)
(setf *v* nil)
(setf *response-time* .209)
(setf *text* t)
(setf *graphic* nil)
(setf *overlay* nil)
(setf *runs* 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 "Visual Search model" 2)
        (:table)
        
        (:table)
         "Latency factor (sec):" (:string :sy *lf* .339) (:new-row)
         "Response time (sec):" (:string :sy *response-time* .209) (:new-row)
         "Number of runs (1-500):" (:string :sy *runs*    50) 
        
        (: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)
        
        (:button "Show Experiment Results" "(output-shiffrin *shiffrin-exp-data* nil)")
       
        (:new-para)
        
        (:button "Run model" "
                              (if (and  (numberp *runs*))
                                  (predict-shiffrin (min 500 (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 50 runs of the model"
        (:new-line)
        "- The trace of 1 run is approximatly 25k (17 pages) in size"
        (:new-para)))



(defun predict-shiffrin (n)
  (reset)
  (sgp-fct (list  :v *v* :era t :lf *lf*))

  (spp-fct (list 'terminate-no :r .5 :effort *response-time*))
  (spp-fct (list 'judge-varied-posiitive :effort *response-time*))
  (spp-fct (list 'success :effort *response-time*))
  
  (encode-lf-shiffrin)
 
  (let ((pred (make-array '(2 2 3 3) :initial-element 0)))
  (dotimes (i n)
    (run-constant-shiffrin pred)
    (run-varied-shiffrin pred))
  
  (dotimes (i 2)
    (dotimes (j 2)
      (dotimes (k 3)
        (dotimes (m 3)
          (setf (aref pred i j k m) (* 1000.0 (/ (aref pred i j k m) n)))))))

  (output-shiffrin pred t)))

(defun output-shiffrin (data sim)
  

     (when sim 
       (format *standard-output* "~%~%Parameters for run: (~S ~S ~S)~%~%" 
                *lf* *response-time* *runs*))
     
     (when *text*
       (format *standard-output* "~a Data:~%~%Frame    Memory |      Consistent                     Varied~%" (if sim "Simulation" "Experimental"))
       (format *standard-output*             "size     size   |  Positive    Negative        Positive    Negative ~%")
       (dotimes (i 3)
         (dotimes (j 3)
           (format *standard-output*         "~3S      ~3s    |   ~6,1F       ~6,1F         ~6,1F     ~6,1F~%" (if (= i 2) 4 (1+ i)) (if (= j 2) 4 (1+ j))
                   (aref data 0 0 j i) (aref data 0 1 j i) (aref data 1 0 j i) (aref data 1 1 j i))))
       (format *standard-output* "~%~%")

       (when (and sim *overlay*)
         (format *standard-output* "Experimental Data:~%~%Frame    Memory |      Consistent                     Varied~%")
         (format *standard-output*             "size     size   |  Positive    Negative        Positive    Negative ~%")
         (dotimes (i 3)
           (dotimes (j 3)
             (format *standard-output*         "~3S      ~3s    |  ~6,1F       ~6,1F          ~6,1F     ~6,1F~%" (if (= i 2) 4 (1+ i)) (if (= j 2) 4 (1+ j))
                     (aref *shiffrin-exp-data* 0 0 j i) (aref *shiffrin-exp-data* 0 1 j i) (aref *shiffrin-exp-data* 1 0 j i) (aref *shiffrin-exp-data* 1 1 j i))))
         (format *standard-output* "~%note: 0's represent values not available~%"))
     
     (when *graphic*
       
       (format *standard-output* " 
         <applet 
        code = \"DansGraphs.class\" 
        width = 300 
        height = 400> 
        <PARAM name=\"title\" value=\"Frame size 1\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"5\">
        <PARAM name=\"ymax\" value=\"1500\">
        <PARAM name=\"ymin\" value=\"0\">
        <PARAM name=\"longestline\" value=\"3\">
        <PARAM name=\"numlines\" value=\"~S\">
        <PARAM name=\"xspacing\" value=\"1\">
        <PARAM name=\"ydiv\" value=\"100\">
        <PARAM name=\"yspacing\" value=\"500\">
        <PARAM name=\"xval0\" value=\"1;4;\">
        <PARAM name=\"xval1\" value=\"1;4;\">
        <PARAM name=\"xval2\" value=\"1;2;4;\">
        <PARAM name=\"xval3\" value=\"1;2;4;\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lcolor1\" value=\"1\">
        <PARAM name=\"lcolor2\" value=\"2\">
        <PARAM name=\"lcolor3\" value=\"3\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"lstyle1\" value=\"~s\">
        <PARAM name=\"lstyle2\" value=\"~s\">
        <PARAM name=\"lstyle3\" value=\"~s\">
        <PARAM name=\"xname\" value=\"Memory set size\">
        <PARAM name=\"yname\" value=\"RT (msec)\">
        <PARAM name=\"name0\" value=\"~a Consistent positive\"> 
        <PARAM name=\"name1\" value=\"~a Consistent negative\"> 
        <PARAM name=\"name2\" value=\"~a Varied positive\"> 
        <PARAM name=\"name3\" value=\"~a Varied negative\">"
               (if (and sim *overlay*) 8 4) 
               (if sim 2 6553)
               (if sim 2 6553)
               (if sim 2 6553)
               (if sim 2 6553)
               (if sim "Simulation" "Experimental")
               (if sim "Simulation" "Experimental")
               (if sim "Simulation" "Experimental")
               (if sim "Simulation" "Experimental"))
       
       (format *standard-output* "<PARAM name=\"yval0\" value=\"~6,1f;~6,1f;\">" (aref data 0 0 0 0) (aref data 0 0 2 0))
       (format *standard-output* "<PARAM name=\"yval1\" value=\"~6,1f;~6,1f;\">" (aref data 0 1 0 0) (aref data 0 1 2 0))
       (format *standard-output* "<PARAM name=\"yval2\" value=\"~6,1f;~6,1f;~6,1f;\">" (aref data 1 0 0 0) (aref data 1 0 1 0) (aref data 1 0 2 0))
       (format *standard-output* "<PARAM name=\"yval3\" value=\"~6,1f;~6,1f;~6,1f;\">" (aref data 1 1 0 0) (aref data 1 1 1 0) (aref data 1 1 2 0))
       
       
       
       (when (and *overlay* sim)
         (format *standard-output* "
        <PARAM name=\"xval4\" value=\"1;4;\">
        <PARAM name=\"xval5\" value=\"1;4;\">
        <PARAM name=\"xval6\" value=\"1;2;4;\">
        <PARAM name=\"xval7\" value=\"1;2;4;\">
        <PARAM name=\"lcolor4\" value=\"0\">
        <PARAM name=\"lcolor5\" value=\"1\">
        <PARAM name=\"lcolor6\" value=\"2\">
        <PARAM name=\"lcolor7\" value=\"3\">
        <PARAM name=\"lstyle4\" value=\"6553\">
        <PARAM name=\"lstyle5\" value=\"6553\">
        <PARAM name=\"lstyle6\" value=\"6553\">
        <PARAM name=\"lstyle7\" value=\"6553\">
        <PARAM name=\"name4\" value=\"Experimental Consistent positive\"> 
        <PARAM name=\"name5\" value=\"Experimental Consistent negative\"> 
        <PARAM name=\"name6\" value=\"Experimental Varied positive\"> 
        <PARAM name=\"name7\" value=\"Experimental Varied negative\">
       ")
         
        (format *standard-output* "<PARAM name=\"yval4\" value=\"~6,1f;~6,1f;\">" (aref *shiffrin-exp-data* 0 0 0 0) (aref *shiffrin-exp-data* 0 0 2 0))
       (format *standard-output* "<PARAM name=\"yval5\" value=\"~6,1f;~6,1f;\">" (aref *shiffrin-exp-data* 0 1 0 0) (aref *shiffrin-exp-data* 0 1 2 0))
       (format *standard-output* "<PARAM name=\"yval6\" value=\"~6,1f;~6,1f;~6,1f;\">" (aref *shiffrin-exp-data* 1 0 0 0) (aref *shiffrin-exp-data* 1 0 1 0) (aref *shiffrin-exp-data* 1 0 2 0))
       (format *standard-output* "<PARAM name=\"yval7\" value=\"~6,1f;~6,1f;~6,1f;\">" (aref *shiffrin-exp-data* 1 1 0 0) (aref *shiffrin-exp-data* 1 1 1 0) (aref *shiffrin-exp-data* 1 1 2 0)))
 

 (format *standard-output* " 
         <applet 
        code = \"DansGraphs.class\" 
        width = 300 
        height = 400> 
        <PARAM name=\"title\" value=\"Frame size 2\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"5\">
        <PARAM name=\"ymax\" value=\"1500\">
        <PARAM name=\"ymin\" value=\"0\">
        <PARAM name=\"longestline\" value=\"3\">
        <PARAM name=\"numlines\" value=\"~S\">
        <PARAM name=\"xspacing\" value=\"1\">
        <PARAM name=\"ydiv\" value=\"100\">
        <PARAM name=\"yspacing\" value=\"500\">
        <PARAM name=\"xval0\" value=\"1;4;\">
        <PARAM name=\"xval1\" value=\"1;4;\">
        <PARAM name=\"xval2\" value=\"1;2;4;\">
        <PARAM name=\"xval3\" value=\"1;2;4;\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lcolor1\" value=\"1\">
        <PARAM name=\"lcolor2\" value=\"2\">
        <PARAM name=\"lcolor3\" value=\"3\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"lstyle1\" value=\"~s\">
        <PARAM name=\"lstyle2\" value=\"~s\">
        <PARAM name=\"lstyle3\" value=\"~s\">
        <PARAM name=\"xname\" value=\"Memory set size\">
        <PARAM name=\"yname\" value=\"RT (msec)\">
        <PARAM name=\"name0\" value=\"~a Consistent positive\"> 
        <PARAM name=\"name1\" value=\"~a Consistent negative\"> 
        <PARAM name=\"name2\" value=\"~a Varied positive\"> 
        <PARAM name=\"name3\" value=\"~a Varied negative\">"
               (if (and sim *overlay*) 8 4) 
               (if sim 2 6553)
               (if sim 2 6553)
               (if sim 2 6553)
               (if sim 2 6553)
               (if sim "Simulation" "Experimental")
               (if sim "Simulation" "Experimental")
               (if sim "Simulation" "Experimental")
               (if sim "Simulation" "Experimental"))
       
       (format *standard-output* "<PARAM name=\"yval0\" value=\"~6,1f;~6,1f;\">" (aref data 0 0 0 1) (aref data 0 0 2 1))
       (format *standard-output* "<PARAM name=\"yval1\" value=\"~6,1f;~6,1f;\">" (aref data 0 1 0 1) (aref data 0 1 2 1))
       (format *standard-output* "<PARAM name=\"yval2\" value=\"~6,1f;~6,1f;~6,1f;\">" (aref data 1 0 0 1) (aref data 1 0 1 1) (aref data 1 0 2 1))
       (format *standard-output* "<PARAM name=\"yval3\" value=\"~6,1f;~6,1f;~6,1f;\">" (aref data 1 1 0 1) (aref data 1 1 1 1) (aref data 1 1 2 1))
       
       
       
       (when (and *overlay* sim)
         (format *standard-output* "
        <PARAM name=\"xval4\" value=\"1;4;\">
        <PARAM name=\"xval5\" value=\"1;4;\">
        <PARAM name=\"xval6\" value=\"1;2;4;\">
        <PARAM name=\"xval7\" value=\"1;2;4;\">
        <PARAM name=\"lcolor4\" value=\"0\">
        <PARAM name=\"lcolor5\" value=\"1\">
        <PARAM name=\"lcolor6\" value=\"2\">
        <PARAM name=\"lcolor7\" value=\"3\">
        <PARAM name=\"lstyle4\" value=\"6553\">
        <PARAM name=\"lstyle5\" value=\"6553\">
        <PARAM name=\"lstyle6\" value=\"6553\">
        <PARAM name=\"lstyle7\" value=\"6553\">
        <PARAM name=\"name4\" value=\"Experimental Consistent positive\"> 
        <PARAM name=\"name5\" value=\"Experimental Consistent negative\"> 
        <PARAM name=\"name6\" value=\"Experimental Varied positive\"> 
        <PARAM name=\"name7\" value=\"Experimental Varied negative\">
       ")
         
        (format *standard-output* "<PARAM name=\"yval4\" value=\"~6,1f;~6,1f;\">" (aref *shiffrin-exp-data* 0 0 0 1) (aref *shiffrin-exp-data* 0 0 2 1))
       (format *standard-output* "<PARAM name=\"yval5\" value=\"~6,1f;~6,1f;\">" (aref *shiffrin-exp-data* 0 1 0 1) (aref *shiffrin-exp-data* 0 1 2 1))
       (format *standard-output* "<PARAM name=\"yval6\" value=\"~6,1f;~6,1f;~6,1f;\">" (aref *shiffrin-exp-data* 1 0 0 1) (aref *shiffrin-exp-data* 1 0 1 1) (aref *shiffrin-exp-data* 1 0 2 1))
       (format *standard-output* "<PARAM name=\"yval7\" value=\"~6,1f;~6,1f;~6,1f;\">" (aref *shiffrin-exp-data* 1 1 0 1) (aref *shiffrin-exp-data* 1 1 1 1) (aref *shiffrin-exp-data* 1 1 2 1)))
 

(format *standard-output* " 
         <applet 
        code = \"DansGraphs.class\" 
        width = 300 
        height = 400> 
        <PARAM name=\"title\" value=\"Frame size 4\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"5\">
        <PARAM name=\"ymax\" value=\"1500\">
        <PARAM name=\"ymin\" value=\"0\">
        <PARAM name=\"longestline\" value=\"3\">
        <PARAM name=\"numlines\" value=\"~S\">
        <PARAM name=\"xspacing\" value=\"1\">
        <PARAM name=\"ydiv\" value=\"100\">
        <PARAM name=\"yspacing\" value=\"500\">
        <PARAM name=\"xval0\" value=\"1;4;\">
        <PARAM name=\"xval1\" value=\"1;4;\">
        <PARAM name=\"xval2\" value=\"1;2;4;\">
        <PARAM name=\"xval3\" value=\"1;2;4;\">
        <PARAM name=\"xname\" value=\"Memory set size\">
        <PARAM name=\"yname\" value=\"RT (msec)\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lcolor1\" value=\"1\">
        <PARAM name=\"lcolor2\" value=\"2\">
        <PARAM name=\"lcolor3\" value=\"3\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"lstyle1\" value=\"~s\">
        <PARAM name=\"lstyle2\" value=\"~s\">
        <PARAM name=\"lstyle3\" value=\"~s\">
        <PARAM name=\"name0\" value=\"~a Consistent positive\"> 
        <PARAM name=\"name1\" value=\"~a Consistent negative\"> 
        <PARAM name=\"name2\" value=\"~a Varied positive\"> 
        <PARAM name=\"name3\" value=\"~a Varied negative\">"
               (if (and sim *overlay*) 8 4) 
               (if sim 2 6553)
               (if sim 2 6553)
               (if sim 2 6553)
               (if sim 2 6553)
               (if sim "Simulation" "Experimental")
               (if sim "Simulation" "Experimental")
               (if sim "Simulation" "Experimental")
               (if sim "Simulation" "Experimental"))
       
       (format *standard-output* "<PARAM name=\"yval0\" value=\"~6,1f;~6,1f;\">" (aref data 0 0 0 2) (aref data 0 0 2 2))
       (format *standard-output* "<PARAM name=\"yval1\" value=\"~6,1f;~6,1f;\">" (aref data 0 1 0 2) (aref data 0 1 2 2))
       (format *standard-output* "<PARAM name=\"yval2\" value=\"~6,1f;~6,1f;~6,1f;\">" (aref data 1 0 0 2) (aref data 1 0 1 2) (aref data 1 0 2 2))
       (format *standard-output* "<PARAM name=\"yval3\" value=\"~6,1f;~6,1f;~6,1f;\">" (aref data 1 1 0 2) (aref data 1 1 1 2) (aref data 1 1 2 2))
       
       
       
       (when (and *overlay* sim)
         (format *standard-output* "
        <PARAM name=\"xval4\" value=\"1;4;\">
        <PARAM name=\"xval5\" value=\"1;4;\">
        <PARAM name=\"xval6\" value=\"1;2;4;\">
        <PARAM name=\"xval7\" value=\"1;2;4;\">
        <PARAM name=\"lcolor4\" value=\"0\">
        <PARAM name=\"lcolor5\" value=\"1\">
        <PARAM name=\"lcolor6\" value=\"2\">
        <PARAM name=\"lcolor7\" value=\"3\">
        <PARAM name=\"lstyle4\" value=\"6553\">
        <PARAM name=\"lstyle5\" value=\"6553\">
        <PARAM name=\"lstyle6\" value=\"6553\">
        <PARAM name=\"lstyle7\" value=\"6553\">
        <PARAM name=\"name4\" value=\"Experimental Consistent positive\"> 
        <PARAM name=\"name5\" value=\"Experimental Consistent negative\"> 
        <PARAM name=\"name6\" value=\"Experimental Varied positive\"> 
        <PARAM name=\"name7\" value=\"Experimental Varied negative\">
       ")
         
        (format *standard-output* "<PARAM name=\"yval4\" value=\"~6,1f;~6,1f;\">" (aref *shiffrin-exp-data* 0 0 0 2) (aref *shiffrin-exp-data* 0 0 2 2))
       (format *standard-output* "<PARAM name=\"yval5\" value=\"~6,1f;~6,1f;\">" (aref *shiffrin-exp-data* 0 1 0 2) (aref *shiffrin-exp-data* 0 1 2 2))
       (format *standard-output* "<PARAM name=\"yval6\" value=\"~6,1f;~6,1f;~6,1f;\">" (aref *shiffrin-exp-data* 1 0 0 2) (aref *shiffrin-exp-data* 1 0 1 2) (aref *shiffrin-exp-data* 1 0 2 2))
       (format *standard-output* "<PARAM name=\"yval7\" value=\"~6,1f;~6,1f;~6,1f;\">" (aref *shiffrin-exp-data* 1 1 0 2) (aref *shiffrin-exp-data* 1 0 1 2) (aref *shiffrin-exp-data* 1 1 2 2))



    )

      

       
       (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 run-varied-shiffrin (pred)
  (do ((set '(1 2 4) (cdr set))
       (i 0 (1+ i)))
      ((null set) pred)
    (do ((screen '(1 2 4) (cdr screen))
         (j 0 (1+ j)))
        ((null screen) nil)
      (let* ((items (mapcar 'car (permut-shiffrin *shiffrin-letters* (+ (car set) (car screen)))))
            (targets  (nthcdr (car screen) (reverse items) ))
            (candidates (nthcdr (car set) items ))
            (prior (actr-time)))
        (setf *screen* candidates)
        (run-trial-shiffrin targets 'letters)
        (setf (aref pred 1 1 i j) (+ (aref pred 1 1 i j) (- (actr-time) (+ .05 prior))))
        (setf prior (actr-time))
        (setf *screen* (permut-shiffrin (cons (car targets) (cdr candidates)) (length candidates)))
        (run-trial-shiffrin targets 'letters)
        (setf (aref pred 1 0 i j) (+ (aref pred 1 0 i j) (- (actr-time) (+ .05 prior) )))))))

(defun run-constant-shiffrin (pred)
  (do ((set '(1 2 4) (cdr set))
       (i 0 (1+ i)))
      ((null set) pred)
    (do ((screen '(1 2 4) (cdr screen))
         (j 0 (1+ j)))
        ((null screen) nil)
      (let* ((targets  (mapcar 'car (permut-shiffrin *shiffrin-numbers* (car set))))
            (candidates (mapcar 'car (permut-shiffrin *shiffrin-letters* (car set))))
            (prior (actr-time)))
        (setf *screen* candidates)
        (run-trial-shiffrin targets 'numbers)
        (setf (aref pred 0 1 i j) (+ (aref pred 0 1 i j) (- (actr-time) (+ .05 prior))))
        (setf prior (actr-time))
        (setf *screen* (permut-shiffrin (cons (car targets) (cdr candidates)) (length candidates)))
        (run-trial-shiffrin targets 'numbers)
        (setf (aref pred 0 0 i j) (+ (aref pred 0 0 i j) (- (actr-time) (+ .05 prior) )))))))

(defun randmem-shiffrin (lis) (nth (random (length lis)) lis))

(defun permut-shiffrin (lis size)
  (let ((x)(ans nil)(count 0))
    (loop (setq x (randmem-shiffrin lis))
          (setq lis (remove x lis))
          (setq ans (cons x ans))
          (setf count (1+ count))
          (cond ((equal count size) (return ans))))))



(defun encode-lf-shiffrin ()
  (do  ((temp '((n1 0  2      7           14       18)
               (n2 0 1  2    7 8 9 10       15 17)
               (n3 0 1 2     7 8 9       14 15  17)
               (n4 0   2  3   7 8 9       14       17)
               (n5 0 1 2 3     8      13    15     19)
               (n6 0 1 2 3     8 9 10    14 15     19)
               (n7 0 1 2 7 14 17)
               (n8 0 1 2 3 7 8 9 10 14 15  18)
               (n9 0 1 2 3 7 8 9 14 15  17)
               (B 0 1      5   7   9 12 14 15  19)
               (C 0 1  3             10 15  19)
               (D 0 1      5   7     12 14 15  19)
               (F 0 1  3         8   10 19)
               (G 0 1  3           9 10 14 15  19)
               (H 0    3       7 8 9 10 14 18)
               (J 0             7     10 14 15  17)
               (K 0     3     6   8   10 13 19)
               (L 0     3             10 15  19)
               (M 0     3 4   6 7     10 14 18)
               (N 0     3 4     7     10 13 14 18)
               (P 0 1  3       7 8 9 10 19)
               (Q 0 1  3       7     10 13 14 15  19)
               (R 0 1  3       7 8 9 10 13 19)
               (S 0 1  3         8 9 14 15  18)
               (T 0 1      5         12 18)
               (V 0     3     6       10 11 18)
               (W 0     3       7     10 11 13 14 18)
               (X 0       4   6       11 13 18)
               (Y 0       4   6       12 18)
               (Z 0 1        6       11 15  18)) (cdr temp)))
       ((null temp) nil)
    (set-ia-fct (list (list (caar temp) (caar temp) 7.5)))
    (do ((temp1 (cdar temp) (cdr temp1)))
        ((null temp1) nil)
      (set-ia-fct  (list (list (caar temp) (car temp1) 4.0))))))

(defun run-trial-shiffrin (set type)
  (setf *seen* nil) 
  (mod-chunk-fct 'search-goal (list 'feature nil 'set 'set 'target nil 'candidate nil 'type type))
  (do ((temp set (cdr temp))
       (prop '(first second third fourth) (cdr prop)))
      ((null prop) nil)
    (mod-chunk-fct 'search-goal (list (car prop) (car temp)))
    (cond ((car temp) (mod-chunk-fct (car temp) (list 'set 'set))
           (set-ia-fct (list (list 'set (car temp) (* 1.5 (- 3 (log (length set)))))))
           )))
  (goal-focus search-goal)
  (run)
  (mapcar  #'(lambda (x) (delete-chunk-fct (list x)))
           (no-output (swm isa recognize)))
  (do ((temp set (cdr temp)))
      ((null temp) nil)
   (mod-chunk-fct (car temp) (list 'set nil)))
)

(defun screen-object-shiffrin (feature)
  (do ((temp *screen* (cdr temp)))
      ((null temp) 
       (cond ((null *seen*) (setf *seen* (list (car *screen*))) 
              (no-output (car (eval `(dm ,(car *screen*))))))
             (t nil)))              
    (cond ((and (member  feature (assoc  (car temp) (append *shiffrin-numbers* *shiffrin-letters*)))
                (not (member (car temp) *seen*)))
           (setf *seen* (cons (car temp) *seen*))
           (return  (no-output (car (eval `(dm ,(car temp))))))))))

(defun number-tester (chunk)
  (assoc  chunk *shiffrin-numbers*))


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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; The ACT-R model

(clearall)

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

(wmetype letter set)
(wmetype number set)
(wmetype feature)
(wmetype search-goal first second third fourth feature set target type candidate)
(wmetype recognize set object result type)

(add-dm (search-goal isa search-goal) (yes isa chunk) 
        (no isa chunk) (set isa chunk)
        (letters isa chunk) (numbers isa chunk)
        (a isa letter) (b isa letter) (c isa letter) 
        (d isa letter) (e isa letter) (f isa letter) 
        (g isa letter) (h isa letter) (i isa letter) 
        (j isa letter) (k isa letter) (l isa letter) 
        (m isa letter) (n isa letter) (o isa letter) 
        (p isa letter) (q isa letter) (r isa letter)
        (s isa letter) (t isa letter) (u isa letter) 
        (v isa letter) (w isa letter) (x isa letter)
        (y isa letter) (z isa letter) (n1 isa number) 
        (n2 isa number) (n3 isa number) (n4 isa number) 
        (n5 isa number) (n6 isa number) (n7 isa number) 
        (n8 isa number) (n9 isa number) (0 isa feature)
        (1 isa feature) (2 isa feature) (3 isa feature) 
        (4 isa feature) (5 isa feature) (6 isa feature)
        (7 isa feature) (8 isa feature) (9 isa feature)
        (10 isa feature) (11 isa feature) (12 isa feature) 
        (13 isa feature) (14 isa feature) (15 isa feature) 
        (16 isa feature) (17 isa feature) (18 isa feature)
        (19 isa feature))








#|
 (mapcar #'(lambda (x y) (eval `(sdp ,x :base-level ,(+ 10 (/ 1.0 y)))))
        '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19)
       '(20 11 1 14 4 3 6 10 6 6 14 4 4 6 10 9 1 1 10 10))
|#

(sdp 0 :base-level 10.05) 
(sdp 1 :base-level 10.090909090909092) 
(sdp 2 :base-level 11.0) 
(sdp 3 :base-level 10.071428571428571) 
(sdp 4 :base-level 10.25) 
(sdp 5 :base-level 10.333333333333334) 
(sdp 6 :base-level 10.166666666666666) 
(sdp 7 :base-level 10.1) 
(sdp 8 :base-level 10.166666666666666) 
(sdp 9 :base-level 10.166666666666666) 
(sdp 10 :base-level 10.071428571428571) 
(sdp 11 :base-level 10.25) 
(sdp 12 :base-level 10.25) 
(sdp 13 :base-level 10.166666666666666) 
(sdp 14 :base-level 10.1) 
(sdp 15 :base-level 10.11111111111111) 
(sdp 16 :base-level 11.0) 
(sdp 17 :base-level 11.0) 
(sdp 18 :base-level 10.1) 
(sdp 19 :base-level 10.1)

(p select
   =goal>
      isa search-goal
      feature nil
   =feature>
      isa feature
==>
!output! ("~S" =feature)
  =goal>
      feature =feature
) 

(p encode-object
   =goal>
      isa search-goal
      feature =feature
      set =set
      candidate nil
     type =type
   !bind! =object (screen-object-shiffrin =feature)
==>
  =newgoal>
     isa recognize
     type =type
     object =object
     set =set
     result =result
  =goal>
     candidate =object
     target =result
!push! =newgoal)

(spp encode-object :effort .185)

(p judge-varied-negative
   =goal>
      isa search-goal
      feature =feature
      type letters
      set =set
     candidate =a
   - target =a
     type =type
   !bind! =object (screen-object-shiffrin =feature)
==>
  =newgoal>
     isa recognize
     type =type
     object =object
     set =set
     result =result
  =goal>
     candidate =object
     target =result
!push! =newgoal)

(spp judge-varied-negative :effort .185)

(p success
   =goal>
      isa search-goal
      type numbers
      target =a
      candidate =a
==>
!pop!)

(spp success :effort .209)

(p judge-varied-posiitive
   =goal>
      isa search-goal
      type letters
      target =a
      candidate =a
==>
!pop!)

(spp judge-varied-posiitive :effort .209)

(p terminate-no
   =goal>
      isa search-goal
==>
!pop!)

(spp terminate-no :r .5 :effort .209)

(p retrieve
   =goal>
     isa recognize
     type letters
     object =object
     set =set
  =candidate>
     isa letter
     set =set
==>
  =goal>
     result =candidate
!pop!)



(p judge-consistent-positive
   =goal>
     isa recognize
     type numbers
     object =object
!eval! (number-tester =object)
==>
  =goal>
     result =object
!pop!)

(p judge-consistent-negative
   =goal>
     isa recognize
     type numbers
     object =object
!eval! (not (number-tester =object))
==>
  =goal>
     result no
!pop!)

(spp judge-consistent-negative :effort .172)