;;;<pre><xmp>
;;;
;;;  Model of the Karla-the-Hawk Stories
;;;  (Representation derived from Falkenhainer, Forbus, & Gentner, 1989)
;;;  Dario Salvucci
;;;
;;;------------------------------------------------------------------- 
;;;
;;;  Parameters
;;;

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

#|
? (r)
 
     SET SOURCE ROLE TO S1-Promisee
     SET SOURCE RELATION TO S1-Promise , PARENT TYPE TO Promise ,
     SLOT TO Promisee , AND CHILD TYPE TO Hawk
     MAPPING S1-Promise
        SET SOURCE ROLE TO S1-Effect1
        SET SOURCE RELATION TO S1-Causes1 , PARENT TYPE TO Causes ,
        SLOT TO Effect , AND CHILD TYPE TO Promise
        MAPPING S1-Causes1
           REACHED ROOT RELATION S1-Causes1
        RETRIEVED ANALOGOUS ROLE S2-Effect1
        MAPPED S1-Causes1 TO S2-Causes2
        MAPPED S1-Promise TO S2-Promise
     RETRIEVED ANALOGOUS ROLE S2-Promisee
     MAPPED S1-Karla TO S2-Zerdia
  Top goal popped.
 
     SET SOURCE ROLE TO S1-Leaver
     SET SOURCE RELATION TO S1-Leavealone , PARENT TYPE TO Leavealone ,
     SLOT TO Leaver , AND CHILD TYPE TO Hunter
     MAPPING S1-Leavealone
        SET SOURCE ROLE TO S1-Promised
        SET SOURCE RELATION TO S1-Promise , PARENT TYPE TO Promise ,
        SLOT TO Promised , AND CHILD TYPE TO Leavealone
        MAPPING S1-Promise
           SET SOURCE ROLE TO S1-Effect1
           SET SOURCE RELATION TO S1-Causes1 , PARENT TYPE TO Causes ,
           SLOT TO Effect , AND CHILD TYPE TO Promise
           MAPPING S1-Causes1
              REACHED ROOT RELATION S1-Causes1
           RETRIEVED ANALOGOUS ROLE S2-Effect1
           MAPPED S1-Causes1 TO S2-Causes2
           MAPPED S1-Promise TO S2-Promise
        RETRIEVED ANALOGOUS ROLE S2-Promised
        MAPPED S1-Leavealone TO S2-Leavealone
     RETRIEVED ANALOGOUS ROLE S2-Leaver
     MAPPED S1-Hunter TO S2-Gagrach
  Top goal popped.
 
     SET SOURCE ROLE TO S1-Desired
     SET SOURCE RELATION TO S1-Desire , PARENT TYPE TO Desire ,
     SLOT TO Desired , AND CHILD TYPE TO Feathers
     MAPPING S1-Desire
        SET SOURCE ROLE TO S1-Realized
        SET SOURCE RELATION TO S1-Realize , PARENT TYPE TO Realize ,
        SLOT TO Realized , AND CHILD TYPE TO Desire
        MAPPING S1-Realize
           SET SOURCE ROLE TO S1-Cause4
           SET SOURCE RELATION TO S1-Causes4 , PARENT TYPE TO Causes ,
           SLOT TO Cause , AND CHILD TYPE TO Realize
           MAPPING S1-Causes4
              REACHED ROOT RELATION S1-Causes4
           RETRIEVED ANALOGOUS ROLE S2-Cause4
           MAPPED S1-Causes4 TO S2-Causes4
           MAPPED S1-Realize TO S2-Realize
        RETRIEVED ANALOGOUS ROLE S2-Realized
        MAPPED S1-Desire TO S2-Desire
     RETRIEVED ANALOGOUS ROLE S2-Desired
     MAPPED S1-Feathers TO S2-Computer
  Top goal popped.
 
     SET SOURCE ROLE TO S1-Badforwhat
     SET SOURCE RELATION TO S1-Badfor , PARENT TYPE TO Badfor ,
     SLOT TO Badforwhat , AND CHILD TYPE TO Crossbow
     MAPPING S1-Badfor
        SET SOURCE ROLE TO S1-Cause5
        SET SOURCE RELATION TO S1-Causes5 , PARENT TYPE TO Causes ,
        SLOT TO Cause , AND CHILD TYPE TO Badfor
        MAPPING S1-Causes5
           REACHED ROOT RELATION S1-Causes5
        RETRIEVED ANALOGOUS ROLE S2-Cause5
        MAPPED S1-Causes5 TO S2-Causes5
        MAPPED S1-Badfor TO S2-Badfor
     RETRIEVED ANALOGOUS ROLE S2-Badforwhat
     MAPPED S1-Crossbow TO S2-Missiles
  Top goal popped.

Time: 23.36 s

Results:
((s1-crossbow s2-missiles) (s1-feathers s2-computer) (s1-hunter 
s2-gagrach) (s1-karla s2-zerdia))

#S(data :labels nil :array 1)
? (rr 500)
;Loading #P"Clyde:Research:Papers - In Progress:CS00:Models, 
Submission:Karla the Hawk:karlahawk.model"...

Source
Model             0.70

nil
?
|#
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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 "Karla-the-Hawk Model" 2)
        
        (:new-para)

        (:table)
        
        (:table)
        "Dissimilar-chunk mismatch: "   (:string :sy *estimated-different-match* 1.7)  
        (:table-end)
         
        (:table-end)
        
         (:new-para)
        (:button "Run model" " 

                               (if  (numberp *estimated-different-match*)
                                 (progn 
                                    (setf *estimated-different-match* (mismatch->similarity-kth *estimated-different-match*))
                                     
                                    (r-kth ))
                                 (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:"
        (:new-para)
        "- It usually takes less than 1 minute to run the model"
        (:new-para)))

;;;------------------------------------------------------------------- 
;;;
;;;  Setup and Analysis Code
;;;

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

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

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

(defvar *results*)

(defun r-kth (&optional (ot t) (ct nil) (act nil) (others nil))
   (reset)
   (setf *results* nil)
   (sgp-fct (list :ot ot :ct ct :act act :cst others :pmt others)); :lt others))
   (my-set-similarities-kth
    (all-pairs-kth '(causes cause effect follows followed follower promise 
                 promiser promised
                 leavealone leaver leavee happy obtain obtainer obtained 
                 offer offerer
                 offeree offered realize realizer realized desire desirer desired
                 failure attack attacker attacked badfor isbadfor 
                 badforwhat see seer
                 seen hunter hawk feathers crossbow country computer missiles))
    *estimated-different-match*)
   (setf *command-trace* ot)
   (dolist (goal '(goal1 goal2 goal3 goal4))
     (goal-focus-fct (list goal))
     (run))
   (when ot
     (format t "~%~%Time: ~,2f s~%~%Results:" (actr-time))
     (pprint *results*)
     (format t "~%~%"))
   )


;;;------------------------------------------------------------------- 
;;;</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)))
)

(add-dm
  (none isa chunk) (fail isa chunk)
 
  (causes isa chunk) (cause isa chunk) (effect isa chunk)
  (follows isa chunk) (followed isa chunk) (follower isa chunk)
  (promise isa chunk) (promiser isa chunk) (promisee isa chunk) 
(promised isa chunk)
  (leavealone isa chunk) (leaver isa chunk) (leavee isa chunk)
  (happy isa chunk)
  (obtain isa chunk) (obtainer isa chunk) (obtained isa chunk)
  (offer isa chunk) (offerer isa chunk) (offeree isa chunk) (offered isa chunk)
  (realize isa chunk) (realizer isa chunk) (realized isa chunk)
  (desire isa chunk) (desirer isa chunk) (desired isa chunk)
  (failure isa chunk)
  (attack isa chunk) (attacker isa chunk) (attacked isa chunk)
  (badfor isa chunk) (isbadfor isa chunk) (badforwhat isa chunk)
  (see isa chunk) (seer isa chunk) (seen isa chunk)

  (hunter isa chunk) (hawk isa chunk)
  (feathers isa chunk) (crossbow isa chunk)

  (country isa chunk)
  (computer isa chunk) (missiles isa chunk)

  ;; Karla the Hawk story

  (s1-causes1 isa chunk)
  (s1-causes2 isa chunk)
  (s1-causes3 isa chunk)
  (s1-causes4 isa chunk)
  (s1-causes5 isa chunk)
  (s1-follows1 isa chunk)
  (s1-follows2 isa chunk)
  (s1-promise isa chunk)
  (s1-leavealone isa chunk)
  (s1-happy isa chunk)
  (s1-obtain isa chunk)
  (s1-offer isa chunk)
  (s1-realize isa chunk)
  (s1-desire isa chunk)
  (s1-failure isa chunk)
  (s1-attack isa chunk)
  (s1-badfor isa chunk)
  (s1-see isa chunk)
  (s1-hunter isa chunk)
  (s1-karla isa chunk)
  (s1-feathers isa chunk)
  (s1-crossbow isa chunk)

  (s1-happy1 isa source-role
             parent s1-happy parent-type happy
             slot happy
             child s1-hunter child-type hunter)
  (s1-leaver isa source-role
             parent s1-leavealone parent-type leavealone
             slot leaver
             child s1-hunter child-type hunter)
  (s1-leavee isa source-role
             parent s1-leavealone parent-type leavealone
             slot leavee
             child s1-karla child-type hawk)
  (s1-promiser isa source-role
               parent s1-promise parent-type promise
               slot promiser
               child s1-hunter child-type hunter)
  (s1-promisee isa source-role
               parent s1-promise parent-type promise
               slot promisee
               child s1-karla child-type hawk)
  (s1-promised isa source-role
               parent s1-promise parent-type promise
               slot promised
               child s1-leavealone child-type leavealone)
  (s1-cause1 isa source-role
             parent s1-causes1 parent-type causes
             slot cause
             child s1-happy child-type happy)
  (s1-effect1 isa source-role
             parent s1-causes1 parent-type causes
             slot effect
             child s1-promise child-type promise)
  (s1-obtainer isa source-role
             parent s1-obtain parent-type obtain
             slot obtainer
             child s1-hunter child-type hunter)
  (s1-obtained isa source-role
             parent s1-obtain parent-type obtain
             slot obtained
             child s1-feathers child-type feathers)
  (s1-cause2 isa source-role
             parent s1-causes2 parent-type causes
             slot cause
             child s1-obtain child-type obtain)
  (s1-effect2 isa source-role
             parent s1-causes2 parent-type causes
             slot effect
             child s1-happy child-type happy)
  (s1-offerer isa source-role
             parent s1-offer parent-type offer
             slot offerer
             child s1-karla child-type hawk)
  (s1-offeree isa source-role
             parent s1-offer parent-type offer
             slot offeree
             child s1-hunter child-type hunter)
  (s1-offered isa source-role
             parent s1-offer parent-type offer
             slot offered
             child s1-feathers child-type feathers)
  (s1-cause3 isa source-role
             parent s1-causes3 parent-type causes
             slot cause
             child s1-offer child-type offer)
  (s1-effect3 isa source-role
             parent s1-causes3 parent-type causes
             slot effect
             child s1-obtain child-type obtain)
  (s1-desirer isa source-role
             parent s1-desire parent-type desire
             slot desirer
             child s1-hunter child-type hunter)
  (s1-desired isa source-role
             parent s1-desire parent-type desire
             slot desired
             child s1-feathers child-type feathers)
  (s1-realizer isa source-role
             parent s1-realize parent-type realize
             slot realizer
             child s1-karla child-type hawk)
  (s1-realized isa source-role
             parent s1-realize parent-type realize
             slot realized
             child s1-desire child-type desire)
  (s1-cause4 isa source-role
             parent s1-causes4 parent-type causes
             slot cause
             child s1-realize child-type realize)
  (s1-effect4 isa source-role
             parent s1-causes4 parent-type causes
             slot effect
             child s1-offer child-type offer)
  (s1-attacker isa source-role
             parent s1-attack parent-type attack
             slot attacker
             child s1-hunter child-type hunter)
  (s1-attacked isa source-role
             parent s1-attack parent-type attack
             slot attacked
             child s1-karla child-type hawk)
  (s1-failure1 isa source-role
             parent s1-failure parent-type failure
             slot failure
             child s1-attack child-type attack)
  (s1-followed1 isa source-role
             parent s1-follows1 parent-type follows
             slot followed
             child s1-failure child-type failure)
  (s1-follower1 isa source-role
             parent s1-follows1 parent-type follows
             slot follower
             child s1-realize child-type realize)
  (s1-isbadfor isa source-role
             parent s1-badfor parent-type badfor
             slot isbadfor
             child s1-feathers child-type feathers)
  (s1-badforwhat isa source-role
             parent s1-badfor parent-type badfor
             slot badforwhat
             child s1-crossbow child-type crossbow)
  (s1-cause5 isa source-role
             parent s1-causes5 parent-type causes
             slot cause
             child s1-badfor child-type badfor)
  (s1-effect5 isa source-role
             parent s1-causes5 parent-type causes
             slot effect
             child s1-failure child-type failure)
  (s1-seer isa source-role
             parent s1-see parent-type see
             slot seer
             child s1-karla child-type hawk)
  (s1-seen isa source-role
             parent s1-see parent-type see
             slot seen
             child s1-hunter child-type hunter)
  (s1-followed2 isa source-role
             parent s1-follows2 parent-type follows
             slot followed
             child s1-see child-type see)
  (s1-follower2 isa source-role
             parent s1-follows2 parent-type follows
             slot follower
             child s1-failure child-type failure)
 
  ;; Zerdia story

  (s2-causes1 isa chunk)
  (s2-causes2 isa chunk)
  (s2-causes3 isa chunk)
  (s2-causes4 isa chunk)
  (s2-causes5 isa chunk)
  (s2-follows1 isa chunk)
  (s2-follows2 isa chunk)
  (s2-promise isa chunk)
  (s2-leavealone isa chunk)
  (s2-happy isa chunk)
  (s2-obtain isa chunk)
  (s2-offer isa chunk)
  (s2-realize isa chunk)
  (s2-desire isa chunk)
  (s2-failure isa chunk)
  (s2-attack isa chunk)
  (s2-badfor isa chunk)
  (s2-see isa chunk)
  (s2-gagrach isa chunk)
  (s2-zerdia isa chunk)
  (s2-computer isa chunk)
  (s2-missiles isa chunk)

  (s2-happy1 isa target-role
             parent s2-happy parent-type happy
             slot happy
             child s2-gagrach child-type country)
  (s2-leaver isa target-role
             parent s2-leavealone parent-type leavealone
             slot leaver
             child s2-gagrach child-type country)
  (s2-leavee isa target-role
             parent s2-leavealone parent-type leavealone
             slot leavee
             child s2-zerdia child-type country)
  (s2-promiser isa target-role
               parent s2-promise parent-type promise
               slot promiser
               child s2-gagrach child-type country)
  (s2-promisee isa target-role
               parent s2-promise parent-type promise
               slot promisee
               child s2-zerdia child-type country)
  (s2-promised isa target-role
               parent s2-promise parent-type promise
               slot promised
               child s2-leavealone child-type leavealone)
  (s2-cause1 isa target-role
             parent s2-causes2 parent-type causes
             slot cause
             child s2-happy child-type happy)
  (s2-effect1 isa target-role
             parent s2-causes2 parent-type causes
             slot effect
             child s2-promise child-type promise)
  (s2-obtainer isa target-role
             parent s2-obtain parent-type obtain
             slot obtainer
             child s2-gagrach child-type country)
  (s2-obtained isa target-role
             parent s2-obtain parent-type obtain
             slot obtained
             child s2-computer child-type computer)
  (s2-cause2 isa target-role
             parent s2-causes2 parent-type causes
             slot cause
             child s2-obtain child-type obtain)
  (s2-effect2 isa target-role
             parent s2-causes2 parent-type causes
             slot effect
             child s2-happy child-type happy)
  (s2-offerer isa target-role
             parent s2-offer parent-type offer
             slot offerer
             child s2-zerdia child-type country)
  (s2-offeree isa target-role
             parent s2-offer parent-type offer
             slot offeree
             child s2-gagrach child-type country)
  (s2-offered isa target-role
             parent s2-offer parent-type offer
             slot offered
             child s2-computer child-type computer)
  (s2-cause3 isa target-role
             parent s2-causes3 parent-type causes
             slot cause
             child s2-offer child-type offer)
  (s2-effect3 isa target-role
             parent s2-causes3 parent-type causes
             slot effect
             child s2-obtain child-type obtain)
  (s2-desirer isa target-role
             parent s2-desire parent-type desire
             slot desirer
             child s2-gagrach child-type country)
  (s2-desired isa target-role
             parent s2-desire parent-type desire
             slot desired
             child s2-computer child-type computer)
  (s2-realizer isa target-role
             parent s2-realize parent-type realize
             slot realizer
             child s2-zerdia child-type country)
  (s2-realized isa target-role
             parent s2-realize parent-type realize
             slot realized
             child s2-desire child-type desire)
  (s2-cause4 isa target-role
             parent s2-causes4 parent-type causes
             slot cause
             child s2-realize child-type realize)
  (s2-effect4 isa target-role
             parent s2-causes4 parent-type causes
             slot effect
             child s2-offer child-type offer)
  (s2-attacker isa target-role
             parent s2-attack parent-type attack
             slot attacker
             child s2-gagrach child-type country)
  (s2-attacked isa target-role
             parent s2-attack parent-type attack
             slot attacked
             child s2-zerdia child-type country)
  (s2-failure1 isa target-role
             parent s2-failure parent-type failure
             slot failure
             child s2-attack child-type attack)
  (s2-followed1 isa target-role
             parent s2-follows2 parent-type follows
             slot followed
             child s2-failure child-type failure)
  (s2-follower1 isa target-role
             parent s2-follows2 parent-type follows
             slot follower
             child s2-realize child-type realize)
  (s2-isbadfor isa target-role
             parent s2-badfor parent-type badfor
             slot isbadfor
             child s2-computer child-type computer)
  (s2-badforwhat isa target-role
             parent s2-badfor parent-type badfor
             slot badforwhat
             child s2-missiles child-type missiles)
  (s2-cause5 isa target-role
             parent s2-causes5 parent-type causes
             slot cause
             child s2-badfor child-type badfor)
  (s2-effect5 isa target-role
             parent s2-causes5 parent-type causes
             slot effect
             child s2-failure child-type failure)
  (s2-seer isa target-role
             parent s2-see parent-type see
             slot seer
             child s2-zerdia child-type country)
  (s2-seen isa target-role
             parent s2-see parent-type see
             slot seen
             child s2-gagrach child-type country)
  (s2-followed2 isa target-role
             parent s2-follows2 parent-type follows
             slot followed
             child s2-see child-type see)
  (s2-follower2 isa target-role
             parent s2-follows2 parent-type follows
             slot follower
             child s2-failure child-type failure)
 
  )

(sdp :references 50)


(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 fail
       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 fail
    !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 fail
       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 fail
       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!)

)

;;;
;;;  Map Story Object
;;;

(chunk-type map-story-object source-object target-object)

(p subgoal-map-object
    =goal>
       isa map-story-object
       source-object =source-object
       target-object nil
==>
    =subgoal>
       isa map-object
       source-object =source-object
       target-object =target-object
    =goal>
       target-object =target-object
    !push! =subgoal)

(p note-mapped-object
    =goal>
       isa map-story-object
       source-object =source-object
       target-object =target-object
==>
    !eval! (push (list =source-object =target-object) *results*)
    !pop!)

;;;
;;;  Main Goal
;;;

(add-dm
  (goal1 isa map-story-object source-object s1-karla)
  (goal2 isa map-story-object source-object s1-hunter)
  (goal3 isa map-story-object source-object s1-feathers)
  (goal4 isa map-story-object source-object s1-crossbow))

(goal-focus goal1 goal2)