;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<pre>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; ACT-R model of the person-location experiment
;;;
;;; Works with ACT-R  4.0 (2/6/97 or newer)
;;;
;;; interface coded by: Dan Bothell
;;;
;;; This file contains an ACT-R model that
;;; models the fan effect present in the recognition 
;;; during the person-location task.
;;; In the task the subject first learns several 
;;; person-location pairs.  The fan of the
;;; people and locations is varied, such that
;;; there are 1, 2, or 3 pairs containing a
;;; given item.  Then, there is a recognition task.
;;; The subject is presented with a 
;;; person-location pair, and must respond yes
;;; or no as to whether or not it was one of the
;;; pairs learned.  The foils are constructed from
;;; the same people and locations as the targets.
;;;
;;; The memory of a set of pairs is encoded into
;;; the model.  The model simulates one recognition step, and
;;; there is a fuction which will present the model
;;; with 18 pairs to be judged.  Half of the pairs are
;;; targets, and half foils, with all possible 
;;; fan combinations represented.
;;; 
;;; A simple function call, and a WWW interface
;;; are included.
;;;
;;; To run the model through the recognition, call
;;; (do-person-location n).  That will print
;;; out a chart of the average time to classify
;;; the pairs over n runs of the model.
;;;
;;; To use the WWW interface, you need to run
;;; the ACT-R on the Web application (follow the
;;; instructions provided with it), or use a
;;; web browser to connect to a site that has
;;; the model installed.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; This section contains the code to simulate 
;;; the experiment, present the interface,
;;; and display the results.  The ACT-R
;;; model is located farther down.


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Global Variables

;; these are set by the interface to control the model

(defvar *lf*)
(defvar *v*)
(defvar *s*)
(defvar *i*)
(defvar *runs*)

(setf *lf* .613)
(setf *v* nil)
(setf *s* 1.45)
(setf *i* .845)
(setf *runs* 1)


;;; description of the model

(defparameter *about-person-location*
"
   This ACT-R model simulation models the 
fan effect present in recognition during the 
person-location task.

   In the task the subject first learns
several person-location pairs.  The fan of
the people and locations is varied, such 
that there are 1, 2, or 3 pairs containing 
a given item.  Then, there is a recognition 
task.  The subject is presented with a 
person-location pair, and must respond yes
or no as to whether or not it was one of
the pairs learned.  The foils are 
constructed from the same people and 
locations as the targets.

   In the model, the memory of a set of 
pairs is pre-encoded, with strengths between
the pair and the items set based on the 
number of pairs in which each item occurs. 
The model simulates one recognition step, and
running the simulation will present the model
with 18 pairs to be judged.  Half of the 
pairs are targets, and half foils, with all
possible fan combinations represented.

Note: the choice between retrieving by person 
and retrieving by location is random, so the 
system matches the foil times only on average 
over many runs.
")


(defparameter *person-location-data* '(1.11 1.17 1.22 
                                      1.17 1.20 1.22 
                                      1.15 1.23 1.36 
                                      1.20 1.22 1.26 
                                      1.25 1.36 1.29 
                                      1.26 1.47 1.47))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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 "The Original Fan Effect Model" 2)
        (:table)
        
        (:table)
        "F (latency scale) (s): "    (:string :sy *lf*           0.613)  (:new-row)
        "I (intercept, min .6) (s): "     (:string :sy *i*   .845)  (:new-row)
        "S (base log probability): "   (:string :sy *s* 1.45) (:new-row) 
        "number of runs (1 - 20): "  (:string :sy *runs* 1) 
        (:table-end)
        
        (:table)
        (:checkbox "Trace" :sy *v*  nil)
        (:table-end)
        (:table-end)
        
        (:new-para)
        (:button "Show Experiment Results" "(progn
                                            (format *standard-output* \"~%Experimental data:~%\")
                                            (output-person-location *person-location-data* 1))")
        (:new-para)
        (:button "Run model" "(if (and (numberp *i*) (numberp *s*) (numberp *lf*) (numberp *runs*))
                                  (do-person-location (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)")
        (:button "About Model" "(format *standard-output* \"~%~A~%\" *about-person-location*)")
        (:new-para)
        "NOTE:"
        (:new-para)
        "- the choice between retrieving by person and retrieving by location is 
         random, so the system matches the foil times only on average over multiple
         runs."
        (:new-para)

         "TIME and SIZE:"
        (:new-para)
        "- It usually takes less than 1 minute for 1 run of the model"
        (:new-line)
        "- The trace of 1 run is approximatly 60k (40 pages) in size"
        ))





;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; do-person-location takes one parameter, times, and prints out the average of 
;;; times runs over the 18 probe types.  
;;; Note: the choice between retrieving by person and retrieving
;;; by location is random and so the system matches the foil times 
;;; only on average over many runs

(defun do-person-location (times) 
  
  (let ((rts '(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))
    (do ((result (list (test-person-location 'lawyer 'store) 
                       (test-person-location 'captain 'cave)
                       (test-person-location 'hippie 'church)
                       (test-person-location 'debutante 'bank)
                       (test-person-location 'e 'c)
                       (test-person-location 'hippie 'bank)
                       (test-person-location 'fireman 'park)
                       (test-person-location 'captain 'park)
                       (test-person-location 'hippie 'park)
                       (test-person-location 'fireman 'store)
                       (test-person-location 'captain 'store)
                       (test-person-location 'g 'store)
                       (test-person-location 'fireman 'bank)
                       (test-person-location 'captain 'bank)
                       (test-person-location 'g 'bank)
                       (test-person-location 'lawyer 'park)
                       (test-person-location 'e 'park)
                       (test-person-location 'g 'park)) 
                 (list (test-person-location 'lawyer 'store)
                       (test-person-location 'captain 'cave)
                       (test-person-location 'hippie 'church)
                       (test-person-location 'debutante 'bank)
                       (test-person-location 'e 'c)
                       (test-person-location 'hippie 'bank)
                       (test-person-location 'fireman 'park)
                       (test-person-location 'captain 'park)
                       (test-person-location 'hippie 'park)
                       (test-person-location 'fireman 'store)
                       (test-person-location 'captain 'store)
                       (test-person-location 'g 'store)
                       (test-person-location 'fireman 'bank)
                       (test-person-location 'captain 'bank)
                       (test-person-location 'g 'bank)
                       (test-person-location 'lawyer 'park)
                       (test-person-location 'e 'park)
                       (test-person-location 'g 'park)))
         (count 0 (1+ count)))
      ((= count times) nil)
      (setf rts (mapcar '+ rts result)))
    (format *standard-output* "~%~%Parameters for simulation: (~S ~S ~S ~S)~%~%Simulation data:~%" *lf* *i* *s* *runs*)
    (output-person-location rts times)))

;;;;;;;;;;;;;;;;;;;
;;;
;;; output-person-location takes two parameters,
;;; a list of response times, and the number of runs
;;; that generated those times, and prints out the tables
;;; of the results

(defun output-person-location (rts times)
  (format *standard-output* "~%TARGETS:~%                   Person fan~%")
  (format *standard-output*  "  Location      1       2       3~%")
  (format *standard-output* "    fan")
  
  ;; print out the target times 
  
  (do ((count 0 (1+ count)))
      ((= count 9))
    (when (zerop (mod count 3)) 
      (format *standard-output* "~%     ~d    " (1+ (truncate (/ count 3))))) 
    (format *standard-output* "~8,3F" (/ (nth count rts) times)))
  
  (format *standard-output* "~%~%FOILS:")
  
  ;; print out the foil times
  
  (do ((count 9 (1+ count)))
      ((= count 18))
    (when (zerop (mod count 3)) 
      (format *standard-output* "~%     ~d    " (1+ (truncate (/ (- count 9) 3)))))
    (format *standard-output* "~8,3F" (/ (nth count rts) times))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;       
;;; test-person-location runs 1 trial, with the stimuli given in p and l
;;; and the time of the run is returned

(defun test-person-location (p l)
  (reset)
  (set-person-location-params)
  (mod-chunk-fct 's1 (list 'second p 'sixth l))
  (mod-chunk goal person nil location nil)
  (goal-focus goal) 
  (run)
  (actr-time))

;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; set-person-location-params sets the parameters for a run based
;;; on the global variables set by one of the interfaces

(defun set-person-location-params ()
  (sgp-fct (list 
            :era t
            :er t
            :LF *lf* 
            :act t
            :le 1 
            :v *v*))
   
  (parameters-fct 'match (list :effort (- (max .6 *i*) .6)))
  (parameters-fct 'not-location (list :effort (- (max .6 *i*) .6)))
  (parameters-fct 'not-person (list :effort (- (max .6 *i*) .6))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<a name="model">
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</a>
;;;
;;; The ACT-R model of the recognition phase of the
;;; person-location fan experiment.


(clearall)


(sgp-fct (list  :era t :LF *lf* :act t :v nil :er t :le 1))

;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; CHUNK TYPES
;;;

(chunk-type proposition 
"
 a chunk type to represent the statement:
   arg1 relation arg2 (example captain in park)
"
 relation arg1 arg2)

(chunk-type sentence 
"
 a chunk type to hold a 6 word sentence
 of the form:
     A subject IS preposition THE place
"
 first second third fourth fifth sixth)

(chunk-type process-sentence 
"
 a chunk type to hold a goal to 
 process a sentence
  slots:
     person - holds the word for the person
              from the sentence (or nil if not yet read)
     location - holds the word for the location
              from the sentence (or nil if not yet read)
     sentence - the sentence to process
     pm - the meaning of the word in the person slot
     lm - the meaning of the word in the location slot
"
person location sentence pm lm)

(chunk-type recognize-goal
"
 a chunk type for a goal to try to recognize
 the association person relation location
  slots:
     person - holds the meaning chunk of a person
     location - holds the meaning chunk of a location
     relation - holds the meaning chunk of a relation
                between person and location
     pp - holds the meaning chunk of a person for
          a retrieved assiciation pp relation pl
     pl - holds the meaning chunk of a location 
          for a retrieved association pp relation pl
"
 person location relation pl pp)

(chunk-type word 
"
 a chunk type to hold words (used for display)
 with a slot containing the meaning chunk
"
 meaning)

(chunk-type meaning 
"
 a chunk type used to represent the meaning
 for a word, the word is in the word slot
"
 word)

;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; CHUNKS
;;;

(add-dm (p1 isa proposition relation in* arg1 hippie* arg2 park*)
        (p2 isa proposition relation in* arg1 hippie* arg2 church*)
        (p3 isa proposition relation in* arg1 hippie* arg2 bank*)
        (p4 isa proposition relation in* arg1 captain* arg2 park*)
        (p5 isa proposition relation in* arg1 captain* arg2 cave*)
        (p6 isa proposition relation in* arg1 debutante* arg2 bank*)
        (p7 isa proposition relation in* arg1 fireman* arg2 park*)
        (p8 isa proposition relation in* arg1 g* arg2 b*)
        (p9 isa proposition relation in* arg1 g* arg2 c*)
        (p10 isa proposition relation in* arg1 g* arg2 d*)
        (p11 isa proposition relation in* arg1 e* arg2 c*)
        (p12 isa proposition relation in* arg1 e* arg2 f*)
        (p26 isa proposition relation in* arg1 lawyer* arg2 store*)
        (goal isa process-sentence sentence s1)
        (g isa word meaning g*)(g* isa meaning word g)
        (b isa word meaning b*)(b* isa meaning word b)
        (c isa word meaning c*)(c* isa meaning word c)
        (d isa word meaning d*)(d* isa meaning word d)
        (e isa word meaning e*)(e* isa meaning word e)
        (f isa word meaning f*)(f* isa meaning word f)
        (hippie isa word meaning hippie*)
        (hippie* isa meaning word hippie)
        (park isa word meaning park*)
        (park* isa meaning word park)
        (church isa word meaning church*)
        (church* isa meaning word church)
        (captain isa word meaning captain*)
        (captain* isa meaning word captain)
        (cave isa word meaning cave*)
        (cave* isa meaning word cave)
        (debutante isa word meaning debutante*)
        (debutante* isa meaning word debutante)
        (bank isa word meaning bank*)
        (bank* isa meaning word bank)
        (fireman isa word meaning fireman*)
        (fireman* isa meaning word fireman)
        (lawyer isa word meaning lawyer*)
        (lawyer* isa meaning word lawyer)
        (store isa word meaning store*)
        (store* isa meaning word store)
        (in isa word meaning in*)
        (in* isa meaning word in)
        (is isa word meaning is*)
        (is* isa meaning word is)
        (the isa word)(a isa word)
        (s1 isa sentence first a second captain third is fourth in fifth the 
            sixth bank))

;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;
;;;
;;; Set the association strengths directly to S - ln(fan)
;;;

(let ((meanings (no-output (swm isa meaning))))
  (dolist (x meanings)
    (let* ((props (append (no-output (sdm-fct (list 'isa 'proposition 'arg1 x)))
                          (no-output (sdm-fct (list 'isa 'proposition 'arg2 x)))))
           (count (length props)))
      (dolist (y props)
        (set-ia-fct (list (list x y (- *s* (log  count)))))))))

;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; eliminate any associative activation
;;; resulting from in* since it will be constant
;;; across all propositions, it is eliminated for 
;;; simplicity in fitting the other parameters

(let ((statements (no-output (swm isa proposition))))
  (dolist (x statements)
    (set-ia-fct (list (list 'in* x 0)))))

;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; set the base level activations to 0 (B = 0)
;;; for the words - people, places, and prepositions
 
(setgeneralbaselevels 
 (g 0)(b 0)(c 0)(d 0)(e 0)(f 0)
 (g* 0)(b* 0)(c* 0)(d* 0)(e* 0)(f* 0)
 (hippie 0)
 (hippie* 0)
 (park 0)
 (park* 0)
 (church 0)
 (church* 0)
 (bank 0)
 (bank* 0)
 (captain 0)
 (captain* 0)
 (cave 0)
 (cave* 0)
 (debutante 0)
 (debutante* 0)
 (bank 0)
 (bank* 0)
 (fireman 0)
 (fireman* 0)
 (lawyer 0)
 (lawyer* 0)
 (store 0)
 (store* 0)
 (in 0)
 (in* 0)
 (the 0)
 (a 0)
 (s1 10)
 (goal 2))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; productions
;;;

(p read-person
"
   IF the goal is to process a sentence and the person has 
      not been read yet
   THEN note the second word of the sentence in the goal as the person
"
   =goal>
      isa process-sentence
      person nil
      sentence =sentence
   =sentence>
      isa sentence
      second =word
==>
  =goal>
     person =word
)

(parameters read-person :effort .15)


(p read-location
"
   IF the goal is to process a sentence and the location has 
      not been read yet
   THEN note the sixth word of the sentence in the goal as the location
"
   =goal>
      isa process-sentence
      location nil
      sentence =sentence

   =sentence>
      isa sentence
      sixth =word
==>
   =goal>
      location =word
)

(parameters read-location :effort .15)


(p understand-person
"
   IF the goal is to process a sentence, and the person has been
       read, but its meaning not found
   THEN store the meaning of the word in the goal
"
   =goal>
      isa process-sentence
      person =word
      pm nil

   =word>
      isa word
      meaning =m
==>
   =goal>
      pm =m
)

(parameters understand-person :effort .1 :strength 10)


(p understand-location
"
   IF the goal is to process a sentence, and the location has been
       read, but its meaning not found
   THEN store the meaning of the word in the goal
"
   =goal>
      isa process-sentence
      location =word
      lm nil

   =word>
      isa word
      meaning =m
==>
   =goal>
      lm =m
)

(parameters understand-location :effort .1 :strength 10)


(p recognize
"
   IF the goal is to process a sentence, and both the person and
      location meanings have been determined
   THEN set a new goal to attempt to remember the association
       the 'person' in the 'location'
"
   =goal>
      isa process-sentence
      pm =p
      lm =l
==>
   =newgoal>
      isa recognize-goal
      person =p
      relation in*
      location =l
    
   !focus-on! =newgoal
)
 

(p retrieve-sentence-p
"
   IF the goal is to recognize the association 'person' in 'location'
      and no location memory has yet been found
      and there is a memory with 'person' in somewhere
   THEN set the retrieved person and location in the goal to
      'person' and somewhere
"
   =goal>
      isa recognize-goal
      person =p
      location =l
      pl nil

   =prop>
      isa proposition
      relation in*
      arg1 =p
      arg2 =newl
==>
   =goal>
      pp =p
      pl =newl
)


(p retrieve-sentence-l
"
   IF the goal is to recognize the association 'person' in 'location'
      and no person memory has yet been found
      and there is a memory with someone in 'location'
   THEN set the retrieved person and location in the goal to
      someone and 'location'
"
   =goal>
      isa recognize-goal
      person =p
      location =l
      pp nil

   =prop>
      isa proposition
      relation in*
      arg1 =newp
      arg2 =l
==>
   =goal>
      pp =newp
      pl =l
)


(p not-person
"
   IF the goal is to recognize the association 'person' in 'location'
      and a memory has been recalled
      and the person is not correct
   THEN respond no
      and pop the goal, finishing the trial
"
   =goal>
      isa recognize-goal
      person =p
      location =l
    - pp =p
      pl =l
==>
   !output! ("no")

   !pop!
)

(parameters-fct 'not-person (list :effort (- (max .6 *i*) .6)))


(p not-location
"
   IF the goal is to recognize the association 'person' in 'location'
      and a memory has been recalled
      and the location is not correct
   THEN respond no
      and pop the goal, finishing the trial
"
   =goal>
      isa recognize-goal
      person =p
      location =l
      pp =p
    - pl =l
==>
   !output! ("no")

   !pop!
)

(parameters-fct  'not-location (list :effort (- (max .6 *i*) .6)))


(p match
"
   IF the goal is to recognize the association 'person' in 'location'
      and a memory has been recalled
      and the memory has both 'person' and 'location'
   THEN respond yes
      and pop the goal, finishing the trial
"
   =goal>
      isa recognize-goal
      location =l
      pl =l
      person =p
      pp =p
==>
   !output! ("yes")

   !pop!
)

(parameters-fct 'match (list :effort (- (max .6 *i*) .6)))