home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 8 Other / 08-Other.zip / PMCLIPS.ZIP / MAB.CLP < prev    next >
Text File  |  1989-03-29  |  12KB  |  360 lines
  1.  
  2. ;;;======================================================
  3. ;;;   Monkees and Bananas Sample Problem
  4. ;;;
  5. ;;;     This is an extended version of a
  6. ;;;     rather common AI planning problem.
  7. ;;;     The point is for the monkee to find
  8. ;;;     and eat some bananas.
  9. ;;;
  10. ;;;     To execute, merely load, reset and run.
  11. ;;;======================================================
  12.   
  13. ;;;*************
  14. ;;;* TEMPLATES *
  15. ;;;*************
  16.            
  17. (deftemplate monkey 
  18.    (field location 
  19.       (type WORD) 
  20.       (default green-couch))
  21.    (field on-top-of 
  22.       (type WORD) 
  23.       (default floor)) 
  24.    (field holding 
  25.       (type WORD) 
  26.       (default nothing)))
  27.  
  28. (deftemplate object 
  29.    (field name 
  30.       (type WORD)
  31.       (default ?NONE)) 
  32.    (field location 
  33.       (type WORD)
  34.       (default ?NONE)) 
  35.    (field on-top-of 
  36.       (type WORD) 
  37.       (default floor))
  38.    (field weight 
  39.       (default light)))
  40.                     
  41. (deftemplate chest 
  42.    (field name 
  43.       (type WORD)
  44.       (default ?NONE)) 
  45.    (field contents 
  46.       (type WORD)
  47.       (default ?NONE)) 
  48.    (field unlocked-by 
  49.       (type WORD)
  50.       (default ?NONE)))
  51.                
  52. (deftemplate goal-is-to 
  53.    (field action 
  54.       (type WORD)
  55.       (default ?NONE)) 
  56.    (multi-field arguments 
  57.       (type WORD)
  58.       (default ?NONE)))
  59.              
  60. ;;;*************************
  61. ;;;* chest unlocking rules *
  62. ;;;*************************
  63.  
  64. (defrule unlock-chest-to-hold-object ""
  65.   (goal-is-to (action holds) (arguments ?obj))
  66.   (chest (name ?chest) (contents ?obj))
  67.   (not (goal-is-to (action unlock) (arguments ?chest)))
  68.   =>
  69.   (assert (goal-is-to (action unlock) (arguments ?chest))))
  70.  
  71. (defrule unlock-chest-to-move-object "" 
  72.   (goal-is-to (action move) (arguments ?obj ?))
  73.   (chest (name ?chest) (contents ?obj))
  74.   (not (goal-is-to (action unlock) (arguments ?chest)))
  75.   =>
  76.   (assert (goal-is-to (action unlock) (arguments ?chest))))
  77.  
  78. (defrule hold-chest-to-put-on-floor "" 
  79.   (goal-is-to (action unlock) (arguments ?chest))
  80.   (object (name ?chest) (on-top-of ~floor) (weight light))
  81.   (monkey (holding ~?chest))
  82.   (not (goal-is-to (action holds) (arguments ?chest)))
  83.   =>
  84.   (assert (goal-is-to (action holds) (arguments ?chest))))
  85.  
  86. (defrule put-chest-on-floor "" 
  87.   (goal-is-to (action unlock) (arguments ?chest))
  88.   ?monkey <- (monkey (location ?place) (on-top-of ?on) (holding ?chest))
  89.   ?object <- (object (name ?chest))
  90.   =>
  91.   (printout t "Monkey throws " ?chest " off " ?on " onto floor." t)
  92.   (modify ?monkey (holding blank))
  93.   (modify ?object (location ?place) (on-top-of floor)))
  94.  
  95. (defrule get-key-to-unlock "" 
  96.   (goal-is-to (action unlock) (arguments ?obj))
  97.   (object (name ?obj) (on-top-of floor))
  98.   (chest (name ?obj) (unlocked-by ?key))
  99.   (monkey (holding ~?key))
  100.   (not (goal-is-to (action holds) (arguments ?key)))
  101.   =>
  102.   (assert (goal-is-to (action holds) (arguments ?key))))
  103.  
  104. (defrule move-to-chest-with-key "" 
  105.   (goal-is-to (action unlock) (arguments ?chest))
  106.   (monkey (location ?mplace) (holding ?key))
  107.   (object (name ?chest) (location ?cplace&~?mplace) (on-top-of floor))
  108.   (chest (name ?chest) (unlocked-by ?key))
  109.   (not (goal-is-to (action walk-to) (arguments ?cplace)))
  110.   =>
  111.   (assert (goal-is-to (action walk-to) (arguments ?cplace))))
  112.  
  113. (defrule unlock-chest-with-key "" 
  114.   ?goal <- (goal-is-to (action unlock) (arguments ?name))
  115.   ?chest <- (chest (name ?name) (contents ?contents) (unlocked-by ?key))
  116.   (object (name ?name) (location ?place) (on-top-of ?on))
  117.   (monkey (location ?place) (on-top-of ?on) (holding ?key))
  118.   =>
  119.   (printout t "Monkey opens " ?name " with " ?key " revealing " ?contents t)
  120.   (modify ?chest (contents nothing))
  121.   (assert (object (name ?contents) (location ?place) (on-top-of ?name)))
  122.   (retract ?goal))
  123.  
  124. ;;;***********************
  125. ;;;* process hold object * 
  126. ;;;***********************
  127.  
  128. (defrule use-ladder-to-hold ""
  129.   (goal-is-to (action holds) (arguments ?obj))
  130.   (object (name ?obj) (location ?place) (on-top-of ceiling) (weight light))
  131.   (not (object (name ladder) (location ?place)))
  132.   (not (goal-is-to (action move) (arguments ladder ?place)))
  133.   =>
  134.   (assert (goal-is-to (action move) (arguments ladder ?place))))
  135.  
  136. (defrule climb-ladder-to-hold ""
  137.   (goal-is-to (action holds) (arguments ?obj))
  138.   (object (name ?obj) (location ?place) (on-top-of ceiling) (weight light))
  139.   (object (name ladder) (location ?place) (on-top-of floor))
  140.   (monkey (on-top-of ~ladder))
  141.   (not (goal-is-to (action on) (arguments ladder)))
  142.   =>
  143.   (assert (goal-is-to (action on) (arguments ladder))))
  144.  
  145. (defrule grab-object-from-ladder "" 
  146.   ?goal <- (goal-is-to (action holds) (arguments ?name))
  147.   ?object <- (object (name ?name) (location ?place) (on-top-of ceiling) (weight light))
  148.   (object (name ladder) (location ?place))
  149.   ?monkey <- (monkey (location ?place) (on-top-of ladder) (holding blank))
  150.   =>
  151.   (printout t "Monkey grabs the " ?name t)
  152.   (modify ?object (location held) (on-top-of held))
  153.   (modify ?monkey (holding ?name))
  154.   (retract ?goal))
  155.  
  156. (defrule climb-to-hold "" 
  157.   (goal-is-to (action holds) (arguments ?obj))
  158.   (object (name ?obj) (location ?place) (on-top-of ?on&~ceiling) (weight light))
  159.   (monkey (location ?place) (on-top-of ~?on))
  160.   (not (goal-is-to (action on) (arguments ?on)))
  161.   =>
  162.   (assert (goal-is-to (action on) (arguments ?on))))
  163.  
  164. (defrule walk-to-hold ""
  165.   (goal-is-to (action holds) (arguments ?obj))
  166.   (object (name ?obj) (location ?place) (on-top-of ~ceiling) (weight light))
  167.   (monkey (location ~?place))
  168.   (not (goal-is-to (action walk-to) (arguments ?place)))
  169.   =>
  170.   (assert (goal-is-to (action walk-to) (arguments ?place))))
  171.  
  172. (defrule drop-to-hold ""
  173.   (goal-is-to (action holds) (arguments ?obj))
  174.   (object (name ?obj) (location ?place) (on-top-of ?on) (weight light))
  175.   (monkey (location ?place) (on-top-of ?on) (holding ~blank))
  176.   (not (goal-is-to (action holds) (arguments blank)))
  177.   =>
  178.   (assert (goal-is-to (action holds) (arguments blank))))
  179.  
  180. (defrule grab-object "" 
  181.   ?goal <- (goal-is-to (action holds) (arguments ?name))
  182.   ?object <- (object (name ?name) (location ?place) (on-top-of ?on) (weight light))
  183.   ?monkey <- (monkey (location ?place) (on-top-of ?on) (holding blank))
  184.   =>
  185.   (printout t "Monkey grabs the " ?name t)
  186.   (modify ?object (location held) (on-top-of held))
  187.   (modify ?monkey (holding ?name))
  188.   (retract ?goal))
  189.  
  190. ;;;**************************
  191. ;;;* move object to a place * 
  192. ;;;**************************
  193.  
  194. (defrule hold-object-to-move ""  
  195.   (goal-is-to (action move) (arguments ?obj ?place))
  196.   (object (name ?obj) (location ~?place) (weight light))
  197.   (monkey (holding ~?obj))
  198.   (not (goal-is-to (action holds) (arguments ?obj)))
  199.   =>
  200.   (assert (goal-is-to (action holds) (arguments ?obj))))
  201.  
  202. (defrule move-object-to-place "" 
  203.   (goal-is-to (action move) (arguments ?obj ?place))
  204.   (monkey (location ~?place) (holding ?obj))
  205.   (not (goal-is-to (action walk-to) (arguments ?place)))
  206.   =>
  207.   (assert (goal-is-to (action walk-to) (arguments ?place))))
  208.  
  209. (defrule drop-object-once-moved "" 
  210.   ?goal <- (goal-is-to (action move) (arguments ?name ?place))
  211.   ?monkey <- (monkey (location ?place) (holding ?obj))
  212.   ?object <- (object (name ?name) (weight light))
  213.   =>
  214.   (printout t "Monkey drops the " ?name "." t)
  215.   (modify ?monkey (holding blank))
  216.   (modify ?object (location ?place) (on-top-of floor))
  217.   (retract ?goal))
  218.  
  219. (defrule already-moved-object ""
  220.   ?goal <- (goal-is-to (action move) (arguments ?obj ?place))
  221.   (object (name ?obj) (location ?place))
  222.   =>
  223.   (retract ?goal))
  224.  
  225. ;;;*************************
  226. ;;;* process walk-to place *
  227. ;;;*************************
  228.  
  229. (defrule already-at-place "" 
  230.   ?goal <- (goal-is-to (action walk-to) (arguments ?place))
  231.   (monkey (location ?place))
  232.   =>
  233.   (retract ?goal))
  234.  
  235. (defrule get-on-floor-to-walk ""
  236.   (goal-is-to (action walk-to) (arguments ?place))
  237.   (monkey (location ~?place) (on-top-of ~floor))
  238.   (not (goal-is-to (action on) (arguments floor)))
  239.   =>
  240.   (assert (goal-is-to (action on) (arguments floor))))
  241.  
  242. (defrule walk-holding-nothing ""
  243.   ?goal <- (goal-is-to (action walk-to) (arguments ?place))
  244.   ?monkey <- (monkey (location ~?place) (on-top-of floor) (holding blank))
  245.   =>
  246.   (printout t "Monkey walks to " ?place t)
  247.   (modify ?monkey (location ?place))
  248.   (retract ?goal))
  249.  
  250. (defrule walk-holding-object ""
  251.   ?goal <- (goal-is-to (action walk-to) (arguments ?place))
  252.   ?monkey <- (monkey (location ~?place) (on-top-of floor) (holding ?obj&~blank))
  253.   =>
  254.   (printout t "Monkey walks to " ?place " holding " ?obj t)
  255.   (modify ?monkey (location ?place))
  256.   (retract ?goal))
  257.  
  258. (defrule drop-object ""  
  259.   ?goal <- (goal-is-to (action holds) (arguments blank))
  260.   ?monkey <- (monkey (location ?place) 
  261.                      (on-top-of ?on) 
  262.                      (holding ?name&~blank))
  263.   ?object <- (object (name ?name))
  264.   =>
  265.   (printout t "Monkey drops " ?name t)
  266.   (modify ?monkey (holding blank))
  267.   (modify ?object (location ?place) (on-top-of ?on))
  268.   (retract ?goal))
  269.  
  270. ;;;*************************
  271. ;;;* process get on object * 
  272. ;;;*************************
  273.  
  274. (defrule jump-onto-floor "" 
  275.   ?goal <- (goal-is-to (action on) (arguments floor))
  276.   ?monkey <- (monkey (on-top-of ?on&~floor))
  277.   =>
  278.   (printout t "Monkey jumps off " ?on " onto the floor." t)
  279.   (modify ?monkey (on-top-of floor))
  280.   (retract ?goal))
  281.  
  282. (defrule walk-to-place-to-climb "" 
  283.   (goal-is-to (action on) (arguments ?obj))
  284.   (object (name ?obj) (location ?place))
  285.   (monkey (location ~?place))
  286.   (not (goal-is-to (action walk-to) (arguments ?place)))
  287.   =>
  288.   (assert (goal-is-to (action walk-to) (arguments ?place))))
  289.  
  290. (defrule drop-to-climb "" 
  291.   (goal-is-to (action on) (arguments ?obj))
  292.   (object (name ?obj) (location ?place))
  293.   (monkey (location ?place) (holding ~blank))
  294.   (not (goal-is-to (action holds) (arguments blank)))
  295.   =>
  296.   (assert (goal-is-to (action holds) (arguments blank))))
  297.  
  298. (defrule climb-indirectly "" 
  299.   (goal-is-to (action on) (arguments ?obj))
  300.   (object (name ?obj) (location ?place) (on-top-of ?on))
  301.   (monkey (location ?place) (on-top-of ~?on&~?obj) (holding blank))
  302.   (not (goal-is-to (action on) (arguments ?on)))
  303.   =>
  304.   (assert (goal-is-to (action on) (arguments ?on))))
  305.  
  306. (defrule climb-directly ""  
  307.   ?goal <- (goal-is-to (action on) (arguments ?obj))
  308.   (object (name ?obj) (location ?place) (on-top-of ?on))
  309.   ?monkey <- (monkey (location ?place) (on-top-of ?on) (holding blank))
  310.   =>
  311.   (printout t "Monkey climbs onto " ?obj t)
  312.   (modify ?monkey (on-top-of ?obj))
  313.   (retract ?goal))
  314.  
  315. (defrule already-on-object ""
  316.   ?goal <- (goal-is-to (action on) (arguments ?obj))
  317.   (monkey (on-top-of ?obj))
  318.   =>
  319.   (retract ?goal))
  320.  
  321. ;;;**********************
  322. ;;;* process eat object * 
  323. ;;;**********************
  324.  
  325. (defrule hold-to-eat ""
  326.   (goal-is-to (action eat) (arguments ?obj))
  327.   (monkey (holding ~?obj))
  328.   (not (goal-is-to (action holds) (arguments ?obj)))
  329.   =>
  330.   (assert (goal-is-to (action holds) (arguments ?obj))))
  331.  
  332. (defrule satisfy-hunger ""
  333.   ?goal <- (goal-is-to (action eat) (arguments ?name))
  334.   ?monkey <- (monkey (holding ?name))
  335.   ?object <- (object (name ?name))
  336.   =>
  337.   (printout t "Monkey eats the " ?name "." t)
  338.   (modify ?monkey (holding blank))
  339.   (retract ?goal ?object))
  340.  
  341. ;;;*****************
  342. ;;;* initial-state * 
  343. ;;;*****************
  344.  
  345. (defrule startup ""
  346.   =>
  347.   (assert (monkey (location t5-7) (on-top-of green-couch) (holding blank)))
  348.   (assert (object (name green-couch) (location t5-7) (weight heavy)))
  349.   (assert (object (name red-couch) (location t2-2) (weight heavy)))
  350.   (assert (object (name big-pillow) (location t2-2) (on-top-of red-couch)))
  351.   (assert (object (name red-chest) (location t2-2) (on-top-of big-pillow)))
  352.   (assert (chest (name red-chest) (contents ladder) (unlocked-by red-key)))
  353.   (assert (object (name blue-chest) (location t7-7) (on-top-of ceiling)))
  354.   (assert (chest (name blue-chest) (contents bananas) (unlocked-by blue-key)))
  355.   (assert (object (name blue-couch) (location t8-8) (weight heavy)))
  356.   (assert (object (name green-chest) (location t8-8) (on-top-of ceiling)))
  357.   (assert (chest (name green-chest) (contents blue-key) (unlocked-by red-key)))
  358.   (assert (object (name red-key) (location t1-3)))
  359.   (assert (goal-is-to (action eat) (arguments bananas))))
  360.