home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / programming / clips_2 / CLIPS / Examples / Dilemma2 < prev    next >
Encoding:
Text File  |  1993-06-02  |  5.7 KB  |  198 lines
  1. ;;;======================================================
  2. ;;;   Farmer's Dilemma Problem
  3. ;;;
  4. ;;;     Another classic AI problem (cannibals and the 
  5. ;;;     missionary) in agricultural terms. The point is
  6. ;;;     to get the farmer, the fox the cabbage and the
  7. ;;;     goat across a stream.
  8. ;;;        But the boat only holds 2 items. If left 
  9. ;;;     alone with the goat, the fox will eat it. If
  10. ;;;     left alone with the cabbage, the goat will eat
  11. ;;;     it.
  12. ;;;        This example uses COOL classes and 
  13. ;;;     message-handlers to solve the problem.
  14. ;;;
  15. ;;;     CLIPS Version 6.0 Example
  16. ;;; 
  17. ;;;     To execute, merely load and enter (solve-dilemma).
  18. ;;;======================================================
  19.  
  20. ;;;**************
  21. ;;;* DEFCLASSES *
  22. ;;;**************
  23.  
  24. (defclass status
  25.    (is-a USER)
  26.    (role concrete)
  27.    (slot farmer
  28.       (create-accessor write)
  29.       (default shore-1))
  30.    (slot fox
  31.       (create-accessor write)
  32.       (default shore-1))
  33.    (slot goat
  34.       (create-accessor write)
  35.       (default shore-1))
  36.    (slot cabbage
  37.       (create-accessor write)
  38.       (default shore-1))
  39.    (slot parent
  40.       (create-accessor write)
  41.       (default no-parent))
  42.    (slot search-depth
  43.       (create-accessor write)
  44.       (default 1))
  45.    (slot last-move
  46.       (create-accessor write)
  47.       (default no-move)))
  48.  
  49. ;;;****************
  50. ;;;* DEFFUNCTIONS *
  51. ;;;****************
  52.  
  53. (deffunction contradiction
  54.    (?f ?x ?g ?c ?d)
  55.    (if (or (and (eq ?x ?g) (neq ?f ?x)) (and (eq ?g ?c) (neq ?f ?g)))
  56.       then
  57.       TRUE
  58.       else
  59.       (any-instancep ((?s status))
  60.         (and (eq ?s:farmer ?f) 
  61.           (eq ?s:fox ?x)
  62.           (eq ?s:goat ?g)
  63.           (eq ?s:cabbage ?c)
  64.           (< ?s:search-depth ?d)))))
  65.  
  66. (deffunction opposite-shore
  67.    (?value)
  68.    (if (eq ?value shore-1)
  69.       then
  70.       shore-2
  71.       else
  72.       shore-1))
  73.  
  74. (deffunction solve-dilemma ()
  75.    (do-for-all-instances ((?a status))
  76.       TRUE
  77.       (send ?a delete))  
  78.    (make-instance start of status)
  79.    (send [start] generate-moves))
  80.  
  81. ;;;**************
  82. ;;;* DEFRULES *
  83. ;;;**************
  84.  
  85. (defrule start-it
  86.   =>
  87.   (solve-dilemma))
  88.  
  89. ;;;***********************
  90. ;;;* DEFMESSAGE-HANDLERS *
  91. ;;;***********************
  92.  
  93. (defmessage-handler status move-farmer
  94.    ()
  95.    (if (not (contradiction (opposite-shore ?self:farmer) ?self:fox 
  96.                            ?self:goat ?self:cabbage ?self:search-depth))
  97.       then
  98.       (bind ?x (make-instance (gensym) of status
  99.          (farmer (opposite-shore ?self:farmer))
  100.          (fox ?self:fox)
  101.          (goat ?self:goat)
  102.          (cabbage ?self:cabbage)
  103.          (last-move farmer)
  104.          (parent ?self)
  105.          (search-depth (+ ?self:search-depth 1))))
  106.       (if (not (send ?x solution?))
  107.          then
  108.          (send ?x generate-moves))))
  109.  
  110. (defmessage-handler status move-goat
  111.    ()
  112.    (if (and (eq ?self:farmer ?self:goat) (not (contradiction 
  113.       (opposite-shore ?self:farmer) ?self:fox (opposite-shore ?self:goat) 
  114.        ?self:cabbage ?self:search-depth)))
  115.       then
  116.       (bind ?x (make-instance (gensym) of status
  117.          (farmer (opposite-shore ?self:farmer))
  118.          (fox ?self:fox)
  119.          (goat (opposite-shore ?self:farmer))
  120.          (cabbage ?self:cabbage)
  121.          (last-move goat)
  122.          (parent ?self)
  123.          (search-depth (+ ?self:search-depth 1))))
  124.       (if (not (send ?x solution?))
  125.          then
  126.          (send ?x generate-moves))))
  127.  
  128. (defmessage-handler status move-fox
  129.    ()
  130.    (if (and (eq ?self:farmer ?self:fox) 
  131.             (not (contradiction (opposite-shore ?self:farmer) 
  132.                                 (opposite-shore ?self:fox) 
  133.                                 ?self:goat ?self:cabbage ?self:search-depth)))
  134.       then
  135.       (bind ?x (make-instance (gensym) of status
  136.          (farmer (opposite-shore ?self:farmer))
  137.          (fox (opposite-shore ?self:farmer))
  138.          (goat ?self:goat)
  139.          (cabbage ?self:cabbage)
  140.          (last-move fox)
  141.          (parent ?self)
  142.          (search-depth (+ ?self:search-depth 1))))
  143.       (if (not (send ?x solution?))
  144.          then
  145.          (send ?x generate-moves))))
  146.  
  147. (defmessage-handler status move-cabbage
  148.    ()
  149.    (if (and (eq ?self:farmer ?self:cabbage) 
  150.             (not (contradiction (opposite-shore ?self:farmer) 
  151.                                 ?self:fox ?self:goat 
  152.                                 (opposite-shore ?self:cabbage) 
  153.                                 ?self:search-depth)))
  154.       then
  155.       (bind ?x (make-instance (gensym) of status
  156.          (farmer (opposite-shore ?self:farmer))
  157.          (fox ?self:fox)
  158.          (goat ?self:goat)
  159.          (cabbage (opposite-shore ?self:farmer))
  160.          (last-move cabbage)
  161.          (parent ?self)
  162.          (search-depth (+ ?self:search-depth 1))))
  163.       (if (not (send ?x solution?))
  164.          then
  165.          (send ?x generate-moves))))
  166.  
  167. (defmessage-handler status generate-moves
  168.    ()
  169.    (send ?self move-farmer)
  170.    (send ?self move-fox)
  171.    (send ?self move-goat)
  172.    (send ?self move-cabbage))
  173.  
  174. (defmessage-handler status print-solution
  175.    ()
  176.    (if (neq ?self:parent no-parent)
  177.       then
  178.       (send ?self:parent print-solution)
  179.       (bind ?move-dest (dynamic-get ?self:last-move))
  180.       (if (eq ?self:last-move farmer)
  181.          then
  182.          (printout t "Farmer moves alone to " ?move-dest "." crlf)
  183.          else
  184.          (printout t "Farmer moves with " ?self:last-move " to " ?move-dest "." crlf))))
  185.  
  186. (defmessage-handler status solution?
  187.    ()
  188.    (if (and (eq ?self:farmer shore-2) (eq ?self:fox shore-2) 
  189.             (eq ?self:goat shore-2) (eq ?self:cabbage shore-2))
  190.       then
  191.       (printout t crlf "Solution found:" crlf crlf)
  192.       (send ?self print-solution)
  193.       TRUE
  194.       else
  195.       FALSE))
  196.  
  197.  
  198.