;<pre><xmp>

(defvar *system-is-still-learning*)
(defvar *style*)
(defvar *done-time*)
(defvar *block-size*)
(defvar *jtb-hacked-block-number*)
(defvar *current-focus*)
(defvar *correct-category*)
(defvar *rt*)
(defvar *last-guess*)
(defvar *ebrw-criterion*)
(defvar *lax-criterion*)
(defvar *strict-criterion*)
(defvar *categories*)
(defvar *r-time* .05)
(defvar *r-thresh* .8)
(defvar *intercept* .2)
(defvar *counter-thresh* 1)
(defvar *runs* 1)
(defvar *text* t)
(defvar *graphic* nil)
(defparameter *v* nil)
(defvar *overlay* nil)

(defparameter *egs* (/ 2.2 (sqrt 2)))
(defparameter *jtb-hack-track* nil)

(defparameter nosof-results '(
                              ((B B B B B B A) 0.0018  0.0040) ((B B B B B A B) 0.0054  0.0040) ((B B B B B A A) 0.0014  0.0000) ((B B B B A B B) 0.0032  0.0040) 
                              ((B B B B A B A) 0.0024  0.0040) ((B B B B A A B) 0.0038  0.0040) ((B B B B A A A) 0.0020  0.0000) ((B B B A B B B) 0.0032  0.0000) 
                              ((B B B A B B A) 0.0020  0.0000) ((B B B A B A B) 0.0124  0.0000) ((B B B A B A A) 0.0028  0.0040) ((B B B A A B B) 0.0028  0.0090) 
                              ((B B B A A B A) 0.0018  0.0000) ((B B B A A A B) 0.0034  0.0000) ((B B B A A A A) 0.0038  0.0000) ((B B A B B B B) 0.0080  0.0440) 
                              ((B B A B B B A) 0.0032  0.0090) ((B B A B B A B) 0.0344  0.0350) ((B B A B B A A) 0.0056  0.0000) ((B B A B A B B) 0.0048  0.0310) 
                              ((B B A B A B A) 0.0030  0.0090) ((B B A B A A B) 0.0170  0.0180) ((B B A B A A A) 0.0038  0.0180) ((B B A A B B B) 0.0106  0.0130) 
                              ((B B A A B B A) 0.0034  0.0000) ((B B A A B A B) 0.1266  0.1320) ((B B A A B A A) 0.0114  0.0040) ((B B A A A B B) 0.0036  0.0000) 
                              ((B B A A A B A) 0.0020  0.0040) ((B B A A A A B) 0.0352  0.0310) ((B B A A A A A) 0.0066  0.0130) ((B A B B B B B) 0.0022  0.0090) 
                              ((B A B B B B A) 0.0022  0.0000) ((B A B B B A B) 0.0038  0.0040) ((B A B B B A A) 0.0038  0.0000) ((B A B B A B B) 0.0030  0.0000) 
                              ((B A B B A B A) 0.0026  0.0000) ((B A B B A A B) 0.0010  0.0000) ((B A B B A A A) 0.0006  0.0000) ((B A B A B B B) 0.0016  0.0000) 
                              ((B A B A B B A) 0.0022  0.0040) ((B A B A B A B) 0.0030  0.0000) ((B A B A B A A) 0.0022  0.0000) ((B A B A A B B) 0.0028  0.0000) 
                              ((B A B A A B A) 0.0028  0.0000) ((B A B A A A B) 0.0022  0.0000) ((B A B A A A A) 0.0030  0.0000) ((B A A B B B B) 0.0116  0.0130) 
                              ((B A A B B B A) 0.0024  0.0000) ((B A A B B A B) 0.0090  0.0090) ((B A A B B A A) 0.0034  0.0000) ((B A A B A B B) 0.0044  0.0000) 
                              ((B A A B A B A) 0.0032  0.0000) ((B A A B A A B) 0.0066  0.0000) ((B A A B A A A) 0.0024  0.0000) ((B A A A B B B) 0.0046  0.0000) 
                              ((B A A A B B A) 0.0032  0.0040) ((B A A A B A B) 0.0112  0.0130) ((B A A A B A A) 0.0056  0.0000) ((B A A A A B B) 0.0032  0.0040) 
                              ((B A A A A B A) 0.0012  0.0000) ((B A A A A A B) 0.0054  0.0000) ((B A A A A A A) 0.0016  0.0000) ((A B B B B B B) 0.0054  0.0000) 
                              ((A B B B B B A) 0.0022  0.0090) ((A B B B B A B) 0.0034  0.0000) ((A B B B B A A) 0.0026  0.0000) ((A B B B A B B) 0.0030  0.0000) 
                              ((A B B B A B A) 0.0024  0.0000) ((A B B B A A B) 0.0020  0.0090) ((A B B B A A A) 0.0036  0.0000) ((A B B A B B B) 0.0026  0.0040) 
                              ((A B B A B B A) 0.0010  0.0000) ((A B B A B A B) 0.0052  0.0130) ((A B B A B A A) 0.0032  0.0000) ((A B B A A B B) 0.0024  0.0040) 
                              ((A B B A A B A) 0.0022  0.0000) ((A B B A A A B) 0.0022  0.0000) ((A B B A A A A) 0.0026  0.0040) ((A B A B B B B) 0.0348  0.0260) 
                              ((A B A B B B A) 0.0038  0.0040) ((A B A B B A B) 0.0290  0.0700) ((A B A B B A A) 0.0048  0.0000) ((A B A B A B B) 0.0138  0.0090) 
                              ((A B A B A B A) 0.0046  0.0090) ((A B A B A A B) 0.0150  0.0260) ((A B A B A A A) 0.0036  0.0090) ((A B A A B B B) 0.0072  0.0000) 
                              ((A B A A B B A) 0.0022  0.0000) ((A B A A B A B) 0.0334  0.0220) ((A B A A B A A) 0.0032  0.0040) ((A B A A A B B) 0.0038  0.0000) 
                              ((A B A A A B A) 0.0024  0.0000) ((A B A A A A B) 0.0106  0.0180) ((A B A A A A A) 0.0046  0.0040) ((A A B B B B B) 0.0124  0.0130) 
                              ((A A B B B B A) 0.0030  0.0040) ((A A B B B A B) 0.0052  0.0040) ((A A B B B A A) 0.0020  0.0000) ((A A B B A B B) 0.0056  0.0040) 
                              ((A A B B A B A) 0.0030  0.0090) ((A A B B A A B) 0.0032  0.0000) ((A A B B A A A) 0.0032  0.0000) ((A A B A B B B) 0.0024  0.0040) 
                              ((A A B A B B A) 0.0020  0.0000) ((A A B A B A B) 0.0028  0.0000) ((A A B A B A A) 0.0016  0.0000) ((A A B A A B B) 0.0024  0.0000) 
                              ((A A B A A B A) 0.0026  0.0040) ((A A B A A A B) 0.0034  0.0000) ((A A B A A A A) 0.0020  0.0040) ((A A A B B B B) 0.1218  0.1410) 
                              ((A A A B B B A) 0.0116  0.0130) ((A A A B B A B) 0.0342  0.0260) ((A A A B B A A) 0.0054  0.0000) ((A A A B A B B) 0.0354  0.0130) 
                              ((A A A B A B A) 0.0072  0.0040) ((A A A B A A B) 0.0102  0.0130) ((A A A B A A A) 0.0020  0.0000) ((A A A A B B B) 0.0104  0.0040) 
                              ((A A A A B B A) 0.0022  0.0000) ((A A A A B A B) 0.0116  0.0130) ((A A A A B A A) 0.0024  0.0000) ((A A A A A B B) 0.0048  0.0040) 
                              ((A A A A A B A) 0.0026  0.0040) ((A A A A A A B) 0.0034  0.0000) ((A A A A A A A) 0.0020  0.0090) ((B B B B B B B) 0.0038  0.0000) 
                              ))


(defparameter *experiment-2-patterns*
  '( (one one one two category-a) (one two one two category-a) 
     (one two one one category-a) (one one two one category-a) 
     (two one one one category-a) (one one two two category-b) 
     (two one one two category-b) (two two two one category-b)
     (two two two two category-b)))

(defparameter *experiment-2-transfer-patterns*
  '( (one two two one) (one two two two) (one one one one) 
     (two two one two) (two one two one) (two two one one) 
     (two one two two)))

(defparameter interesting-patterns '((A A A A A A A) (A A A A B A B) (A A A B A A B) (A A A B A B B) (A A A B B A B) (A A A B B B A) (A A A B B B B) (A A B B A B A) (A A B B B B B) (A B A 
                                                                                                                                                                                        A A A B) (A B A A B A B) (A B A B A A A) (A B A B A A B) (A B A B A B A) (A B A B A B B) (A B A B B A B) (A B A B B B B) (A B B A B A B) (A B B B A A B) (A B B 
                                                                                                                                                                                                                                                                                                                                                    B B B A) (B A A A B A B) (B A A B B A B) (B A A B B B B) (B A B B B B B) (B B A A A A A) (B B A A A A B) (B B A A B A B) (B B A A B B B) (B B A B A A A) (B B A 
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                B A A B) (B B A B A B A) (B B A B A B B) (B B A B B A B) (B B A B B B A) (B B A B B B B) (B B B A A B B)))

(defparameter *jtb-hack-track-track* nil)



(defparameter *interesting* '(
                              (a a a a a) (a a a a b) (a a a b a) (a a a b b) (a a b a a) (a a b a b) (a a b b a) (a a b b b)
                              (a b a a a) (a b a a b) (a b a b a) (a b a b b) (a b b a a) (a b b a b) (a b b b a) (a b b b b)
                              (b a a a a) (b a a a b) (b a a b a) (b a a b b) (b a b a a) (b a b a b) (b a b b a) (b a b b b)
                              (b b a a a) (b b a a b) (b b a b a) (b b a b b) (b b b a a) (b b b a b) (b b b b a) (b b b b b)))


(defparameter *exp-data-catds2* '(0.013 0.012 0.013 0.008 0.013 0.03 0.03 0.171 0.026 0.004 0.039 0.004
                          0.044 0.018 0.07 0.039 0 0.004 0.013 0.008 0 0 0.013 0.022 0.044 0.013
                          0.14 0.013 0.04 0.048 0.039 0.057))

(defparameter *rulex-data-catds2* '(0.0108 0.0124 0.0184 0.017 0.0186 0.0512 0.0468 0.1488 0.02 0.0108
                            0.045 0.013 0.0242 0.0238 0.0398 0.0462 0.0122 0.01 0.022 0.0116
                            0.0106 0.0132 0.02 0.0184 0.049 0.0102 0.1532 0.0192 0.0266 0.0134
                            0.0468 0.0168))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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 "Categorization Model of Nosofsky, Palmeri, & McKinley,1994" 2)
        (:table)
        
        (:table)
        "Retrieval Time: "        (:string :sy *r-time*  .05)   (:new-row)
        "Retrieval Threshold: "   (:string :sy *r-thresh*  .8)  (:new-row)
        "Intercept Parameter: "   (:string :sy *intercept*  .20)     (:new-row)
        "Counter Threshold: "     (:string :sy *counter-thresh* 1)     (:new-row)
        "Number of runs (10-200): " (:string :sy *runs* 10)
        (:table-end)
        
        (:table)
       (:checkbox "Trace (NOT recommended, see below)" :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 Experimental and Rulex Results" "(display-catds2 nil 
                                                                       *exp-data-catds2* *rulex-data-catds2*)")
           
        (:new-para)
        
        (:button "Run model" "(if (and (numberp *r-time*) (numberp *r-thresh*)
                                       (numberp *intercept*) (numberp *counter-thresh*)
                                       (numberp *runs*))
                                   (display-catds2 (mapcar #'cdr (demo-2-catds2 (min 200 (max 10 *runs*)) *r-time* *r-thresh* *intercept* *counter-thresh*))
                                                     *exp-data-catds2* *rulex-data-catds2*
                                                                       )
                                   
                                   (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 1 minute for 10 runs of the model"
        (:new-line)
        "- The trace of 10 runs is approximatly 1.5 MEGABYTES (800 pages) in size"
        (:new-para)))

(defun p-to-s-catds2 (pat)
  (format nil "~{~:@(~S~)~}" pat))


(defun display-catds2 (model experi rulex)
  (when model 
    (format *standard-output* "~%~%Parameters for run: (~S ~S ~S ~S ~S)~%" 
            *r-time* *r-thresh* *intercept* *counter-thresh* (min 200 (max 10 *runs*))))
  
  (when *text*
    (when model
      (format *standard-output* "~%~%ACT-R Generalization:~%")
      (format *standard-output* "~%Pattern~%")
      (dotimes (i 32)
        (format *standard-output* "~10a~10,3f~%" (p-to-s-catds2 (nth i *interesting*)) (nth i  model))))
      
    (when (or (null model) *overlay*)
      (format *standard-output* "~%~%Rulex Generalization:~%")
      (format *standard-output* "~%Pattern~%")
      (dotimes (i 32)
        (format *standard-output* "~10a~10,3f~%" (p-to-s-catds2 (nth i *interesting*)) (nth i  rulex)))
      (format *standard-output* "~%~%Experimental Generalization:~%")
      (format *standard-output* "~%Pattern~%")
      (dotimes (i 32)
        (format *standard-output* "~10a~10,3f~%" (p-to-s-catds2 (nth i *interesting*)) (nth i  experi)))
      
      (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* 
    (let ((num-lines (cond ((and model (not *overlay*)) 1)
                 ((null model) 2)
                 (t 3))))

      (format *standard-output* " 
        <applet 
        code = \"DansGraphs.class\" 
        width = 400 
        height = 800> 
        <PARAM name=\"title\" value=\"Generalization\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\".2\">
        <PARAM name=\"ymax\" value=\"32\">
        <PARAM name=\"ymin\" value=\"-1\">
        <PARAM name=\"numylabels\" value=\"34\">
        <PARAM name=\"ylabels\" value=\" ;BBBBB;BBBBA;BBBAB;BBBAA;BBABB;BBABA;BBAAB;BBAAA;BABBB;BABBA;BABAB;BABAA;BAABB;BAABA;BAAAB;BAAAA;ABBBB;ABBBA;ABBAB;ABBAA;ABABB;ABABA;ABAAB;ABAAA;AABBB;AABBA;AABAB;AABAA;AAABB;AAABA;AAAAB;AAAAA; ;\">
        <PARAM name=\"widestylabel\" value=\"WWWWW\">
        <PARAM name=\"longestline\" value=\"96\">
        <PARAM name=\"numlines\" value=\"~S\">
        <PARAM name=\"xspacing\" value=\".1\">
        <PARAM name=\"xdiv\" value=\".025\">
         <PARAM name=\"xname\" value=\" \">
        <PARAM name=\"yname\" value=\"Pattern\">
        
" 
           
              (1+ num-lines)
            )
    
    (dotimes (i num-lines)
        (format *standard-output* "<PARAM name=\"lcolor~s\" value=\"~s\">
                                   <PARAM name=\"lstyle~s\" value=\"2\">
                                   <PARAM name=\"xval~s\" value=\"" i i i i)
        (dotimes (j 32)
          (format *standard-output* "~4,3f;0;0;" (nth j (case i
                                                          (0 (case num-lines
                                                               (1 model)
                                                               (2 rulex)
                                                               (3 model)))
                                                          (1 (case num-lines
                                                               (2 experi)
                                                               (3 rulex)))
                                                          (2 experi)))))
        (format *standard-output* "\">
                                   <PARAM name=\"yval~s\" value=\"" i)

        (dotimes (j 32)
          (format *standard-output* "~S;~S;~S;" (- 31 (+ (- j .2) (* .2 i))) (- 31 (+ (- j .2) (* .2 i))) (- 31 (+ (+ j .8) (* .2 i)))))

        (format *standard-output* "\">"))
        

    (dotimes (i num-lines)
      (format *standard-output* "<PARAM name=\"name~s\" value=\"~a\">" 
              i 
              (case i
                  (0 (case num-lines
                       (1 "ACT-R")
                       (2 "Rulex")
                       (3 "ACT-R")))
                  (1 (case num-lines
                       (2 "Experimental Data")
                       (3 "Rulex")))
                  (2 "Experimental Data"))))
    
       
     (format *standard-output* "<PARAM name=\"lcolor~s\" value=\"7\">
                                   <PARAM name=\"lstyle~s\" value=\"2\">
                                   <PARAM name=\"xval~s\" value=\"0;0;\">
                                   <PARAM name=\"yval~s\" value=\"-1;32;\">"

              num-lines num-lines num-lines num-lines) 
    (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 demo-2-catds2 (n time tau intercept counter)
  (let (result)
    (setf *rt* tau)
    (setq *ebrw-criterion* counter)
    (setf result (experiment-2-run-and-show-catds2 n time intercept))
    (aggregate-catds2 (car result) n)
;    (mapcar #'(lambda (x) (/ x (* 1.0 n))) (second result))
))

(defun experiment-2-run-and-show-catds2 (number-subjects time intercept)
  (let (results this-result nosof-freq result-value (gain-noise *egs*) what-to-return ssd2)
    (setq results (experiment-2-present-many-subjects-catds2 number-subjects gain-noise time intercept))
    (setq what-to-return '())
 
    (setq ssd2 0)
    
    (dolist (itm interesting-patterns)
      (setq this-result (assoc itm (second results) :test #'equal))
      (setq nosof-freq (second (assoc itm nosof-results :test #'equal)))
      (setq result-value (if this-result (second this-result) 0))
      (setq what-to-return (cons (/ result-value number-subjects) what-to-return))  
      (setq ssd2 (+ (sqr-catds2 (- nosof-freq (/ result-value number-subjects))) ssd2))
      )
    
    (list (second results) (fourth results))
    )
  )
(defun experiment-2-present-many-subjects-catds2 (number-subjects gain-noise time intercept)
  (let (all-hammings all-generalizations immediate-result tmp hamm-res gen-res (rule-count 0) history)
    (setq all-hammings '())
    (setq all-generalizations '())
    
    (do ((n 0 (+ 1 n))) ((equal n number-subjects))
      (setq immediate-result (run-experiment-2-once-catds2 gain-noise time intercept))
      (cond ((eq *style* 'rule) (setf rule-count (1+ rule-count))))
      (setq all-hammings (cons (first immediate-result) all-hammings))
      (setq all-generalizations (cons (second immediate-result) all-generalizations))
      (setf history (cons (third immediate-result) history))
      (setq *jtb-hack-track-track* (cons *jtb-hack-track* *jtb-hack-track-track*))
      (setq *jtb-hack-track* nil)
      )
    
    (setq tmp all-generalizations)
    (setq gen-res nil)
    (dolist (itm all-generalizations)
      (if (member itm tmp)
        (list (setq gen-res (cons (list itm (count itm tmp :test #'equal)) gen-res))
              (setq tmp (set-difference  tmp (list itm) :test #'equal))))
      )
    
    (setq hamm-res '())
    
    (dolist (itm '(0 1 2 3 4 5 6 7))
      (if (member itm all-hammings)
        (setq hamm-res (cons (list itm (count itm all-hammings :test #'equal)) hamm-res))))
    (list hamm-res gen-res rule-count (examples-catds2 history))))

(defun run-experiment-2-once-catds2 (noise time intercept)
  (setf *categories* '(category-a category-b)) 
  (let (transfer-results styles)
    (reset) 
    (spp-fct (list 'recall-2feature :effort time))
    (spp-fct (list 'done-classifying-by-exemplar :effort intercept))
    (spp-fct (list 'DONE-CLASSIFYING-BY-RULE :effort intercept))
    (setq *jtb-hacked-block-number* 0)
    (experiment-2-setup-catds2 noise)
    (sgp-fct (list :v *v* :rt *rt*))
    (setq *system-is-still-learning* 1)
    (do ((n 0 (+ 1 n))) ((equal n 16))
      (present-block-catds2 (randomize-catds2 *experiment-2-patterns*))
      (setf styles (append styles (list *style*)))
      )
    
    (setq transfer-results '())
    (setq *system-is-still-learning* '())
    
    (do ((n 0 (+ 1 n))) ((equal n 3))
      (setq transfer-results (cons (present-block-catds2 *experiment-2-transfer-patterns*) transfer-results)))
    
    
    (list (hamming-dist-catds2 (third transfer-results) (second transfer-results))
          (pattern-list-trans-catds2 (majority-rule-catds2 (first transfer-results) (second transfer-results) (third transfer-results)))
          styles)
    
    ))


(defun experiment-2-setup-catds2 (noise)
  (add-dm
   
   (category-a ISA category opposite category-b)
   (category-b ISA category opposite category-a)
   (one ISA feature-value value 1)
   (two ISA feature-value value 2)
   (checked ISA feature-value)
   
   (feature1-p ISA rule feature1 1.5 viable T type perfect correct 0 incorrect 0)
   (feature2-p ISA rule feature2 1.5 viable T type perfect correct 0 incorrect 0)
   (feature3-p ISA rule feature3 1.5 viable T type perfect correct 0 incorrect 0)
   (feature4-p ISA rule feature4 1.5 viable T type perfect correct 0 incorrect 0)
   
   (feature1-i ISA rule feature1 1.5 viable T type imperfect correct 0 incorrect 0)
   (feature2-i ISA rule feature2 1.5 viable T type imperfect correct 0 incorrect 0)
   (feature3-i ISA rule feature3 1.5 viable T type imperfect correct 0 incorrect 0)
   (feature4-i ISA rule feature4 1.5 viable T type imperfect correct 0 incorrect 0)
   )
  
  
  (set-base-levels (feature1-p 1000 -100) (feature2-p 1000 -100) (feature3-p 1000 -100)
                   (feature4-p 1000 -100) 
                   (feature1-i 1000 -100) (feature2-i 1000 -100) (feature3-i 1000 -100)
                   (feature4-i 1000 -100)
                   (one 1000 -100) (two 1000 -100) (category-a 1000 -100) (category-b 1000 -100)
                   )
  
  (set-similarities (one two 0.95))
  
  (setq *block-size* 9)
  (setq *lax-criterion* 0.55)
  (setq *strict-criterion* (+ 0.65 (/ (random 2000) 10000)))
  (setq *ebrw-criterion* 1)
  (sgp :rt 1.1)
  
  (set-gain-noise-and-production-catds2 noise)
  )


(defun present-block-catds2 (pattern-list)
  ; IMPORTANT: THIS FUNCTION DOES NOT RANDOMIZE THE STIMULI!!!
  ; DO IT WHEN YOU CALL!
  (setq *jtb-hacked-block-number* (+ 2 *jtb-hacked-block-number*))
  (mapcar #'(lambda (x) (eval `(sdp ,x :references ,*jtb-hacked-block-number*))) 
          (no-output (sdm isa stimulus)))
  
  
  (let (pb-res) 
    (setq pb-res '())
    
    (dolist (itm pattern-list)
      (setq pb-res (cons (present-pattern-catds2 itm) pb-res)))
    
    (reverse pb-res)
    )
  )

(defun randomize-catds2 (list)
  (let ((n (length list))
        (result nil))
    (setf list (copy-tree list))
    (dotimes (i n result)
      (let ((data (nth (random (- n i)) list)))
        (push data result)
        (setf list (delete data list))))))

(defun hamming-dist-catds2 (l1 l2)
  (let (total)
    (setq total 0)
    (do ((n 0 (+ 1 n))) ((equal n (length l1)))
      (if (not (equal (nth n l1) (nth n l2))) (setq total (+ 1 total))))
    total)
  )
(defun pattern-list-trans-catds2 (lis)
  (let (res)
    (setq res '())
    (dolist (itm lis)
      (if (eq itm 'Category-A) (setq res (cons 'A res))
          (if (eq itm 'Category-B) (setq res (cons 'B res))
              (if (eq itm 'Category-C) (setq res (cons 'C res))
                  (if (eq itm 'Category-D) (setq res (cons 'D res)))))))
    (reverse res)
    )
  )
(defun majority-rule-catds2 (l1 l2 l3)
  (let (res)
    (setq res '())
    (do ((n 0 (+ 1 n))) ((equal n (length l1)))
      (setq res (cons (two-out-of-three-catds2 (mapcar #'(lambda(x) (nth n x)) (list l1 l2 l3))) res)))
    (reverse res)
    )
  )
(defun set-gain-noise-and-production-catds2 (noise)
  (let ()(sgp-fct (list :egs noise))
       )
  )
(defun present-pattern-catds2 (pattern)
  (let (name)
    (setf *last-guess* nil)
    (setq *style* nil)
    (setq *done-time* nil)
    (setq name (gentemp "ITEM"))
    (if (car (no-output (sgp :v))) (print pattern))
    (add-dm-fct (list (list name 'isa 'presentation 'feature1 (first pattern) 
                            'feature2 (second pattern) 'feature3 (third pattern) 'feature4 (fourth pattern))))
    (setq *correct-category* (fifth pattern))
    (setq *current-focus* name)
    (goal-focus-fct (list *current-focus*))
    (run)
    (setq *jtb-hack-track* (cons 
                            (if (equal *style* 'rule) 1 
                                (if (equal *style* 'exem4) 0 0.5)) *jtb-hack-track*))
    *last-guess*)
  )
(defun two-out-of-three-catds2 (lis)
  (if (or (equal (first lis) (second lis)) (equal (first lis) (third lis))) (first lis)
      (second lis))
  )
(defun sqr-catds2 (x) (* x x))

(defun random-category-catds2 ()
  (nth (random (length *categories*)) *categories*)
  )



(defun increment-category-count-catds2 (classify-goal category)
  (if (equal category 'category-A)
    (modwme-fct classify-goal 
                (list 'countA (+ 1 (chunk-slot-value-fct classify-goal 'countA))))
    (if (equal category 'category-B)
      (modwme-fct classify-goal
                  (list 'countB (+ 1 (chunk-slot-value-fct classify-goal 'countB))))
      (if (equal category 'category-C)
        (modwme-fct classify-goal
                    (list 'countC (+ 1 (chunk-slot-value-fct classify-goal 'countC))))
        (if (equal category 'category-D)
          (modwme-fct classify-goal
                      (list 'countD (+ 1 (chunk-slot-value-fct classify-goal 'countD))))))))
  )

(defun correct-category-catds2 (blah)
  (declare (ignore blah))
  (if (equal *done-time* nil) (setq *done-time* (actr-time)))
  (setq *last-guess* (chunk-slot-value-fct *current-focus* 'category)) 
  (if *system-is-still-learning* *correct-category* (chunk-slot-value-fct *current-focus* 'category))
  )


(defun winner-catds2 (stimulus)
  (let (numA numB numC numD) 
    (setq numA (chunk-slot-value-fct stimulus 'countA))
    (setq numB (chunk-slot-value-fct stimulus 'countB))
    (setq numC (chunk-slot-value-fct stimulus 'countC))
    (setq numD (chunk-slot-value-fct stimulus 'countD))
    (if (and (>= (- numA numB) *ebrw-criterion*)
             (>= (- numA numC) *ebrw-criterion*)
             (>= (- numA numD) *ebrw-criterion*)) 'category-A
        (if (and (>= (- numB numA) *ebrw-criterion*)
                 (>= (- numB numC) *ebrw-criterion*)
                 (>= (- numB numD) *ebrw-criterion*)) 'category-B
            (if (and (>= (- numC numA) *ebrw-criterion*)
                     (>= (- numC numB) *ebrw-criterion*)
                     (>= (- numC numD) *ebrw-criterion*)) 'category-C
                (if (and (>= (- numD numA) *ebrw-criterion*)
                         (>= (- numD numB) *ebrw-criterion*)
                         (>= (- numD numC) *ebrw-criterion*)) 'category-D))))
    )
  
  )

(defun rule-category-catds2 (rule stim)
  (if (and 
       (or (and (chunk-slot-value-fct rule 'feature1) 
                (< (chunk-slot-value-fct rule 'feature1) 
                   (chunk-slot-value-fct (chunk-slot-value-fct stim 'feature1) 'value)))
           (not (chunk-slot-value-fct rule 'feature1)))
       
       
       (or (and (chunk-slot-value-fct rule 'feature2) 
                (< (chunk-slot-value-fct rule 'feature2) 
                   (chunk-slot-value-fct (chunk-slot-value-fct stim 'feature2) 'value)))
           (not (chunk-slot-value-fct rule 'feature2)))
       
       
       (or (and (chunk-slot-value-fct rule 'feature3) 
                (< (chunk-slot-value-fct rule 'feature3) 
                   (chunk-slot-value-fct (chunk-slot-value-fct stim 'feature3) 'value)))
           (not (chunk-slot-value-fct rule 'feature3)))
       
       (or (and (chunk-slot-value-fct rule 'feature4) 
                (< (chunk-slot-value-fct rule 'feature4) 
                   (chunk-slot-value-fct (chunk-slot-value-fct stim 'feature4) 'value)))
           (not (chunk-slot-value-fct rule 'feature4))))
    
    (chunk-slot-value-fct stim 'category)
    (nth (random (1- (length *categories*))) (remove (chunk-slot-value-fct stim 'category) *categories*)))
  )


(defun examples-catds2 (history)
  (do ((temp history (cdr temp))
       (result (list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
               (do ((temp1 result (cdr temp1))
                    (temp2 (car temp) (cdr temp2))
                    (answer nil (cond ((eq (car temp2) 'rule) (cons (car temp1) answer))
                                      (t (cons (1+ (car temp1)) answer)))))
                   ((null temp1) (reverse answer)))))
      ((null temp) result)))

(defun aggregate-catds2 (data n)
  (do ((temp *interesting* (cdr temp))
       (result nil (append result (list (cons (car temp) (do ((temp1 data (cdr temp1))
                                                              (sum 0 (cond ((match-pattern-catds2 (caar temp1) (car temp)) (+ sum (cadar temp1)))
                                                                           (t sum))))
                                                             ((null temp1) (/ sum (* n 1.0)))))))))
      ((null temp) result)))

(defun match-pattern-catds2 (a b)
  (and (eq (first a) (first b))
       (eq (second a) (second b))
       (eq (fourth a) (third b))
       (eq (fifth a) (fourth b))
       (eq (sixth a) (fifth b))))

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

(clear-all)
(sgp-fct (list :lt nil :pct nil :pmt nil :v *v* :pm t :era t :er t :pl t :bll 0.5 :ans .55 :egs *egs* :ga 1 :lf 1 :mp 45 :rt 0.0 :ut -20))

(chunk-type presentation feature1 feature2 feature3 feature4 category choice exn-used evaluated)
(chunk-type stimulus feature1 feature2 feature3 feature4 category)
(chunk-type feature-value value)
(chunk-type category opposite)
(chunk-type clean-up)
(chunk-type rule feature1 feature2 feature3 feature4 guess viable current type correct incorrect)
(chunk-type classify-by-rule presentation category exceptions-checked exn-used)
(chunk-type apply-rule-to-presentation rule presentation checked category)
(chunk-type classify-by-exemplar presentation category counta countb countc countd feature1 feature2 feature3 feature4)
(chunk-type exception feature1 feature2 feature3 feature4 category)
(chunk-type rule-type)
(chunk-type find-rule presentation)
(chunk-type evaluate classification-style presentation count last-result exn-used)
(chunk-type classification-style)

(add-dm
   (perfect ISA rule-type)
   (imperfect ISA rule-type)
   (conjunctive ISA rule-type)
   (rule-2 isa chunk)
   (rule ISA classification-style)
   (exemplar ISA classification-style))

(P choose-to-classify-by-rule
   =goal>
      ISA         presentation
      category    nil
   =rule>
      ISA         rule
      viable      t
==>
   =classify-by-rule-goal>
      ISA         classify-by-rule
      presentation =goal
      category    =c
      exn-used    =exn
   =goal>
      category    =c
      choice      rule
      exn-used    =exn
  !eval!          (setq *STYLE* 'RULE)
   !push!         =classify-by-rule-goal
)

(P cant-do-jack
   =goal>
      ISA         presentation
      category    nil
==>
   =goal>
      category    (!eval! (random-category-catds2))
      choice      random
)

(P random-guess-was-right
   =goal>
      ISA         presentation
      choice      random
      category    =c
   !eval!         (equal =c (correct-category-catds2 =goal))
==>
   =goal>
      evaluated   right
      choice      rule
)

(P random-guess-was-wrong
   =goal>
      ISA         presentation
      choice      random
      category    =c
   !eval!         (not (equal =c (correct-category-catds2 =goal)))
==>
   =goal>
      evaluated   wrong
      category    (!eval! (correct-category-catds2 =goal))
      choice      rule
)



(P choose-to-classify-by-exemplar-4feature
   =goal>
      ISA         presentation
      category    nil
      feature1    =f1
      feature2    =f2
      feature3    =f3
      feature4    =f4
      choice      nil
   =recall-stimulus>
      ISA         stimulus
      feature1    =f1
      feature2    =f2
      feature3    =f3
      feature4    =f4
      category    =c
==>
   =classify-by-exemplar-goal>
      ISA         classify-by-exemplar
      presentation =goal
      counta      0
      countb      0
      countc      0
      countd      0
      category    =cat
      feature1    =f1
      feature2    =f2
      feature3    =f3
      feature4    =f4
   =goal>
      category    =cat
      choice      exemplar
    !eval!          (setq *STYLE* 'EXEM4)
   !push!         =classify-by-exemplar-goal
)

(P choose-to-classify-by-exemplar-2feature
   =goal>
      ISA         presentation
      category    nil
      feature1    =f1
      feature2    =f2
      feature3    nil
      feature4    nil
      choice      nil
   =recall-stimulus>
      ISA         stimulus
      feature1    =f1
      feature2    =f2
      feature3    nil
      feature4    nil
      category    =c
==>
   =classify-by-exemplar-goal>
      ISA         classify-by-exemplar
      presentation =goal
      counta      0
      countb      0
      countc      0
      countd      0
      category    =cat
      feature1    =f1
      feature2    =f2
      feature3    nil
      feature4    nil
   =goal>
      category    =cat
      choice      exemplar
   !eval!         (setq *STYLE* 'EXEM2)
   !push!         =classify-by-exemplar-goal
)

(P cover-for-failed-classify
   =goal>
      ISA         presentation
      category    failure
==>
   =goal>
      category    (!eval! (random-category-catds2))
)

(P general-rule-match
   =goal>
      ISA         classify-by-rule
      presentation =pres
      category   nil
   =rule>
      ISA         rule
      current     t
   =pres>
      ISA         presentation
==>
!output! =rule
   =apply-rule-goal>
      ISA         apply-rule-to-presentation
      presentation =pres
      rule        =rule
      checked     0
      category    =c
   =goal>
      category    =c
      exn-used    nil
   !push!         =apply-rule-goal
)

(P done-classifying-by-rule
   =goal>
      ISA         classify-by-rule
      category    =c
    - category    failure
==>
   !pop!
)

(P feature1-with-rule
   =goal>
      ISA         apply-rule-to-presentation
      rule        =rule
      presentation =pres
      checked     0
      category    nil
   =rule>
      ISA         rule
      feature1    =cutoff
      guess       =cat
   =pres>
      ISA         presentation
      feature1    =actual
   =actual>
      ISA         feature-value
      value       =val
   !eval!         (< =cutoff =val)
==>
   =goal>
      checked     1
      category    =cat
)

(P feature2-with-rule-v1
   =goal>
      ISA         apply-rule-to-presentation
      rule        =rule
      presentation =pres
      checked     1
      category    nil
   =rule>
      ISA         rule
      feature2    =cutoff
      guess       =cat
   =pres>
      ISA         presentation
      feature2    =actual
   =actual>
      ISA         feature-value
      value       =val
   !eval!         (< =cutoff =val)
==>
   =goal>
      checked     2
      category    =cat
)

(P feature2-with-rule-v2
   =goal>
      ISA         apply-rule-to-presentation
      rule        =rule
      presentation =pres
      checked     1
      category    =cat
   =rule>
      ISA         rule
      feature2    =cutoff
      guess       =cat
   =pres>
      ISA         presentation
      feature2    =actual
   =actual>
      ISA         feature-value
      value       =val
   !eval!         (< =cutoff =val)
==>
   =goal>
      checked     2
      category    =cat
)

(P feature3-with-rule-v1
   =goal>
      ISA         apply-rule-to-presentation
      rule        =rule
      presentation =pres
      checked     2
      category    nil
   =rule>
      ISA         rule
      feature3    =cutoff
      guess       =cat
   =pres>
      ISA         presentation
      feature3    =actual
   =actual>
      ISA         feature-value
      value       =val
   !eval!         (< =cutoff =val)
==>
   =goal>
      checked     3
      category    =cat
)

(P feature3-with-rule-v2
   =goal>
      ISA         apply-rule-to-presentation
      rule        =rule
      presentation =pres
      checked     2
      category    =cat
   =rule>
      ISA         rule
      feature3    =cutoff
      guess       =cat
   =pres>
      ISA         presentation
      feature3    =actual
   =actual>
      ISA         feature-value
      value       =val
   !eval!         (< =cutoff =val)
==>
   =goal>
      checked     3
      category    =cat
)

(P feature4-with-rule-v1
   =goal>
      ISA         apply-rule-to-presentation
      rule        =rule
      presentation =pres
      checked     3
      category    nil
   =rule>
      ISA         rule
      feature4    =cutoff
      guess       =cat
   =pres>
      ISA         presentation
      feature4    =actual
   =actual>
      ISA         feature-value
      value       =val
   !eval!         (< =cutoff =val)
==>
   =goal>
      checked     4
      category    =cat
)

(P feature4-with-rule-v2
   =goal>
      ISA         apply-rule-to-presentation
      rule        =rule
      presentation =pres
      checked     3
      category    =cat
   =rule>
      ISA         rule
      feature4    =cutoff
      guess       =cat
   =pres>
      ISA         presentation
      feature4    =actual
   =actual>
      ISA         feature-value
      value       =val
   !eval!         (< =cutoff =val)
==>
   =goal>
      checked     4
      category    =cat
)

(P feature1-against-rule
   =goal>
      ISA         apply-rule-to-presentation
      rule        =rule
      presentation =pres
      checked     0
      category    nil
   =rule>
      ISA         rule
      feature1    =cutoff
      guess       =cat
   =pres>
      ISA         presentation
      feature1    =actual
   =cat>
      ISA         category
      opposite    =opp
   =actual>
      ISA         feature-value
      value       =val
   !eval!         (> =cutoff =val)
==>
   =goal>
      checked     1
      category    =opp
)

(P feature2-against-rule-v1
   =goal>
      ISA         apply-rule-to-presentation
      rule        =rule
      presentation =pres
      checked     1
   =rule>
      ISA         rule
      feature2    =cutoff
      guess       =cat
   =pres>
      ISA         presentation
      feature2    =actual
   =cat>
      ISA         category
      opposite    =opp
   =actual>
      ISA         feature-value
      value       =val
   !eval!         (> =cutoff =val)
==>
   =goal>
      checked     2
      category    =opp
)

(P feature2-against-rule-v2
   =goal>
      ISA         apply-rule-to-presentation
      rule        =rule
      presentation =pres
      checked     1
      category    =cat
   =rule>
      ISA         rule
      feature2    =cutoff
    - guess       =cat
==>
   =goal>
      checked     2
)

(P feature3-against-rule-v1
   =goal>
      ISA         apply-rule-to-presentation
      rule        =rule
      presentation =pres
      checked     2
   =rule>
      ISA         rule
      feature3    =cutoff
      guess       =cat
   =pres>
      ISA         presentation
      feature3    =actual
   =cat>
      ISA         category
      opposite    =opp
   =actual>
      ISA         feature-value
      value       =val
   !eval!         (> =cutoff =val)
==>
   =goal>
      checked     3
      category    =opp
)

(P feature3-against-rule-v2
   =goal>
      ISA         apply-rule-to-presentation
      rule        =rule
      presentation =pres
      checked     2
      category    =cat
   =rule>
      ISA         rule
      feature3    =cutoff
    - guess       =cat
==>
   =goal>
      checked     3
)

(P feature4-against-rule-v1
   =goal>
      ISA         apply-rule-to-presentation
      rule        =rule
      presentation =pres
      checked     3
   =rule>
      ISA         rule
      feature4    =cutoff
      guess       =cat
   =pres>
      ISA         presentation
      feature4    =actual
   =cat>
      ISA         category
      opposite    =opp
   =actual>
      ISA         feature-value
      value       =val
   !eval!         (> =cutoff =val)
==>
   =goal>
      checked     4
      category    =opp
)

(P feature4-against-rule-v2
   =goal>
      ISA         apply-rule-to-presentation
      rule        =rule
      presentation =pres
      checked     3
      category    =cat
   =rule>
      ISA         rule
      feature4    =cutoff
    - guess       =cat
==>
   =goal>
      checked     4
)

(P feature1-is-nil
   =goal>
      ISA         apply-rule-to-presentation
      rule        =rule
      checked     0
   =rule>
      ISA         rule
      feature1    nil
==>
   =goal>
      checked     1
)

(P feature2-is-nil
   =goal>
      ISA         apply-rule-to-presentation
      rule        =rule
      checked     1
   =rule>
      ISA         rule
      feature2    nil
==>
   =goal>
      checked     2
)

(P feature3-is-nil
   =goal>
      ISA         apply-rule-to-presentation
      rule        =rule
      checked     2
   =rule>
      ISA         rule
      feature3    nil
==>
   =goal>
      checked     3
)

(P feature4-is-nil
   =goal>
      ISA         apply-rule-to-presentation
      rule        =rule
      checked     3
   =rule>
      ISA         rule
      feature4    nil
==>
   =goal>
      checked     4
)

(P done-applying-presentation
   =goal>
      ISA         apply-rule-to-presentation
      rule        =rule
      checked     4
==>
   !pop!
)

(P move-on-with-rule
   =goal>
      ISA         apply-rule-to-presentation
      rule        =rule
      checked     =n
!eval! (< =n 4)
==>
   =goal>
      checked (!eval! (1+ =n))
)

(P wild-flaming-leap-of-faith-guess
   =goal>
      ISA         classify-by-rule
      presentation =pres
==>
   =goal>
      category    (!eval! (random-category-catds2))
      exn-used    wildleapoffaith
   !pop!
)

(P check-for-exception-4
   =goal>
      ISA         classify-by-rule
      presentation =pres
   =pres>
      isa presentation
      feature1 =f1
      feature2 =f2
      feature3 =f3
      feature4 =f4
   =exception>
      isa exception
      feature1 =f1
      feature2 =f2
      feature3 =f3
      feature4 =f4
      category =c
==>
   =goal>
      category    =c
!pop!
)


(P check-for-exception-2
   =goal>
      ISA         classify-by-rule
      presentation =pres
   =pres>
      isa presentation
      feature1 =f1
      feature2 =f2
   =exception>
      isa exception
      feature1 =f1
      feature1 =f3
      feature2 =f2
      feature2 =f4
      category =c
   !eval! (and (equal =f1 =f3) (equal =f2 =f4))
==>
   =goal>
      category    =c
!pop!
)

(P recall-4feature
   =goal>
      ISA         classify-by-exemplar
      feature1    =f1
      feature2    =f2
      feature3    =f3
      feature4    =f4
      category    nil
   =recall-stim>
      ISA         stimulus
      feature1    =f1
      feature2    =f2
      feature3    =f3
      feature4    =f4
      category    =cat
==>
   !eval!         (increment-category-count-catds2 =goal =cat)
   =goal>
      category    (!eval! (winner-catds2 =goal))
   !output!       ("I recall ~s" =recall-stim)
)

(P recall-continue-a
   =goal>
      isa classify-by-exemplar
==>
   !eval!         (increment-category-count-catds2 =goal 'category-a)
   =goal>
      category    (!eval! (winner-catds2 =goal))
)

(P recall-continue-b
   =goal>
      isa classify-by-exemplar
==>
   !eval!         (increment-category-count-catds2 =goal 'category-b)
   =goal>
      category    (!eval! (winner-catds2 =goal))
)


(P recall-2feature
   =goal>
      ISA         classify-by-exemplar
      feature1    =f1
      feature2    =f2
      feature3    nil
      feature4    nil
      category    nil
      counta      =a
   =recall-stim>
      ISA         stimulus
      feature1    =f1
      feature2    =f2
      feature3    nil
      feature4    nil
      category    =cat
==>
   !eval!         (increment-category-count-catds2 =goal =cat)
   =goal>
      category    (!eval! (winner-catds2 =goal))
   !output!       ("I recall ~s" =recall-stim)
)

(P done-classifying-by-exemplar
   =goal>
      ISA         classify-by-exemplar
      category    =cat
==>
   !pop!
)

(P correct-finish-from-exemplar
   =goal>
      ISA         presentation
      category    =c
    - category    failure
      choice      exemplar
      evaluated   nil
   !eval!         (equal =c (correct-category-catds2 =goal))
==>
   =goal>
      evaluated   right
      choice      rule
)

(P incorrect-finish-by-exemplar
   =goal>
      ISA         presentation
      category    =c
    - category    failure
      choice      exemplar
      evaluated   nil
   !eval!         (not (equal =c (correct-category-catds2 =goal)))
==>
   =goal>
      evaluated   wrong
      category    (!eval! (correct-category-catds2 =goal))
   =evaluate-goal>
      ISA         evaluate
      classification-style exemplar
      last-result wrong
      presentation =goal
      count       0
   !push!         =evaluate-goal
)


(P classification-by-rule-is-right
   =goal>
      ISA         presentation
      category    =c
      choice      rule
      exn-used    nil
      evaluated   nil
   !eval!         (equal =c (correct-category-catds2 =goal))
==>
   =goal>
      evaluated   right
   =evaluate-goal>
      ISA         evaluate
      classification-style rule
      last-result right
      presentation =goal
   !push!         =evaluate-goal
)

(P classification-by-rule-is-wrong
   =goal>
      ISA         presentation
      category    =c
    - category    failure
      choice      rule
      exn-used    nil
      evaluated   nil
   !eval!         (not (equal =c (correct-category-catds2 =goal)))
==>
   =goal>
      category    (!eval! (correct-category-catds2 =goal))
      evaluated   wrong
   =evaluate-goal>
      ISA         evaluate
      classification-style rule
      presentation =goal
      last-result wrong
   !push!         =evaluate-goal
)

(P it-was-a-wild-leap-of-faith-so-find-a-rule
   =goal>
      ISA         presentation
      category    =c
      choice      rule
      exn-used    wildleapoffaith
      evaluated   nil
==>
   =goal>
      category    (!eval! (correct-category-catds2 =goal))
      evaluated   wrong
   =newgoal>
      isa clean-up
   =find-rule-goal>
      ISA         find-rule
      presentation =goal
   !push!         =find-rule-goal
   !push!         =newgoal
)

(P it-was-a-wild-leap-of-faith-so-update-rule
   =goal>
      ISA         presentation
      category    =c
      choice      rule
      exn-used    wildleapoffaith
      evaluated   nil
   =rule>
      ISA         rule
      current     t
==>
   =goal>
      category    (!eval! (correct-category-catds2 =goal))
      evaluated   wrong)

(p nothing-to-clean-up
   =goal>
      isa clean-up
==>
!pop!)


(P one-more-study-2feature-version
   =goal>
      ISA         presentation
    - evaluated   nil
      feature1    =f1
      feature2    =f2
      feature3    nil
      feature4    nil
      category    =c
      choice      rule
   !eval!         *system-is-still-learning*
==>
   =goal>
      choice      done
   =stimulus-goal>
      ISA         stimulus
      feature1    =f1
      feature2    =f2
      category    =c
   !push!         =stimulus-goal
)

(P one-more-study-4feature-version
   =goal>
      ISA         presentation
    - evaluated   nil
      feature1    =f1
      feature2    =f2
      feature3    =f3
      feature4    =f4
      category    =c
      choice      rule
   !eval!         *system-is-still-learning*
==>
   =goal>
      choice      done
   =stimulus-goal>
      ISA         stimulus
      feature1    =f1
      feature2    =f2
      feature3    =f3
      feature4    =f4
      category    =c
   !push!         =stimulus-goal
)

(P cant-study
   =goal>
      ISA         presentation
    - evaluated   nil
      choice      rule
   !eval!         (not *system-is-still-learning*)
==>
   =goal>
      choice      done
)

(P done-wrong
   =goal>
      ISA         presentation
    - choice      rule
      evaluated   wrong
==>
   !pop!
)

(P done-right
   =goal>
      ISA         presentation
    - choice      rule
      evaluated   right
==>
   !pop!
)

(P set-study-goal-4feature
   =goal>
      ISA         evaluate
      classification-style exemplar
    - count       5
      count       =count
      presentation =pres
   =pres>
      ISA         presentation
      feature1    =f1
      feature2    =f2
      feature3    =f3
      feature4    =f4
      category    =c
   !eval!         *system-is-still-learning*
==>
   =goal>
      count       (!eval! (+ 1 =count))
   =study-stimulus>
      ISA         stimulus
      feature1    =f1
      feature2    =f2
      feature3    =f3
      feature4    =f4
      category    =c
   !push!         =study-stimulus
)

(P set-study-goal-2feature
   =goal>
      ISA         evaluate
      classification-style exemplar
    - count       5
      count       =count
      presentation =pres
   =pres>
      ISA         presentation
      feature1    =f1
      feature2    =f2
      feature3    nil
      feature4    nil
      category    =c
   !eval!         *system-is-still-learning*
==>
   =goal>
      count       (!eval! (+ 1 =count))
   =study-stimulus>
      ISA         stimulus
      feature1    =f1
      feature2    =f2
      feature3    nil
      feature4    nil
      category    =c
   !push!         =study-stimulus
)

(P pop-on-study
   =goal>
      ISA         stimulus
==>
   !pop!
)

(P done-studying
   =goal>
      ISA         evaluate
      classification-style exemplar
      count       5
==>
   !pop!
)

(P no-more-learning
   =goal>
      ISA         evaluate
   !eval!         (not *system-is-still-learning*)
==>
   !pop!
)

(P perfect-rule-is-okay
   =goal>
      ISA         evaluate
      last-result right
   =rule>
      ISA         rule
      current     t
      type        perfect
   !eval!         *system-is-still-learning*
==>
   !pop!
)

(P throw-out-perfect-rule
   =goal>
      ISA         evaluate
      classification-style rule
      last-result wrong
      presentation =pres
   =rule>
      ISA         rule
      current     t
      type        perfect
      viable      t
   !eval!         *system-is-still-learning*
==>
   =rule>
      current     nil
      viable      nil
   =find-rule-goal>
      ISA         find-rule
      presentation =pres
   !focus-on!     =find-rule-goal
)

(P increment-incorrect-count
   =goal>
      ISA         evaluate
      classification-style rule
      last-result wrong
   =rule>
      ISA         rule
      current     t
    - type        perfect
      incorrect   =ic
   !eval!         *system-is-still-learning*
==>
   =rule>
      incorrect   (!eval! (+ 1 =ic))
   =goal>
      last-result nil
)

(P increment-correct-count
   =goal>
      ISA         evaluate
      classification-style rule
      last-result right
   =rule>
      ISA         rule
      current     t
    - type        perfect
      correct     =c
   !eval!         *system-is-still-learning*
==>
   =rule>
      correct     (!eval! (+ 1 =c))
   =goal>
      last-result nil
)

(P learn-exception-to-imperfect-rule-4
   =goal>
      ISA         evaluate
      classification-style rule
      last-result wrong
      presentation =pres
      exn-used    nil
   =rule>
      ISA         rule
      correct     =c
      incorrect   =ic
      type        imperfect
      current     t
   !eval!         (>= (+ =c =ic) (* 2 *block-size*))
   !eval!         (>= (/ =c (+ =c =ic)) *strict-criterion*)
   !eval!         *system-is-still-learning*
   =pres>
      ISA         presentation
      category    =cat
      feature1    =f1
      feature2    =f2
      feature3    =f3
      feature4    =f4
==>
   =goal>
      exn-used t
   =exception-goal>
      ISA         exception
      feature1    =f1
      feature2    =f2
      feature3    =f3
      feature4    =f4
      category    =cat
   !focus-on!     =exception-goal
)

(P learn-exception-to-imperfect-rule-2
   =goal>
      ISA         evaluate
      classification-style rule
      last-result wrong
      presentation =pres
      exn-used    nil
   =rule>
      ISA         rule
      correct     =c
      incorrect   =ic
      type        imperfect
      current     t
   !eval!         (>= (+ =c =ic) (* 2 *block-size*))
   !eval!         (>= (/ =c (+ =c =ic)) *strict-criterion*)
   !eval!         *system-is-still-learning*
   =pres>
      ISA         presentation
      category    =cat
      feature1    =f1
      feature2    =f2
==>
   =goal>
      exn-used t
   =exception-goal>
      ISA         exception
      feature1    =f1
      feature2    =f2
      category    =cat
   !focus-on!     =exception-goal
)

(p pop-exception
   =goal>
     isa exception
==>
!pop!)

(P imperfect-rule-not-yet-to-lower-window
   =goal>
      ISA         evaluate
      classification-style rule
      last-result nil
   =rule>
      ISA         rule
      current     t
      correct     =c
      incorrect   =ic
   !eval!         (< (+ =c =ic) *block-size*)
   !eval!         *system-is-still-learning*
==>
   !pop!
)

(P keep-rule-at-lower-window
   =goal>
      ISA         evaluate
      classification-style rule
      last-result nil
   =rule>
      ISA         rule
      correct     =c
      incorrect   =ic
    - type        perfect
      current     t
   !eval!         (>= (+ =c =ic) *block-size*)
   !eval!         (< (+ =c =ic) (* 2 *block-size*))
   !eval!         (>= (/ =c (+ =c =ic)) *lax-criterion*)
   !eval!         *system-is-still-learning*
==>
   !pop!
)

(P drop-rule-at-lower-window
   =goal>
      ISA         evaluate
      classification-style rule
      last-result nil
      presentation =pres
   =rule>
      ISA         rule
      correct     =c
      incorrect   =ic
    - type        perfect
      current     t
   !eval!         (>= (+ =c =ic) *block-size*)
   !eval!         (< (+ =c =ic) (* 2 *block-size*))
   !eval!         (< (/ =c (+ =c =ic)) *lax-criterion*)
   !eval!         *system-is-still-learning*
==>
   =rule>
      current     nil
      viable      nil
   =find-rule-goal>
      ISA         find-rule
      presentation =pres
   !focus-on!     =find-rule-goal
)

(P keep-imperfect-rule-at-upper-window
   =goal>
      ISA         evaluate
      classification-style rule
      last-result nil
      presentation =pres
   =rule>
      ISA         rule
      correct     =c
      incorrect   =ic
      type        imperfect
      current     t
   !eval!         (>= (+ =c =ic) (* 2 *block-size*))
   !eval!         (>= (/ =c (+ =c =ic)) *strict-criterion*)
   !eval!         *system-is-still-learning*
==>
   !pop!
)


(P drop-imperfect-rule-at-uwindow
   =goal>
      ISA         evaluate
      classification-style rule
      last-result nil
      presentation =pres
   =rule>
      ISA         rule
      correct     =c
      incorrect   =ic
      type        imperfect
      current     t
   !eval!         (= (+ =c =ic) (* 2 *block-size*))
   !eval!         (< (/ =c (+ =c =ic)) *strict-criterion*)
   !eval!         *system-is-still-learning*
==>
   =rule>
      current     nil
      viable      nil
   =find-rule-goal>
      ISA         find-rule
      presentation =pres
   !focus-on!     =find-rule-goal
)





(P select-perfect-rule
   =goal>
      ISA         find-rule
      presentation =pres
   =rule>
      ISA         rule
      viable      t
      current     nil
      type        perfect
   =pres>
      ISA         presentation
   !eval!         *system-is-still-learning*
==>
   =rule>
      current     t
      guess       (!eval! (rule-category-catds2 =rule =pres))
   !pop!
)

(P select-imperfect-rule
   =goal>
      ISA         find-rule
      presentation =pres
   =rule>
      ISA         rule
      viable      t
      current     nil
      type        imperfect
   =pres>
      ISA         presentation
   !eval!         *system-is-still-learning*
==>
   =rule>
      current     t
      guess       (!eval! (rule-category-catds2 =rule =pres))
      correct     1
   !pop!
)




(spp SELECT-PERFECT-RULE :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp SELECT-IMPERFECT-RULE :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 750 :EVENTUAL-FAILURES 250 :EVENTUAL-EFFORTS 1000)
(spp SET-STUDY-GOAL-4FEATURE :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp SET-STUDY-GOAL-2FEATURE :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp NO-MORE-LEARNING :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp RECALL-4FEATURE :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp RECALL-2FEATURE :STRENGTH 10 :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp DONE-CLASSIFYING-BY-EXEMPLAR :EFFORT 0.20 :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp WILD-FLAMING-LEAP-OF-FAITH-GUESS  :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 250 :EVENTUAL-FAILURES 750 :EVENTUAL-EFFORTS 1000)
(spp GENERAL-RULE-MATCH :SUCCESSES 10000 :FAILURES 0 :EFFORTS 500 :EVENTUAL-SUCCESSES 8000 :EVENTUAL-FAILURES 2000 :EVENTUAL-EFFORTS 10000)
(spp DONE-CLASSIFYING-BY-RULE :EFFORT 0.20 :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp POP-ON-STUDY :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp keep-imperfect-rule-at-upper-window :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 500 :EVENTUAL-FAILURES 500 :EVENTUAL-EFFORTS 1000)
(spp recall-continue-a :SUCCESSES 10000 :FAILURES 0 :EFFORTS 500 :EVENTUAL-SUCCESSES 2500 :EVENTUAL-FAILURES 7500 :EVENTUAL-EFFORTS 10000)
(spp recall-continue-b :SUCCESSES 10000 :FAILURES 0 :EFFORTS 500 :EVENTUAL-SUCCESSES 2500 :EVENTUAL-FAILURES 7500 :EVENTUAL-EFFORTS 10000)
(spp increment-incorrect-count :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 750 :EVENTUAL-FAILURES 250 :EVENTUAL-EFFORTS 1000)
(spp increment-correct-count :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 750 :EVENTUAL-FAILURES 250 :EVENTUAL-EFFORTS 1000)
(spp learn-exception-to-imperfect-rule-2 :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp learn-exception-to-imperfect-rule-4 :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp pop-exception :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp check-for-exception-2 :SUCCESSES 1000000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp check-for-exception-4 :SUCCESSES 1000000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp RANDOM-GUESS-WAS-RIGHT :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp ONE-MORE-STUDY-4FEATURE-VERSION :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp ONE-MORE-STUDY-2FEATURE-VERSION :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp IT-WAS-A-WILD-LEAP-OF-FAITH-SO-FIND-A-RULE :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 500 :eventual-failures 500 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp it-was-a-wild-leap-of-faith-so-update-rule :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)

(spp INCORRECT-FINISH-BY-EXEMPLAR :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp DONE-RIGHT :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp COVER-FOR-FAILED-CLASSIFY :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp CORRECT-FINISH-FROM-EXEMPLAR :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp CLASSIFICATION-BY-RULE-IS-WRONG :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp CLASSIFICATION-BY-RULE-IS-RIGHT :SUCCESSES 1000 :FAILURES 0 :EFFORTS 50 :EVENTUAL-SUCCESSES 1000 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 1000)
(spp CHOOSE-TO-CLASSIFY-BY-RULE :SUCCESSES 20 :FAILURES 0 :EFFORTS 1 :EVENTUAL-SUCCESSES 30 :EVENTUAL-EFFORTS 30)
(spp CHOOSE-TO-CLASSIFY-BY-EXEMPLAR-4FEATURE :SUCCESSES 2400 :EFFORTS 120 :EVENTUAL-SUCCESSES 30 :EVENTUAL-FAILURES 50 :EVENTUAL-EFFORTS 80)
(spp DONE-WRONG :EVENTUAL-EFFORTS 1000 :EVENTUAL-FAILURES 0 :EFFORTS 50 :SUCCESSES 1000 :EVENTUAL-SUCCESSES 1000 :FAILURE T)
(spp CHOOSE-TO-CLASSIFY-BY-EXEMPLAR-2FEATURE :EFFORT 0.1  :FAILURES 0 :SUCCESSES 2400 :EFFORTS 120 :EVENTUAL-SUCCESSES 30 :EVENTUAL-FAILURES 50 :EVENTUAL-EFFORTS 80)
(spp CANT-DO-JACK :SUCCESSES 10000 :EFFORTS 500 :EVENTUAL-SUCCESSES 12500 :EVENTUAL-FAILURES 87500 :EVENTUAL-EFFORTS 100000)

(spp FEATURE1-AGAINST-RULE :EFFORT 0.05 :SUCCESSES 100 :EFFORTS 5 :EVENTUAL-SUCCESSES 100 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 100)
(spp FEATURE1-WITH-RULE :EFFORT 0.05 :SUCCESSES 100 :EFFORTS 5 :EVENTUAL-SUCCESSES 100 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 100)
(spp FEATURE1-IS-NIL :EFFORT 0.05 :SUCCESSES 100 :EFFORTS 5 :EVENTUAL-SUCCESSES 100 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 100)

(spp FEATURE2-AGAINST-RULE-V1 :EFFORT 0.05 :SUCCESSES 100 :EFFORTS 5 :EVENTUAL-SUCCESSES 100 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 100)
(spp FEATURE2-AGAINST-RULE-V2 :EFFORT 0.05 :SUCCESSES 100 :EFFORTS 5 :EVENTUAL-SUCCESSES 100 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 100)
(spp FEATURE2-WITH-RULE-V1 :EFFORT 0.05 :SUCCESSES 100 :EFFORTS 5 :EVENTUAL-SUCCESSES 100 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 100)
(spp FEATURE2-WITH-RULE-V2 :EFFORT 0.05 :SUCCESSES 100 :EFFORTS 5 :EVENTUAL-SUCCESSES 100 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 100)
(spp FEATURE2-IS-NIL :EFFORT 0.05 :SUCCESSES 100 :EFFORTS 5 :EVENTUAL-SUCCESSES 100 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 100)
(spp move-on-with-rule :EFFORT 0.05 :SUCCESSES 100 :EFFORTS 5 :EVENTUAL-SUCCESSES 100 :EVENTUAL-FAILURES 300 :EVENTUAL-EFFORTS 400)
(spp FEATURE3-AGAINST-RULE-V1 :EFFORT 0.05 :SUCCESSES 100 :EFFORTS 5 :EVENTUAL-SUCCESSES 100 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 100)
(spp FEATURE3-AGAINST-RULE-V2 :EFFORT 0.05 :SUCCESSES 100 :EFFORTS 5 :EVENTUAL-SUCCESSES 100 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 100)
(spp FEATURE3-WITH-RULE-V1 :EFFORT 0.05 :SUCCESSES 100 :EFFORTS 5 :EVENTUAL-SUCCESSES 100 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 100)
(spp FEATURE3-WITH-RULE-V2 :EFFORT 0.05 :SUCCESSES 100 :EFFORTS 5 :EVENTUAL-SUCCESSES 100 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 100)
(spp FEATURE3-IS-NIL :EFFORT 0.05 :SUCCESSES 100 :EFFORTS 5 :EVENTUAL-SUCCESSES 100 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 100)

(spp FEATURE4-AGAINST-RULE-V1 :EFFORT 0.05 :SUCCESSES 100 :EFFORTS 5 :EVENTUAL-SUCCESSES 100 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 100)
(spp FEATURE4-AGAINST-RULE-V2 :EFFORT 0.05 :SUCCESSES 100 :EFFORTS 5 :EVENTUAL-SUCCESSES 100 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 100)
(spp FEATURE4-WITH-RULE-V1 :EFFORT 0.05 :SUCCESSES 100 :EFFORTS 5 :EVENTUAL-SUCCESSES 100 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 100)
(spp FEATURE4-WITH-RULE-V2 :EFFORT 0.05 :SUCCESSES 100 :EFFORTS 5 :EVENTUAL-SUCCESSES 100 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 100)
(spp FEATURE4-IS-NIL :EFFORT 0.05 :SUCCESSES 100 :EFFORTS 5 :EVENTUAL-SUCCESSES 100 :EVENTUAL-FAILURES 0 :EVENTUAL-EFFORTS 100)