;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                        ;;
;;        ACT-R MODEL OF AGRAMMATIC APHASIA               ;;
;;                                                        ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                        ;;
;; (C) 2005,                                              ;;
;; by:                                                    ;;
;; Andrea Stocco, University of Trieste, Italy            ;;
;; Cristiano Crescentini, SISSA, Trieste, Italy           ;;
;;                                                        ;;
;; Part of the code is based on previous models by        ;;
;; Cristiano Crescentini and Rosapia Lauro-Grotto,        ;;
;; (University of Florence, Italy), Raluca Budiu and      ;;
;; John R. Anderson (Carnegie-Mellon University,          ;;
;; Pittsburgh, PA) and Richard Lewis (Michigan State      ;;
;; University, MI).                                       ;;
;;                                                        ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                        ;;
;; A.S. dedicates this model to Raffaella                 ;;
;;                                                        ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                        ;;
;; Last revised: May 29, 2005                             ;;
;; Fixed minor bugs.  Changed some chunks and productions ;;
;; to make them more coherent and clear.                  ;;
;;                                                        ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                        ;;
;; First release: March 31, 2005                          ;;
;;                                                        ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defvar  *response* nil)
(defvar  *response-time* nil)

(defvar *mythesis-study-set*
   '("the magician amazed the lawyer"
     "the robber worried the policeman"
     "the singer was inspired by the waitress"
     "the waitress was loved by the policeman"
     "the photographer was desired by the singer"
     "the waitress liked the robber"
     "the photographer was frightened by the policeman"
     "the singer entertained the waitress"
     "the lawyer annoyed the waitress"
     "the magician trusted the policeman"
     "the policeman was adored by the waitress"
     "the singer was despised by the magician"))

(defvar *mythesis-test-set*
   '((1 "k" "the magician amazed the lawyer")
     (2 "k" "the policeman was worried by the robber")
     (3 "k" "the singer was inspired by the waitress")
     (4 "k" "the waitress was loved by the policeman")
     (5 "k" "the singer desired the photographer")
     (6 "k" "the waitress liked the robber")
     (7 "d" "the photographer frightened the policeman")
     (8 "d" "the waitress entertained the singer")
     (9 "d" "the lawyer was annoyed by the waitress")
     (10 "d" "the magician was trusted by the policeman")
     (11 "d" "the policeman adored the waitress")
     (12 "d" "the magician was despised by the singer")))

(defun study-sentence (text time)
  (if *actr-enabled-p*
      (study-sentence-model text time)))

(defun study-sentence-model (text time)
  (let ((window (open-exp-window "Sentence Experiment" :visible t :width 500)))
    (pm-install-device window)
    (add-text-to-exp-window :text text :x 25 :y 150 :width 250)
    (pm-proc-display :clear t)
    (pm-run time :full-time t)))

(defun test-sentence (test)
  (if *actr-enabled-p*
      (test-sentence-model test)))

(defun test-sentence-model (test)
  (let ((window (open-exp-window "Sentence Experiment" :visible nil :width 500)))
    (pm-install-device window)
    (add-text-to-exp-window :text (third test) :x 25 :y 150 :width 250)
    (pm-proc-display :clear t)

    (setf *response-time* nil)
    (setf *response* nil)
    
    (let ((start-time (pm-get-time)))
      (pm-run 30)
      (setf *response-time* (if *response-time*
                                (- *response-time* start-time)
                              30000)))

     (list (first test) (/ *response-time* 1000.0)
           (string-equal *response* (second test)))))

(defun study-sentences (set time)
   (dolist (x set)
     (study-sentence x time)))

(defun test-sentences (set)
   (let ((results nil))
     (dolist (x set)
       (push (test-sentence x) results))
     (mapcar #'cdr (sort results #'< :key #'first))))

(defun do-experiment (&key (in-order t))
  (let ((study (if in-order
                   *mythesis-study-set*
                 (permute-list *mythesis-study-set*)))
        (tests (if in-order
                   *mythesis-test-set*
                 (permute-list *mythesis-test-set*))))

     (reset)
     (study-sentences study 7)
     (study-sentence "                            test" 2)
     (report-data (test-sentences tests))))

 (defun report-data (lis)
   (let ((rts (mapcar #'first lis)))
     (format t "          Active-Active Active-Passive Passive-Active 
Passive-Passive~%")

     (format t "True: ~:{~9,2F (~3s)~}~%" (subseq lis 0 6))
     (format t "False:~:{~9,2F (~3s)~}~%" (subseq lis 6 12))))


(defmethod rpm-window-key-event-handler ((win rpm-window) key)
  (setf *response-time* (pm-get-time))
  (setf *response* (string key)))

(defun eq-meaning (m1 m2)
   (and (equal (chunk-slot-value-fct m1 'action)
               (chunk-slot-value-fct m2 'action))
        (equal (chunk-slot-value-fct m1 'experiencer)
               (chunk-slot-value-fct m2 'experiencer))
        (equal (chunk-slot-value-fct m1 'theme)
               (chunk-slot-value-fct m2 'theme))))

(defun check-lists (l1 l2)
  (mapcar #'eq-meaning l1 l2))

(defun check ()
  (check-lists (sdm isa meaning purpose debug)
               (sdm isa meaning purpose study)))

;; SIMULATE (N)
;; Simulates (n) experiments and returns a list
;; of the meaning checks.
;;
(defun simulate (n)
  (let ((lst nil))
    (dotimes (i n)
      (progn
        (do-experiment)
        (setf lst (cons (check) lst))))
    lst))

(clear-all)
(pm-reset)

(pm-set-params :show-focus t :real-time nil)


;; PARAMETERS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; A complete description of the parameters, their use,  ;;
;; and their relative and mutual influence over          ;;
;; performance is in AS & CC, 2005, "Notes on the ACT-R  ;;
;; Model of Agrammatic Aphasia", available at:           ;;
;; <http://labsico.units.it/papers/MoANotes.pdf>         ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(SGP :V   NIL)  ; Stops tracing productions (to enhance performance)
(SGP :ESC T)    ; Enables rational analysis (necessary)
(SGP :LF  0.05) ; Latency factor for retriavals
(SGP :ANS 0.05) ; Activation noise at each cycle
(SGP :BLC 1.0)  ; Base level costant (added to activation).
(SGP :RT  -200) ; Retrieval th17.12resold (retrieves everyting).
(SGP :ERA T)    ; Same as :ESC
(SGP :ER  T)    ; Enabled randomness. May be needed in future
                ;   improvements of the model itself.


(SGP :GA 2.0)   ; Uncomment this on for Agrammatics patients
;(SGP :GA 3.0)  ; Uncomment this on for normal part.s.


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

;; PARSE-SENTENCE
;; The basic chunk in the model: it encapsulates
;; the goal of comprehending a sentence (that is currently
;; being processed) and keeps note of several syntactic
;; properties of the sentences itself (i.e., the nouns
;; which are involved and the correct theta grid).
;;
(chunk-type PARSE-SENTENCE
  Current-word 
  Comprehended 
  Meaning
  Step
  Theta-grid
  First-noun
  Second-noun
  Verb
  Purpose)

;; MEANING
;; A meaninh holds a simplified semantic representation for 
;; a sentence. Three slots (Approved, Origin, and Purpose)
;; hold episodic information about this specific encoding.
;;
(chunk-type MEANING 
  Action 
  Experiencer
  Theme
  Approved
  Origin
  Purpose)

;; THETA-GRID
;; A theta-grid contains an ordered list of thematic roles.
;; Names in a sentence will be given the appropriate theta
;; role according to their position within the sentence.
;; Their position is mapped onto the ordered slots in the
;; THETA-GRID chunk type---i.e., the first noun encountered
;; will be assigned the role encoded in the "First-role"
;; chunk slot.
;;
(chunk-type THETA-GRID
  First-role
  Second-role)

;; WORD
;; A word is an abstract dictionary entry of a specific 
;; word instance (Lexeme), and holds information about
;; its category and whether it is relevant for semantics
;; or not.  A word is considered relevant for the semantic
;; interpretation of a sentence if it requires any sort
;; of manipulation over the ongoing semantic representation
;; (encoded in a MEANING chunk).  According to this
;; definition, relevant words are:
;;   * All those belonging to the NOUN category
;;   * All the verbs
;;   * Words signalling the existence of a passive form
;;     (in this model, only the word "BY" has this 
;;     function).
;;
(chunk-type WORD
  Relevant
  Category
  Lexeme)

;; PASSIVE-FORM
;; A passive-form is a pointer linking a Thematic-Grid
;; (Stored in the Main-Grid slot) with another grid
;; containing the very same theta-roles, but in reversed
;; order. Pointing occurs through associative links.
;;
(chunk-type PASSIVE-FORM
  Verb)

;; FIND-GRID
;; A small goal requesting to find a given Theta-Grid 
;; by means of a given cue (stored in the slot Cue).
;;
(chunk-type FIND-GRID
  Cue       ; The cue that points to the grid
  Found)    ; A flag signalling whether the grid has been
            ;   retrieved or not

;; Just to be precise: Some special CHUNKS for storing 
;; thematic roles, processing steps, and other non-slotted
;; declarative representation. Not needed, really 
;; (just for making easier to inspect declarative memory 
;; from lisp code).
;;
(chunk-type ROLE)
(chunk-type PROCESS-STEP)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DECLARATIVE MEMORY ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; BASIC FEATURES
(add-dm (Yes     ISA CHUNK)
        (No      ISA CHUNK)
        (Unknown ISA CHUNK))

;; THETA-ROLES
(add-dm (Experiencer ISA ROLE)
        (Theme       ISA ROLE))

;; PROCESS STEPS
(add-dm (Find               ISA PROCESS-STEP)
        (Process            ISA PROCESS-STEP)
        (Read               ISA PROCESS-STEP)
        (Attending          ISA PROCESS-STEP)
        (Looking            ISA PROCESS-STEP)
        (Second-Noun        ISA PROCESS-STEP)
        (Attach-Meaning     ISA PROCESS-STEP)
        (Loading-Grid       ISA PROCESS-STEP)
        (Respond            ISA PROCESS-STEP)
        (Sentence-Complete  ISA PROCESS-STEP))

;; MAIN GOAL
(add-dm (Comprehend ISA PARSE-SENTENCE 
          Current-word  Nil
          Comprehended  No 
          Meaning       NIL
          Step          NIL
          Theta-grid    NIL
          First-Noun    Unknown
          Second-Noun   Unknown
          Purpose       Study))

;; THETA-GRIDS
;; Two of them: the default (Exp/Theme) and the
;; reversed (Theme/exp) one.
;;
(add-dm (Default-Grid ISA THETA-GRID
          First-Role    Experiencer
          Second-Role   Theme)
        (Reversed-Grid ISA THETA-GRID
          First-Role    Theme
          Second-Role   Experiencer))

;; PASSIVE FORMS
;; Chunks representing the passive form of an
;; active verb.  Each of these passive forms
;; connects a verb to its opposite grid 
;;
(add-dm (Passive-Of-Amaze     ISA PASSIVE-FORM
          Verb Amaze)
        (Passive-Of-Entertain ISA PASSIVE-FORM
          Verb Entertain)
        (Passive-Of-Inspire   ISA PASSIVE-FORM
          Verb Inspire)
        (Passive-Of-Worry     ISA PASSIVE-FORM
          Verb Worry)
        (Passive-Of-Frighten  ISA PASSIVE-FORM
          Verb Frighten)
        (Passive-Of-Annoy     ISA PASSIVE-FORM
          Verb Annoy)
        (Passive-Of-Like      ISA PASSIVE-FORM
          Verb Like)
        (Passive-Of-Love      ISA PASSIVE-FORM
          Verb Love)
        (Passive-Of-Despise   ISA PASSIVE-FORM
          Verb Despise)
        (Passive-Of-Trust     ISA PASSIVE-FORM
          Verb Trust)
        (Passive-Of-Adore     ISA PASSIVE-FORM
          Verb Adore)
        (Passive-Of-Desire    ISA PASSIVE-FORM
          Verb Desire))
        
;; LEXICAL ENTRIES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; NOUNS
;; A collection of nouns.
;;
(add-dm (Magician   ISA WORD 
          Lexeme    "magician" 
          Relevant  yes 
          Category  noun)
        (Lawyer     ISA WORD 
          Lexeme    "lawyer" 
          Relevant  yes 
          Category  noun)
        (Robber     ISA WORD 
          Lexeme    "robber" 
          Relevant  yes 
          Category  noun)
        (Policeman  ISA WORD 
          Lexeme    "policeman" 
          Relevant  Yes 
          Category  Noun)
        (Singer     ISA WORD 
          Lexeme    "singer" 
          Relevant  Yes 
          Category  Noun)
        (Waitress   ISA WORD 
          Lexeme    "waitress" 
          Relevant  Yes 
          Category  Noun)
        (Photographer ISA WORD 
          Lexeme    "photographer" 
          Relevant  Yes 
          Category  Noun))

;; THEME-EXP VERBS
;; Verbs linked to the reversed theta-grid, which
;; requires the role order <Theme/Experiencer>
;;
(add-dm (Amaze      ISA WORD 
          Lexeme    "amazed" 
          Relevant  Yes 
          Category  Verb)
        (Entertain  ISA WORD 
          Lexeme    "entertained" 
          Relevant  Yes 
          Category  Verb)
        (Inspire    ISA WORD 
          Lexeme    "inspired" 
          Relevant  Yes 
          Category  Verb)
        (Worry      ISA WORD 
          Lexeme    "worried" 
          Relevant  Yes 
          Category  Verb)
        (Frighten   ISA WORD 
          Lexeme    "frightened" 
          Relevant  Yes 
          Category  Verb)
        (Annoy      ISA WORD 
          Lexeme    "annoyed" 
          Relevant  Yes 
          Category  Verb))

;; EXP-THEME VERBS
;; Verbs linked to the default theta-grid, which requires
;; arguments in the order <Experiencer/Theme>.
;;
(add-dm (Like       ISA WORD 
          lexeme    "liked" 
          relevant  yes 
          category  verb)
        (Love       ISA WORD 
          Lexeme    "loved" 
          Relevant  Yes 
          Category  Verb)
        (Despise    ISA WORD 
          Lexeme    "despised" 
          Relevant  Yes 
          Category  Verb)
        (Trust      ISA WORD 
          Lexeme    "trusted" 
          Relevant  Yes 
          Category  Verb)
        (Adore      ISA WORD 
          Lexeme    "adored" 
          Relevant  Yes 
          Category  Verb)
        (Desire     ISA WORD 
          Lexeme    "desired" 
          Relevant  Yes 
          Category  Verb))

;; OTHER WORDS
;;
(add-dm (test       ISA WORD 
          lexeme    "test" 
          relevant  no 
          category  noun)
        (by         ISA WORD
          lexeme    "by"
          relevant  yes
          category  preposition)
        (was        ISA WORD
          lexeme    "was"
          relevant  no
          category  verb)
        (the        ISA WORD
          lexeme    "the"
          relevant  no
          category  article))

;; MEANING TESTS
;; This is a set of chunk which are irrelevant for running the model, and are needed only
;; for the pupose of evaluating performance.  Each of them encodes the correct meaning of one
;; of the test sentences.
;;
(add-dm (1-M ISA MEANING
          Action  Amaze
          Experiencer Lawyer
          Theme  Magician
          Purpose Debug)
        (2-M ISA MEANING
          Action  Worry
          Experiencer Policeman
          Theme  Robber
          Purpose Debug)
        (3-M ISA MEANING
          Action  Inspire
          Experiencer Singer
          Theme  Waitress
          Purpose Debug)
        (4-M ISA MEANING
          Action  Love
          Experiencer Policeman
          Theme  Waitress
          Purpose Debug)
        (5-M ISA MEANING
          Action  Desire
          Experiencer Singer
          Theme  Photographer
          Purpose Debug)
        (6-M ISA MEANING
          Action  Like
          Experiencer Waitress
          Theme  Robber
          Purpose Debug)
        (7-M ISA MEANING
          Action  Frighten
          Experiencer Photographer
          Theme  Policeman
          Purpose Debug)
        (8-M ISA MEANING
          Action  Entertain
          Experiencer Waitress
          Theme  Singer
          Purpose Debug)
        (9-M ISA MEANING
          Action  Annoy
          Experiencer Waitress
          Theme  Lawyer
          Purpose Debug)
        (10-M ISA MEANING
          Action  Trust
          Experiencer Magician
          Theme  Policeman
          Purpose Debug)
        (11-M ISA MEANING
          Action  Adore
          Experiencer Waitress
          Theme  Policeman
          Purpose Debug)
        (12-M ISA MEANING
          Action  Despise
          Experiencer Magician
          Theme  Singer
          Purpose Debug))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PRODUCTIONS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; NEW-SENTENCE-DETECTED
;; Moves attention to the first word of a new sentence
;;
(p New-Sentence-Detected
  =goal>
    ISA           PARSE-SENTENCE
    Step          NIL
  =visual-location>
    ISA           VISUAL-LOCATION
  =visual-state>
    ISA           MODULE-STATE
    Modality      Free
==>
  -manual>
  =goal>
    Step          Attending
  +visual>
    ISA           Visual-object
    Screen-Pos    =visual-location
)

;; FIND-NEXT-WORD
;; Finds a visual-location where the next word on the
;; screen lies.
;;
(p Find-Next-Word
  =goal>
    ISA           PARSE-SENTENCE
    Step          Find
==>
  +visual-location>
    ISA           VISUAL-LOCATION
    Screen-X      Greater-than-current
    Nearest       Current
  =goal>
    Step          Looking
)

;; ATTEND-WORD
;; Moves visual attention to the next word on the screen
;;
(p Attend-Word
  =goal>
    ISA           PARSE-SENTENCE
    step          Looking
  =visual-location>
    ISA           VISUAL-LOCATION
  =visual-state>
    ISA           MODULE-STATE
    Modality      Free
==>
  =goal>
    Step          Attending
  +visual>
    ISA           VISUAL-OBJECT
    Screen-pos    =visual-location
)

;; READ-WORD
;; Encodes the word it is attending to. It also
;; stores the word into the goal chunk, and retrieves
;; the corresponding lexical entry.
;;
(P Read-Word
  =goal>
    ISA           PARSE-SENTENCE
    step          Attending
  =visual>
    ISA           TEXT
    Value         =word
==>
  -visual-location>
  =goal>
    Current-Word  =word
    Step          Process
  +retrieval>
    ISA           WORD
    Lexeme        =word
)

;; PART I: UNRELEVANT WORDS
    
;; SKIP-UNRELEVANT
;; Skips words that are unrelevant for semantic
;; processing of the sentences (i.e. "was", "the"...)
;;
(p Skip-Unrelevant
  =goal>
    ISA           PARSE-SENTENCE
    Comprehended  No
    Step          Process
  - Current-Word  "test"
  =retrieval> 
    ISA           WORD
    Relevant      No
==>
  =goal>
    ISA           PARSE-SENTENCE
    Comprehended  No
    Step          Find
    Current-Word  NIL
  -retrieval>
)

;; PART II: VERBS

;; PROCESS-VERB
;; Process a verb. When processing a verb, a goal is
;; set to find a Theta Grid that is cued by the verb 
;; itself.
;;
(p Process-Verb
  =goal>
    ISA           PARSE-SENTENCE
    Comprehended  No
    Step          Process
    Meaning       =meaning
  =retrieval>
    ISA           WORD
    Relevant      Yes
    Category      Verb
==>
  =goal>
    Verb          =retrieval
  =meaning>
    ISA           MEANING
    Action        =retrieval
  +goal>
    ISA           Find-Grid
    Found         No
    Cue           =retrieval
  -retrieval>
)

;; PART III: NOUNS

;; LOAD-GRID-WHEN-NEEDED
;; Processes the first noun encountered. Basically,
;; when the processor encounters a noun and there is
;; still no theta-grid being attached to it, then it
;; loads a new grid.
;;
(p Load-Grid-If-Missing
  =goal>
    ISA           PARSE-SENTENCE
    Comprehended  No
    Step          Process
    Theta-grid    NIL
  =retrieval>
    ISA           WORD
    Relevant      Yes
==>
  =goal>
    Step          Loading-Grid
  +retrieval>
    ISA           THETA-GRID
)

;; ATTACH-THETA-GRID
;; Once a new theta grid has been loaded, it attaches
;; it to the current Comprehend Goal.
;;
(p Attach-Theta-Grid
  =goal>
    ISA           PARSE-SENTENCE
    Comprehended  No
    Step          Loading-Grid
    Theta-Grid    NIL
    Current-Word  =word
  =retrieval>
    ISA           THETA-GRID
==>
  =goal>
    Step          Process
    Theta-Grid    =retrieval
  +retrieval>
    ISA           WORD
    Lexeme        =word
)

;; ATTACH-FIRST-NOUN
;; Attaches a noun to the first-noun slot
;; in the comprehension goal.  The slot should be free 
;; (i.e. NIL) for the production to fire.
;;
(p Attach-First-Noun
  =goal>
    ISA           PARSE-SENTENCE
    Comprehended  No
    Step          Process
    First-Noun    Unknown
    Second-Noun   Unknown
    Theta-Grid    =THETA-GRID
  =theta-grid>
    ISA           THETA-GRID
    First-Role    =first
    Second-Role   =second
  =retrieval>
    ISA           WORD
    relevant      yes
    category      noun
==>
  =goal>
    First-Noun   =retrieval
    Step          Process
  +retrieval>
    ISA           THETA-GRID
    First-Role    =first
    Second-Role   =second
)

;; ATTACH-SECOND-NOUN
;; Attaches a noun to the second-noun slot
;; in the comprehension goal.  The slot should be free 
;; (i.e. NIL) for the production to fire.
;; 
(p Attach-Second-Noun
  =goal>
    ISA           PARSE-SENTENCE
    Comprehended  No
    Step          Process
  - First-Noun    Unknown
    Second-Noun   Unknown
    Theta-Grid    =theta-grid
  =theta-grid>
    ISA           THETA-GRID
    First-Role    =first
    Second-Role   =second
  =retrieval>
    ISA           word
    relevant      yes
    category      noun
==>
  =goal>
    Second-Noun   =retrieval
    Step          Second-Noun
  +retrieval>
    ISA           THETA-GRID
    First-Role    =first
    Second-Role   =second
)

;; PART IV: PASSIVE ("BY")

;; NOTICE-PASSIVE
;; Begins the processing of a passive form. This process
;; is triggered by the encounter of the word "BY", and 
;; requires the retrieval of chunk representing a passive 
;; form, which will be later used as a cue for the 
;; retrieval of the proper grid (see next production).
;;
(p Process-Passive
  =goal>
    ISA           PARSE-SENTENCE
    Comprehended  no
    Step          process
    Verb          =verb
  =retrieval>
    ISA           WORD
    Relevant      yes
    Lexeme        "by"
==>
   +retrieval>
    ISA           PASSIVE-FORM
    Verb          =verb
)

;; PROCESS-REVERSE-FORM
;; Creates a goal to find a theta-grid with 
;; the indication of the passive of a
;; verb as a cue.  This cue prompts
;; the retrieval of the inverted grid.
;; 
(p Process-Passive-Form
  =goal>
    ISA           PARSE-SENTENCE
    Comprehended  No
    Step          Process
  =retrieval>
    ISA           PASSIVE-FORM
==>
  +goal>
    ISA           FIND-GRID
    Found         No
    Cue           =retrieval
  -retrieval>
)

;; LOAD-GRID
;; If your goal is to find a grid with a given cue...
;; Simply retrieve it---and let the cue prompt it!
;;
(p Load-Grid
  =goal>
    ISA           FIND-GRID
    Found         No
==>
  =goal>
    Found         Yes
  +retrieval>
    ISA           THETA-GRID
)

;; RETRIEVE-COMPREHEND-ONCE-FOUND-GRID
;; Once the goal of finding a theta-grid has been 
;; accomplished, the processor focusses on the grid
;; and retrieves the pending PARSE-SENTENCE goal.
;;
(p Retrieve-Comprehend-Once-Found-Grid
  =goal>
    ISA           FIND-GRID
    Found         Yes
  =retrieval>
    ISA           THETA-GRID
==>
  !Focus-On!      =retrieval
  +retrieval>
    ISA           PARSE-SENTENCE
    Comprehended  No
)

;; BACK-TO-COMPREHEND-FROM-GRID
;; Refocusses on parsing a sentence after having retrieved
;; a theta-grid.
;;
(p Back-To-Comprehend-From-Grid
  =goal>
    ISA           THETA-GRID
    First-Role    =first-role
    Second-Role   =second-role
  =retrieval>
    ISA           PARSE-SENTENCE
    Meaning       =meaning
==>
  !focus-on!      =retrieval
  +retrieval>     ; Swaps t-Grid from goal to retrieval
    ISA           THETA-GRID
    First-Role    =first-role
    Second-Role   =second-role
)
 
;; CREATE-MEANING-IF-MISSING
;; When coming to assigning roles but there's no meaning,
;; a little detour is required to crete a meaning for the
;; current comprehension process
;;
(p Create-Meaning-If-Missing
  =goal>
    ISA           PARSE-SENTENCE
    Meaning       NIL
    Step          Process
    Purpose       =purpose
  =retrieval> 
    ISA           THETA-GRID
==>
  =goal>
    Step          Attach-meaning
  +goal>
    ISA           MEANING
    Action        nil
    Theme         Unknown
    Experiencer   Unknown
    Origin        =goal
    Purpose       =purpose
)

;; FOCUS-ON-ORIGIN
;; Moves attention back to the main goal of comprehending
;; a whole sentence, after having created a specific semantic
;; representation.
;;
(p Focus-On-Origin
  =goal>
    ISA           MEANING
    Action        nil
    Theme         Unknown
    Experiencer   Unknown
    Origin        =origin
  =retrieval>
    ISA           THETA-GRID
==>
  !focus-on!      =origin
  +retrieval>
    ISA           MEANING
    Action        nil
    Theme         Unknown
    Experiencer   Unknown
    Origin        =origin
)

;; ATTACH-MEANING
;; Once a meaning has been created, it must be linked to
;; the current comprehension process.
;;
(p Attach-Meaning
  =goal>
    ISA           PARSE-SENTENCE
    Comprehended  No
    Meaning       NIL
    Step          Attach-Meaning
    Theta-grid    =theta
  =theta>
    ISA           THETA-GRID
    first-role    =first
    second-role   =second
  =retrieval>
    ISA           MEANING
    Action        nil
    Theme         Unknown
    Experiencer   Unknown
    Origin        =goal
==>
  =goal>
    Meaning       =retrieval
    Step          Process
  +retrieval>
    ISA           THETA-GRID
    first-role    =first
    second-role   =second
)

;; ASSIGN-ROLES-ACCORDING-TO-DEFAULT
;; Attaches theta-roles to nouns according to the 
;; default theta-grid. 
;;
(p Assign-Roles-According-To-Default
  =goal>
    ISA             PARSE-SENTENCE
    First-Noun      =first-noun
    Second-Noun     =second-noun
    Meaning         =meaning
  =retrieval> 
    ISA             THETA-GRID
    First-Role      Experiencer
    Second-Role     Theme
==>
  =goal>
    Theta-Grid      =retrieval
  =meaning>
    ISA             MEANING
    Experiencer     =first-noun
    Theme           =second-noun
  +retrieval>
    ISA             PARSE-SENTENCE
    Comprehended    No
)

;; ASSIGN-ROLES-ACCORDING-TO-REVERSED
;; Attaches theta-roles to nouns according to the reversed
;; theta-grid (which is always <Theme/Experiencer>).
;;
(p Assign-Roles-According-To-Reversed
  =goal>
    ISA           PARSE-SENTENCE
    First-Noun    =first-noun
    Second-Noun   =second-noun
    Meaning       =meaning
  =retrieval> 
    ISA           THETA-GRID
    First-Role    Theme
    Second-Role   Experiencer
==>
  =goal>
    Theta-Grid    =retrieval
  =meaning>
    ISA           MEANING
    Experiencer   =second-noun
    Theme         =first-noun
  +retrieval>
    ISA           PARSE-SENTENCE
    Comprehended  No
)

;; BACK-TO-COMPREHEND-FROM-MEANING
;; Once the meaning has been modified, returns to 
;; the original goal of comprehending the sentence.
;;
(p Back-To-Comprehend-After-Meaning
  =goal>
    ISA           MEANING
  =retrieval>
    ISA           PARSE-SENTENCE
==>
  !focus-on!      =retrieval
)

;; BACK-TO-PARSING
;; If the sentence is not finished, returns to the 
;; parsing process.
;;
(p Back-To-Parsing
  =goal>
    ISA           PARSE-SENTENCE
    Step          Process
    Meaning       =meaning
  =retrieval>
    ISA           PARSE-SENTENCE
    Step          Process
==>
  =goal>
    Step          Find
)

;; NOTICE-SENTENCE-COMPLETED-AND-PASS
;; If the sentence is finished, and the sentence
;; was presented during the Study Phase, then simply
;; mark it as completed and approve its meaning.
;;
(p Notice-Sentence-Completed-And-Pass
  =goal>
    ISA           PARSE-SENTENCE
    Step          Second-Noun
    Purpose       Study
    Meaning       =meaning
  =meaning>
    ISA           MEANING
  =retrieval>
    ISA           PARSE-SENTENCE
    Step          Second-Noun
==>
  =goal>
    Step          Sentence-Complete
    Comprehended  Yes
  =meaning>
    Approved      Yes
)

;; NOTICE-SENTENCE-COMPLETED-AND-RESPOND
;; If the sentence is finished, and the sentence
;; was presented during the Test Phase, then 
;; mark it as completed and notice that you must
;; respond before starting a new sentence.
;;
(p Notice-Sentence-Completed-And-Respond
  =goal>
    ISA           PARSE-SENTENCE
    Step          Second-Noun
    Purpose       Test
    Meaning       =meaning
  =meaning>
    ISA           MEANING
  =retrieval>
    ISA           PARSE-SENTENCE
    Step          Second-Noun
==>
  =goal>
    Step          Respond
    Comprehended  Yes
  =meaning>
    Approved      Yes
)

;; START-COMPREHENDING-NEW-SENTENCE
;; When a sentence has been completed, focusses on the
;; of comprehending the next one.  Comprehension will
;; take place only after a new sentence has been 
;; presented and its first word noticed.
;; This production will maintain the same purpose.
;;
(p Start-Comprehending-New-Sentence
  =goal>
    ISA           PARSE-SENTENCE
    Comprehended  Yes
    Step          Sentence-Complete
    Purpose       =purpose
==>
  -visual>        ; Unloads contents of the visual buffer
  +goal>          ; Loads a new goal
    ISA           PARSE-SENTENCE
    Current-Word  Nil
    Comprehended  No
    Meaning       Nil
    Step          Nil
    Theta-grid    Nil
    First-noun    Unknown
    Second-noun   Unknown
    Verb          Unknown
    Purpose       =purpose
)

;; TEST PHASE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; NOTICE-IS-TEST
;; A production that intepretates the "test" signal on the 
;; screen, and changes the purpose of comprehending the
;; sentence.
;;
(P Notice-Is-Test
  =goal>
    ISA           PARSE-SENTENCE
    Current-Word  "test"
  =retrieval>
    ISA           WORD
    Lexeme        "test"
==>
  -visual>
  =goal>
    Step          NIL
    Current-Word  NIL
    Purpose       Test
)

;; RETRIEVE-MEANING-FOR-RESPONSE
;; Retrieves a meaning involving the same action as the
;; current sentence.  The comparison between current
;; and retrieved meaning will yield a response.
;;
(p Retrieve-Meaning-For-Response
  =goal>
    ISA           PARSE-SENTENCE
    Meaning       =meaning
    Step          Respond
  =meaning>
    ISA           MEANING
    Action        =action
  =retrieval>
    ISA           PARSE-SENTENCE
==>
  -visual>
  +retrieval>
    ISA           MEANING
    Action        =action
    Purpose       Study
)

;; RESPOND-YES
;; Responds yes---if the retrieved meaning perfectly
;; matches the current one.
;;
(p Respond-Yes
  =goal>
    ISA           PARSE-SENTENCE
    Meaning       =meaning
    Step          Respond
  =meaning>
    ISA           MEANING
    Action        =action
    Theme         =theme
    Experiencer   =experiencer
  =retrieval>
    ISA           MEANING
    Action        =action
    Theme         =theme
    Experiencer   =experiencer
  =manual-state>
    ISA           MODULE-STATE
    modality      Free
==> 
  =goal>
    ISA           PARSE-SENTENCE
    Step          Sentence-Complete
  +manual>
    ISA           PRESS-KEY
    Key           "k"  
)

;; RESPOND-NO
;; Responds no---if the retrieved meaning does not
;; match the current one.
;;
(p Respond-No
  =goal>
    ISA           PARSE-SENTENCE
    Meaning       =meaning
    Step          Respond
  =meaning>
    ISA           MEANING
    Action        =action
    Theme         =theme
    Experiencer   =experiencer
  =retrieval>
    ISA           MEANING
    Action        =action
  - Theme         =theme
  - Experiencer   =experiencer
  =manual-state>
    ISA           MODULE-STATE
    modality      Free
==> 
  =goal>
    ISA           PARSE-SENTENCE
    Step          Sentence-Complete
  +manual>
    ISA           PRESS-KEY
    Key           "d"
)

;; OTHER COMMANDS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(set-base-levels (default-grid 5.0))

;; ASSOCIATIVE LINKS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; FROM VERB TO GRID /1
;; Association to the Default Theta Grid (Experiencer/Theme)
;; Inter-associative strengths are needed to produce fast,
;; automatic retrieval of information during parsing.
;; 
;; Note the these IAs have been setted to 4.0.  
;; However, a large set of values is possibile, provided they
;; respect some math constraints.  In particular, associative
;; strengths are needed to overcome the default theta grid 
;; actiovation.  This activation provides the lexical interference
;; threshold, which we denote by T.  Given a certain amount of W,
;; and a number N of goal slots, then associative strengths S need to
;; respect this constraint:
;;
;;    (W * S)/N  >>  T.
;;
;; Therefore, multiplying by N/W:
;;
;;    S  >>  (N * T)/W
;;
;; When (W * S) / N ~ T, we could reproduce agrammatic performance.
;; When lower, we obtain bad frontal-like performance on passive
;; forms.
;;
(Add-IA (Like     Default-Grid  4.0)
        (Love     Default-Grid  4.0)
        (Despise  Default-Grid  4.0)
        (Trust    Default-Grid  4.0)
        (Adore    Default-Grid  4.0)
        (Desire   Default-Grid  4.0))

(add-IA (Passive-Of-Like     Reversed-Grid  4.0)
        (Passive-Of-Love     Reversed-Grid  4.0)
        (Passive-Of-Despise  Reversed-Grid  4.0)
        (Passive-Of-Trust    Reversed-Grid  4.0)
        (Passive-Of-Adore    Reversed-Grid  4.0)
        (Passive-Of-Desire   Reversed-Grid  4.0))

;; FROM VERB TO GRID /2
;; Association to the Reversed Theta Grid (Theme/Experiencer)
;; Values must follow the constraints provided above.
;;
(Add-IA (Amaze      Reversed-Grid   4.0)
        (Entertain  Reversed-Grid   4.0)
        (Inspire    Reversed-Grid   4.0)
        (Worry      Reversed-Grid   4.0)
        (Frighten   Reversed-Grid   4.0)
        (Annoy      Reversed-Grid   4.0))

(Add-IA (Passive-Of-Amaze      Default-Grid   4.0)
        (Passive-Of-Entertain  Default-Grid   4.0)
        (Passive-Of-Inspire    Default-Grid   4.0)
        (Passive-Of-Worry      Default-Grid   4.0)
        (Passive-Of-Frighten   Default-Grid   4.0)
        (Passive-Of-Annoy      Default-Grid   4.0))

(pm-set-visloc-default :attended new :screen-x lowest)
(setf *actr-enabled-p* t)

(goal-focus comprehend)

;; PRODUCTION PARAMETERS
;; Making productions faster (about 1.5 ~ 2.0 secs. for
;; reading each sentence).
;;
(SPP  (Assign-Roles-According-To-Default      :effort 0.02)
      (Assign-Roles-According-To-Reversed     :effort 0.02)
      (Attach-First-Noun                      :effort 0.02)
      (Attach-Meaning                         :effort 0.02)
      (Attach-Second-Noun                     :effort 0.02)
      (Attach-Theta-Grid                      :effort 0.02)
      (Attend-Word                            :effort 0.02)
      (Back-To-Comprehend-After-Meaning       :effort 0.02)
      (Back-To-Comprehend-From-Grid           :effort 0.02)
      (Back-To-Parsing                        :effort 0.02)
      (Create-Meaning-If-Missing              :effort 0.02)
      (Find-Next-Word                         :effort 0.02)
      (Focus-On-Origin                        :effort 0.02)
      (Found-New-Word                         :effort 0.02)
      (Load-Grid                              :effort 0.02)
      (Load-Grid-If-Missing                   :effort 0.02)
      (Notice-Is-Test                         :effort 0.02)
      (Notice-Sentence-Completed-And-Pass     :effort 0.02)
      (Notice-Sentence-Completed-And-Respond  :effort 0.02)
      (Process-Passive                        :effort 0.02)
      (Process-Passive-Form                   :effort 0.02)
      (Process-Verb                           :effort 0.02)
      (Read-Word                              :effort 0.02)
      (Respond-No                             :effort 0.02)
      (Respond-Yes                            :effort 0.02)
      (Retrieve-Comprehend-Once-Found-Grid    :effort 0.02)
      (Retrieve-Meaning-For-Response          :effort 0.02)
      (Skip-Unrelevant                        :effort 0.02)
      (Start-Comprehending-New-Sentence       :effort 0.02))