home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / misc / compsci / clips42.sit / DILEMMA.CLP < prev    next >
Encoding:
Text File  |  1988-04-20  |  3.7 KB  |  142 lines
  1.  
  2. ;;;======================================================
  3. ;;;   Farmer's Dilemma Problem
  4. ;;;
  5. ;;;     Another classic AI problem (cannibals and the 
  6. ;;;     missionary) in agricultural terms. The point is
  7. ;;;     to get the farmer, the fox, the cabbage, and the
  8. ;;;     goat across a stream.
  9. ;;;     But the boat only holds 2 items. If left 
  10. ;;;     alone with the goat, the fox will eat it. If
  11. ;;;     left alone with the cabbage, the goat will eat
  12. ;;;     it.
  13. ;;;
  14. ;;;     To execute, merely load, reset and run.
  15. ;;;======================================================
  16.  
  17. ;;;****************************
  18. ;;;* Farmer's Dilemma Problem *
  19. ;;;****************************
  20.  
  21. ;;; The status facts hold the state information of the search tree.
  22. ;;; (status <search-depth>
  23. ;;;         <id>
  24. ;;;         <parent>
  25. ;;;         <farmer-location>
  26. ;;;         <fox-location>
  27. ;;;         <goat-location>
  28. ;;;         <cabbage-location>)
  29.  
  30. ;;; The moves facts hold the information of all the moves made to
  31. ;;; reach a given state.
  32. ;;; (status <id>
  33. ;;;         <move-1>
  34. ;;;            .
  35. ;;;            .
  36. ;;;            .
  37. ;;;         <move-n>)
  38.  
  39. ;;;*****************
  40. ;;;* Initial State *
  41. ;;;*****************
  42.  
  43. (deffacts initial-positions
  44.   (status 1 initial-setup no-parent shore-1 shore-1 shore-1 shore-1 no-move))
  45.  
  46. (deffacts opposites
  47.   (opposite-of shore-1 shore-2)
  48.   (opposite-of shore-2 shore-1))
  49.  
  50. ;;;************************
  51. ;;;* Generate Paths Rules *
  52. ;;;************************
  53.  
  54. (defrule move-alone ""
  55.   (status ?num ?name ? ?fs ?xs ?gs ?cs ?)
  56.   (opposite-of ?fs ?ns)
  57.   =>
  58.   (bind ?nn (gensym))
  59.   (assert (status =(+ 1 ?num) ?nn ?name ?ns ?xs ?gs ?cs alone)))
  60.  
  61. (defrule move-with-fox ""
  62.   (status ?num ?name ? ?fs ?fs ?gs ?cs ?)
  63.   (opposite-of ?fs ?ns)
  64.   =>
  65.   (bind ?nn (gensym))
  66.   (assert (status =(+ 1 ?num) ?nn ?name ?ns ?ns ?gs ?cs fox)))
  67.  
  68. (defrule move-with-goat ""
  69.   (status ?num ?name ? ?fs ?xs ?fs ?cs ?)
  70.   (opposite-of ?fs ?ns)
  71.   =>
  72.   (bind ?nn (gensym))
  73.   (assert (status =(+ 1 ?num) ?nn ?name ?ns ?xs ?ns ?cs goat)))
  74.  
  75. (defrule move-with-cabbage ""
  76.   (status ?num ?name ? ?fs ?xs ?gs ?fs ?)
  77.   (opposite-of ?fs ?ns)
  78.   =>
  79.   (bind ?nn (gensym))
  80.   (assert (status =(+ 1 ?num) ?nn ?name ?ns ?xs ?gs ?ns cabbage)))
  81.  
  82. ;;;******************************
  83. ;;;* Constraint Violation Rules *
  84. ;;;******************************
  85.  
  86. (defrule fox-eats-goat ""
  87.   (declare (salience 10000))
  88.   ?rm <- (status ? ?name ? ?s1 ?s2&~?s1 ?s2 ? ?)
  89.   =>
  90.   (retract ?rm))
  91.  
  92. (defrule goat-eats-cabbage ""
  93.   (declare (salience 10000))
  94.   ?rm <- (status ? ?name ? ?s1 ? ?s2&~?s1 ?s2 ?)
  95.   =>
  96.   (retract ?rm))
  97.  
  98. (defrule circular-path ""
  99.   (declare (salience 10000))
  100.   (status ?nm ? ? ?fs ?xs ?gs ?cs ?)
  101.   ?rm <- (status ?nm1&:(< ?nm ?nm1) ?name ? ?fs ?xs ?gs ?cs ?)
  102.   =>
  103.   (retract ?rm))
  104.  
  105. ;;;********************************
  106. ;;;* Find and Print Solution Rule *
  107. ;;;********************************
  108.  
  109. (defrule recognize-solution ""
  110.   (declare (salience 5000))
  111.   ?rm <- (status ?num ?name ?parent shore-2 shore-2 shore-2 shore-2 ?move)
  112.   =>
  113.   (retract ?rm)
  114.   (assert (moves ?parent ?move)))
  115.  
  116. (defrule further-solution ""
  117.   (declare (salience 5000))
  118.   ?mv <- (moves ?name $?rest)
  119.   (status ? ?name ?parent ? ? ? ? ?move)
  120.   =>
  121.   (retract ?mv)
  122.   (assert (moves ?parent ?move $?rest)))
  123.  
  124. (defrule print-solution ""
  125.   (declare (salience 5000))
  126.   ?mv <- (moves no-parent no-move $?m)
  127.   =>
  128.   (retract ?mv)
  129.   (printout t t  "Solution found: " t t)
  130.   (bind ?length (length $?m))
  131.   (bind ?i 1)
  132.   (bind ?shore shore-2)
  133.   (while (<= ?i ?length)
  134.      (bind ?thing (nth ?i $?m))
  135.      (if (eq ?thing alone)
  136.         then (printout t "Farmer moves alone to " ?shore "." t)
  137.         else (printout t "Farmer moves with " ?thing " to " ?shore "." t))
  138.      (if (eq ?shore shore-1)
  139.         then (bind ?shore shore-2)
  140.         else (bind ?shore shore-1))
  141.      (bind ?i (+ 1 ?i))))
  142.