home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 8 Other / 08-Other.zip / PMCLIPS.ZIP / TTT.CLP < prev    next >
Text File  |  1988-05-03  |  8KB  |  271 lines
  1.  
  2. ;;;======================================================
  3. ;;;   Tic Tac Toe Sample Problem
  4. ;;;
  5. ;;;     This is a rather simple tic tac toe expert
  6. ;;;     system. It will usually win if possible, but
  7. ;;;     won't always stop you from winning.
  8. ;;;
  9. ;;;     To execute, merely load, reset and run.
  10. ;;;======================================================
  11.  
  12. (deffacts initial-state
  13.   (square 1 1 " " corner)
  14.   (square 2 1 " " side)
  15.   (square 3 1 " " corner)
  16.   (square 1 2 " " side)
  17.   (square 2 2 " " center)
  18.   (square 3 2 " " side)
  19.   (square 1 3 " " corner)
  20.   (square 2 3 " " side)
  21.   (square 3 3 " " corner))
  22.  
  23. ;;;******************************************
  24. ;;; evaluate board for blocks, wins, and ties
  25. ;;;******************************************
  26.  
  27. (defrule evaluate-potential-win ""
  28.   (evaluate board for ?)
  29.   (square ?row1 ?col1 ?pl&~" " ?)
  30.   (square ?row2 ?col2 " " ?)
  31.   (test (or  (!= ?row1 ?row2) (!= ?col1 ?col2)))
  32.   (square ?row3 ?col3 " " ?type)
  33.   (test (and (or  (!= ?row1 ?row3) (!= ?col1 ?col3))
  34.                 (or  (!= ?row2 ?row3) (!= ?col2 ?col3))))
  35.   (test (or  (and (= ?row1 ?row2)
  36.                         (= ?row1 ?row3))
  37.                 (and (= ?col1 ?col2)
  38.                         (= ?col1 ?col3))
  39.                 (and (= (+ ?row1 ?col1) (+ ?row2 ?col2))
  40.                         (= (+ ?row1 ?col1) (+ ?row3 ?col3)))
  41.                 (and (= (- ?row1 ?col1) (- ?row2 ?col2))
  42.                         (= (- ?row1 ?col1) (- ?row3 ?col3)))))
  43.    =>
  44.    (assert (potential-win ?row3 ?col3 ?type ?pl)))
  45.  
  46. (defrule evaluate-immediate-block-or-win ""
  47.   (evaluate board for ?)
  48.   (square ?row1 ?col1 ?pl&~" " ?)
  49.   (square ?row2 ?col2 ?pl ?)
  50.   (test (or (!= ?row1 ?row2) (!= ?col1 ?col2)))
  51.   (square ?row3 ?col3 " " ?type)
  52.   (test (and (or  (!= ?row1 ?row3) (!= ?col1 ?col3))
  53.                 (or  (!= ?row2 ?row3) (!= ?col2 ?col3))))
  54.   (test (or  (and (= ?row1 ?row2)
  55.                         (= ?row1 ?row3))
  56.                 (and (= ?col1 ?col2)
  57.                         (= ?col1 ?col3))
  58.                 (and (= (+ ?row1 ?col1) (+ ?row2 ?col2))
  59.                         (= (+ ?row1 ?col1) (+ ?row3 ?col3)))
  60.                 (and (= (- ?row1 ?col1) (- ?row2 ?col2))
  61.                         (= (- ?row1 ?col1) (- ?row3 ?col3)))))
  62.    =>
  63.    (assert (immediate-block-or-win ?row3 ?col3 ?type ?pl)))
  64.  
  65. (defrule tie-game ""
  66.   ?phase <- (evaluate board for ?)
  67.   (not (square ? ? " " ?))
  68.   =>
  69.   (retract ?phase)
  70.   (printout t "The game has ended in a tie." t))
  71.  
  72. ;;;*****************************
  73. ;;; rules for the computers move
  74. ;;;*****************************
  75.  
  76. (defrule move-computer-to-win
  77.    ?phase <- (computer move)
  78.    (computer is ?cs)
  79.    ?dummy <- (immediate-block-or-win ?row ?col ?type ?cs)
  80.    ?square <- (square ?row ?col ? ?)
  81.    =>
  82.    (assert (display board))
  83.    (retract ?dummy ?phase ?square)
  84.    (assert (square ?row ?col ?cs ?type))
  85.    (printout t "Computer moves to win!" t))
  86.  
  87. (defrule move-computer-to-block ""
  88.   ?phase <- (computer move)
  89.   (computer is ?cs)
  90.   (not (immediate-block-or-win ? ? ? ?cs))
  91.   (human is ?hs)
  92.   ?dummy <- (immediate-block-or-win ?row ?col ?type ?hs)
  93.   ?square <- (square ?row ?col ? ?)
  94.   =>
  95.   (retract ?dummy ?phase ?square)
  96.   (assert (display board))
  97.   (assert (square ?row ?col ?cs ?type))
  98.   (assert (next-move human)))
  99.  
  100. (defrule move-to-center ""
  101.    ?phase <- (computer move)
  102.    (computer is ?cs)
  103.    (not (immediate-block-or-win ? ? ? ?))
  104.    ?square <- (square ? ? " " center)
  105.    =>
  106.    (retract ?phase ?square)
  107.    (assert (display board))
  108.    (assert (square 2 2 ?cs center))
  109.    (assert (next-move human)))
  110.  
  111. (defrule move-to-corner ""
  112.    (computer is ?cs)
  113.    ?phase <- (computer move)
  114.    (not (immediate-block-or-win ? ? ? ?)) 
  115.    ?square <- (square ?row ?col " " corner)
  116.    (not (square ? ? " " center))
  117.    =>
  118.    (retract ?phase ?square)
  119.    (assert (display board))
  120.    (assert (square ?row ?col ?cs corner))
  121.    (assert (next-move human)))
  122.  
  123. (defrule move-to-side ""
  124.    ?phase <- (computer move)
  125.    (computer is ?cs)
  126.    (not (immediate-block-or-win ? ? ? ?)) 
  127.    ?square <- (square ?row ?col " " side) 
  128.    (not (square ? ? " " corner))
  129.    (not (square ? ? " " center))
  130.    =>
  131.    (retract ?phase ?square)
  132.    (assert (display board))
  133.    (assert (square ?row ?col ?cs side))
  134.    (assert (next-move human)))
  135.  
  136. ;;;*******************************************
  137. ;;; Get human move and determine validity
  138. ;;;*******************************************
  139.  
  140. (defrule human-input ""
  141.   (human move)
  142.   =>
  143.   (printout t "Column? ")
  144.   (bind ?col (read))
  145.   (printout t "Row? ")
  146.   (bind ?row (read))
  147.   (printout t crlf)
  148.   (assert (human-to ?col ?row)))
  149.  
  150. (defrule valid-human-move ""
  151.   ?phase <- (human move)
  152.   (human is ?hs)
  153.   ?move  <- (human-to ?row ?col)
  154.   ?square <- (square ?row ?col " " ?type)
  155.   =>
  156.   (assert (display board))
  157.   (retract ?phase ?move ?square)
  158.   (assert (square ?row ?col ?hs ?type))
  159.   (assert (valid-move ?row ?col)))
  160.  
  161. (defrule human-winning-move ""
  162.   ?move <- (valid-move ?row ?col)
  163.   (human is ?hs)
  164.   ?info <- (immediate-block-or-win ?row ?col ?type ?hs)
  165.   =>
  166.   (retract ?move ?info)
  167.   (printout t "You have made the winning move!" t))
  168.  
  169. (defrule human-blocking-move ""
  170.   ?move <- (valid-move ?row ?col)
  171.   (computer is ?cs)
  172.   ?info <- (immediate-block-or-win ? ? ?type ?cs)
  173.   =>
  174.   (retract ?info ?move)
  175.   (assert (next-move computer)))
  176.  
  177. (defrule no-block-or-win-for-human ""
  178.   ?move <- (valid-move ?row ?col)
  179.   (not (immediate-block-or-win ? ? ? ?))
  180.   =>
  181.   (retract ?move)
  182.   (assert (next-move computer)))
  183.  
  184. (defrule invalid-human-move ""
  185.   ?phase <- (human move)
  186.   ?move  <- (human-to ?row ?col)
  187.   (square ?row ?col ~" " ?)
  188.   =>
  189.   (printout t "Invalid move. Try another." t)
  190.   (retract ?phase ?move)
  191.   (assert (human move)))
  192.  
  193. ;;;******************************
  194. ;;; cleanup rules
  195. ;;;******************************
  196.  
  197. (defrule cleanup-1 ""
  198.   (cleanup for ?)
  199.   ?trash <- (immediate-block-or-win ? ? ? ?)
  200.   =>
  201.   (retract ?trash))
  202.  
  203. (defrule cleanup-2 ""
  204.   (cleanup for ?)
  205.   ?trash <- (potential-win ? ? ? ?)
  206.   =>
  207.   (retract ?trash))
  208.  
  209. ;;;******************************
  210. ;;; phase control rules
  211. ;;;******************************
  212.  
  213. (defrule setup ""
  214.   =>
  215.   (printout t "Should the computer move first? ")
  216.   (bind ?resp (read))
  217.   (printout t t)
  218.   (if (or (eq ?resp yes) (eq ?resp y))
  219.       then
  220.       (assert (computer is o))
  221.       (assert (human is x))
  222.       (assert (evaluate board for computer))
  223.       else
  224.       (assert (computer is x))
  225.       (assert (human is o))
  226.       (assert (evaluate board for human))))
  227.  
  228. (defrule cleanup-for-player ""
  229.   (declare (salience -10))
  230.   ?phase <- (next-move ?player)
  231.   =>
  232.   (retract ?phase)
  233.   (assert (cleanup for ?player)))
  234.  
  235. (defrule switch-to-evaluate ""
  236.   (declare (salience -10))
  237.   ?phase <- (cleanup for ?player)
  238.   =>
  239.   (retract ?phase)
  240.   (assert (evaluate board for ?player)))
  241.  
  242. (defrule switch-to-move ""
  243.   (declare (salience -10))
  244.   ?phase <- (evaluate board for ?player)
  245.   =>
  246.   (retract ?phase)
  247.   (printout t "*********" t)
  248.   (printout t ?player " move" t)
  249.   (printout t "*********" t)
  250.   (assert (?player move)))
  251.  
  252. (defrule board ""
  253.   ?phase <- (display board)
  254.   (square 1 1 ?p1-1 ?)
  255.   (square 2 1 ?p2-1 ?)
  256.   (square 3 1 ?p3-1 ?)
  257.   (square 1 2 ?p1-2 ?)
  258.   (square 2 2 ?p2-2 ?)
  259.   (square 3 2 ?p3-2 ?)
  260.   (square 1 3 ?p1-3 ?)
  261.   (square 2 3 ?p2-3 ?)
  262.   (square 3 3 ?p3-3 ?)
  263.   =>
  264.   (retract ?phase)
  265.   (format t "%nBoard:%n%n")
  266.   (format t " %s|%s|%s%n" ?p1-1 ?p2-1 ?p3-1)
  267.   (format t " -----%n")
  268.   (format t " %s|%s|%s%n" ?p1-2 ?p2-2 ?p3-2)
  269.   (format t " -----%n")
  270.   (format t " %s|%s|%s%n%n" ?p1-3 ?p2-3 ?p3-3))
  271.