;
If your browser supports JAVA, you can display the data in a graph by checking the Graphic output box on the interface page.;? (prediction 1000 *tnoise* *MYF* *MYrt* *MYans* *intercept* *flail* 34 .9 .12) ;((2.2825219213372225 0.8712201214551573 2.2805549009111505 0.8622860001152304 2.5435756582886233 0.88 3.0010679395398485 0.804 2.877735958215894 0.88) ;(2.527724054710839 0.8660316269555351 2.3765863129279654 0.8322893956620042 3.003691657301336 0.586203812268628 2.659512672618731 0.804 2.691345318650561 0.88) ;(2.97688216774599 0.6526953643486675 2.373005712299652 0.8055038561543372 3.1168693673597576 0.5050339947764386 2.508793289888122 0.804 2.466559428036153 0.88)) (defvar *sentence*) (defvar *goal*) (defvar *hold*) (defvar *retrieval*) (defvar sent1) (defvar sent2) (defvar sent3)(defvar sent4) (defvar *response*) (defvar *assoc*) (defvar *vars*) (defvar *high*) (defvar *low*) (defvar *study*) (defvar *test*) (defvar *yes*) (defvar *no*) (setf *vars* nil) (setf *assoc* nil) (defvar *plaus*) (defvar *read*) (setf *read* 0.1) (setf *plaus* nil) (defvar *encoding*) (setf *encoding* 0.2) (defvar *mismatch*) (setf *mismatch* .1) (setf *no* 0.65) (setf *yes* .65) (defparameter *intercept* 0.85) (defvar *myrt*) (defvar *myans*) (setf *myrt* .3) (setf *myans* .2) (defvar *flail*) (setf *flail* 0.80) (defvar *myf*) (setf *myf* .3) (defvar *tnoise*) (setf *tnoise* .05) (defvar *slip* .12) (defvar *goal-val* 34) (defvar *text* t) (defvar *graphic* nil) (defvar *v* nil) (defvar *overlay* nil) (defvar *runs* 1) (defvar *p-plause* .9) (defvar *latency-data-r82* '((2.16 2.395 2.5875 3 2.86) (2.6025 2.3175 2.96 2.665 2.69) (2.8975 2.3525 3.16 2.5475 2.43))) (defvar *accuracy-data-r82* '((0.1425 0.22 0.0825 0.18 0.11) (0.1625 0.4075 0.105 0.2025 0.135) (0.28 0.55 0.135 0.205 0.16))) (defvar *WWW-interface*) (setf *WWW-interface* '((:heading "Reder 1982" 2) (:table) (:table) "Intercept: " (:string :sy *intercept* .85) (:new-row) "Slip probability: " (:string :sy *slip* .12) (:new-row) "Goal value, G: " (:string :sy *goal-val* 34) (:new-row) "Guess latency: " (:string :sy *flail* .8) (:new-row) "Probability of plausible: " (:string :sy *p-plause* .9) (:new-row) "Number of runs (20 - 500): " (:string :sy *runs* 20) (:new-row) (:table-end) (:table) (:checkbox "Trace (NOT recomended, 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 both simulation and experiment data" :sy *overlay* nil) (:table-end) (:table-end) (:new-para) (:button "Show Experimental Results" "(display-r82 nil (list *latency-data-r82* *accuracy-data-r82*))") (:new-para) (:button "Run model" "(if (and (numberp *intercept*) (numberp *slip*) (numberp *goal-val*) (numberp *flail*) (numberp *runs*) (numberp *p-plause*) ) (display-r82 (prediction (min 500 (max 20 *runs*)) *tnoise* *MYF* *MYrt* *MYans* *intercept* *flail* *goal-val* *p-plause* *slip*) (list *latency-data-r82* *accuracy-data-r82*)) (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 2 minutes for 20 runs of the model" (:new-line) "- The trace of 20 runs is approximatly 2M bytes (1500 pages) in size" (:new-para))) (defun display-r82 (model exp) (when model (format *standard-output* "~%~%Parameters for run: (~S ~S ~S ~S ~S ~s)~%" *intercept* *slip* *goal-val* *flail* *p-plause* (min 1000 (max *runs* 20)))) (when *text* (when model (format *standard-output* "~%ACT-R Latency~%Condition Delay~% Immediate 20 minutes 2 days~%") (dotimes (i 5) (format *standard-output* "~18a~4,2f ~4,2f ~4,2f~%" (case i (0 "Recognize Old") (1 "Plausible Old") (2 "Recognize New") (3 "Plausible New") (4 "Implausible")) (nth i (first (first model))) (nth i (second (first model))) (nth i (third (first model))) )) (format *standard-output* "~%ACT-R Accuracy~%Condition Delay~% Immediate 20 minutes 2 days~%") (dotimes (i 5) (format *standard-output* "~18a~4,2f ~4,2f ~4,2f~%" (case i (0 "Recognize Old") (1 "Plausible Old") (2 "Recognize New") (3 "Plausible New") (4 "Implausible")) (nth i (first (second model))) (nth i (second (second model))) (nth i (third (second model))) )) ) (when (or (null model) *overlay*) (format *standard-output* "~%Experimental Latency~%Condition Delay~% Immediate 20 minutes 2 days~%") (dotimes (i 5) (format *standard-output* "~18a~4,2f ~4,2f ~4,2f~%" (case i (0 "Recognize Old") (1 "Plausible Old") (2 "Recognize New") (3 "Plausible New") (4 "Implausible")) (nth i (first (first exp))) (nth i (second (first exp))) (nth i (third (first exp))) )) (format *standard-output* "~%Experimental Accuracy~%Condition Delay~% Immediate 20 minutes 2 days~%") (dotimes (i 5) (format *standard-output* "~18a~4,2f ~4,2f ~4,2f~%" (case i (0 "Recognize Old") (1 "Plausible Old") (2 "Recognize New") (3 "Plausible New") (4 "Implausible")) (nth i (first (second exp))) (nth i (second (second exp))) (nth i (third (second exp))) ))) (unless *graphic* (format *standard-output* "~%
~%~%")))
(when *graphic*
(format *standard-output* "
")
(format *standard-output* "
")))
;General functions
(defun read-word ()
(eval `(mod-chunk ,*goal* word ,(or (pop *sentence*) 'eos))))
(defun get-activation (item)
(caar (no-output (eval `(sdp ,item :activation)))))
(defun comprehend-sentence (sent)
(setf *goal* 'goal)
(mod-chunk goal word nil type nil link nil link-type nil
task Comprehend past nil meaning nil)
(setf *sentence* sent)
(setf *hold* *sentence*)
(goal-focus goal)
(run))
(defun average (lis &optional (n 1))
(list (if lis (/ (apply '+ lis) (length lis)) nil)
(/ (length lis) (* 1.0 n))))
(defun uniform-ias (val)
(do ((temp (no-output (eval `(sdm context experiment))) (cdr temp)))
((null temp) nil)
(set-ia-fct (list (list (chunk-slot-value-fct (car temp) 'child)
(car temp) val)
(list (chunk-slot-value-fct (car temp) 'parent)
(car temp) val)
(list (chunk-slot-value-fct (car temp) 'context)
(car temp) val)
(list (chunk-slot-value-fct (car temp) 'role)
(car temp) val)))))
(defun reset-sent () (setf *sentence* *hold*))
(defun encode-script (name script variable)
(setf *vars* (cons variable *vars*))
(setf *assoc* (cons (list variable variable) *assoc*))
(eval `(add-dm (,name isa chunk) (,variable isa chunk)))
(mapcar #'(lambda (x) (encode-triple x name)) script))
(defun encode-triple (triple context)
(let* ((agent (encode-it (car triple) 'noun))
(relation (encode-it (cadr triple) 'verb))
(object (encode-it (caddr triple) 'noun))
(proposition (gentemp "PROP"))
(semantic-chunks
(eval `(add-dm (,proposition isa proposition context ,context)
(,(gentemp "Semantic-chunk") isa semantic-chunk child ,agent parent ,proposition
role agent referent ,context)
(,(gentemp "Semantic-chunk") isa semantic-chunk child ,relation parent ,proposition
role relation referent ,context)
(,(gentemp "Semantic-chunk") isa semantic-chunk child ,object parent ,proposition
role object referent ,context)))))
(eval `(set-ia (,agent ,proposition 10) (,relation ,proposition 10)
(,object ,proposition 10)))))
(defun encode-it (word type)
(cond ((assoc word *assoc*) (second (assoc word *assoc*)))
(t
(let ((idea (gentemp (string word))))
(setf *assoc* (cons (list word idea) *assoc*))
(eval `(add-dm (,word isa chunk)
(,idea isa chunk)
(,(gentemp "LEX") isa lex-entry type ,type word ,word meaning ,idea)))
idea))))
;to derive predictions for Reder(1982)
(defun do-experiment (study test sign time ret)
(let (hold) (reset) (eval `(sgp :v ,*v* :er t))
(spp retrieve-sentence :r 0.5)
(spp begin-comprehend :r 1.0)
(spp start-recognition :r 0.5)
(spp try-retrieval :r 0.5)
(spp try-plausibility :r 1.0)
(do ((temp study (cdr temp)))
((null temp) nil)
(setf *sentence* (car temp))
(setf *goal* 'goal)
(mod-chunk goal word nil type nil link nil link-type nil
task Comprehend past nil meaning nil)
(goal-focus goal)
(run)) (uniform-ias 6)
(do ((temp test (cdr temp))
(temp1 '(yes yes no yes no) (cdr temp1))
(temp2 '(.5 1 .5 1 1) (cdr temp2))
(result nil (cond ((equal *response* (car temp1)) (cons (- *time* hold) result))
(t (cons nil result)))))
((null temp) (reverse result))
(eval `(spp try-retrieval :r ,(- 1.5 (car temp2))))
(eval`(spp try-plausibility :r ,(car temp2)))
(cond ((and ret (equal (car temp2) 1))
(spp try-retrieval :r 1)(spp try-plausibility :r 0.5)(setf *plaus* t))
((equal (car temp2) .5) (setf *plaus* nil))
(t (setf *plaus* t)))
(setf *time* time)
(setf hold *time*)
(setf *sentence* (car temp))
(setf *goal* 'goal1)
(mod-chunk goal1 struct nil response Yes state Start struct-test nil word nil)
(goal-focus goal1)
(setf *hold* *sentence*)
(setf *retrieval* t)
(run))))
(defun run-n (study test time ret n plaus)
(let (result)
(do ((count 0 (1+ count))
(r1 nil (cond ((numberp (first result)) (cons (first result) r1)) (t r1)))
(r2 nil (cond ((numberp (second result)) (cons (second result) r2)) (t r2)))
(r3 nil (cond ((numberp (third result)) (cons (third result) r3)) (t r3)))
(r4 nil (cond ((numberp (fourth result)) (cons (fourth result) r4)) (t r4)))
(r5 nil (cond ((numberp (fifth result)) (cons (fifth result) r5)) (t r5))))
((equal count n) (plausibility (append (average r1 n) (average r2 n)
(average r3 n) (average r4 n)(average r5 n))
plaus ret))
(setf result (do-experiment study test nil time ret)))))
(defun plausibility (lis plausibility ret)
(list (first lis) (second lis) (third lis)
(cond (ret (+ (second lis)
(* plausibility (- 1 (second lis)))))
(t (* 1 plausibility)))
(fifth lis) (sixth lis) (seventh lis)(* 1 plausibility)
(ninth lis) 1))
(defun utility (results G slip)
(let* ((acc-pres (fourth results))
(acc-not (eighth results))
(mix-pres (+ (* acc-pres (- 1 slip)) (* (- 1 acc-pres) slip)))
(mix-not (+ (* acc-not (- 1 slip)) (* (- 1 acc-not) slip)))
(implaus (+ (* (tenth results) (- 1 slip)) (* (- 1 (tenth results)) slip)))
(time (/ (+ (third results) (seventh results) (ninth results) (ninth results)) 4))
(accuracy (/ (+ mix-pres mix-not implaus implaus) 4)))
; (print (list acc-pres acc-not mix-pres mix-not implaus time accuracy))
(- (* g accuracy) time)))
(defun prediction (n tnoise F rt ans intercept flail G plaus slip)
(setf slip (- 1 slip))
(setf *tnoise* tnoise)
(setf *myrt* rt) (setf *myans* ans) (setf *myf* f)
(setf *no* (- intercept .20))
(setf *yes* (- intercept .20))
(setf *flail* flail)
(let* ((d120a (run-n *study* *test* 120 t n plaus))
(d120b (run-n *study* *test* 120 nil n plaus))
(dif120(- (utility d120a G slip)
(utility d120b G slip)))
(e120 (/ 1 (+ 1 (exp (- (/ dif120 *tnoise*))))))
(d120 (mapcar #'(lambda (x y) (+ (* e120 x) (* (- 1 e120) y))) d120a d120b))
(d1200a (run-n *study* *test* 1200 t n plaus))
(d1200b (run-n *study* *test* 1200 nil n plaus))
(dif1200 (- (utility d1200a G slip)
(utility d1200b G slip)))
(e1200 (/ 1 (+ 1 (exp (- (/ dif1200 *tnoise*))))))
(d1200 (mapcar #'(lambda (x y) (+ (* e1200 x) (* (- 1 e1200) y))) d1200a d1200b))
(d5000a (run-n *study* *test* 5000 t n plaus))
(d5000b (run-n *study* *test* 5000 nil n plaus))
(dif5000 (- (utility d5000a G slip)
(utility d5000b G slip)))
(e5000 (/ 1 (+ 1 (exp (- (/ dif5000 *tnoise*))))))
(d5000 (mapcar #'(lambda (x y) (+ (* e5000 x) (* (- 1 e5000) y))) d5000a d5000b)))
; (list (report d120 (- 1 slip)) (report d1200 (- 1 slip)) (report d5000 (- 1 slip)))
(list (list (report-lat d120) (report-lat d1200) (report-lat d5000))
(list (report-prob d120 (- 1 slip)) (report-prob d1200 (- 1 slip)) (report-prob d5000 (- 1 slip))))
))
(defun report-lat (lis)
(list (first lis)
(third lis)
(fifth lis)
(seventh lis)
(ninth lis)))
(defun report-prob (lis slip)
(list (probability (second lis) slip)
(probability (fourth lis) slip)
(probability (sixth lis) slip)
(probability (eighth lis) slip)
(probability (tenth lis) slip)))
(defun probability (p slip) (+ (* p slip) (* (- 1 p) (- 1 slip))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; The ACT-R model
(clearall)
(setf *assoc* '((ate *eat*) (consumed *eat*)))
(eval `(sgp :era t :lf ,*myf* :bll .5 :rt ,*myrt* :ans ,*myans*))
(chunk-type parse word type link link-type task past meaning)
(chunk-type proposition context)
(chunk-type match-props agent relation object context referent check response)
(chunk-type struct)
(chunk-type lex-entry word type meaning)
(chunk-type semantic-chunk child parent role referent context)
(chunk-type syntactic-chunk child parent role referent context)
(chunk-type respond response parent)
(chunk-type response opposite)
(chunk-type associate proposition agent relation object)
(chunk-type find-referent meaning agent relation object)
(chunk-type match-up struct response state struct-test word)
(add-dm (goal isa parse task comprehend) (retrieve isa chunk)
(the-mouse isa chunk) (the-cat isa chunk) (switch isa chunk)
(goal1 isa match-up response yes state start) (args isa chunk)
(subject isa chunk) (role isa chunk) (start isa chunk)
(bob isa chunk) (*bob* isa chunk) (bobby isa chunk) (again isa chunk)
(dan-n isa lex-entry type noun word dan meaning *dan*)
(danny-n isa lex-entry type noun word danny meaning *dan*)
(dan isa chunk) (*dan* isa chunk) (danny isa chunk)
(bob-n isa lex-entry type noun word bob meaning *bob*)
(bobby-n isa lex-entry type noun word bobby meaning *bob*)
(tom isa chunk) (*tom* isa chunk) (tommy isa chunk)
(tom-n isa lex-entry type noun word tom meaning *tom*)
(tommy-n isa lex-entry type noun word tommy meaning *tom*)
(the-det isa lex-entry type det word the) (null isa chunk)
(the-cat-n isa lex-entry type noun word the-cat meaning *cat*)
(chased-v isa lex-entry type verb word chased meaning *chase*)
(petted-v isa lex-entry type verb word petted meaning *pet*)
(petted isa chunk) (*pet* isa chunk) (plaus isa chunk)
(eat-v isa lex-entry type verb word ate meaning *eat*)
(consume-v Isa lex-entry type verb word consumed meaning *eat*)
(ate isa chunk)(consumed isa chunk) (*eat* isa chunk)
(the-mouse-n isa lex-entry type noun word the-mouse meaning *mouse*)
(by-prep isa lex-entry type prep word by) (comprehend isa chunk)
(prep isa chunk) (by isa chunk) (pp isa chunk) (recognize isa chunk)
(first-np isa chunk) (form isa chunk) (noun-match isa chunk)
(yes isa response opposite no) (no isa response opposite yes)
(*cat* isa chunk) (*chase* isa chunk) (*mouse* isa chunk)
(was-aux isa lex-entry type aux word was) (subj-test isa chunk)
(was isa chunk) (aux isa chunk) (needs-subj isa chunk)
(mouse isa chunk) (eos isa chunk) (done isa chunk) (experiment isa chunk)
(np isa chunk) (vp isa chunk) (sent isa chunk) (agent isa chunk) (object isa chunk)
(relation isa chunk) (arg1 isa chunk) (arg2 isa chunk)(sentence1 isa chunk)
(chased isa chunk) (verb isa chunk) (aux-test isa chunk) (vp1 isa chunk)
(cat isa chunk) (noun isa chunk)(head isa chunk)
(det isa chunk)(the isa chunk))
(encode-script 'r-script
'((p1 entered the-restaurant high)
(the-hostess seated p1 low)
(p1 ordered the-meal high)
(the-waiter delivered the-meal low)
(p1 ate the-meal high)
(p1 paid the-waiter low)
(p1 thanked the-hostess low)
(p1 left the-restaurant high)) 'p1)
(encode-script 'l-script
'((p2 entered the-laundromat high)
(p2 sorted the-clothes low)
(p2 found the-washer low)
(the-washer cleaned the-clothes high)
(p2 moved the-clothes low )
(the-dryer dried the-clothes high)
(p2 collected the-clothes low)
(p2 left the-laudromat high)) 'p2)
(setf *study* '((Bob entered the-restaurant)
(Bob ordered the-meal)
(the-waiter delivered the-meal)
(Bob ate the-meal)))
(setf *test* '( (Bob entered the-restaurant)
(Bob ordered the-meal)
(Bob left the-restaurant)
(Bob paid the-waiter)
(Bob delivered the-meal)
))
(sdp :references 1000 :creation-time -10000)
(no-output (do ((props (sdm isa proposition) (cdr props)))
((null props) nil)
(eval `(sdp ,(car props) :references 1 :creation-time -10000))))
(goal-focus goal)
(p read-word
=goal>
isa parse
word nil
==>
!eval! (read-word))
(eval `(spp read-word :effort ,*read*))
;productions for parsing
(p retrieve-type
=goal>
isa parse
word =word
- word eos
type nil
=entry>
isa lex-entry
word =word
type =type
==>
=goal>
type =type)
(p np-no-sent
=goal>
isa parse
type noun
word =word
link nil
meaning nil
=lex>
isa lex-entry
word =word
meaning =mean
==>
=meaning>
isa proposition
=np>
isa struct
=sent>
isa struct
=semantic-chunk>
isa semantic-chunk
role agent
parent =meaning
child =mean
context experiment
=syntactic-chunk1>
isa syntactic-chunk
referent np
role head
child =word
parent =np
=syntactic-chunk2>
isa syntactic-chunk
referent sent
role arg1
child =np
parent =sent
=goal>
word nil
type nil
link =np
link-type np
meaning =meaning
)
(p np-vp
=goal>
isa parse
type noun
word =word
link =vp
link-type vp
meaning =meaning
=lex>
isa lex-entry
word =word
meaning =mean
==>
=semantic-chunk>
isa semantic-chunk
role object
child =mean
parent =meaning
context experiment
=np>
isa struct
=syntactic-chunk1>
isa syntactic-chunk
referent np
role head
child =word
parent =np
context sentence1
=syntactic-chunk2>
isa syntactic-chunk
referent vp
role arg2
child =np
parent =vp
context sentence1
=goal>
word nil
type nil
link =np
link-type np
)
(p np-pp
=goal>
isa parse
type noun
word =word
link =pp
link-type pp
meaning =meaning
=lex>
isa lex-entry
word =word
meaning =mean
==>
=semantic-chunk>
isa semantic-chunk
role agent
parent =meaning
child =mean
context experiment
=np>
isa struct
=syntactic-chunk1>
isa syntactic-chunk
referent np
role head
child =word
parent =np
=syntactic-chunk2>
isa syntactic-chunk
referent pp
role head
child =np
parent =pp
=goal>
word nil
type nil
link =np
link-type np
)
(p verb-attach
=goal>
isa parse
type verb
word =word
link =vp1
link-type vp1
meaning =meaning
=role1>
isa semantic-chunk
parent =meaning
role agent
child =noun
=syntactic-chunk>
isa syntactic-chunk
child =vp1
parent =parent
=lex>
isa lex-entry
word =word
meaning =mean
==>
=semantic-chunk>
isa semantic-chunk
role relation
parent =meaning
child =mean
context experiment
=role1>
role object
=syntactic-chunk2>
isa syntactic-chunk
referent vp1
role head
child =word
parent =vp1
context sentence1
=goal>
link =parent
link-type vp
type nil
word nil)
(p prep-sent
=goal>
isa parse
type prep
word =word
link =vp
link-type vp
==>
=prepp>
isa struct
=syntactic-chunk1>
isa syntactic-chunk
referent pp
role arg1
child =word
parent =prepp
context sentence1
=syntactic-chunk2>
isa syntactic-chunk
referent vp
role arg2
child =prepp
parent =vp
context sentence1
=goal>
word nil
type nil
link =prepp
link-type pp
)
(p verb-np
=goal>
isa parse
type verb
word =word
link =np
link-type np
meaning =meaning
=orole>
isa syntactic-chunk
child =np
parent =sent
=lex>
isa lex-entry
word =word
meaning =mean
==>
=semantic-chunk>
isa semantic-chunk
role relation
child =mean
parent =meaning
context experiment
=vp>
isa struct
=vp1>
isa struct
=syntactic-chunk1>
isa syntactic-chunk
referent vp1
role head
child =word
parent =vp1
context sentence1
=syntactic-chunk3>
isa syntactic-chunk
referent vp1
role arg1
child null
parent =vp1
context sentence1
=syntactic-chunk2>
isa syntactic-chunk
referent sent
role head
child =vp
parent =sent
context sentence1
=syntactic-chunk4>
isa syntactic-chunk
referent vp
role head
child =vp1
parent =vp
context sentence1
=goal>
link =vp
word nil
type nil
link-type vp)
(p aux-vp
=goal>
isa parse
type aux
word =word
link =np
link-type np
meaning =meaning
=orole>
isa syntactic-chunk
child =np
parent =sent
==>
=vp>
isa struct
=vp1>
isa struct
=syntactic-chunk1>
isa syntactic-chunk
referent vp1
role arg1
child =word
parent =vp1
context sentence1
=syntactic-chunk2>
isa syntactic-chunk
referent sent
role head
child =vp
parent =sent
context sentence1
=syntactic-chunk3>
isa syntactic-chunk
referent vp
role head
child =vp1
parent =vp
context sentence1
=goal>
word nil
type nil
link =vp1
link-type vp1
past =word)
; productions for trying to find a situational referent
(p complete
=goal>
isa parse
word eos
task comprehend
meaning =meaning
=semantic-chunk1>
isa semantic-chunk
parent =meaning
role agent
child =agent
=semantic-chunk2>
isa semantic-chunk
parent =meaning
role relation
child =relation
=semantic-chunk3>
isa semantic-chunk
parent =meaning
role object
child =object
==>
=newgoal>
isa find-referent
agent =agent
relation =relation
object =object
!focus-on! =newgoal)
(p Find-Referent
=goal>
isa find-referent
agent =agent
relation =relation
object =object
=proposition>
isa proposition
==>
=newgoal>
isa associate
proposition =proposition
agent =agent
relation =relation
object =object
!focus-on! =newgoal)
(p Associate
=goal>
isa associate
proposition =proposition
agent =agent
relation =relation
object =object
=proposition>
isa proposition
=semantic-chunk1>
isa semantic-chunk
parent =meaning
role agent
child =agent
context experiment
referent nil
=semantic-chunk2>
isa semantic-chunk
parent =meaning
role relation
child =relation
context experiment
referent nil
=semantic-chunk3>
isa semantic-chunk
parent =meaning
role object
child =object
context experiment
referent nil
==>
=semantic-chunk1>
referent =proposition
=semantic-chunk2>
referent =proposition
=semantic-chunk3>
referent =proposition
!pop!)
(p go-ahead
=goal>
isa find-referent
agent =agent
relation =relation
object =object
=semantic-chunk1>
isa semantic-chunk
parent =meaning
role agent
child =agent
context experiment
referent nil
=semantic-chunk2>
isa semantic-chunk
parent =meaning
role relation
child =relation
context experiment
referent nil
=semantic-chunk3>
isa semantic-chunk
parent =meaning
role object
child =object
context experiment
referent nil
==>
!pop!)
(spp go-ahead :r .5)
;productions that implement match of either proposition or situational referent
(p match-props
=goal>
isa parse
word eos
task recognize
meaning =meaning
=semantic-chunk1>
isa semantic-chunk
parent =meaning
child =agent
role agent
=semantic-chunk2>
isa semantic-chunk
parent =meaning
child =relation
role relation
=semantic-chunk3>
isa semantic-chunk
parent =meaning
child =object
role object
==>
=newgoal>
isa match-props
agent =agent
object =object
relation =relation
context experiment
!focus-on! =newgoal)
(p try-plausibility
=goal>
isa match-props
context =context
referent nil
!eval! *plaus*
=mrole>
isa semantic-chunk
context =context
referent =prop1
=role>
isa semantic-chunk
parent =prop1
referent =script
=prop>
isa proposition
context =script
==>
!eval! (setf *plaus* nil)
=goal>
referent =prop
context agent
response yes
check nil)
(p default-no
=goal>
isa match-props
==>
!eval! (setf *response* nil)
=newgoal>
isa respond
response nil
parent =goal
!focus-on! =newgoal)
(spp default-no :r .25)
(p try-retrieval
=goal>
isa match-props
context =context
relation =relation
referent nil
=semantic-chunk>
isa semantic-chunk
parent =proposition
role relation
context =context
referent =referent
!eval! *retrieval*
==>
=goal>
referent =proposition
check nil
context agent
response yes)
(p try-retrieval-again
=goal>
isa match-props
context =context
relation =relation
referent nil
=semantic-chunk>
isa semantic-chunk
parent =proposition
role relation
context =context
referent =referent
!eval! *retrieval*
==>
=goal>
referent =proposition
check nil
context agent
response yes)
(spp try-retrieval-again :r 0.75)
(p check-agent
=goal>
isa match-props
referent =referent
context agent
check nil
=semantic-chunk>
isa semantic-chunk
parent =referent
role agent
child =term
==>
=goal>
check =term)
(p checked-agent
=goal>
isa match-props
referent =referent
context agent
check =agent
agent =agent
==>
=goal>
check nil
context relation)
(p check-relation
=goal>
isa match-props
referent =referent
context relation
check nil
=semantic-chunk>
isa semantic-chunk
parent =referent
role relation
child =term
==>
=goal>
check =term)
(p checked-relation
=goal>
isa match-props
referent =referent
context relation
check =relation
relation =relation
==>
=goal>
check nil
context object)
(p check-object
=goal>
isa match-props
referent =referent
context object
check nil
=semantic-chunk>
isa semantic-chunk
parent =referent
role object
child =term
==>
=goal>
check =term)
(p checked-object
=goal>
isa match-props
referent =referent
context object
check =object
object =object
response =response
==>
=newgoal>
isa respond
response =response
parent =goal
!focus-on! =newgoal)
(p fail-check-agent
=goal>
isa match-props
context agent
check =object
!eval! (not (member =object *vars*))
==>
=goal>
check nil
context relation
response no
)
(EVAL `(spp fail-check-agent :r .5 :effort ,(+ 0.05 *mismatch*)))
(p variable-agent
=goal>
isa match-props
context agent
check =object
!eval! (member =object *vars*)
==>
=goal>
check nil
context relation
)
(p fail-check-relation
=goal>
isa match-props
context relation
check =object
!eval! (not (member =object *vars*))
==>
=goal>
check nil
context object
response no
)
(eval `(spp fail-check-relation :r .5 :effort ,(+ 0.05 *mismatch*)))
(p variable-relation
=goal>
isa match-props
context relation
check =object
!eval! (member =object *vars*)
==>
=goal>
check nil
context object)
(p fail-check-object
=goal>
isa match-props
context object
check =object
!eval! (not (member =object *vars*))
==>
=newgoal>
isa respond
response no
parent =goal
!focus-on! =newgoal)
(eval `(spp fail-check-object :r .5 :effort ,(+ 0.05 *mismatch*)))
(p variable-object
=goal>
isa match-props
context object
check =object
response =response
!eval! (member =object *vars*)
==>
=newgoal>
isa respond
response =response
parent =goal
!focus-on! =newgoal)
(p start-recognition
=goal>
isa match-up
state start
word nil
==>
!eval! (read-word))
(eval `(spp start-recognition :effort ,*encoding*))
;productions that choose between syntax matching and a comprehension strategy
(p retrieve-sentence
=goal>
isa match-up
state start
word =word
struct nil
=syntactic-chunk>
isa syntactic-chunk
role head
referent =type
child =word
parent =np
==>
=goal>
struct =np
struct-test =type)
(p begin-comprehend
=goal>
isa match-up
word =word
==>
!eval! (reset-sent)
=newgoal>
isa parse
task recognize
!eval! (setf *goal* =newgoal)
!focus-on! =newgoal)
;productions that implement syntactic matching
(p retrieve-again
=goal>
isa match-up
state start
word =word
struct =struct
- struct-test sent
=syntactic-chunk>
isa syntactic-chunk
child =struct
parent =parent
referent =type
==>
=goal>
struct =parent
struct-test =type)
(p retrieve-subject
=goal>
isa match-up
state start
struct =struct
struct-test sent
=syntactic-chunk0>
isa syntactic-chunk
referent sent
role head
child =vp
parent =struct
=syntactic-chunk1>
isa syntactic-chunk
referent sent
role arg1
child =subj
parent =struct
=syntactic-chunk2>
isa syntactic-chunk
referent np
role head
child =head
parent =subj
==>
=goal>
struct =vp
struct-test =head
state subj-test)
(p subjects-match
=goal>
isa match-up
state subj-test
struct-test =noun
word =noun
==>
=goal>
struct-test null
state aux-test
!eval! (read-word))
(eval `(spp subjects-match :effort ,*read*))
(p subjects-mismatch
=goal>
isa match-up
state subj-test
struct-test =noun
- word =noun
response =response
==>
=goal>
struct-test null
state aux-test
response no
!eval! (read-word))
(eval `(spp subjects-mismatch :effort ,*read*))
(p retrieve-aux
=goal>
isa match-up
state aux-test
struct-test null
struct =struct
=syntactic-chunk2>
isa syntactic-chunk
referent vp
role head
child =vp1
parent =struct
=syntactic-chunk3>
isa syntactic-chunk
referent vp1
role arg1
child =aux
parent =vp1
==>
=goal>
state aux
struct-test =aux)
(p aux-aux
=goal>
isa match-up
state aux
word =word
struct-test =word
struct =struct
==>
!eval! (read-word)
=goal>
struct-test null)
(eval `(spp aux-aux :effort ,*read*))
(p retrieve-verb
=goal>
isa match-up
state aux
- word was
struct-test null
response =response
word =struct
==>
=newgoal>
isa respond
response =response
parent =goal
!focus-on! =newgoal)
(p aux-noaux-yes
=goal>
isa match-up
state aux
- word was
struct-test was
response no
==>
=goal>
response yes
struct-test null)
(eval `(spp aux-noaux-yes :effort ,(+ 0.05 *mismatch*)))
(p noaux-aux-yes
=goal>
isa match-up
state aux
word was
struct-test null
struct =struct
response no
==>
!eval! (read-word)
=goal>
response yes)
(eval `(spp noaux-aux-yes :effort ,(+ *mismatch* *read*)))
(p aux-noaux-no
=goal>
isa match-up
state aux
- word was
struct-test was
response yes
struct =struct
=syntactic-chunk1>
isa syntactic-chunk
referent vp
parent =struct
child =vp1
role head
=syntactic-chunk2>
isa syntactic-chunk
referent vp1
parent =vp1
child =head
role head
==>
=goal>
response no
struct-test null)
(eval `(spp aux-noaux-no :effort ,(+ 0.05 *mismatch*)))
(p noaux-aux-no
=goal>
isa match-up
state aux
word was
struct-test null
struct =struct
response yes
=syntactic-chunk1>
isa syntactic-chunk
referent vp
parent =struct
child =vp1
role head
=syntactic-chunk2>
isa syntactic-chunk
referent vp1
parent =vp1
child =head
role head
==>
!eval! (read-word)
=goal>
response no)
(eval `(spp noaux-aux-no :effort ,(+ *mismatch* *read*)))
;response generation productions
(p respond-yes
=goal>
isa respond
response yes
==>
!eval! (setf *response* 'yes)
!output! yes
!pop!)
(eval `(spp respond-yes :effort ,*yes*))
(p respond-no
=goal>
isa respond
response no
!eval! (not *plaus*)
==>
!eval! (setf *response* 'no)
!output! no
!pop!)
(eval `(spp respond-no :effort ,*no*))
(p switch-plausibility
=goal>
isa respond
- response yes
parent =newgoal
!eval! (and *plaus* *retrieval*)
=newgoal>
isa match-props
==>
!eval! (setf *retrieval* nil)
=newgoal>
context experiment
referent nil
check nil
response nil
!focus-on! =newgoal)
(spp switch-plausibility :r 1.0)
(p respond-no-ANYWAYS
=goal>
isa respond
response no
!eval! *plaus*
==>
!eval! (setf *response* 'no)
!output! no
!pop!)
(eval `(spp respond-no-anyways :effort ,*no* :R 0.95))
(p guess-no
=goal>
isa respond
response nil
!eval! (not *plaus*)
==>
!eval! (setf *response* 'no)
!output! no
!pop!)
(eval `(spp guess-no :effort ,(+ *flail* *no*)))
(p guess-yes
=goal>
isa respond
response nil
!eval! (not *plaus*)
==>
!eval! (setf *response* 'yes)
!output! yes
!pop!)
(eval `(spp guess-yes :effort ,(+ *flail* *yes*)))