home *** CD-ROM | disk | FTP | other *** search
/ Computer Club Elmshorn Atari PD / CCE_PD.iso / pc / 0600 / CCE_0622.ZIP / CCE_0622.PD / CLIPS / MAB2.CLP < prev    next >
Text File  |  1993-09-01  |  9KB  |  301 lines
  1.  
  2. ;;;======================================================
  3. ;;;   Monkees and Bannanas 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 bannanas.
  9. ;;;
  10. ;;;     To execute, merely load, reset and run.
  11. ;;;======================================================
  12.  
  13. ;;;*************************
  14. ;;;* chest unlocking rules *
  15. ;;;*************************
  16.  
  17. (defrule unlock-chest-to-hold-object ""
  18.   (goal-is-to active holds ?obj)
  19.   (object ?chest ? ? ? ?obj ?)
  20.   (not (goal-is-to active unlock ?chest))
  21.   =>
  22.   (assert (goal-is-to active unlock ?chest)))
  23.  
  24. (defrule unlock-chest-to-move-object "" 
  25.   (goal-is-to active move ?obj ?)
  26.   (object ?chest ? ? ? ?obj ?)
  27.   (not (goal-is-to active unlock ?chest))
  28.   =>
  29.   (assert (goal-is-to active unlock ?chest)))
  30.  
  31. (defrule hold-chest-to-put-on-floor "" 
  32.   (goal-is-to active unlock ?chest)
  33.   (object ?chest ? light ~floor ? ?)
  34.   (not (goal-is-to active holds ?chest))
  35.   =>
  36.   (assert (goal-is-to active holds ?chest)))
  37.  
  38. (defrule put-chest-on-floor "" 
  39.   (goal-is-to active unlock ?chest)
  40.   ?f1 <- (monkey ?place ?on ?chest)
  41.   ?f2 <- (object ?chest held light held ?contains ?key)
  42.   =>
  43.   (retract ?f1 ?f2)
  44.   (assert (monkey ?place ?on blank))
  45.   (assert (object ?chest ?place light floor ?contains ?key)))
  46.  
  47. (defrule get-key-to-unlock "" 
  48.   (goal-is-to active unlock ?obj)
  49.   (object ?obj ?place ? floor ? ?key)
  50.   (monkey ? ? ~?key)
  51.   (not (goal-is-to active holds ?key))
  52.   =>
  53.   (assert (goal-is-to active holds ?key)))
  54.  
  55. (defrule move-to-chest-with-key "" 
  56.   (goal-is-to active unlock ?chest)
  57.   (monkey ?mplace ? ?key)
  58.   (object ?chest ?cplace&~?mplace ? floor ? ?key)
  59.   (not (goal-is-to active walk-to ?cplace))
  60.   =>
  61.   (assert (goal-is-to active walk-to ?cplace)))
  62.  
  63. (defrule unlock-chest-with-key "" 
  64.   ?f1 <- (goal-is-to active unlock ?chest-obj)
  65.   ?f2 <- (object ?chest-obj ?place ?weight ?on ?obj-in ?key)
  66.   (monkey ?place ?on ?key)
  67.   =>
  68.   (retract ?f1 ?f2)
  69.   (assert (object ?chest-obj ?place ?weight ?on nil ?key))
  70.   (assert (object ?obj-in ?place light ?chest-obj nil nil)))
  71.  
  72. ;;;***********************
  73. ;;;* process hold object * 
  74. ;;;***********************
  75.  
  76. (defrule use-ladder-to-hold ""
  77.   (goal-is-to active holds ?obj)
  78.   (object ?obj ?place light ceiling ? ?)
  79.   (not (goal-is-to active move ladder ?place))
  80.   =>
  81.   (assert (goal-is-to active move ladder ?place)))
  82.  
  83. (defrule climb-ladder-to-hold ""
  84.   (goal-is-to active holds ?obj)
  85.   (object ?obj ?place light ceiling ? ?)
  86.   (object ladder ?place ? floor ? ?)
  87.   (not (goal-is-to active on ladder))
  88.   =>
  89.   (assert (goal-is-to active on ladder)))
  90.  
  91. (defrule grab-object-from-ladder "" 
  92.   ?f1 <- (goal-is-to active holds ?obj)
  93.   ?f2 <- (object ?obj ?place light ceiling ?contains ?key)
  94.   (object ladder ?place ? ? ? ?)
  95.   ?f3 <- (monkey ?place ladder blank)
  96.   =>
  97.   (retract ?f1 ?f2 ?f3)
  98.   (assert (object ?obj held light held ?contains ?key))
  99.   (assert (monkey ?place ladder ?obj)))
  100.  
  101. (defrule climb-to-hold "" 
  102.   (goal-is-to active holds ?obj)
  103.   (object ?obj ?place light ?on&~floor&~ceiling ? ?)
  104.   (monkey ?place ~?on ?)
  105.   (not (goal-is-to active on ?on))
  106.   =>
  107.   (assert (goal-is-to active on ?on)))
  108.  
  109. (defrule walk-to-hold ""
  110.   (goal-is-to active holds ?obj)
  111.   (object ?obj ?place light ~ceiling ? ?)
  112.   (monkey ~?place ? ?)
  113.   (not (goal-is-to active walk-to ?place))
  114.   =>
  115.   (assert (goal-is-to active walk-to ?place)))
  116.  
  117. (defrule drop-to-hold ""
  118.   (goal-is-to active holds ?obj)
  119.   (object ?obj ?place light floor ? ?)
  120.   (monkey ?place ? ~blank)
  121.   (not (goal-is-to active holds blank))
  122.   =>
  123.   (assert (goal-is-to active walk-to ?place)))
  124.  
  125. (defrule get-on-floor-to-hold ""
  126.   (goal-is-to active holds ?obj)
  127.   (object ?obj ?place light floor ? ?)
  128.   (monkey ?place ~floor ?)
  129.   (not (goal-is-to active on floor))
  130.   =>
  131.   (assert (goal-is-to active on floor)))
  132.  
  133. (defrule grab-object "" 
  134.   ?f1 <- (goal-is-to active holds ?obj)
  135.   ?f2 <- (object ?obj ?place light ?on ?contains ?key)
  136.   ?f3 <- (monkey ?place ?on blank)
  137.   =>
  138.   (retract ?f1 ?f2 ?f3)
  139.   (assert (object ?obj held light held ?contains ?key))
  140.   (assert (monkey ?place ?on ?obj)))
  141.  
  142. ;;;**************************
  143. ;;;* move object to a place * 
  144. ;;;**************************
  145.  
  146. (defrule hold-object-to-move ""  
  147.   (goal-is-to active move ?obj ?place)
  148.   (object ?obj ~?place light ? ? ?)
  149.   (monkey ? ? ~?obj)
  150.   (not (goal-is-to active holds ?obj))
  151.   =>
  152.   (assert (goal-is-to active holds ?obj)))
  153.  
  154. (defrule move-object-to-place "" 
  155.   (goal-is-to active move ?obj ?place)
  156.   (monkey ~?place ? ?obj)
  157.   (not (goal-is-to active walk-to ?place))
  158.   =>
  159.   (assert (goal-is-to active walk-to ?place)))
  160.  
  161. (defrule drop-object-once-moved "" 
  162.   ?f1 <- (goal-is-to active move ?obj ?place)
  163.   ?f2 <- (monkey ?place ?on ?obj)
  164.   ?f3 <- (object ?obj ? light ? ?contains ?key)
  165.   =>
  166.   (retract ?f1 ?f2 ?f3)
  167.   (assert (monkey ?place ?on blank))
  168.   (assert (object ?obj ?place light floor ?contains ?key)))
  169.  
  170. (defrule already-moved-object ""
  171.   ?f1 <- (goal-is-to active move ?obj ?place)
  172.   (object ?obj ?place ? ? ? ?)
  173.   =>
  174.   (retract ?f1))
  175.  
  176. ;;;*************************
  177. ;;;* process walk-to place *
  178. ;;;*************************
  179.  
  180. (defrule already-at-place "" 
  181.   ?f1 <- (goal-is-to active walk-to ?place)
  182.   (monkey ?place ? ?)
  183.   =>
  184.   (retract ?f1))
  185.  
  186. (defrule get-on-floor-to-walk ""
  187.   (goal-is-to active walk-to ?place)
  188.   (monkey ~?place ~floor ?)
  189.   (not (goal-is-to active on floor))
  190.   =>
  191.   (assert (goal-is-to active on floor)))
  192.  
  193. (defrule walk-holding-nothing ""
  194.   ?f1 <- (goal-is-to active walk-to ?place)
  195.   ?f2 <- (monkey ~?place floor blank)
  196.   =>
  197.   (retract ?f1 ?f2)
  198.   (assert (monkey ?place floor blank)))
  199.  
  200. (defrule walk-holding-object ""
  201.   ?f1 <- (goal-is-to active walk-to ?place)
  202.   ?f2 <- (monkey ~?place floor ?obj&~blank)
  203.   =>
  204.   (retract ?f1 ?f2)
  205.   (assert (monkey ?place floor ?obj)))
  206.  
  207. (defrule drop-object ""  
  208.   ?f1 <- (goal-is-to active holds blank)
  209.   ?f2 <- (monkey ?place ?on ?obj&~blank)
  210.   ?f3 <- (object ?obj held light held ?inside ?key)
  211.   =>
  212.   (retract ?f1 ?f2 ?f3)
  213.   (assert (object ?obj ?place light ?on ?inside ?key))
  214.   (assert (monkey ?place ?on blank)))
  215.  
  216. ;;;*************************
  217. ;;;* process get on object * 
  218. ;;;*************************
  219.  
  220. (defrule jump-onto-floor "" 
  221.   ?f1 <- (goal-is-to active on floor)
  222.   ?f2 <- (monkey ?at ?on&~floor ?obj)
  223.   =>
  224.   (retract ?f1 ?f2)
  225.   (assert (monkey ?at floor ?obj)))
  226.  
  227. (defrule walk-to-place-to-climb "" 
  228.   (goal-is-to active on ?obj)
  229.   (object ?obj ?place ? ? ? ?)
  230.   (monkey ~?place ? ?)
  231.   (not (goal-is-to active walk-to ?place))
  232.   =>
  233.   (assert (goal-is-to active walk-to ?place)))
  234.  
  235. (defrule drop-to-climb "" 
  236.   (goal-is-to active on ?obj)
  237.   (object ?obj ?place ? ? ? ?)
  238.   (monkey ?place ? ~blank)
  239.   (not (goal-is-to active holds blank))
  240.   =>
  241.   (assert (goal-is-to active holds blank)))
  242.  
  243. (defrule climb-indirectly "" 
  244.   (goal-is-to active on ?obj)
  245.   (object ?obj ?place ? ?on ? ?)
  246.   (monkey ?place ~?on&~?obj blank)
  247.   (not (goal-is-to active on ?on))
  248.   =>
  249.   (assert (goal-is-to active on ?on)))
  250.  
  251. (defrule climb-directly ""  
  252.   ?f1 <- (goal-is-to active on ?obj)
  253.   (object ?obj ?place ? ?on ? ?)
  254.   ?f2 <- (monkey ?place ?on blank)
  255.   =>
  256.   (retract ?f1 ?f2)
  257.   (assert (monkey ?place ?obj blank)))
  258.  
  259. (defrule already-on-object ""
  260.   ?f1 <- (goal-is-to active on ?obj)
  261.   (monkey ? ?obj ?)
  262.   =>
  263.   (retract ?f1))
  264.  
  265. ;;;**********************
  266. ;;;* process eat object * 
  267. ;;;**********************
  268.  
  269. (defrule hold-to-eat ""
  270.   (goal-is-to active eat ?obj)
  271.   (monkey ? ? ~?obj)
  272.   (not (goal-is-to active holds ?obj))
  273.   =>
  274.   (assert (goal-is-to active holds ?obj)))
  275.  
  276. (defrule satisfy-hunger ""
  277.   ?f1 <- (goal-is-to active eat ?obj)
  278.   ?f2 <- (monkey ?place ?on ?obj)
  279.   ?f3 <- (object ?obj ? ? ? ? ?)
  280.   =>
  281.   (retract ?f1 ?f2 ?f3)
  282.   (assert (monkey ?place ?on blank)))
  283.  
  284. ;;;*****************
  285. ;;;* initial-state * 
  286. ;;;*****************
  287.  
  288. (defrule startup ""
  289.   (initial-fact)
  290.   =>
  291.   (assert (monkey t5-7 green-couch blank))
  292.   (assert (object green-couch t5-7 heavy floor foo foo))
  293.   (assert (object red-couch t2-2 heavy floor foo foo))
  294.   (assert (object big-pillow t2-2 light red-couch foo foo))
  295.   (assert (object red-chest t2-2 light big-pillow ladder red-key))
  296.   (assert (object blue-chest t7-7 light ceiling bananas blue-key))
  297.   (assert (object blue-couch t8-8 heavy floor foo foo))
  298.   (assert (object green-chest t8-8 light ceiling blue-key red-key))
  299.   (assert (object red-key t1-3 light floor foo foo))
  300.   (assert (goal-is-to active eat bananas)))
  301.