Liren Large Software Subsidy 9/09.iso/e/e051/2.ddi/EXAMPLES/MAB.OPS

Text File | 1987-08-08 | 9.3 KB | 349 lines

;;;; new monkeys and bananas MAB5
;;;
;;; there is a planning phase and an execution phase

#|    to grab object1, stand on object two
    to stand on object2, move object two to place, and climb
    to move object2 to place, go to object2
    to go to object two, etc.
    try to have conjunctive goals
    need goal satisfaction routine
    remove pending routine
    make plan to plan
    make execute to execute
|#

(literalize monkey
    at
    on
    holds)


(literalize object
    name
    class
    at
    weight
    size
    on)

(literalize goal
    id
    status        ;satisfied, active, pending
    typ        ;hold, move, grab, on, climb
    class
    object
    to
    at
    pending-on)

(vector-attribute pending-on)

(p get-class-of-object
    (plan)
    {<ingoal> (goal ^status active ^typ hold ^class <w>)}
    (object ^class <w> ^name <u> ^at <p>)
    -->
    (bind <name>)
    (make goal ^id <name> ^status active ^typ grab ^object <u> ^at <p>)
    (modify <ingoal> ^status pending ^object <u> ^pending-on <name>))

(p get-object-on-floor
    (plan)
    {<ingoal> (goal ^status active ^typ grab ^object <w> ^at <p>)}
    (object ^name <w> ^at <p> ^on floor)
    -->
    (bind <name>)
    (make goal ^id <name> ^status active ^typ move ^object self ^to <p>)
    (modify <ingoal> ^status pending ^pending-on <name>))


(p get-object-on-ceiling
    (plan)
    {<ingoal> (goal ^status active ^typ grab ^object <w> ^at <p>)}
    (object ^name <w> ^at <p> ^on ceiling)
    (object ^class << furniture tool >> ^name <implement> ^size large
        ^weight light ^at <q>)
    -->
    (bind <name>)
    (make goal ^id <name> ^status active ^typ on ^object <implement>
           ^at <p>)
    (modify <ingoal> ^status pending ^pending-on <name>))

(p get-on-object
    (plan)
    {<ingoal> (goal ^status active ^typ on ^object <implement> ^at <p>)}
     -->
    (bind <name>)
    (make goal ^id <name> ^status active ^typ climb
           ^object <implement> ^at <p>)
    (modify <ingoal> ^status pending ^pending-on <name>))


(p able-to-climb-on-object
    (plan)
    {<ingoal> (goal ^status active ^typ climb ^object <implement>
            ^at <p>)}
     -->
    (bind <name1>)
    (bind <name2>)
    (bind <name3>)
    (make goal ^id <name1> ^status active ^typ move
           ^object <implement> ^to <p>)
    (make goal ^id <name2> ^status pending ^typ move ^object self
           ^to <p> ^pending-on <name1>)
    (make goal ^id <name3> ^status pending ^typ hold ^object nil
           ^at <p> ^pending-on <name1> <name2>)
    (modify <ingoal> ^status pending
             ^pending-on <name1> <name2> <name3>))


(p move-implement-to-scene
    (plan)
    {<ingoal>(goal ^status active ^typ move ^object <implement>
            ^to <p>)}
    (object ^name <implement> ^at {<q> <> <p>})
     -->
    (bind <name1>)
    (bind <name2>)
    (bind <name3>)
    (bind <name4>)
    (make goal ^id <name1> ^status active ^typ move ^object self
           ^to <q>)
    (make goal ^id <name2> ^status pending ^typ hold ^object nil
           ^at <q> ^pending-on <name1>)
    (make goal ^id <name3> ^status pending ^typ grab
           ^object <implement> ^at <q> ^pending-on <name1> <name2>)
    (make goal ^id <name4> ^status pending ^typ move
           ^object self ^to <p> ^pending-on <name3>)
    (modify <ingoal> ^status pending ^pending-on <name4>))

(p move-self-to-scene
    (plan)
    {<ingoal> (goal ^status active ^typ move ^object self
            ^to {<q> <> floor})}
    {<monk> (monkey ^on {<x> <> floor} ^at {<p> <> <q>})}
   -->
    (bind <name>)
    (make goal ^id <name> ^status active ^typ move ^object self
           ^to floor ^at <p>)
    (modify <ingoal> ^status pending ^pending-on <name>))


(p move-down-to-scene
    (plan)
    {<ingoal> (goal ^status active ^typ move ^object self
            ^to {<q> <> floor})}
    {<monk> (monkey ^on {<x> <> floor} ^at <q>)}
   -->
    (modify <ingoal> ^to floor ^at <q>))


;;;;;;;;;;;;;;;;;;; EXECUTION PHASE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;; for converting pending to active ;;;;;;;;;;;;;;;;;
;;; goals pending on other goals list the other goals under the ;;;
;;; pending-on attribute.  We can detect and remove satisfied   ;;;
;;; dependencies one at a time, beginning with the first in the ;;;
;;; the list and placing nil at the end of the list for each    ;;;
;;; satisfied dependency.                                       ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(p shift-from-planning
    {<pwme> (plan)}
    {<init> (init-done)}
   -->
    (remove <pwme> <init>)
    (make executing)
    (write (crlf)
  "The plan is complete.  To see the plan, use the (WM) command." (crlf)
  "To execute the plan, use the (RUN) command." (crlf))
    (halt))

(p pending-to-active
    (executing)
    {<pgoal>
    (goal ^status pending ^pending-on <other-goal>)}
    (goal ^id <other-goal> ^status satisfied)
    -->
    (bind <x> (litval pending-on))
    (bind <x> (compute <x> + 1))
    (modify <pgoal> ^pending-on (substr <pgoal> <x> inf) nil))

(p nil-pending
    (executing)
    {<pgoal>
    (goal ^status pending ^pending-on nil)}
    -->
    (modify <pgoal> ^status active))

;;;;;;;;;;;;;; converting standard active goals to satisfied ;;;;;;;

(p drop-object
    (executing)
    {<ingoal> (goal ^status active ^typ hold ^object nil)}
    {<monk> (monkey ^holds {<x> <> nil})}
    {<obj> (object ^name <x>)}
    -->
    (write (crlf) monkey drops <x> (crlf))
    (modify <monk> ^holds nil)
    (modify <obj> ^on floor)
    (modify <ingoal> ^status satisfied))

(p no-object-to-drop
    (executing)
    {<ingoal> (goal ^status active ^typ hold ^object nil)}
    {<monk> (monkey ^holds nil)}
    -->
    (modify <ingoal> ^status satisfied))


(p holds-now
    (executing)
    {<ingoal> (goal ^status active ^typ hold ^object <x>)}
    {<obj> (object ^name <x> ^weight light)}
    {<monk> (monkey)}
    -->
    (modify <monk> ^holds <x>)
    (modify <obj> ^on monkey)
    (write (crlf) monkey holds <x> (crlf))
    (modify <ingoal> ^status satisfied))

(p holds-fails
    (executing)
    {<ingoal>
    (goal ^status active ^typ hold ^object <x>)}
    (object ^name <x> ^weight heavy)
    -->
    (write (crlf) <x> too heavy for monkey (crlf)))

(p move-done
    (executing)
    {<ingoal>
    (goal ^status active ^typ move ^object <x> ^to <p>)}
    {<obj> (object ^name <x>)}
    -->
    (modify <obj> ^at <p>)
    (write (crlf) the <x> |is(are)| now at <p> (crlf))
    (modify <ingoal> ^status satisfied))

(p move-self-to-floor
    (executing)
    {<ingoal> (goal ^status active ^typ move ^object self ^to floor
            ^at <p>)}
    {<monk> (monkey ^on {<x> <> floor} ^at <p>)}
   -->
    (modify <monk> ^on floor ^at <p>)
    (write (crlf) "Monkey jumps to floor" (crlf))
    (modify <ingoal> ^status satisfied))


(p move-self
    (executing)
    {<ingoal>
    (goal ^status active ^typ move ^object self ^to <p>)}
    {<monk> (monkey ^on floor)}
    -->
    (modify <monk> ^at <p>)
    (write (crlf) the monkey is now at <p> (crlf))
    (modify <ingoal> ^status satisfied))

(p move-self-done
    (executing)
    {<ingoal>
    (goal ^status active ^typ move ^object self ^to <p>)}
    {<monk> (monkey ^on floor ^at <p>)}
    -->
    (modify <ingoal> ^status satisfied))

(p grab-object
    (executing)
    {<ingoal> (goal ^status active ^typ grab ^object <x> ^at <p>)}
    {<obj> (object ^name <x> ^at <p>)}
    {<monk> (monkey ^holds nil ^at <p>)}
    -->
    (write (crlf) "monkey grabs" <x> (crlf))
    (modify <monk> ^holds <x>)
    (modify <obj> ^on monkey)
    (modify <ingoal> ^status satisfied))

(p gets-on
    (executing)
    {<ingoal> (goal ^status active ^typ on ^object <x> ^at <p>)}
    (object ^name <x> ^at <p>)
    {<monk> (monkey)}
    -->
    (modify <monk> ^on <x>)
    (write (crlf) the monkey is on the <x> (crlf))
    (modify <ingoal> ^status satisfied))

(p climb-on-object
    (executing)
    {<ingoal> (goal ^status active ^typ climb ^object <x> ^at <p>)}
    (object ^name <x> ^at <p>)
    {<monk> (monkey ^at <p> ^holds nil)}
    -->
    (write (crlf) the monkey climbs the <x> (crlf))
    (modify <monk> ^on <x>)
    (modify <ingoal> ^status satisfied))

(p got-class-of-object
    (executing)
    {<ingoal> (goal ^status active ^typ hold ^class food ^object <u>)}
    (monkey ^holds <u>)
    -->
    (write (crlf) the monkey is happy to have the <u> (crlf))
    (modify <ingoal> ^status satisfied))


;;;;;;;;;;;;;;;;;;; INITIALIZATION PHASE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(p initialize
    (start)
    -->
    (write (crlf)
      "Make working memory element plan to make a plan." (crlf)))

(p initialize-plan
    (plan)
    -->
    (write (crlf)
  "In the monkeys and bananas problem, we begin with a monkey sitting" (crlf)
  "on a couch.  There are some bananas on the ceiling across the room." (crlf)
  "There is also a ladder in a different part of the room.  To solve" (crlf)
  "the problem, we must make a plan the monkey can use to get the" (crlf)
  "bananas.  Type a carriage return to see the room" (crlf))
    (bind <foo> (acceptline))
    (write (crlf) (crlf)
"    1    2    3    4    5    6    7"
 (crlf) (crlf)
"1"
 (crlf) (crlf)
"2            bananas"
 (crlf) (crlf))
    (write
"3"
 (crlf) (crlf)
"4"
 (crlf) (crlf)
"5                          ladder"
 (crlf) (crlf)
"6"
 (crlf)
"                  monkey" (crlf)
"7                   couch" (crlf) (crlf))
    (make monkey ^at loc4-7 ^on couch)
    (make object ^name couch ^at loc4-7 ^weight heavy ^size large
             ^class furniture)
    (make object ^name bananas ^on ceiling ^at loc2-2 ^size small
             ^class food)
    (make object ^name ladder ^on floor ^at loc6-5 ^weight light
             ^size large ^class tool)
    (make init-done)
    (make goal ^id (genatom) ^status active ^typ hold
           ^class food))


;;; end mab ;;;