;;;;;;;;;;;;;;;;;;;;;;;;<pre>
;;;
;;; This file contains the ACT-R model of the
;;; mirror effect as presented in Chapter 7
;;;
;;; ACT-R version 4 required
;;; 
;;; A WWW interface and a command line interface
;;; are provided.  
;;; To run the command line version, call
;;; (do-mirror n)
;;; replacing n with the number of runs to
;;; simulate.

;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; This section contains the LISP functions to simulate
;;; the experiment, implement the interface, collect the
;;; data, and display the results
;;;
;;; The ACT-R Model starts further down
;;;

;;; Global variables
(defparameter *mirror-contexts* '(l1 l2 l3 l4 l5 l6 l7 l8 l9 l10
                     l11 l12 l13 l14 l15 l16 l17 l18 l19 l20))
(defvar *stop-it*)
(defvar *items*)
(defvar *ht*)
(defvar *lt*)
(defvar *p*)
(defvar *t*)
(defvar *hf*)
(defvar *lf*)
(defvar *data*)
(defvar *thresh*)
(defvar *penalty*)
(defvar *noise*)
(defvar *runs*)
(defvar *v*)
(defvar *factor*)
(defvar *respond*)
(defvar *encode*)
(defvar *rehearse*)
 
(setf *factor*  2)
(setf *thresh* 1.8)
(setf *penalty* 20)
(setf *noise* .5)
(setf *runs* 1)
(setf *v* nil)
(setf *respond* .5)
(setf *encode* .2)
(setf *rehearse* .5)


(defparameter *mirror-results* #3a(((613 387) (281 719)) ((704 296) (228 772))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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 "Glanzer and Adams Experiment model" 2)
        (:table)
        
        (:table)
        "Noise (s): "       (:string :sy *noise*    .5)     (:new-row)
        "Threshold: "       (:string :sy *thresh*   1.8)    (:new-row)
        "Factor (F):"       (:string :sy *factor*    2)     (:new-row)
        "Penalty:   "       (:string :sy *penalty*  2.0)    (:new-row)
        "Response time (sec.): " (:string :sy *respond* .5)        (:new-row)
        "Encoding time (sec.): " (:string :sy *encode* .2)         (:new-row)
        "Rehearsal time (sec.): " (:string :sy *rehearse* .5) (:new-row)

        "Number of runs (1-20): "  (:string :sy *runs*     1)
        (:table-end)
        (:table)
        (:checkbox "Trace" :sy *v*  nil) (:new-row)
        (:table-end)
        
         
        (:table-end)
        (:new-para)
        (:button "Show Experiment Results" "(progn 
                                            (format *standard-output* \"~%~%Experimental data:~%\")
                                            (mirror-results *mirror-results*))")
       
        (:new-para)
        
        (:button "Run model" "(progn 
                               (when (numberp *penalty*) 
                                  (setf *penalty* (* 10 *penalty*)))
                               (if (and (numberp *thresh*) (numberp *penalty*)
                                        (numberp *noise*) (numberp *factor*) 
                                        (numberp *runs*) (numberp *respond*) 
                                        (numberp *encode*) (numberp *rehearse*))
                            (do-mirror (min 20 (max 1 *runs*))) 
                            (format *standard-output* \"All parameters must be numbers~%\")))")       
 (:reset "Default values")

        (:button "Production Rules" "(let ((prods (no-output (pp))))
                                       (dolist (x prods)
                                         (pp-fct (list x))
                                         (spp-fct (list x))
                                         (format *standard-output* \"~%\")))")
        (:button "Chunk types" "(chunk-type)")
        (:button "Chunks" "(dm)")
        (:new-para)
         "TIME and SIZE:"
        (:new-para)
        "- It usually takes about 1 minute for 1 run of the model"
        (:new-line)
        "- The trace of 1 run is approximatly 120k (80 pages) in size"
        (:new-para)))


;;; set-mirror-params is used to set
;;; the parameters of the model before each run
;;; it is needed for the WWW interface

(defun set-mirror-params ()
  (sgp-fct (list :bll .5 :ans *noise*  :mp *penalty*
                 :pm t :rt *thresh* :lf *factor* :v *v*))

  (parameters-fct  'reject-a-word-2 (list :r .5 :effort *respond*))
  (parameters-fct 'accept-word (list :effort *respond*))
  (parameters-fct 'attend-test (list :a *encode* :effort *encode*))
  (parameters-fct 'rehearse-token (list :effort *rehearse*))
  (parameters-fct 'attend (list :effort *encode*)))

;;; mirror-setup takes 2 parameters
;;; a word and the number of previous
;;; contexts for that word
;;; and adds a chunk for that word
;;; and returns a list of chunk
;;; definitions for the previous
;;; memory tokens
 
(defun mirror-setup (word n)
  (addwm-fct (list (list word 'isa 'word)))
  (do ((count 0 (1+ count))
       (result nil (cons   `(,(gentemp "C") isa memory-token 
                             context ,(nth count *mirror-contexts*)
                             name ,word) result)))
      ((= count n) result)))

;;; do-mirror takes one parameter 
;;; the number of runs of the
;;; simulation, and then runs the simulation
;;; that many times, and reports the 
;;; results
 
(defun do-mirror (n)
    (setf *data* (make-array '(2 2 2) :initial-element 0))
    (do ((count 0 (1+ count)))
        ((= count n) (progn (format *standard-output* "~%~%Simulation parameters: (~S ~S ~S ~S ~S ~S ~S ~S)~%~%Simulation data:~%"
                                    *noise* *thresh* *factor* (/ *penalty* 10) *respond* *encode* *rehearse* n)
                            (mirror-results *data*)))
      (reset)
      (set-mirror-params)
      (run-mirror-experiment)))

;;; mirror-results takes one parameter, the data
;;; array for the mirror experiment, and 
;;; displays the summary of the data

(defun mirror-results (data)
  (let ((high-hits (aref data 0 0 0))
        (high-h-presented (+ (aref data 0 0 1) (aref data 0 0 0)))
        (high-falses (aref data 0 1 0))
        (high-f-presented (+ (aref data 0 1 0) (aref data 0 1 1)))
        (low-hits (aref data 1 0 0))
        (low-h-presented (+ (aref data 1 0 1) (aref data 1 0 0)))
        (low-falses (aref data 1 1 0))
        (low-f-presented (+ (aref data 1 1 0) (aref data 1 1 1))))
    
    (format *standard-output* "~%             Hits         False Alarms~%")
    (format *standard-output* "Low Freq.    ~3,1F%            ~3,1F%~%" (* 100 (/ low-hits low-h-presented))
            (* 100 (/ low-falses low-f-presented)))
    (format *standard-output* "High Freq.   ~3,1F%            ~3,1F%~%" (* 100 (/ high-hits high-h-presented))
            (* 100 (/ high-falses high-f-presented)))))

;;; mirror-setup-materials takes no parameters
;;; and generates the memory chunks for the words,
;;; and the previous memory tokens for those words
;;; and sets the base levels for everything to 10
;;; occurences with a creation time of 400 units
;;; ago and returns a list of all the word chunks

(defun mirror-setup-materials ()
   (do ((count 0 (1+ count))
        (high nil (append (mirror-setup (gentemp "H") 5) high))
        (low nil (append (mirror-setup (gentemp "L")  2)low))
        (rest nil (cond ((>= count 48) rest)
                        (t (append (mirror-setup (gentemp "R") 1) rest)))))
       ((= count 100) 
        (eval `(addwm ,@(append high low rest)))
        (setallbaselevels 10 -400)
        (list (remove-duplicates (mapcar 'seventh high))
              (remove-duplicates (mapcar 'seventh low))  
               (mapcar 'seventh rest )))))

;;; run-mirror-experiment takes no parameters
;;; and generates the items needed for the 
;;; experiment, and then runs 1 simulation

(defun run-mirror-experiment ()  
  (let* ((materials (mirror-setup-materials))
         (buffer-front (nthcdr 24 (third materials)))
         (buffer-back (nthcdr 24 (reverse (third materials))))
         (study-high (nthcdr 50 (first materials)))
         (test-high (nthcdr 50 (reverse (first materials))))
         (study-low (nthcdr 50 (second materials)))
         (test-low (nthcdr 50 (reverse (second materials))))
         (study (append buffer-front 
                        (permut-mirror (append study-high study-low))
                        buffer-back))
         (test (permut-mirror (append study-high test-high study-low test-low))))
    (setsimilarities (l0 l1 .9)(l0 l2 .9)(l0 l3 .9)(l0 l4 .9)(l0 l5 .9)
                     (l1 l2 .9)(l1 l3 .9)(l1 l4 .9)(l1 l5 .9)
                     (l2 l3 .9)(l2 l4 .9)(l2 l5 .9)
                     (l3 l4 .9)(l3 l5 .9)(l4 l5 .9))
    (setf *stop-it* 0) 
    (setf *ht* (no-output (wm-fct study-high)))
    (setf *hf* (no-output (wm-fct test-high)))
    (setf *lt* (no-output (wm-fct study-low)))
    (setf *lf* (no-output (wm-fct test-low)))
    (setf *items* (no-output (wm-fct study)))

    (addwm (goal isa study-words context L0))
    (wmfocus goal) 
    (run)

    (setf *items* (no-output (wm-fct test)))
    (addwm (newgoal isa recognize-words context L0))
    (wmfocus newgoal)
    (run)))

;;; permut-mirror takes one parameter
;;; a list, and returns a permuted
;;; copy of the list

(defun permut-mirror (lis)
  (do ((result  (list (nth (random (length lis)) lis))
                (cons (nth (random (length lis)) lis) result)))
      ((null lis) result)
    (setf lis (remove (car result) lis))
    (cond ((null lis) (return result)))))
       

;;; analyze-mirror takes 2 parameters
;;; a word chunk and a response
;;; the response is analyzed, and the results
;;; stored in the global data array

(defun analyze-mirror (word response)
  (let ((i)(j))
    (cond ((member word *ht*)(setf i 0)(setf j 0))
          ((member word *hf*)(setf i 0)(setf j 1))
          ((member word *lt*)(setf i 1)(setf j 0))
          ((member word *lf*)(setf i 1)(setf j 1)))
    (cond ((eq response 'yes) (setf (aref *data* i j 0) (1+ (aref *data* i j 0))))
          (t (setf (aref *data* i j 1) (1+ (aref *data* i j 1)))))))

;;; get-word-mirror takes no parameters
;;; and increments the time to the next
;;; word presentation, and returns
;;; the word chunk for the word that
;;; is either being shown for study or for test

(defun get-word-mirror ()
  (setf *stop-it* (1+ *stop-it*))
   (pop *items*))
    
    
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<a name="model">
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</a>
;;;
;;; ACT-R Model of the task
;;;
;;;

(clearall)

(sgp-fct (list :bll .5 :ans *noise*  :mp *penalty*
            :pm t :rt *thresh* :lf *factor* :v nil))


(chunk-type study-words count context)
(chunk-type memory-token name time count context)
(chunk-type context)
(chunk-type word)
(chunk-type read-instruction)
(chunk-type recognize-words context target)
(chunk-type type-word position word)
(chunk-type spelling word position value)
(chunk-type rehearsal-fact count name)

;; add the contexts to working memory

(add-dm (l0 isa context)
       (l1 isa context)
       (l2 isa context)
       (l3 isa context)
       (l4 isa context)
       (l5 isa context))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Productions
;;;


(p attend
"
  IF the goal is to study words 
     and there are items to study
     and there is a new word presented
  THEN create a memory token of the current context
     mark it in the goal
     and push the memory token on the goal stack
"
   =goal>
      isa study-words
      context =context

   !eval! *items*

   !eval! (>= (actr-time) *stop-it*)
==>
   =newgoal>
      isa memory-token
      context =context

   =goal>
       count =newgoal

   !push! =newgoal
)

(parameters-fct 'attend (list :effort *encode*))


(p create-token
"
  IF the goal is a memory toke
  THEN store the word chunk in the goal
     and create a rehearsal fact for this word
     and focus on the rehearsal fact
"
   =goal>
      isa memory-token
==>
   !bind! =name  (get-word-mirror)

   =goal>
       name =name

   =token>
       isa rehearsal-fact
       name =name
  
   !focus-on! =token
)


(p initialize-count
"
  IF the goal is a rehearsal fact
  THEN mark the count in the goal to 0
     and pop the goal
"
   =goal>
      isa rehearsal-fact
==>
   =goal>
      count 0

   !pop!
)

(parameters initialize-count :r .5)


(p recognize-count
"
  IF the goal is a rehearsal fact
     and a rehearsal fact with the same
     name cam be recalled
  THEN set the count of the goal to 
     the count in the recalled fact
"
   =goal>
      isa rehearsal-fact
      name =name

   =mem>
      isa rehearsal-fact
      name =name
      count =count
==>
   =goal>
      count =count

   !pop!
)


(p rehearse-token
"
  IF the goal is to study words
     and the next word has not yet been presented
     and a memory token for the current context
     can be recalled
     and a rehearsal fact for that word with
     an count less than 3 can be recalled
  THEN
     increment the count of the rehearsal fact
"
   =goal>
      isa study-words
      count =n
      context =context

   !eval! (< (actr-time) *stop-it*)

   =memory>
      isa memory-token
      name   =name
      context  =context

   =token>
      isa rehearsal-fact
      count  =count
      name =name
    - count 3
==>
   =token>
      count (!eval! (1+ =count))
)

(parameters-fct 'rehearse-token (list :effort *rehearse*))


(p rehearse-skip
"
  IF the goal is to study words
     and the next word has not yet been presented
  THEN do nothing
"
   =goal>
      isa study-words
      count =n
      context =context

   !eval! (< (actr-time) *stop-it*)
==>
)

(parameters rehearse-skip :r .5)


(p attend-test
"
  IF the goal is to recognize words
     and there are words to be presented
  THEN mark the goal to get the word
"
   =goal>
      isa recognize-words
      target nil

  !eval! *items*
==>
   =goal>
      target t
)

(parameters-fct 'attend-test (list :a *encode* :effort *encode*))


(p probe-token
"
  IF the goal is to get a word to recognize
  THEN mark the goal with the word to check
"
   =goal>
      isa recognize-words
      target t
==>
   =goal>
       target (!eval! (get-word-mirror))
)


(p accept-word
"
  IF the goal is to recognize a word
     and a memory token of the word 
     in the current context can be recalled
  THEN respond yes 
     and mark the goal as responded
"
   =goal>
      isa recognize-words
      target =word
   -  target t
      context =context

   =token>
      isa memory-token
      name =word
      context =context
==>
   !eval! (analyze-mirror =word 'yes)
   
   =goal>
      target nil
)

(parameters-fct 'accept-word (list :effort *respond*))


(p reject-a-word-2
"
  IF the goal is to recognize a word
  THEN respond no
     and mark the goal as responded
"
   =goal>
      isa recognize-words
      target =word
      context =context
==>
   !eval! (analyze-mirror =word 'no)

   =goal>
      target nil
)

(parameters-fct  'reject-a-word-2 (list :r .5 :effort *respond*))