Advertisement
Guest User

Untitled

a guest
May 11th, 2019
121
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. (ns edaa40.lab3)
  2.  
  3. (use 'edaa40.core)
  4.  
  5. ;;
  6. ;;  testing
  7. ;;
  8.  
  9. (defn test?
  10.  
  11.   (
  12.     [msg v]
  13.  
  14.     (if v
  15.       (println msg ": passed")
  16.       (println msg ": ERROR")
  17.     )
  18.   )
  19.  
  20.   (
  21.     [msg v1 v2]
  22.  
  23.     (if (= v1 v2)
  24.       (println msg ": passed")
  25.       (println msg ": ERROR -- got'" v1 "', expected '" v2 "'")
  26.     )
  27.   )
  28. )
  29.  
  30.  
  31. ;; indices of winning lines
  32. ;; this can be used by threeinarow to determine
  33. ;; whether a player has won
  34.  
  35. (def winning-lines [
  36.   [0 1 2]
  37.   [3 4 5]
  38.   [6 7 8]
  39.   [0 3 6]
  40.   [1 4 7]
  41.   [2 5 8]
  42.   [2 4 6]
  43.   [0 4 8] ]
  44. )
  45.  
  46. ;; these definitions have variables point to the symbols representing them;
  47. ;; the reason is so that we can avoid "quoting" the X, O, and _ symbols all the time
  48.  
  49. (def X 'X)
  50.  
  51. (def O 'O)
  52.  
  53. (def _ '_)
  54.  
  55. ;; this is the empty board
  56.  
  57. (def B0 [_ _ _
  58.          _ _ _
  59.          _ _ _] )
  60.  
  61. ;; if X gets to move next in this one, it wins:
  62.  
  63. (def B1 [_ O _
  64.          _ X _
  65.          _ _ _])
  66.  
  67. ;; this shows why O needs to answer in the corner, if X
  68. ;; takes the center in its first move: if X gets the
  69. ;; next move in this position, it cannot do better than a draw
  70.  
  71. (def B2 [O _ _
  72.          _ X _
  73.          _ _ _])
  74.  
  75.  
  76. (declare threeinarow)
  77.  
  78.  (defn- threeinarow
  79.    "determines whether the specified line (a vector of three indices) is
  80.    fully occupied by player p in the board b"
  81.  
  82.    [p b ln]
  83.  
  84.    (every? #{p} (for [x ln
  85.                   :let [e (get b x)]]   ;;let e be the element of an index in ln
  86.                   e ))                  ;;create the set of all the elements in a specified line
  87.                                         ;;check if each element in the new set is a member of the "player"-set (checks equality)
  88.  )
  89.  
  90.  
  91.  (test? "threeinarow 1" (threeinarow X [_ _ _ _ _ _ X X X] (winning-lines 2)))
  92.  (test? "threeinarow 2" (not (threeinarow X [_ _ _ _ _ _ X X X]  (winning-lines 1))))
  93.  (test? "threeinarow 3" (not (threeinarow O [_ _ _ _ _ _ X X X]  (winning-lines 2))))
  94.  
  95.  
  96. (declare win?)
  97.  
  98.  (defn win?
  99.  
  100.    [p b]
  101.  
  102.    (some #(threeinarow p b %) winning-lines)
  103.  
  104. ;;   hint: of course, this one uses threeinarow and winning-lines. Also, "some".
  105.  )
  106.  
  107.  (test? "win? 1" (win? X [X _ _ X _ _ X _ _]))
  108.  (test? "win? 2" (not (win? O [X _ _ X _ _ X _ _])))
  109.  
  110. (defn opponent
  111.   "computes the opponent of the specified player"
  112.  
  113.   [p]
  114.  
  115.   (case p
  116.     X O
  117.     O X
  118.     _)
  119. )
  120.  
  121. (declare moves)
  122.  
  123.  
  124.  (defn moves
  125.    "computes all possible moves player p can make on board b;
  126.    it returns a list of all possible new boards after p made a move,
  127.    or an empty list, if p cannot make any move"
  128.  
  129.    [p b]
  130.  
  131.    (for [x (map first(filter #(= (second %) _)(map-indexed vector b)))] (assoc b x p))
  132.  )
  133.  
  134.  (test? "moves 1" (count (moves X B0)) 9)
  135.  (test? "moves 2" (count (moves X B1)) 7)
  136.  (test? "moves 3" (count (moves X B2)) 7)
  137.  
  138. ;; A "game tree" is a map that has the following structure:
  139. ;; {:player <player> :board <some board> :win <winner> :children <list of game trees>}
  140. ;;
  141. ;; <player> : is either X or O, and signifies the player whose move is next
  142. ;; <some board> : is a board, i.e. a tictactoe configuration
  143. ;; <winner> : is either X, O, or _, depending on whether in this configuration,
  144. ;;            X wins, O wins, or we get a draw (assuming optimal play).
  145.  
  146.  
  147. (defn gametree
  148.   "computes the game tree that starts from board position b,
  149.   with player p moving next"
  150.  
  151.   [p b]
  152.  
  153.   (cond
  154.     (win? X b)  {:player p :board b :win X :children '()}   ;; X has won
  155.     (win? O b)  {:player p :board b :win O :children '()}   ;; O has won
  156.     :else
  157.       (let
  158.         [
  159.           c (map #(gametree (opponent p) %) (moves p b))       ;; all possible moves
  160.           w (cond
  161.               (empty? c)            _       ;; no moves: this is a draw
  162.               (some #(= (% :win) p) c)      p       ;; at least one winning move: s wins
  163.               (some #(= (% :win) _) c)      _       ;; no winner, but at least one move to a draw: draw
  164.               :else                 (opponent p)    ;; all moves lead to opponent win, :-(
  165.             )
  166.         ]
  167.  
  168.         { :player p :board b :children c :win w }
  169.       )
  170.   )
  171. )
  172.  
  173. ;; If you have implemented "moves" and it passes the tests, try uncommenting these.
  174.  
  175.  (def B0-GT (gametree X B0))
  176.  
  177.  (def B1-GT (gametree X B1))
  178.  
  179.  (def B2-GT (gametree X B2))
  180.  
  181.  
  182.  (defn gametree-count
  183.    "counts the number of nodes in a game tree"
  184.  
  185.    [t]
  186.     (if (empty? (t :children))
  187.  
  188.                         1                                                         ;;if empty, count 1
  189.                         (inc (reduce + (map #(gametree-count %) (t :children))))) ;;else, reduce children-count + parent(1)
  190.  )
  191.  
  192.  (test? "gametree-count B0" (gametree-count B0-GT) 549946)
  193.  (test? "gametree-count B1" (gametree-count B1-GT) 7064)
  194.  (test? "gametree-count B2" (gametree-count B2-GT) 6812)
  195.  
  196.  
  197. (defn reduce-gametree
  198.   "reduces the game tree by throwing away all nodes where the winner is not the same as the
  199.   winner of the overall game"
  200.  
  201.   [t]
  202.  
  203.   (if (t :children)
  204.     (assoc t :children (map reduce-gametree (filter #(= (% :win) (t :win)) (t :children))))
  205.     t
  206.   )
  207. )
  208.  
  209. ;; If all the tests pass up to here, try uncommenting this:
  210. ;;
  211.  (def B0-RGT (reduce-gametree B0-GT))
  212.  
  213.  (def B1-RGT (reduce-gametree B1-GT))
  214.  
  215.  (def B2-RGT (reduce-gametree B2-GT))
  216.  
  217.  
  218.  (test? "reduce-gametree count B0" (gametree-count B0-RGT) 12134)
  219.  (test? "reduce-gametree count B1" (gametree-count B1-RGT) 1765)
  220.  (test? "reduce-gametree count B2" (gametree-count B2-RGT) 206)
  221.  
  222.  
  223. (declare gametree-height)
  224.  
  225.  (defn gametree-height
  226.    "computes the height of a game tree; a tree without children
  227.    has height 1, otherwise it has the maximal height of all its
  228.    children, plus 1"
  229.  
  230.    [t]
  231.  
  232.    (if (empty? (t :children))
  233.  
  234.                     1
  235.                     (inc (reduce max (map #(gametree-height %) (t :children))))
  236.                     )
  237.  
  238.  )
  239.  
  240.  (test? "height B0-GT" (gametree-height B0-GT) 10)
  241.  (test? "height B1-GT" (gametree-height B1-GT) 8)
  242.  (test? "height B2-GT" (gametree-height B2-GT) 8)
  243.  
  244.  
  245. (defn choose-maxheight-gametrees
  246.   "gets a list of game trees and picks those with the largest height,
  247.   returns a list of those with the largest height"
  248.  
  249.   [ts]
  250.  
  251.   (if (empty? ts)
  252.     ts
  253.     (let
  254.       [d (reduce max (map gametree-height ts))]
  255.  
  256.       (filter #(= d (gametree-height %)) ts)
  257.     )
  258.   )
  259. )
  260.  
  261. (defn choose-minheight-gametrees
  262.   "get a list of game trees and picks those with the smallest height,
  263.   returns a list of those with the smallest height"
  264.  
  265.   [ts]
  266.  
  267.   (if (empty? ts)
  268.     ts
  269.     (let
  270.       [d (reduce min (map gametree-height ts))]
  271.  
  272.       (filter #(= d (gametree-height %)) ts)
  273.     )
  274.   )
  275. )
  276.  
  277. (defn- optimal-gametree-reduced
  278.   "computes the optimal game tree from a reduced game tree"
  279.  
  280.   [rt]
  281.  
  282.   (if (rt :children)
  283.     (let
  284.       [c (map optimal-gametree-reduced (rt :children))]
  285.  
  286.       (if (= (rt :player) (rt :win))
  287.         (assoc rt :children (choose-minheight-gametrees c))
  288.         (assoc rt :children (choose-maxheight-gametrees c))
  289.       )
  290.     )
  291.     rt
  292.   )
  293. )
  294.  
  295. (defn optimal-gametree
  296.   "computes an optimal game tree.
  297.   We call a tree optimal if it only contains moves where the
  298.   winning player chooses moves where it wins as quickly as possible,
  299.   while a losing or drawing player tries to pick moves that put the
  300.   loss or draw as far out as possible"
  301.  
  302.   [t]
  303.  
  304.   (optimal-gametree-reduced (reduce-gametree t))
  305. )
  306.  
  307. ;; If all the tests pass up to here, try uncommenting this:
  308.  
  309.  (def B0-OGT (optimal-gametree B0-GT))
  310.  
  311.  (def B1-OGT (optimal-gametree B1-GT))
  312.  
  313.  (def B2-OGT (optimal-gametree B2-GT))
  314.  
  315.  
  316.  (test? "optimal-gametree count B0" (gametree-count B0-OGT) 12134)
  317.  (test? "optimal-gametree count B1" (gametree-count B1-OGT) 123)
  318.  (test? "optimal-gametree count B2" (gametree-count B2-OGT) 206)
  319.  
  320.  
  321. (declare rand-moves)
  322.  
  323.  (defn rand-moves
  324.    "compute a sequence of moves from a game tree by randomly picking a child at each node,
  325.    returns a list of boards"
  326.  
  327.     [t]
  328.  
  329.     ;;(cons (t :board) (if-let [c (if (rand-nth (t :children)))] (rand-moves c)))
  330.     (cons (t :board) (if (empty? (t :children)) #{} (rand-moves (rand-nth (t :children)))))
  331.  
  332.  
  333. ;;  hint: uses cons, empty?, rand-nth
  334. ;;        Returns a list where the first element is the board of the root node, followed by the
  335. ;;        list of boards produced from a randomly chosen child, or '() if there are no children.
  336.  )
  337.  
  338.  
  339. ;; a small function to pretty-print a board, and one to print a list of boards,
  340. ;; and another one to print info on the top node in a game tree,
  341. ;; in case you'd like a play around a little with configurations
  342.  
  343. (defn print-board
  344.   "prints a board configuration in three lines"
  345.  
  346.   [b]
  347.  
  348.   (println (b 0)(b 1)(b 2))
  349.   (println (b 3)(b 4)(b 5))
  350.   (println (b 6)(b 7)(b 8))
  351. )
  352.  
  353. (defn print-boards
  354.   "prints a sequence of boards"
  355.  
  356.   [bs]
  357.  
  358.   (doseq [b bs] (print-board b) (println "----------"))
  359.   nil
  360. )
  361.  
  362. (defn print-gametree-top
  363.   "prints some info on a game tree"
  364.  
  365.   [t]
  366.  
  367.   (print-board (t :board))
  368.   (println "next move: " (t :player))
  369.   (println "winner: " (t :win))
  370.   (println "winning config: " (if (or (win? X (t :board)) (win? O (t :board))) "yes" "no"))
  371.   (println "children: " (count (t :children)))
  372.   (println "height: " (gametree-height t))
  373.   (println "nodes: " (gametree-count t))
  374. )
  375.  
  376.  
  377. ;; try this a few times:
  378.  
  379.    (print-boards (rand-moves B0-OGT))
  380.  
  381.    (print-boards (rand-moves B1-OGT))
  382.  
  383.    (print-boards (rand-moves B2-OGT))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement