;;;<pre><xmp>
;;;===============================================================================
;;;
;;;  Story-Mapping Model
;;;
;;;  Dario D. Salvucci & John R. Anderson
;;;  "Integrating Analogical Mapping and General Problem Solving:
;;;   The Path-Mapping Theory"
;;;

;;;-------------------------------------------------------------------------------
;;;
;;;  Parameters
;;;

(defparameter *estimated-similar-match* .99)
(defparameter *estimated-different-match* .83)

(defparameter *estimated-memorize-s1-2s* .95)
(defparameter *estimated-stop-memorize* .96)
(defparameter *estimated-skip-read-s2* .95)
(defparameter *estimated-give-up-search-1s* .87)
(defparameter *estimated-intro-encoding-time* 3.0)
(defparameter *estimated-encoding-time* .300)
(defparameter *estimated-keying-time* .300)
(defparameter *estimated-production-strength* 5)

;;;-------------------------------------------------------------------------------
;;;
;;;  Setup Code
;;;

(defparameter *condition* 'one-story)
(defparameter *result* nil)
(defparameter *results* nil)

(defparameter *stimulus* nil)
(defparameter *conditions* '(one-story two-story))

(defparameter *v* nil)
(defparameter *runs* 10)


(defstruct data-story
  (correct nil)
  (times nil)
  (gazes nil)
  (transitions nil)
  (key-times nil)
  (key-before-23 nil))

(defparameter *data-story* 
  (make-data-story :correct '(.85 .73 .99 .94)
             :times '((14.4 14.4 6.7 6.6)
                      (12.9 18.3 12.2 14.5))
             :gazes '((4.5 6.3 3.8)
                      (2.4 2.5 1.5)
                      (3.1 6.2 4.6)
                      (2.6 4.1 2.4 2.7 3.9 2.9))
             :transitions '(#2a((0 .92 .08) (.41 0 .59) (.18 .82 0))
                            #2a((0 .89 .11) (.30 0 .70) (.15 .85 0))
                            #2a((0 .39 .10 .22 .21 .09) (.26 0 .27 .04 .27 .16)
                                (.06 .33 0 .05 .21 .35) (.33 .25 .05 0 .33 .04)
                                (.08 .41 .10 .14 0 .26) (.07 .23 .29 .08 .33 0)))
             :key-times '((.51 .80 .90)
                          (.52 .79 .92))
             :key-before-23 '(.18 .07)))



(defparameter *stimuli-story* '
(
 (1
  (((john isa person story s1 pos i1) (got-1 isa parent story s1 pos i1)
    (s1-1 isa target-role parent got-1 parent-type got slot got-agent
                        child john child-type person))
   ((larry isa person story s1 pos i2) (unpacked-1 isa parent story s1 pos i2)
    (s1-2 isa target-role parent unpacked-1 parent-type unpacked slot unpacked-agent
                        child larry child-type person))
   ((kurt isa person story s1 pos i3) (planned-1 isa parent story s1 pos i3)
    (s1-3 isa target-role parent planned-1 parent-type planned slot planned-agent
                        child kurt child-type person)))
  (((jen isa person story s2 pos i1) (obtained-1 isa parent story s2 pos i1)
    (s2-1 isa source-role parent obtained-1 parent-type obtained slot obtained-agent
                        child jen child-type person))
   ((lori isa person story s2 pos i2) (took-out-1 isa parent story s2 pos i2)
    (s2-2 isa source-role parent took-out-1 parent-type took-out slot took-out-agent
                        child lori child-type person))
   ((kate isa person story s2 pos i3) (chose-1 isa parent story s2 pos i3)
    (s2-3 isa source-role parent chose-1 parent-type chose slot chose-agent
                        child kate child-type person))))
 (2
  (((kurt isa person story s1 pos i1) (prepared-1 isa parent story s1 pos i1)
    (s1-1 isa target-role parent prepared-1 parent-type prepared slot prepared-agent
                        child kurt child-type person))
   ((john isa person story s1 pos i2) (walked-to-1 isa parent story s1 pos i2)
    (s1-2 isa target-role parent walked-to-1 parent-type walked-to slot walked-to-agent
                        child john child-type person))
   ((larry isa person story s1 pos i3) (paid-for-1 isa parent story s1 pos i3)
    (s1-3 isa target-role parent paid-for-1 parent-type paid-for slot paid-for-agent
                        child larry child-type person)))
  (((kate isa person story s2 pos i1) (set-1 isa parent story s2 pos i1)
    (s2-1 isa source-role parent set-1 parent-type set slot set-agent
                        child kate child-type person))
   ((jen isa person story s2 pos i2) (drove-to-1 isa parent story s2 pos i2)
    (s2-2 isa source-role parent drove-to-1 parent-type drove-to slot drove-to-agent
                        child jen child-type person))
   ((lori isa person story s2 pos i3) (bought-1 isa parent story s2 pos i3)
    (s2-3 isa source-role parent bought-1 parent-type bought slot bought-agent
                        child lori child-type person))))
 (3
  (((larry isa person story s1 pos i1) (carried-1 isa parent story s1 pos i1)
    (s1-1 isa target-role parent carried-1 parent-type carried slot carried-agent
                        child larry child-type person))
   ((kurt isa person story s1 pos i2) (placed-1 isa parent story s1 pos i2)
    (s1-2 isa target-role parent placed-1 parent-type placed slot placed-agent
                        child kurt child-type person))
   ((john isa person story s1 pos i3) (cleaned-1 isa parent story s1 pos i3)
    (s1-3 isa target-role parent cleaned-1 parent-type cleaned slot cleaned-agent
                        child john child-type person)))
  (((jen isa person story s2 pos i1) (cleared-1 isa parent story s2 pos i1)
    (s2-1 isa source-role parent cleared-1 parent-type cleared slot cleared-agent
                        child jen child-type person))
   ((lori isa person story s2 pos i2) (brought-1 isa parent story s2 pos i2)
    (s2-2 isa source-role parent brought-1 parent-type brought slot brought-agent
                        child lori child-type person))
   ((kate isa person story s2 pos i3) (planted-1 isa parent story s2 pos i3)
    (s2-3 isa source-role parent planted-1 parent-type planted slot planted-agent
                        child kate child-type person))))
 (4
  (((larry isa person story s1 pos i1) (rested-on-1 isa parent story s1 pos i1)
    (s1-1 isa target-role parent rested-on-1 parent-type rested-on slot rested-on-agent
                        child larry child-type person))
   ((kurt isa person story s1 pos i2) (prepared-1 isa parent story s1 pos i2)
    (s1-2 isa target-role parent prepared-1 parent-type prepared slot prepared-agent
                        child kurt child-type person))
   ((john isa person story s1 pos i3) (collected-1 isa parent story s1 pos i3)
    (s1-3 isa target-role parent collected-1 parent-type collected slot collected-agent
                        child john child-type person)))
  (((kate isa person story s2 pos i1) (readied-1 isa parent story s2 pos i1)
    (s2-1 isa source-role parent readied-1 parent-type readied slot readied-agent
                        child kate child-type person))
   ((jen isa person story s2 pos i2) (gathered-1 isa parent story s2 pos i2)
    (s2-2 isa source-role parent gathered-1 parent-type gathered slot gathered-agent
                        child jen child-type person))
   ((lori isa person story s2 pos i3) (slept-on-1 isa parent story s2 pos i3)
    (s2-3 isa source-role parent slept-on-1 parent-type slept-on slot slept-on-agent
                        child lori child-type person))))
 (5
  (((jen isa person story s1 pos i1) (fell-to-1 isa parent story s1 pos i1)
    (s1-1 isa target-role parent fell-to-1 parent-type fell-to slot fell-to-agent
                        child jen child-type person))
   ((lori isa person story s1 pos i2) (broke-1 isa parent story s1 pos i2)
    (s1-2 isa target-role parent broke-1 parent-type broke slot broke-agent
                        child lori child-type person))
   ((kate isa person story s1 pos i3) (phoned-1 isa parent story s1 pos i3)
    (s1-3 isa target-role parent phoned-1 parent-type phoned slot phoned-agent
                        child kate child-type person)))
  (((john isa person story s2 pos i1) (called-1 isa parent story s2 pos i1)
    (s2-1 isa source-role parent called-1 parent-type called slot called-agent
                        child john child-type person))
   ((larry isa person story s2 pos i2) (ran-into-1 isa parent story s2 pos i2)
    (s2-2 isa source-role parent ran-into-1 parent-type ran-into slot ran-into-agent
                        child larry child-type person))
   ((kurt isa person story s2 pos i3) (sprained-1 isa parent story s2 pos i3)
    (s2-3 isa source-role parent sprained-1 parent-type sprained slot sprained-agent
                        child kurt child-type person))))
 (6
  (((jen isa person story s1 pos i1) (completed-1 isa parent story s1 pos i1)
    (s1-1 isa target-role parent completed-1 parent-type completed slot completed-agent
                        child jen child-type person))
   ((lori isa person story s1 pos i2) (slept-on-1 isa parent story s1 pos i2)
    (s1-2 isa target-role parent slept-on-1 parent-type slept-on slot slept-on-agent
                        child lori child-type person))
   ((kate isa person story s1 pos i3) (played-1 isa parent story s1 pos i3)
    (s1-3 isa target-role parent played-1 parent-type played slot played-agent
                        child kate child-type person)))
  (((john isa person story s2 pos i1) (rested-on-1 isa parent story s2 pos i1)
    (s2-1 isa source-role parent rested-on-1 parent-type rested-on slot rested-on-agent
                        child john child-type person))
   ((larry isa person story s2 pos i2) (toyed-with-1 isa parent story s2 pos i2)
    (s2-2 isa source-role parent toyed-with-1 parent-type toyed-with slot toyed-with-agent
                        child larry child-type person))
   ((kurt isa person story s2 pos i3) (finished-1 isa parent story s2 pos i3)
    (s2-3 isa source-role parent finished-1 parent-type finished slot finished-agent
                        child kurt child-type person))))
 (7
  (((kate isa person story s1 pos i1) (stole-1 isa parent story s1 pos i1)
    (s1-1 isa target-role parent stole-1 parent-type stole slot stole-agent
                        child kate child-type person))
   ((jen isa person story s1 pos i2) (broke-1 isa parent story s1 pos i2)
    (s1-2 isa target-role parent broke-1 parent-type broke slot broke-agent
                        child jen child-type person))
   ((lori isa person story s1 pos i3) (whined-to-1 isa parent story s1 pos i3)
    (s1-3 isa target-role parent whined-to-1 parent-type whined-to slot whined-to-agent
                        child lori child-type person)))
  (((john isa person story s2 pos i1) (grabbed-1 isa parent story s2 pos i1)
    (s2-1 isa source-role parent grabbed-1 parent-type grabbed slot grabbed-agent
                        child john child-type person))
   ((larry isa person story s2 pos i2) (crushed-1 isa parent story s2 pos i2)
    (s2-2 isa source-role parent crushed-1 parent-type crushed slot crushed-agent
                        child larry child-type person))
   ((kurt isa person story s2 pos i3) (cried-to-1 isa parent story s2 pos i3)
    (s2-3 isa source-role parent cried-to-1 parent-type cried-to slot cried-to-agent
                        child kurt child-type person))))
 (8
  (((lori isa person story s1 pos i1) (purchased-1 isa parent story s1 pos i1)
    (s1-1 isa target-role parent purchased-1 parent-type purchased slot purchased-agent
                        child lori child-type person))
   ((kate isa person story s1 pos i2) (prepared-1 isa parent story s1 pos i2)
    (s1-2 isa target-role parent prepared-1 parent-type prepared slot prepared-agent
                        child kate child-type person))
   ((jen isa person story s1 pos i3) (talked-to-1 isa parent story s1 pos i3)
    (s1-3 isa target-role parent talked-to-1 parent-type talked-to slot talked-to-agent
                        child jen child-type person)))
  (((john isa person story s2 pos i1) (bought-1 isa parent story s2 pos i1)
    (s2-1 isa source-role parent bought-1 parent-type bought slot bought-agent
                        child john child-type person))
   ((larry isa person story s2 pos i2) (organized-1 isa parent story s2 pos i2)
    (s2-2 isa source-role parent organized-1 parent-type organized slot organized-agent
                        child larry child-type person))
   ((kurt isa person story s2 pos i3) (spoke-with-1 isa parent story s2 pos i3)
    (s2-3 isa source-role parent spoke-with-1 parent-type spoke-with slot spoke-with-agent
                        child kurt child-type person))))
 (9
  (((john isa person story s1 pos i1) (lifted-1 isa parent story s1 pos i1)
    (s1-1 isa target-role parent lifted-1 parent-type lifted slot lifted-agent
                        child john child-type person))
   ((larry isa person story s1 pos i2) (pulled-1 isa parent story s1 pos i2)
    (s1-2 isa target-role parent pulled-1 parent-type pulled slot pulled-agent
                        child larry child-type person))
   ((kurt isa person story s1 pos i3) (ran-on-1 isa parent story s1 pos i3)
    (s1-3 isa target-role parent ran-on-1 parent-type ran-on slot ran-on-agent
                        child kurt child-type person)))
  (((jen isa person story s2 pos i1) (picked-up-1 isa parent story s2 pos i1)
    (s2-1 isa source-role parent picked-up-1 parent-type picked-up slot picked-up-agent
                        child jen child-type person))
   ((lori isa person story s2 pos i2) (tugged-1 isa parent story s2 pos i2)
    (s2-2 isa source-role parent tugged-1 parent-type tugged slot tugged-agent
                        child lori child-type person))
   ((kate isa person story s2 pos i3) (walked-on-1 isa parent story s2 pos i3)
    (s2-3 isa source-role parent walked-on-1 parent-type walked-on slot walked-on-agent
                        child kate child-type person))))
 (10
  (((larry isa person story s1 pos i1) (started-1 isa parent story s1 pos i1)
    (s1-1 isa target-role parent started-1 parent-type started slot started-agent
                        child larry child-type person))
   ((kurt isa person story s1 pos i2) (added-to-1 isa parent story s1 pos i2)
    (s1-2 isa target-role parent added-to-1 parent-type added-to slot added-to-agent
                        child kurt child-type person))
   ((john isa person story s1 pos i3) (finished-1 isa parent story s1 pos i3)
    (s1-3 isa target-role parent finished-1 parent-type finished slot finished-agent
                        child john child-type person)))
  (((lori isa person story s2 pos i1) (began-1 isa parent story s2 pos i1)
    (s2-1 isa source-role parent began-1 parent-type began slot began-agent
                        child lori child-type person))
   ((kate isa person story s2 pos i2) (put-on-1 isa parent story s2 pos i2)
    (s2-2 isa source-role parent put-on-1 parent-type put-on slot put-on-agent
                        child kate child-type person))
   ((jen isa person story s2 pos i3) (completed-1 isa parent story s2 pos i3)
    (s2-3 isa source-role parent completed-1 parent-type completed slot completed-agent
                        child jen child-type person))))
 (11
  (((kurt isa person story s1 pos i1) (dodged-1 isa parent story s1 pos i1)
    (s1-1 isa target-role parent dodged-1 parent-type dodged slot dodged-agent
                        child kurt child-type person))
   ((john isa person story s1 pos i2) (tossed-1 isa parent story s1 pos i2)
    (s1-2 isa target-role parent tossed-1 parent-type tossed slot tossed-agent
                        child john child-type person))
   ((larry isa person story s1 pos i3) (ran-on-1 isa parent story s1 pos i3)
    (s1-3 isa target-role parent ran-on-1 parent-type ran-on slot ran-on-agent
                        child larry child-type person)))
  (((jen isa person story s2 pos i1) (threw-1 isa parent story s2 pos i1)
    (s2-1 isa source-role parent threw-1 parent-type threw slot threw-agent
                        child jen child-type person))
   ((lori isa person story s2 pos i2) (jogged-on-1 isa parent story s2 pos i2)
    (s2-2 isa source-role parent jogged-on-1 parent-type jogged-on slot jogged-on-agent
                        child lori child-type person))
   ((kate isa person story s2 pos i3) (avoided-1 isa parent story s2 pos i3)
    (s2-3 isa source-role parent avoided-1 parent-type avoided slot avoided-agent
                        child kate child-type person))))
 (12
  (((kurt isa person story s1 pos i1) (arranged-1 isa parent story s1 pos i1)
    (s1-1 isa target-role parent arranged-1 parent-type arranged slot arranged-agent
                        child kurt child-type person))
   ((john isa person story s1 pos i2) (collected-1 isa parent story s1 pos i2)
    (s1-2 isa target-role parent collected-1 parent-type collected slot collected-agent
                        child john child-type person))
   ((larry isa person story s1 pos i3) (spoke-to-1 isa parent story s1 pos i3)
    (s1-3 isa target-role parent spoke-to-1 parent-type spoke-to slot spoke-to-agent
                        child larry child-type person)))
  (((lori isa person story s2 pos i1) (talked-to-1 isa parent story s2 pos i1)
    (s2-1 isa source-role parent talked-to-1 parent-type talked-to slot talked-to-agent
                        child lori child-type person))
   ((kate isa person story s2 pos i2) (prepared-1 isa parent story s2 pos i2)
    (s2-2 isa source-role parent prepared-1 parent-type prepared slot prepared-agent
                        child kate child-type person))
   ((jen isa person story s2 pos i3) (gathered-1 isa parent story s2 pos i3)
    (s2-3 isa source-role parent gathered-1 parent-type gathered slot gathered-agent
                        child jen child-type person))))
 (13
  (((kate isa person story s1 pos i1) (gathered-1 isa parent story s1 pos i1)
    (s1-1 isa target-role parent gathered-1 parent-type gathered slot gathered-agent
                        child kate child-type person))
   ((jen isa person story s1 pos i2) (set-up-1 isa parent story s1 pos i2)
    (s1-2 isa target-role parent set-up-1 parent-type set-up slot set-up-agent
                        child jen child-type person))
   ((lori isa person story s1 pos i3) (typed-in-1 isa parent story s1 pos i3)
    (s1-3 isa target-role parent typed-in-1 parent-type typed-in slot typed-in-agent
                        child lori child-type person)))
  (((kurt isa person story s2 pos i1) (wrote-in-1 isa parent story s2 pos i1)
    (s2-1 isa source-role parent wrote-in-1 parent-type wrote-in slot wrote-in-agent
                        child kurt child-type person))
   ((john isa person story s2 pos i2) (collected-1 isa parent story s2 pos i2)
    (s2-2 isa source-role parent collected-1 parent-type collected slot collected-agent
                        child john child-type person))
   ((larry isa person story s2 pos i3) (put-up-1 isa parent story s2 pos i3)
    (s2-3 isa source-role parent put-up-1 parent-type put-up slot put-up-agent
                        child larry child-type person))))
 (14
  (((lori isa person story s1 pos i1) (sawed-1 isa parent story s1 pos i1)
    (s1-1 isa target-role parent sawed-1 parent-type sawed slot sawed-agent
                        child lori child-type person))
   ((kate isa person story s1 pos i2) (blew-on-1 isa parent story s1 pos i2)
    (s1-2 isa target-role parent blew-on-1 parent-type blew-on slot blew-on-agent
                        child kate child-type person))
   ((jen isa person story s1 pos i3) (hammered-1 isa parent story s1 pos i3)
    (s1-3 isa target-role parent hammered-1 parent-type hammered slot hammered-agent
                        child jen child-type person)))
  (((larry isa person story s2 pos i1) (whistled-1 isa parent story s2 pos i1)
    (s2-1 isa source-role parent whistled-1 parent-type whistled slot whistled-agent
                        child larry child-type person))
   ((kurt isa person story s2 pos i2) (beat-1 isa parent story s2 pos i2)
    (s2-2 isa source-role parent beat-1 parent-type beat slot beat-agent
                        child kurt child-type person))
   ((john isa person story s2 pos i3) (bowed-1 isa parent story s2 pos i3)
    (s2-3 isa source-role parent bowed-1 parent-type bowed slot bowed-agent
                        child john child-type person))))
 (15
  (((jen isa person story s1 pos i1) (monitored-1 isa parent story s1 pos i1)
    (s1-1 isa target-role parent monitored-1 parent-type monitored slot monitored-agent
                        child jen child-type person))
   ((lori isa person story s1 pos i2) (gripped-1 isa parent story s1 pos i2)
    (s1-2 isa target-role parent gripped-1 parent-type gripped slot gripped-agent
                        child lori child-type person))
   ((kate isa person story s1 pos i3) (extracted-1 isa parent story s1 pos i3)
    (s1-3 isa target-role parent extracted-1 parent-type extracted slot extracted-agent
                        child kate child-type person)))
  (((kurt isa person story s2 pos i1) (watched-1 isa parent story s2 pos i1)
    (s2-1 isa source-role parent watched-1 parent-type watched slot watched-agent
                        child kurt child-type person))
   ((john isa person story s2 pos i2) (held-1 isa parent story s2 pos i2)
    (s2-2 isa source-role parent held-1 parent-type held slot held-agent
                        child john child-type person))
   ((larry isa person story s2 pos i3) (removed-1 isa parent story s2 pos i3)
    (s2-3 isa source-role parent removed-1 parent-type removed slot removed-agent
                        child larry child-type person))))
 (16
  (((kate isa person story s1 pos i1) (gathered-1 isa parent story s1 pos i1)
    (s1-1 isa target-role parent gathered-1 parent-type gathered slot gathered-agent
                        child kate child-type person))
   ((jen isa person story s1 pos i2) (assembled-1 isa parent story s1 pos i2)
    (s1-2 isa target-role parent assembled-1 parent-type assembled slot assembled-agent
                        child jen child-type person))
   ((lori isa person story s1 pos i3) (painted-1 isa parent story s1 pos i3)
    (s1-3 isa target-role parent painted-1 parent-type painted slot painted-agent
                        child lori child-type person)))
  (((larry isa person story s2 pos i1) (collected-1 isa parent story s2 pos i1)
    (s2-1 isa source-role parent collected-1 parent-type collected slot collected-agent
                        child larry child-type person))
   ((kurt isa person story s2 pos i2) (built-1 isa parent story s2 pos i2)
    (s2-2 isa source-role parent built-1 parent-type built slot built-agent
                        child kurt child-type person))
   ((john isa person story s2 pos i3) (stained-1 isa parent story s2 pos i3)
    (s2-3 isa source-role parent stained-1 parent-type stained slot stained-agent
                        child john child-type person))))
))


(defparameter *possible-r-pairs-story*
  '((0.5 1) (0.4297569854495891 0.99) (0.3622329853874057 0.98) (0.2997417054096622 0.97)
    (0.24390820414711487 0.96) (0.19557031749304296 0.95) (0.15485012369050266 0.94)
    (0.12132960631340796 0.93) (0.09425604446442083 0.92) (0.07272368910745285 0.91)
    (0.055807219207169835 0.9) (0.042644771477401526 0.89) (0.03247996956598456 0.88)
    (0.024675599285335057 0.87) (0.0187102188088448 0.86) (0.014166035876688418 0.85)
    (0.010713457055882388 0.84) (0 0)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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 "Story-Mapping Model" 2)
        
        (:new-para)

        (:table)
        
        (:table)
        "Similar-chunk mismatch: "   (:string :sy *estimated-similar-match* .1)  (:new-row)
        "Dissimilar-chunk mismatch: "   (:string :sy *estimated-different-match* 1.7)  (:new-row)
        "Probability of memorizing story 1, two-story:" (:string :sy *estimated-memorize-s1-2s* .20) (:new-row)
        "Probability of stopping memorization after successful recall:" (:string :sy *estimated-stop-memorize* .24) (:new-row) 
        "Probability of not reading the target story:" (:string :sy *estimated-skip-read-s2* .20) (:new-row) 
        "Probability of giving up search, one-story:" (:string :sy *estimated-give-up-search-1s* .02) (:new-row) 
        "Time for introduction encoding, sec:" (:string :sy *estimated-intro-encoding-time* 3.0) (:new-row) 
        "Time for relation encoding, sec:" (:string :sy *estimated-encoding-time* 0.3) (:new-row) 
        "Time for typing one character, sec:" (:string :sy *estimated-keying-time* 0.3) (:new-row) 
        "Production strength:" (:string :sy *estimated-production-strength* 5) (:new-row) 
        "Nunber of Runs (1-100): " (:string :sy *runs* 5) 
         
        (:table-end)
        (:table)
        (:checkbox "Trace" :sy *v*  nil)         
        (:table-end)
       (:table-end)
         
        
        (:new-para)
        (:button "Show Experiment Results" "(output-tables-story *data-story* nil)")
       (:new-para)
       (:button "Run model" "  (if  (and (numberp *runs*) 
                                         (numberp *estimated-memorize-s1-2s*)
                                         (numberp *estimated-stop-memorize*)
                                         (numberp *estimated-skip-read-s2*)
                                         (numberp *estimated-give-up-search-1s*)
                                         (numberp *estimated-intro-encoding-time*)
                                         (numberp *estimated-encoding-time*)
                                         (numberp *estimated-keying-time*)
                                         (numberp *estimated-production-strength*)
                                         (numberp *estimated-different-match*)
                                         (numberp *estimated-similar-match*))
                                 (if (and (>= *estimated-memorize-s1-2s* 0) 
                                          (<= *estimated-memorize-s1-2s* .5)
                                          (>= *estimated-stop-memorize* 0) 
                                          (<= *estimated-stop-memorize* .5)
                                          (>= *estimated-skip-read-s2* 0) 
                                          (<= *estimated-skip-read-s2* .5)
                                          (>= *estimated-give-up-search-1s* 0) 
                                          (<= *estimated-give-up-search-1s* .5))
                                   (progn 
                                    (setf *estimated-different-match* (mismatch->similarity-story *estimated-different-match*))
                                    (setf *estimated-similar-match* (mismatch->similarity-story *estimated-similar-match*))
                                    (setf *estimated-stop-memorize* (probability->r *estimated-stop-memorize*)) 
                                    (setf *estimated-memorize-s1-2s* (probability->r *estimated-memorize-s1-2s*)) 
                                    (setf *estimated-skip-read-s2* (probability->r *estimated-skip-read-s2*)) 
                                    (setf *estimated-give-up-search-1s* (probability->r *estimated-give-up-search-1s*)) 
                                    
                                    (rr-story (min 100 (max 1 *runs*)) ))
                                   (format *standard-output* \"Probabilities must be in the range of 0 - .5.\"))
                                 (format *standard-output* \"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 5 runs of the model" (:new-line)
        "- The trace of 1 run is about 200k (150 pages)"
        (:new-para)))


(defun mismatch->similarity-story (mm)
  (- 1 (/ mm 10)))

(defun probability->r (p)
  (let ((best-diff 2) (best-r 1))
    (dolist (pair *possible-r-pairs-story*)
      (let ((diff (abs (- p (first pair)))))
        (when (< diff best-diff)
          (setf best-diff diff
                best-r (second pair)))))
    best-r))

(defun all-pairs-story (lst)
  (when lst
    (append (mapcar #'(lambda (x) (list (first lst) x)) (rest lst))
            (all-pairs-story (rest lst)))))

(defun my-set-similarities-story (pairs value)
  (dolist (pair pairs)
    (set-similarities-fct (list (list (first pair) (second pair) value)))))


;;;-------------------------------------------------------------------------------
;;;
;;;  Running and Analysis Routines
;;;


(defun my/-story (x y) (if (zerop y) 0 (/ x y)))

(defun print-tabbed-story (string &rest args)
  (apply #'format (append (list *standard-output* (substitute #\Tab #\Space string)) args)))

(defun sm-invert-story (matrix)
  (cond ((null matrix) nil)
        ((null (first matrix)) nil)
        (t (cons (mapcar #'first matrix) (sm-invert-story (mapcar #'rest matrix))))))

(defun sm-average-story (lst)
  (my/-story (apply #'+ lst) (length lst)))

(defun sm-average-transition-matrices-story (lst)
  (let* ((ni (array-dimension (first lst) 0))
         (nj (array-dimension (first lst) 1))
         (array (make-array (list ni nj) :initial-element 0)))
    (dotimes (i ni)
      (dotimes (j nj)
        (dolist (matrix lst)
          (incf (aref array i j) (aref matrix i j))))
      (let ((sum 0))
        (dotimes (j nj) (incf sum (aref array i j)))
        (dotimes (j nj) (setf (aref array i j) (my/-story (aref array i j) sum)))))
    array))

(defun collapse-trace-story (trace)
  (cond ((null trace) nil)
        ((equalp (first (first trace)) (first (second trace)))
         (collapse-trace-story (cons (first trace) (rest (rest trace)))))
        (t (cons (first trace) (collapse-trace-story (rest trace))))))


(defun trace-study-phase-story (trace)
  (cond ((null trace) nil)
        ((equalp (first (first trace)) 'ok) (list (first trace)))
        (t (cons (first trace) (trace-study-phase-story (rest trace))))))

(defun trace-mapping-phase-story (trace)
  (cond ((null trace) nil)
        ((equalp (first (first trace)) 'ok) (rest trace))
        (t (trace-mapping-phase-story (rest trace)))))

(defun result-adjacency-story (result)
  (if (member (second result) '(1 2 7 8 9 10 15 16)) t nil))

(defun result-times-story (result)
  (let* ((trace (third result))
         (oks (remove-if-not #'(lambda (tuple) (equalp (first tuple) 'ok)) trace)))
    (list (second (first oks))
          (- (second (second oks)) (second (first oks))))))

(defun result-correct-story (result)
  (let* ((trace (third result))
         (keys (remove-if-not #'(lambda (tuple) (equalp (first tuple) 'type)) trace))
         (response (mapcar #'third keys)))
    (case (second result)
      (1 (equalp response '(john larry kurt)))
      (2 (equalp response '(kurt john larry)))
      (3 (equalp response '(john larry kurt)))
      (4 (equalp response '(kurt john larry)))
      (5 (equalp response '(kate jen lori)))
      (6 (equalp response '(lori kate jen)))
      (7 (equalp response '(kate jen lori)))
      (8 (equalp response '(lori kate jen)))
      (9 (equalp response '(john larry kurt)))
      (10 (equalp response '(larry kurt john)))
      (11 (equalp response '(john larry kurt)))
      (12 (equalp response '(larry kurt john)))
      (13 (equalp response '(lori kate jen)))
      (14 (equalp response '(kate jen lori)))
      (15 (equalp response '(jen lori kate)))
      (16 (equalp response '(kate jen lori))))))

(defun result-gaze-counts-story (result phase targets)
  (let ((trace (collapse-trace-story (if (equalp phase 'sp)
                                   (trace-study-phase-story (third result))
                                   (trace-mapping-phase-story (third result))))))
    (mapcar #'(lambda (target) (count target trace :key #'first))
            targets)))

(defun key-before-23-story (trace)
  (cond ((null trace) nil)
        ((equalp 's2-2 (first (first trace))) nil)
        ((equalp 's2-3 (first (first trace))) nil)
        ((equalp 'type (first (first trace))) t)
        (t (key-before-23-story (rest trace)))))

(defun result-key-before-23-story (result)
  (key-before-23-story (trace-mapping-phase-story (third result))))

(defun result-key-time-ratios-story (result)
  (let ((times (result-times-story result)))
    (mapcar #'(lambda (time) (/ time (second times)))
      (mapcar #'(lambda (time) (- time (first times)))
        (mapcar #'second
          (remove-if-not #'(lambda (tup) (equalp 'type (first tup)))
                         (trace-mapping-phase-story (third result))))))))

(defun result-transitions-story (result phase targets)
  (let* ((trace (collapse-trace-story 
                 (remove-if-not #'(lambda (g) (member (first g) targets))
                                (if (equalp phase 'sp)
                                    (trace-study-phase-story (third result))
                                    (trace-mapping-phase-story (third result))))))
         (n (length targets))
         (array (make-array (list n n) :initial-element 0)))
    (mapcar #'(lambda (g1 g2)
                (incf (aref array
                            (position (first g1) targets)
                            (position (first g2) targets))))
            trace (rest trace))
    array))

(defun simulation-data-story ()
  (make-data-story
   
   :correct
   (let ((correct nil))
     (dolist (cnd '(one-story two-story))
       (dolist (adj '(t nil))
         (let* ((all-results (remove-if-not #'(lambda (r)
                                                (and (equalp (first r) cnd)
                                                     (equalp (result-adjacency-story r) adj)))
                                            *results*))
                (corrs (mapcar #'result-correct-story all-results))
                (correctness (my/-story (count t corrs) (length corrs))))
           (push correctness correct))))
     (reverse correct))

   :times
   (let ((study-times nil) (map-times nil))
     (dolist (cnd '(one-story two-story))
       (dolist (adj '(t nil))
         (let* ((corr-results (remove-if-not #'(lambda (r)
                                                 (and (result-correct-story r)
                                                      (equalp (first r) cnd)
                                                      (equalp (result-adjacency-story r) adj)))
                                             *results*))
                (matrix (mapcar #'result-times-story corr-results))
                (times (mapcar #'sm-average-story (sm-invert-story matrix))))
           (push (first times) study-times)
           (push (second times) map-times))))
     (list (reverse study-times)
           (reverse map-times)))

   :gazes
   (let ((gazes nil))
     (dolist (phase '(sp mp))
       (dolist (cnd '(one-story two-story))
         (let* ((results (remove-if-not #'(lambda (r)
                                            (and (result-correct-story r)
                                                 (equalp (first r) cnd)))
                                        *results*))
                (targets '(s1-1 s1-2 s1-3 s2-1 s2-2 s2-3))
                (matrix (mapcar #'(lambda (r) (result-gaze-counts-story r phase targets)) results))
                (avgs (mapcar #'sm-average-story (sm-invert-story matrix)))
                (avgs (remove 0 avgs)))
           (push avgs gazes))))
     (reverse gazes))
   
   :transitions
   (let ((transitions nil))
     (let* ((phase 'sp)
            (targets '(s1-1 s1-2 s1-3))
            (results (remove-if-not #'result-correct-story *results*))
            (matrices (mapcar #'(lambda (r) (result-transitions-story r phase targets)) results))
            (matrix (sm-average-transition-matrices-story matrices)))
       (push matrix transitions))
     (let* ((phase 'mp) (cnd 'one-story)
            (targets '(s2-1 s2-2 s2-3))
            (results (remove-if-not #'(lambda (r)
                                        (and (result-correct-story r)
                                             (equalp (first r) cnd)))
                                    *results*))
            (matrices (mapcar #'(lambda (r) (result-transitions-story r phase targets)) results))
            (matrix (sm-average-transition-matrices-story matrices)))
       (push matrix transitions))
     (let* ((phase 'mp) (cnd 'two-story)
            (targets '(s1-1 s1-2 s1-3 s2-1 s2-2 s2-3))
            (results (remove-if-not #'(lambda (r)
                                        (and (result-correct-story r)
                                             (equalp (first r) cnd)))
                                    *results*))
            (matrices (mapcar #'(lambda (r) (result-transitions-story r phase targets)) results))
            (matrix (sm-average-transition-matrices-story matrices)))
       (push matrix transitions))
     (reverse transitions))

   :key-times
   (let ((key-times nil))
     (dolist (cnd '(one-story two-story))
       (let* ((results (remove-if-not #'(lambda (r)
                                          (and (result-correct-story r)
                                               (equalp (first r) cnd)))
                                      *results*))
              (matrix (mapcar #'result-key-time-ratios-story results))
              (avgs (mapcar #'sm-average-story (sm-invert-story matrix))))
         (push avgs key-times)))
     (reverse key-times))
   
   :key-before-23
   (let ((key-before-23 nil))
     (dolist (cnd '(one-story two-story))
       (let* ((results (remove-if-not #'(lambda (r)
                                          (and (result-correct-story r)
                                               (equalp (first r) cnd)))
                                      *results*))
              (kb23s (mapcar #'result-key-before-23-story results))
              (avg-kb23 (my/-story (count t kb23s) (length kb23s))))
         (push avg-kb23 key-before-23)))
     (reverse key-before-23))
   ))

(defun output-tables-story (data sim)
  (unless *conditions*
    (setf *conditions* '(one-story two-story)))
  
  (format *standard-output* "~%~A results...~%~%"
          (if sim "Model" "Experiment"))
  
  (format *standard-output* "Correctness and Times:~%~%")
  (print-tabbed-story "Condition Adjacent Correctness Study-Time Mapping-Time~%")
  (print-tabbed-story "-----------------------------------------------------------------------------~%")
  (let ((correct (data-story-correct data))
        (study-times (first (data-story-times data)))
        (map-times (second (data-story-times data))))
    (dotimes (ci 2)
      (dotimes (ai 2)
        (print-tabbed-story "~a ~a  ~4,2f  ~4,1f  ~4,1f~%"
                      (nth ci *conditions*)
                      (if (zerop ai) 'yes 'no)
                      (nth (+ (* ci 2) ai) correct)
                      (nth (+ (* ci 2) ai) study-times)
                      (nth (+ (* ci 2) ai) map-times)))))
  (format *standard-output* "~%")
  
  (format *standard-output* "Gaze Counts:~%~%")
  (print-tabbed-story "Phase  Condition s1-1 s1-2 s1-3 s2-1 s2-2 s2-3~%")
  (print-tabbed-story "-----------------------------------------------------------------------------~%")
  (let ((gazes (data-story-gazes data)))
    (dotimes (phi 2)
      (dotimes (ci 2)
        (print-tabbed-story "~a  ~a "
                      (if (zerop phi) 'study 'mapping)
                      (nth ci *conditions*))
        (when (and (= phi 1) (= ci 0)) (print-tabbed-story "- - - "))
        (dolist (x (nth (+ (* phi 2) ci) gazes))
          (if (zerop x)
              (format *standard-output* "-~c" #\Tab)
              (print-tabbed-story "~3,2f " x)))
        (when (= phi 0) (print-tabbed-story "- - - "))
        (print-tabbed-story "~%"))))
  (format *standard-output* "~%")
  
  (format *standard-output* "Transition probabilities, study phase, both conditions:~%~%")
  (print-tabbed-story "to-> s1-1 s1-2 s1-3~%")
  (print-tabbed-story "-----------------------------~%")
  (let ((transitions (first (data-story-transitions data)))
        (targets '(s1-1 s1-2 s1-3)))
    (dotimes (i (length targets))
      (print-tabbed-story "~a " (nth i targets))
      (dotimes (j (length targets))
        (if (= i j)
            (format *standard-output* "-~c" #\Tab)
            (print-tabbed-story "~4,2f " (aref transitions i j))))
      (format *standard-output* "~%")))
  (format *standard-output* "~%")
  
  (format *standard-output* "Transition probabilities, mapping phase, one-story condition:~%~%")
  (print-tabbed-story "to-> s2-1 s2-2 s2-3~%")
  (print-tabbed-story "-----------------------------~%")
  (let ((transitions (second (data-story-transitions data)))
        (targets '(s2-1 s2-2 s2-3)))
    (dotimes (i (length targets))
      (print-tabbed-story "~a " (nth i targets))
      (dotimes (j (length targets))
        (if (= i j)
            (format *standard-output* "-~c" #\Tab)
            (print-tabbed-story "~4,2f " (aref transitions i j))))
      (format *standard-output* "~%")))
  (format *standard-output* "~%")
  
  (format *standard-output* "Transition probabilities, mapping phase, two-story condition:~%~%")
  (print-tabbed-story "to-> s1-1 s1-2 s1-3 s2-1 s2-2 s2-3~%")
  (print-tabbed-story "-----------------------------------------------------~%")
  (let ((transitions (third (data-story-transitions data)))
        (targets '(s1-1 s1-2 s1-3 s2-1 s2-2 s2-3)))
    (dotimes (i (length targets))
      (print-tabbed-story "~a " (nth i targets))
      (dotimes (j (length targets))
        (if (= i j)
            (format *standard-output* "-~c" #\Tab)
            (print-tabbed-story "~4,2f " (aref transitions i j))))
      (format *standard-output* "~%")))
  (format *standard-output* "~%")
  
  (format *standard-output* "Key-Time Ratios:~%~%")
  (print-tabbed-story "Condition Key1 Key2 Key3~%")
  (print-tabbed-story "-------------------------------------~%")
  (let ((key-times (data-story-key-times data)))
    (dotimes (ci 2)
      (print-tabbed-story "~a " (nth ci *conditions*))
      (dolist (x (nth ci key-times))
        (print-tabbed-story "~3,2f " x))
      (print-tabbed-story "~%")))
  (format *standard-output* "~%")
  
  (format *standard-output* "Key Before s2-2/3:~%~%")
  (print-tabbed-story "Condition Proportion-Trials~%")
  (print-tabbed-story "----------------------------------~%")
  (let ((key-before-23 (data-story-key-before-23 data)))
    (dotimes (ci 2)
      (print-tabbed-story "~a ~3,2f~%"
                    (nth ci *conditions*)
                    (nth ci key-before-23))))
  (format *standard-output* "~%")
)

(defun r-story (&optional (cnd 'two-story)  (ct nil) (act nil) (others nil))
  (setf *condition* cnd)
  (reset)
  
  (dolist (stimulus  *stimuli-story*)
    (setf *result* nil)
    (setf *stimulus* stimulus)
    (reset)
    
    (sgp-fct (list :ct ct :act act :cst others :pmt others :lt others :v *v*))
    
    (my-set-similarities-story
     (all-pairs-story
      '(got unpacked planned obtained took-out chose walked-to paid-for set drove-to carried
        placed cleaned cleared brought planted readied fell-to phoned called ran-into sprained
        slept-on played rested-on toyed-with stole broke whined-to grabbed crushed cried-to
        purchased bought organized spoke-with lifted pulled picked-up tugged walked-on started
        added-to finished began put-on completed dodged tossed ran-on threw jogged-on avoided
        arranged spoke-to talked-to prepared set-up typed-in wrote-in put-up sawed blew-on
        hammered whistled beat bowed monitored gripped extracted watched held removed gathered
        assembled painted collected built stained))
     *estimated-different-match*)
    
    (my-set-similarities-story
     (all-pairs-story
      '(got-agent unpacked-agent planned-agent obtained-agent took-out-agent chose-agent
        walked-to-agent paid-for-agent set-agent drove-to-agent carried-agent placed-agent
        cleaned-agent cleared-agent brought-agent planted-agent readied-agent fell-to-agent
        phoned-agent called-agent ran-into-agent sprained-agent slept-on-agent played-agent
        rested-on-agent toyed-with-agent stole-agent broke-agent whined-to-agent grabbed-agent
        crushed-agent cried-to-agent purchased-agent bought-agent organized-agent spoke-with-agent
        lifted-agent pulled-agent picked-up-agent tugged-agent walked-on-agent started-agent
        added-to-agent finished-agent began-agent put-on-agent completed-agent dodged-agent
        tossed-agent ran-on-agent threw-agent jogged-on-agent avoided-agent arranged-agent
        spoke-to-agent talked-to-agent prepared-agent set-up-agent typed-in-agent wrote-in-agent
        put-up-agent sawed-agent blew-on-agent hammered-agent whistled-agent beat-agent bowed-agent
        monitored-agent gripped-agent extracted-agent watched-agent held-agent removed-agent
        gathered-agent assembled-agent painted-agent collected-agent built-agent stained-agent))
     *estimated-different-match*)
    
    (my-set-similarities-story
     '((got obtained) (unpacked took-out) (planned chose) (prepared set) (walked-to drove-to)
       (paid-for bought) (carried brought) (placed planted) (cleaned cleared)
       (prepared readied) (gathered collected) (slept-on rested-on) (fell-to ran-into)
       (broke sprained) (phoned called) (completed finished) (slept-on rested-on)
       (played toyed-with) (stole grabbed) (broke crushed) (whined-to cried-to)
       (purchased bought) (prepared organized) (talked-to spoke-with) (lifted picked-up)
       (pulled tugged) (ran-on walked-on) (started began) (added-to put-on)
       (finished completed) (dodged avoided) (tossed threw) (ran-on jogged-on)
       (arranged prepared) (collected gathered) (spoke-to talked-to) (gathered collected)
       (set-up put-up) (typed-in wrote-in) (sawed bowed) (blew-on whistled) (hammered beat)
       (monitored watched) (gripped held) (extracted removed) (gathered collected)
       (assembled built) (painted stained))
     *estimated-similar-match*)
    
    (my-set-similarities-story
     '((got-agent obtained-agent) (unpacked-agent took-out-agent) (planned-agent chose-agent)
       (prepared-agent set-agent) (walked-to-agent drove-to-agent) (paid-for-agent bought-agent)
       (carried-agent brought-agent) (placed-agent planted-agent) (cleaned-agent cleared-agent)
       (prepared-agent readied-agent) (gathered-agent collected-agent)
       (slept-on-agent rested-on-agent) (fell-to-agent ran-into-agent) (broke-agent sprained-agent)
       (phoned-agent called-agent) (completed-agent finished-agent)
       (slept-on-agent rested-on-agent) (played-agent toyed-with-agent) (stole-agent grabbed-agent)
       (broke-agent crushed-agent) (whined-to-agent cried-to-agent) (purchased-agent bought-agent)
       (prepared-agent organized-agent) (talked-to-agent spoke-with-agent)
       (lifted-agent picked-up-agent) (pulled-agent tugged-agent) (ran-on-agent walked-on-agent)
       (started-agent began-agent) (added-to-agent put-on-agent) (finished-agent completed-agent)
       (dodged-agent avoided-agent) (tossed-agent threw-agent) (ran-on-agent jogged-on-agent)
       (arranged-agent prepared-agent) (collected-agent gathered-agent)
       (spoke-to-agent talked-to-agent) (gathered-agent collected-agent)
       (set-up-agent put-up-agent) (typed-in-agent wrote-in-agent) (sawed-agent bowed-agent)
       (blew-on-agent whistled-agent) (hammered-agent beat-agent) (monitored-agent watched-agent)
       (gripped-agent held-agent) (extracted-agent removed-agent) (gathered-agent collected-agent)
       (assembled-agent built-agent) (painted-agent stained-agent))
     *estimated-similar-match*)
    
    
    (spp-fct (list 'give-up-search-1s :r *estimated-give-up-search-1s*))
    (spp-fct (list 'done-memorize-story :r *estimated-stop-memorize*))
    (spp-fct (list 'subgoal-memorize-s1 :r *estimated-memorize-s1-2s*))
    (spp-fct (list 'skip-read-s2 :r *estimated-skip-read-s2*))
    (spp-fct (list :strength *estimated-production-strength*))
    
    (case *condition*
      (one-story (add-dm (goal isa do-problem condition one-story phase i1)))
      (two-story (add-dm (goal isa do-problem condition two-story phase i1)))
      (t (error "Variable *condition* must be set to 'one-story or 'two-story")))
    
    (goal-focus goal)
    
    
    (run)
    (push (list cnd (first stimulus) (reverse *result*)) *results*)))

(defun rr-story (&optional (n 5))
  (reset)

  (setf *condition* 'one-story)
  (setf *result* nil)
  (setf *stimulus* nil)
  (setf *conditions* '(one-story two-story))

  (setf *results* nil)
  (dolist (cnd *conditions*)
    (dotimes (i n)
      (r-story cnd nil)))
  (output-tables-story *data-story* nil)
  (output-tables-story (simulation-data-story) t))

;;;-------------------------------------------------------------------------------
;;;
;;;  Visual Interface Routines
;;;

(defun vi-read-introduction-story (story)
  (declare (ignore story))
  (actr-time-fct *estimated-intro-encoding-time*))

(defun vi-read-role-story (story pos)
  (when (and (member story '(s1 s2))
             (member pos '(i1 i2 i3)))
    (let* ((set (nth (case story (s1 1) (s2 2)) *stimulus*))
           (chunks (nth (case pos (i1 0) (i2 1) (i3 2)) set))
           (role-name (first (third chunks))))
      (dolist (chunk chunks)
        (let* ((name (first chunk))
               (wme (get-wme name)))
          ;(format *standard-output* "~%** reading ~a ~a" story pos)
          (if wme
              (add-reference (wme-references wme))
              (add-dm-fct (list chunk)))))
      (actr-time-fct *estimated-encoding-time*)
      (push (list role-name (actr-time-fct)) *result*)
      role-name)))

(defun vi-type-name-story (name)
  (unless (equalp name 'failure)
    (actr-time-fct *estimated-keying-time*)
    (push (list 'type (actr-time-fct) name) *result*)))

(defun vi-type-enter-story ()
  (actr-time-fct *estimated-keying-time*)
  (push (list 'ok (actr-time-fct)) *result*))

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

(clear-all)

(sgp :era t
     :er  t
     :pm  t
     :mp  10
     :bll .5
     :ans .5
     :egs .5
     :ga  0
     :lt  nil)

(progn
(chunk-type role parent parent-type slot child child-type)
(chunk-type (source-role   (:include role)))
(chunk-type (target-role (:include role)))
)

(chunk-type person story pos)
(chunk-type parent story pos)

(chunk-type position next previous opposite)

(add-dm
 (none isa chunk) (failure isa chunk) (success isa chunk)
 (one-story isa chunk) (two-story isa chunk)
 (s1 isa chunk) (s2 isa chunk)

 (i0 isa position)
 (i1 isa position previous i0  next i2  opposite i3)
 (i2 isa position previous i1  next i3)
 (i3 isa position previous i2  next i4  opposite i1)
 (i4 isa position)

 (agent isa chunk) (child isa chunk)

 (person isa chunk)

 (got isa chunk) (unpacked isa chunk) (planned isa chunk) (obtained isa chunk)
 (took-out isa chunk) (chose isa chunk) (walked-to isa chunk) (paid-for isa chunk)
 (set isa chunk) (drove-to isa chunk) (carried isa chunk) (placed isa chunk)
 (cleaned isa chunk) (cleared isa chunk) (brought isa chunk) (planted isa chunk)
 (readied isa chunk) (fell-to isa chunk) (phoned isa chunk) (called isa chunk)
 (ran-into isa chunk) (sprained isa chunk) (slept-on isa chunk) (played isa chunk)
 (rested-on isa chunk) (toyed-with isa chunk) (stole isa chunk) (broke isa chunk)
 (whined-to isa chunk) (grabbed isa chunk) (crushed isa chunk) (cried-to isa chunk)
 (purchased isa chunk) (bought isa chunk) (organized isa chunk) (spoke-with isa chunk)
 (lifted isa chunk) (pulled isa chunk) (picked-up isa chunk) (tugged isa chunk)
 (walked-on isa chunk) (started isa chunk) (added-to isa chunk) (finished isa chunk)
 (began isa chunk) (put-on isa chunk) (completed isa chunk) (dodged isa chunk)
 (tossed isa chunk) (ran-on isa chunk) (threw isa chunk) (jogged-on isa chunk)
 (avoided isa chunk) (arranged isa chunk) (spoke-to isa chunk) (talked-to isa chunk)
 (prepared isa chunk) (set-up isa chunk) (typed-in isa chunk) (wrote-in isa chunk)
 (put-up isa chunk) (sawed isa chunk) (blew-on isa chunk) (hammered isa chunk)
 (whistled isa chunk) (beat isa chunk) (bowed isa chunk) (monitored isa chunk)
 (gripped isa chunk) (extracted isa chunk) (watched isa chunk) (held isa chunk)
 (removed isa chunk) (gathered isa chunk) (assembled isa chunk) (painted isa chunk)
 (collected isa chunk) (built isa chunk) (stained isa chunk)

 (got-agent isa chunk) (unpacked-agent isa chunk) (planned-agent isa chunk)
 (obtained-agent isa chunk) (took-out-agent isa chunk) (chose-agent isa chunk)
 (walked-to-agent isa chunk) (paid-for-agent isa chunk) (set-agent isa chunk)
 (drove-to-agent isa chunk) (carried-agent isa chunk) (placed-agent isa chunk)
 (cleaned-agent isa chunk) (cleared-agent isa chunk) (brought-agent isa chunk)
 (planted-agent isa chunk) (readied-agent isa chunk) (fell-to-agent isa chunk)
 (phoned-agent isa chunk) (called-agent isa chunk) (ran-into-agent isa chunk)
 (sprained-agent isa chunk) (slept-on-agent isa chunk) (played-agent isa chunk)
 (rested-on-agent isa chunk) (toyed-with-agent isa chunk) (stole-agent isa chunk)
 (broke-agent isa chunk) (whined-to-agent isa chunk) (grabbed-agent isa chunk)
 (crushed-agent isa chunk) (cried-to-agent isa chunk) (purchased-agent isa chunk)
 (bought-agent isa chunk) (organized-agent isa chunk) (spoke-with-agent isa chunk)
 (lifted-agent isa chunk) (pulled-agent isa chunk) (picked-up-agent isa chunk)
 (tugged-agent isa chunk) (walked-on-agent isa chunk) (started-agent isa chunk)
 (added-to-agent isa chunk) (finished-agent isa chunk) (began-agent isa chunk)
 (put-on-agent isa chunk) (completed-agent isa chunk) (dodged-agent isa chunk)
 (tossed-agent isa chunk) (ran-on-agent isa chunk) (threw-agent isa chunk)
 (jogged-on-agent isa chunk) (avoided-agent isa chunk) (arranged-agent isa chunk)
 (spoke-to-agent isa chunk) (talked-to-agent isa chunk) (prepared-agent isa chunk)
 (set-up-agent isa chunk) (typed-in-agent isa chunk) (wrote-in-agent isa chunk)
 (put-up-agent isa chunk) (sawed-agent isa chunk) (blew-on-agent isa chunk)
 (hammered-agent isa chunk) (whistled-agent isa chunk) (beat-agent isa chunk)
 (bowed-agent isa chunk) (monitored-agent isa chunk) (gripped-agent isa chunk)
 (extracted-agent isa chunk) (watched-agent isa chunk) (held-agent isa chunk)
 (removed-agent isa chunk) (gathered-agent isa chunk) (assembled-agent isa chunk)
 (painted-agent isa chunk) (collected-agent isa chunk) (built-agent isa chunk)
 (stained-agent isa chunk)
)

(sdp :references 50)


;;;-------------------------------------------------------------------------------
;;;
;;;  Analogy Module
;;;

(progn

;;;
;;;  map-object
;;;

(chunk-type map-object
            source-object source-role target-role
            target-object void
            source-relation target-relation parent-type slot child-type)

(p Retrieve-Previous-Mapping
   =goal>
      isa map-object
      source-object =source-object
      source-role nil
      target-object nil
   =oldgoal>
      isa map-object
      source-object =source-object
      target-object =target-object
      - target-object failure
      void nil
==>
   !output! (Retrieved previous mapping =source-object to =target-object)
   =goal>
      target-object =target-object
   !pop!)

(p Retrieve-Source-Role
   =goal>
      isa map-object
      source-object =source-object
      source-role nil
      target-object nil
   =source-role>
      isa source-role
      child =source-object
==>
   !output! (Set source role to =source-role)
   =goal>
      source-role =source-role)

(spp Retrieve-Source-Role :r .6)

(p Reached-Source-Path-Root
   =goal>
      isa map-object
      source-object =source-object
      source-role nil
      target-object nil
==>
   !output! (Reached root relation =source-object)
   =goal>
      target-object failure
   !pop!)

(spp Reached-Source-Path-Root :r .2)

(p Retrieve-Components
   =goal>
      isa map-object
      source-role =source-role
      source-relation nil
      parent-type nil
      slot nil
      child-type nil
   =source-role>
      isa source-role
      parent =source-relation
      parent-type =parent-type
      slot =slot
      child-type =child-type
==>
   !output! (Set source relation to =source-relation "," parent type to =parent-type ",")
   !output! (slot to =slot "," and child type to =child-type)
   =goal>
      source-relation =source-relation
      parent-type =parent-type
      slot =slot
      child-type =child-type)

(spp Retrieve-Components :r .6)

(p Map-Source-Relation
   =goal>
      isa map-object
      source-relation =source-relation
      target-relation nil
==>
   !output! (Mapping =source-relation)
   =subgoal>
      isa map-object
      source-object =source-relation
      target-object =target-relation
   =goal>
      target-relation =target-relation
   !push! =subgoal)

(p Retrieve-Analog-At-Root
   =goal>
      isa map-object
      source-object =source-object
      source-relation =source-relation
      target-relation failure
      parent-type =parent-type
      slot =slot
      child-type =child-type
      target-role nil
   =target-role>
      isa target-role
      parent =target-relation
      parent-type =parent-type
      slot =slot
      child-type =child-type
      child =target-object
==>
   !output! (Retrieved analogous role =target-role)
   !output! (Mapped =source-relation to =target-relation)
   !output! (Mapped =source-object to =target-object)
   =subgoal>
      isa map-object
      source-object =source-relation
      target-object =target-relation
   =goal>
      target-object =target-object
   !focus-on! =subgoal)

(p Retrieve-Analog-Below-Root
   =goal>
      isa map-object
      source-object =source-object
      target-relation =target-relation
      - target-relation failure
      parent-type =parent-type
      slot =slot
      child-type =child-type
      target-role nil
   =target-role>
      isa target-role
      parent =target-relation
      parent-type =parent-type
      slot =slot
      child-type =child-type
      child =target-object
==>
   !output! (Retrieved analogous role =target-role)
   !output! (Mapped =source-object to =target-object)
   =goal>
      target-object =target-object
   !pop!)

(p Retrieve-Specific-Target-Role
   =goal>
      isa map-object
      source-object =source-object
      source-relation =source-relation
      parent-type =parent-type
      slot =slot
      child-type =child-type
      target-role =target-role
   =target-role>
      isa target-role
      parent-type =parent-type
      slot =slot
      child-type =child-type
      child =target-object
==>
   !output! (Retrieved specific role =target-role)
   !output! (Mapped =source-object to =target-object)
   =subgoal>
      isa map-object
      source-object =source-relation
      target-object =target-relation
   =goal>
      target-object =target-object
   !focus-on! =subgoal)

(p Done-Map-Object
   =goal>
      isa map-object
      source-object =source-object
      target-object =target-object
==>
   !pop!)

)

;;;-------------------------------------------------------------------------------
;;;
;;;  General Productions
;;;

;;;
;;;  read-story
;;;

(chunk-type read-story
            story start
            pos done-2)

(p read-story-1-1
   =goal>
      isa read-story
      story =story
      start i1
      pos nil
==>
   !eval! (vi-read-role-story =story 'i1)
   =goal>
      pos i2)

(p read-story-1-2
   =goal>
      isa read-story
      story =story
      start i1
      pos i2
==>
   !eval! (vi-read-role-story =story 'i2)
   =goal>
      pos i3)

(p read-story-1-3
   =goal>
      isa read-story
      story =story
      start i1
      pos i3
==>
   !eval! (vi-read-role-story =story 'i3)
   !pop!)

(p read-story-3-3
   =goal>
      isa read-story
      story =story
      start i3
      pos nil
==>
   !eval! (vi-read-role-story =story 'i3)
   =goal>
      pos i2)

(p read-story-3-2
   =goal>
      isa read-story
      story =story
      start i3
      pos i2
==>
   !eval! (vi-read-role-story =story 'i2)
   =goal>
      pos i1)

(p read-story-3-1
   =goal>
      isa read-story
      story =story
      start i3
      pos i1
==>
   !eval! (vi-read-role-story =story 'i1)
   !pop!)

(p read-story-2-2a
   =goal>
      isa read-story
      story =story
      start i2
      pos nil
==>
   !eval! (vi-read-role-story =story 'i2)
   =goal>
      pos i1)

(p read-story-2-2b
   =goal>
      isa read-story
      story =story
      start i2
      pos nil
==>
   !eval! (vi-read-role-story =story 'i2)
   =goal>
      pos i3)

(p read-story-2-1a
   =goal>
      isa read-story
      story =story
      start i2
      pos i1
      done-2 nil
==>
   !eval! (vi-read-role-story =story 'i1)
   =goal>
      pos i3
      done-2 t)

(p read-story-2-1b
   =goal>
      isa read-story
      story =story
      start i2
      pos i1
      done-2 t
==>
   !eval! (vi-read-role-story =story 'i1)
   !pop!)

(p read-story-2-3a
   =goal>
      isa read-story
      story =story
      start i2
      pos i3
      done-2 nil
==>
   !eval! (vi-read-role-story =story 'i3)
   =goal>
      pos i1
      done-2 t)

(p read-story-2-3b
   =goal>
      isa read-story
      story =story
      start i2
      pos i3
      done-2 t
==>
   !eval! (vi-read-role-story =story 'i3)
   !pop!)

;;;
;;;  read-story-first-time
;;;

(chunk-type read-story-first-time
            story start
            times)

(p subgoal-read-story-1
   =goal>
      isa read-story-first-time
      story =story
      start =start
      times nil
   =start>
      isa position
      opposite =opposite
==>
   !eval! (vi-read-introduction-story =story)
   =subgoal>
      isa read-story
      story =story
      start =start
   =goal>
      start =opposite
      times i2
   !push! =subgoal)

(p subgoal-read-story-2
   =goal>
      isa read-story-first-time
      story =story
      start =start
      times i2
   =start>
      isa position
      opposite =opposite
==>
   =subgoal>
      isa read-story
      story =story
      start =start
   =goal>
      start =opposite
      times i3
   !push! =subgoal)

(p done-read-story-first-time
   =goal>
      isa read-story-first-time
      story =story
      start =start
      times i3
==>
   !pop!)

;;;
;;;  review-story
;;;

(chunk-type review-story
            story start
            result
            pos read retrieved)

(p start-review-story
   =goal>
      isa review-story
      start =start
      pos nil
==>
   =goal>
      pos =start
      result success)

(p review-story-parent
   =goal>
      isa review-story
      story =story
      pos =pos
      - pos i0
      - pos i4
      read nil
==>
   !eval! (vi-read-role-story =story =pos)
   =goal>
      read t)

(p done-review-story-down
   =goal>
      isa review-story
      start i1
      pos i4
==>
   !pop!)

(p done-review-story-up
   =goal>
      isa review-story
      start i3
      pos i0
==>
   !pop!)

(p retrieve-story-parent-success
   =goal>
      isa review-story
      story =story
      pos =pos
      read t
      retrieved nil
   =person>
      isa person
      story =story
      pos =pos
==>
   ;!output! (Successfully retrieved target role =role at =pos)
   =goal>
      retrieved t)

(p retrieve-story-parent-failure
   =goal>
      isa review-story
      pos =pos
      read t
      retrieved nil
==>
   ;!output! (Failed to retrieve role at =pos)
   =goal>
      retrieved t
      result failure)
(spp retrieve-story-parent-failure :r .5)

(p recall-next-story-parent-down
   =goal>
      isa review-story
      start i1
      pos =pos
      read t
      retrieved t
   =pos>
      isa position
      next =next
==>
   =goal>
      pos =next
      read nil
      retrieved nil)

(p recall-next-story-parent-up
   =goal>
      isa review-story
      start i3
      pos =pos
      read t
      retrieved t
   =pos>
      isa position
      previous =previous
==>
   =goal>
      pos =previous
      read nil
      retrieved nil)

;;;
;;;  memorize-story
;;;

(chunk-type memorize-story
            condition story start
            review)

(p start-memorize-story
   =goal>
      isa memorize-story
      review nil
==>
   =goal>
      review failure)

(p subgoal-review-story
   =goal>
      isa memorize-story
      story =story
      start =start
      - review nil
   =start>
      isa position
      opposite =opposite
==>
   !output! (Reviewing =story from =start)
   =subgoal>
      isa review-story
      story =story
      start =start
      result =result
   =goal>
      start =opposite
      review =result
   !push! =subgoal)

(p done-memorize-story
   =goal>
      isa memorize-story
      - review nil
      - review failure
==>
   !pop!)

;;;-------------------------------------------------------------------------------
;;;
;;;  Study Phase Productions
;;;

;;;
;;;  do-study-phase
;;;

(chunk-type do-study-phase
            condition
            read done)

(p subgoal-read-s1
   =goal>
      isa do-study-phase
      read nil
==>
   !output! (Reading s1)
   =subgoal>
      isa read-story-first-time
      story s1
      start i1
   =goal>
      read t
   !push! =subgoal)

(p subgoal-memorize-s1
   =goal>
      isa do-study-phase
      read t
      done nil
==>
   !output! (Memorizing s1)
   =subgoal>
      isa memorize-story
      story s1
      start i1
   =goal>
      done t
   !push! =subgoal)

(p subgoal-skip-memorize-s1-2s
   =goal>
      isa do-study-phase
      condition two-story
      read t
      done nil
==>
   =goal>
      done t)

(p done-study-phase
   =goal>
      isa do-study-phase
      done t
==>
   !output! (Clicking OK)
   !eval! (vi-type-enter-story)
   !pop!)

;;;-------------------------------------------------------------------------------
;;;
;;;  Mapping Phase Productions
;;;

;;;
;;;  evaluate-analog
;;;

(chunk-type evaluate-analog
            condition pos source-role
            result
            target-role person)

(p evaluate-get-target-person-1s
   =goal>
      isa evaluate-analog
      condition one-story
      pos =pos
      person nil
   =person>
      isa person
      story s1
      pos =pos
==>
   !output! (Retrieved person =person)
   =goal>
      person =person)

(p evaluate-get-target-role-1s
   =goal>
      isa evaluate-analog
      condition one-story
      pos =pos
      person =person
      target-role nil
   =target-role>
      isa target-role
      child =person
==>
   !output! (Retrieved target-role =target-role)
   !eval! (vi-read-role-story 's2 =pos)
   =goal>
      target-role =target-role)

(p evaluate-get-target-role-2s
   =goal>
      isa evaluate-analog
      condition two-story
      pos =pos
      target-role nil
   !bind! =target-role (vi-read-role-story 's1 =pos)
==>
   !output! (Read target-role =target-role)
   =goal>
      target-role =target-role)

(p evaluate-subgoal-map-object
   =goal>
      isa evaluate-analog
      source-role =source-role
      target-role =target-role
      result nil
   =source-role>
      isa source-role
      child =source-object
==>
   !output! (Trying to map =source-object with source-role =source-role and target-role =target-role)
   =subgoal>
      isa map-object
      source-object =source-object
      source-role =source-role
      target-role =target-role
      target-object =target-object
   =goal>
      result =target-object
   !push! =subgoal)

(p done-evaluate-analog
   =goal>
      isa evaluate-analog
      result =result
==>
   !output! (Evaluation resulted in =result)
   !pop!)

;;;
;;;  Search
;;;

(chunk-type search
            condition start source-role
            result result-pos
            pos once)

(p start-search
   =goal>
      isa search
      start =start
      pos nil
==>
   =goal>
      pos =start)

(p subgoal-evaluate-analog
   =goal>
      isa search
      condition =condition
      pos =pos
      source-role =source-role
      result nil
==>
   !output! (Evaluating analog at =pos)
   =subgoal>
      isa evaluate-analog
      condition =condition
      pos =pos
      source-role =source-role
      result =result
   =goal>
      result =result
   !push! =subgoal)

(p done-search
   =goal>
      isa search
      pos =pos
      result =result
      - result nil
      - result failure
==>
   !output! (Found analog =result)
   =goal>
      result-pos =pos
   !pop!)

(p give-up-search-1s
   =goal>
      isa search
      condition one-story
      once t
      result failure
==>
   !output! (Giving up search)
   !pop!)

(p continue-search-1-1
   =goal>
      isa search
      start i1
      pos i1
      result failure
==>
   =goal>
      pos i2
      result nil)

(p continue-search-1-2
   =goal>
      isa search
      start i1
      pos i2
      result failure
==>
   =goal>
      pos i3
      result nil)

(p continue-search-1-3
   =goal>
      isa search
      start i1
      pos i3
      result failure
==>
   =goal>
      start i3
      once t
      result nil)

(p continue-search-3-3
   =goal>
      isa search
      start i3
      pos i3
      result failure
==>
   =goal>
      pos i2
      result nil)

(p continue-search-3-2
   =goal>
      isa search
      start i3
      pos i2
      result failure
==>
   =goal>
      pos i1
      result nil)

(p continue-search-3-1
   =goal>
      isa search
      start i3
      pos i1
      result failure
==>
   =goal>
      start i1
      once t
      result nil)

(p continue-search-2a
   =goal>
      isa search
      start i2
      result failure
==>
   =goal>
      start i3
      pos i1
      result nil)

(p continue-search-2b
   =goal>
      isa search
      start i2
      result failure
==>
   =goal>
      start i1
      pos i3
      result nil)

;;;
;;;  incremental-map
;;;

(chunk-type incremental-map
            condition
            pos answer answer-pos)

(p start-incremental-map
   =goal>
      isa incremental-map
      pos nil
==>
   =goal>
      pos i1)

(p done-incremental-map
   =goal>
      isa incremental-map
      pos i4
==>
   !pop!)

(p subgoal-search
   =goal>
      isa incremental-map
      condition =condition
      pos =pos
      - pos i4
      answer nil
   !bind! =source-role (vi-read-role-story 's2 =pos)
==>
   !output! (Searching for analog for =pos)
   =subgoal>
      isa search
      condition =condition
      start =pos
      source-role =source-role
      result =result
      result-pos =result-pos
   =goal>
      answer =result
      answer-pos =result-pos
   !push! =subgoal)

(p type-mapping
   =goal>
      isa incremental-map
      pos =pos
      answer =answer
      answer-pos =answer-pos
   =pos>
      isa position
      next =next
==>
   !output! (Typing =answer)
   !eval! (vi-read-role-story 's2 =pos)
   !eval! (vi-type-name-story =answer)
   =goal>
      pos =next
      answer nil
      answer-pos nil)

;;;
;;;  do-mapping-phase
;;;

(chunk-type do-mapping-phase
            condition
            read done-read mapped)

(p decide-to-read-s2
   =goal>
      isa do-mapping-phase
      read nil
      done-read nil
==>
   =goal>
      read t)

(p skip-read-s2
   =goal>
      isa do-mapping-phase
      read nil
      done-read nil
==>
   !output! (Skipping s2)
   =goal>
      done-read t)

(p subgoal-read-s2
   =goal>
      isa do-mapping-phase
      read t
      done-read nil
==>
   !output! (Reading s2)
   =subgoal>
      isa read-story-first-time
      story s2
      start i1
   =goal>
      done-read t
   !push! =subgoal)

(p subgoal-incremental-map
   =goal>
      isa do-mapping-phase
      condition =condition
      done-read t
      mapped nil
==>
   !output! (Mapping s2 to s1)
   =subgoal>
      isa incremental-map
      condition =condition
   =goal>
      mapped t
   !push! =subgoal)

(p done-mapping-phase
   =goal>
      isa do-mapping-phase
      mapped t
==>
   !output! (Clicking OK)
   !eval! (vi-type-enter-story)
   !pop!)

;;;-------------------------------------------------------------------------------
;;;
;;;  Do Problem Productions
;;;

;;;
;;;  Do Problem
;;;

(chunk-type do-problem
            condition phase)

(p subgoal-do-study-phase
   =goal>
      isa do-problem
      condition =condition
      phase i1
==>
   !output! (Starting study phase)
   =subgoal>
      isa do-study-phase
      condition =condition
   =goal>
      phase i2
   !push! =subgoal)

(p subgoal-do-mapping-phase
   =goal>
      isa do-problem
      condition =condition
      phase i2
==>
   !output! (Starting mapping phase)
   =subgoal>
      isa do-mapping-phase
      condition =condition
   =goal>
      phase i3
   !push! =subgoal
)

(p done-do-problem
   =goal>
      isa do-problem
      phase i3
==>
   !output! (Done problem)
   !pop!)

;;;
;;;  Final
;;;