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