Getting things ready part 2

.gitignore

@@ -17,3 +17,5 @@ pom.xml
 /.lein-*
 /.env
 .nrepl-port
+/src/clj/game_of_ur/experiments.clj
+README.html

README.md

@@ -3,6 +3,18 @@
 
 [Live Demo](https://polymeris.github.io/game-of-ur/)
 
+## How to improve?
+
+There are two main things to improve. The first one is simple, and is to improve
+user interface/experience by getting the UI to work better. The second and more
+interesting one is to improve the AI. For this we've thought about two
+approaches. One is to improve the search function which as for now is a
+simple _expectiminimax_, either by implementing some pruning or by
+memoizing some redundant information somehow. The other and again more
+interesting, is to either create better evaluation functions at
+`cljc/game_of_ur/ai/eval.cljc`, or to make them evolve using some kind of
+genetic algorithm.
+
 ## Development Mode
 
 ### Run application:
@@ -16,6 +28,11 @@ Figwheel will automatically push cljs changes to the browser.
 
 Wait a bit, then browse to [http://localhost:3449](http://localhost:3449).
 
+We also encourage to set `(spec/check-asserts true)`
+to `false` in `cljc/game_of_ur/game/board.cljc` when working on the AI, since it
+makes the program run considerably faster.
+
+
 ## Production Build
 
 

src/clj/game_of_ur/ascii.clj

@@ -2,6 +2,7 @@
   (:require
     [game-of-ur.game.board :as board]
     [game-of-ur.ai.minmax :as mm]
+    [game-of-ur.ai.ai :as ai]
     [clojure.string :as cs]))
 
 ;; rectangle board coordinates
@@ -33,7 +34,7 @@
   "Prints a game-state given a board, player, roll, and destination.
    Example:
 
-          -3 -2 -1  0  1  2  3  4 
+          -3 -2 -1  0  1  2  3  4
         --------------------------
         | x                 xx
       -1| [~][ ][x][ ]      [~][ ]
@@ -44,27 +45,26 @@
       black rolled 2 from :home to [-1 1]
   "
   [{:keys [home stones] :as board} player roll origin destination]
-  (let [in-goal    (board/stones-in-goal board)
+  (let [in-goal    (get board :goal)
         white-goal (apply str (concat (repeat (- 18 (:white home)) " ")
                                       (repeat (:white in-goal) \x)))
         black-goal (apply str (concat (repeat (- 18 (:black home)) " ")
                                       (repeat (:black in-goal) \o)))
         board-str  (stones->string stones)
         board-str' (map #(cons (format "%2d| " %1) %2) (range -1 2) board-str)]
-    (do
-      (println "\n    -3 -2 -1  0  1  2  3  4 ")
-      (println "  --------------------------")
-      (println (apply str (concat (cons "  | " (repeat (:white home) "x")) white-goal)))
-      (doall (map (comp println (partial apply str)) board-str'))
-      (println (apply str (concat (cons "  | " (repeat (:black home) "o")) black-goal)))
-      (print (str "\n" (apply str (rest (str player))) " rolled " roll))
-      (println (str " from " origin " to " destination "\n")))))
+    (println "\n    -3 -2 -1  0  1  2  3  4 ")
+    (println "  --------------------------")
+    (println (apply str (concat (cons "  | " (repeat (:white home) "x")) white-goal)))
+    (doall (map (comp println (partial apply str)) board-str'))
+    (println (apply str (concat (cons "  | " (repeat (:black home) "o")) black-goal)))
+    (print (str "\n" (apply str (rest (str player))) " rolled " roll))
+    (println (str " from " origin " to " destination "\n"))))
 
 (defn graphic-simulation
   "Prints every step of an AI vs AI game simulation, until the game is ended.
    see: ai/simulate-game"
-  [eval-fn-black eval-fn-white depth]
-  (let [game (ai/simulate-game eval-fn-black eval-fn-white depth)
+  [black-fn white-fn]
+  (let [game (ai/simulate-game {:black black-fn :white white-fn})
         show (fn [[board {:keys [origin destination player roll]}]]
                (print-game-state board player roll origin destination))]
     (doall (map show game))))
@@ -76,27 +76,27 @@
    that is two numbers separated by spaces like '3 -1'. If the coordinate is out of
    range the specs will throw an error too"
   [board valid-moves roll]
-  (do (println (str "\nyour roll is " roll ". Enter coordinates:"))
-      (let [entry  (read-line)
-            origin (cond (= entry "home") :home
-                         (= entry "pass") :pass
-                         :else            (mapv read-string (cs/split entry #" ")))]
-        (if (contains? (board/valid-moves board roll)
-              (board/full-move {:roll roll :origin origin :player (:turn board)}))
-          (board/full-move {:roll roll :origin origin :player (:turn board)})
-          (recur board valid-moves roll)))))
+  (println (str "\nyour roll is " roll ". Enter coordinates:"))
+  (let [entry  (read-line)
+        origin (cond (= entry "home") :home
+                     (= entry "pass") :pass
+                     :else            (mapv read-string (cs/split entry #" ")))]
+    (if (contains? (board/valid-moves board roll)
+                   (board/full-move {:roll roll :origin origin :player (:turn board)}))
+      (board/full-move {:roll roll :origin origin :player (:turn board)})
+      (recur board valid-moves roll))))
 
 (defn game-loop
   "Given a starting board, a color chosen by the player and a depth for the AI,
    will simulate a game until the player gets bured and closes the repl, or until
    the game ends"
   [board evaluation-fn color depth]
   (loop [board board, player nil, roll nil, origin nil, destination nil]
-    (do (print-game-state board player roll origin destination)
-      (when-not (board/game-ended? board)
-        (let [roll   (rand-nth [0 1 1 1 1 2 2 2 2 2 2 3 3 3 3 4])
-              move   (if (= (:turn board) color)
-                       (player-move board (board/valid-moves board roll) roll)
-                       (mm/best-move evaluation-fn depth board roll))
-              nboard (board/child-board board move)]
-          (recur nboard (:turn board) roll (:origin move) (:destination move)))))))
+    (print-game-state board player roll origin destination)
+    (when-not (board/game-ended? board)
+      (let [roll   (rand-nth [0 1 1 1 1 2 2 2 2 2 2 3 3 3 3 4])
+            move   (if (= (:turn board) color)
+                     (player-move board (board/valid-moves board roll) roll)
+                     (ai/best-move evaluation-fn depth board roll))
+            nboard (board/child-board board move)]
+        (recur nboard (:turn board) roll (:origin move) (:destination move))))))

src/cljc/game_of_ur/ai/ai.cljc

@@ -22,14 +22,31 @@
   "Returns a lazy-sequence like '([board-1 move-1] [board-2 move-2] ... [board-n move-n])
    where board-n is a finished game. `black-fn` and `white-fn` should be functions
    that take a board and a roll and return a valid move."
-  [{:keys [black-fn white-fn]}]
+  [fns]
   (letfn [(roll [] (rand-nth [0 1 1 1 1 2 2 2 2 2 2 3 3 3 3 4]))
-          (decide-fn [board] (if (= :white (:turn board))
-                               white-fn
-                               black-fn))
+          (decide-fn [board] (fns (:turn board)))
           (next-board [[board _]]
             (let [move ((decide-fn board) board (roll))]
-              [(game/child-board board move) move]))]
+              [(game/unsafe-child-board board move) move]))]
     (->> [game/initial-board nil]
          (iterate next-board)
          (take-until (comp game/game-ended? first)))))
+
+(defn ranked-moves
+  "Evaluates which is/are the best move/s for a given player, board, and roll. Given
+  the criteria of `rank-fn`. We assume that the greater the number, the better the
+  positions is for black."
+  [rank-fn board roll]
+  (map (fn [m] [m (rank-fn board m)])
+       (game/valid-moves board roll)))
+
+(defn best-moves
+  [rank-fn board roll]
+  (let [options    (ranked-moves rank-fn board roll)
+        best-score (reduce (if (= :black (:turn board)) max min) (map second options))]
+    (keep (fn [[move score]] (when (= score best-score) move))
+          options)))
+
+(defn best-move [rank-fn board roll]
+  (when-not (game/game-ended? board)
+    (rand-nth (best-moves rank-fn board roll))))

src/cljc/game_of_ur/ai/eval.cljc

@@ -0,0 +1,36 @@
+(ns game-of-ur.ai.eval
+  #?(:clj
+      (:require
+       [clojure.spec.alpha :as spec]
+       [game-of-ur.game.board :as game])
+      :cljs
+      (:require
+       [cljs.spec.alpha :as spec]
+       [game-of-ur.game.board :as game])))
+
+(defn- ev-wrap [win-score f]
+  (fn [board]
+    (spec/assert ::game/board board)
+    (cond (game/player-won? board :black) win-score
+          (game/player-won? board :white) (- win-score)
+          :else                           (f board))))
+
+;; Decided to call evaluation functions by jazz album's/song's.
+
+(def dumb-evaluation-fn
+  (ev-wrap 10e6
+   #(- (+ (* 7 (get-in % [:goal :black])) (* 3 (game/stones-on-board % :black)))
+       (+ (* 7 (get-in % [:goal :white])) (* 3 (game/stones-on-board % :white))))))
+
+(defn- stones-value [{:keys [stones goal]} player f]
+  (let [p (game/paths player)]
+    (->> (map-indexed vector p)
+         (keep (fn [[n x]] (when (= player (stones x)) (f n))))
+         (reduce +)
+         (+ (* (get goal player) (f (dec (count p))))))))
+
+;; Wins about 70% of games against dumb-evaluation-fn
+(def inner-urge
+  (ev-wrap 10e6
+   #(- (stones-value % :black (partial * 0.5))
+       (stones-value % :white (partial * 0.5)))))

src/cljc/game_of_ur/ai/minmax.cljc

@@ -8,22 +8,8 @@
        [cljs.spec.alpha :as spec]
        [game-of-ur.game.board :as game])))
 
-(def roll-probability
-  {0 0.0625
-   1 0.25
-   2 0.375
-   3 0.25
-   4 0.0625})
-
-(defn dumb-evaluation-fn
-  "sample board evaluation function"
-  [board]
-  (spec/assert ::game/board board)
-  (if (game/player-won? board :black)
-    10e6
-    (- (+ (* 7 (:black (game/stones-in-goal board))) (* 3 (game/stones-on-board board :black)))
-       (+ (* 7 (:white (game/stones-in-goal board))) (* 3 (game/stones-on-board board :white))))))
 
+;;;;; BASIC MINIMAX
 
 ;; The following functions build a board search tree
 ;; The tree's root is the current board and branches into possible rolls, weighted by probability, these branches,
@@ -41,31 +27,24 @@
 
 (declare expected-child-board-value)
 
-(defn evaluate-board-branch
+(defn- evaluate-board-branch
   "Recursively evaluates the provided board's score using the given function up to `depth` levels.
    Calls `expected-child-board-value` to determine the value of the best move for a given roll."
   [board-eval-fn depth board]
-  (if (or (game/game-ended? board) (zero? depth))
+  (if (or (zero? depth) (game/game-ended? board))
     (board-eval-fn board)
-    #(->> roll-probability
+    #(->> game/roll-probability
           (map (fn [[roll prob]] (* prob (expected-child-board-value board-eval-fn (dec depth) board roll))))
           (reduce +))))
 
-(defn expected-child-board-value
+(defn- expected-child-board-value
   "Recursively evaluates the value of the possible child boards for the given board and roll."
   [board-eval-fn depth board roll]
   (->> (game/valid-moves board roll)
-       (map (comp (partial trampoline evaluate-board-branch board-eval-fn depth)
-                  (partial game/child-board board)))
-       (reduce max)))
+       (map (fn [move] (trampoline evaluate-board-branch board-eval-fn depth
+                                   (game/unsafe-child-board board move))))
+       (reduce (if (= :black (:turn board)) max min))))
 
-(defn best-move
-  "Using the provided function evaluates the board's possible child boards, and returns the best move.
-   Calls the mutually recursive `evaluate-board-branch` and `expected-child-board-value`"
-  [board-eval-fn depth board roll]
-  (let [eval-fn (comp (if (= (:turn board) :white) - +) board-eval-fn)]
-    (->> (game/valid-moves board roll)
-         (map (comp (fn [[child-board move]] [(trampoline evaluate-board-branch eval-fn depth child-board) move])
-                    (fn [move] [(game/child-board board move) move])))
-         (reduce (partial max-key first))
-         (second))))
+(defn minimax-rank-move [eval-fn depth board move]
+  (trampoline evaluate-board-branch eval-fn depth
+              (game/unsafe-child-board board move)))

src/cljc/game_of_ur/game/board.cljc

@@ -22,26 +22,34 @@
            [3 -1] [4 -1] [4 0] [4 1] [3 1]
            :goal]})
 
+(def valid-origins
+  {:white (-> :white paths set (disj :goal))
+   :black (-> :black paths set (disj :goal))})
+
 (def rosettes
   #{[-3 -1] [-3 1] [0 0] [3 -1] [3 1]})
 
-(defn valid-origins [player]
-  (-> (set (paths player))
-      (disj :goal)))
-
 (def valid-positions
   (-> (set/union (set (:white paths)) (set (:black paths)))
       (disj :home :goal)))
 
 (def initial-board
   {:home   {:black 7, :white 7}
+   :goal   {:black 0, :white 0}
    :turn   :white
    :stones (into {} (map (fn [k] [k nil]) valid-positions))})
 
 (def opponent
   {:white :black
    :black :white})
 
+(def roll-probability
+  {0 0.0625
+   1 0.25
+   2 0.375
+   3 0.25
+   4 0.0625})
+
 (def stone-colors #{:white :black})
 (spec/def ::position (spec/with-gen #(contains? valid-positions %)
                                     #(spec/gen valid-positions)))
@@ -63,7 +71,8 @@
 (spec/def ::destination (spec/or :h ::home-position :p ::position :g ::goal-position
                                  :pass ::pass-position))
 (spec/def ::home (spec/keys :req-un [::white ::black]))
-(spec/def ::board (spec/keys :req-un [::home ::turn ::stones]))
+(spec/def ::goal (spec/keys :req-un [::white ::black]))
+(spec/def ::board (spec/keys :req-un [::home ::goal ::turn ::stones]))
 (spec/def ::move (spec/keys :req-un [::roll ::origin]))
 (spec/def ::full-move (spec/keys :req-un [::roll ::origin ::destination ::player]))
 
@@ -78,15 +87,6 @@
        (count)
        (+ (get home player))))
 
-(defn stones-in-goal
-  "Returns number of stones in goal for the given board and player"
-  [board]
-  (spec/assert ::board board)
-  {:white (- (get-in initial-board [:home :white])
-             (stones-in-play board :white))
-   :black (- (get-in initial-board [:home :black])
-             (stones-in-play board :black))})
-
 (defn stones-on-board
   "Return the number of stones not in goal or home for the given player"
   [{:keys [stones]} player]
@@ -103,7 +103,8 @@
   [board player]
   (spec/assert ::board board)
   (spec/assert ::player player)
-  (= 0 (stones-in-play board player)))
+  (= (get-in initial-board [:home player])
+     (get-in board [:goal player])))
 
 (defn game-ended?
   "Returns true iff either white or black wins"
@@ -172,7 +173,20 @@
             (not (#{:home :pass} origin)) (assoc-in [:stones origin] nil)
             (not (#{:home :goal :pass} destination)) (assoc-in [:stones destination] player)
             (= opponent-color (get stones destination)) (update-in [:home opponent-color] inc)
-            (= :home origin) (update-in [:home player] dec))))
+            (= :home origin) (update-in [:home player] dec)
+            (= :goal destination) (update-in [:goal player] inc))))
+
+(defn unsafe-child-board
+  "As move-stone, but changing player's turn. As child-move, except
+   it assumes the move is 'full-move' and valid"
+  [{:keys [turn] :as board} {:keys [roll] :as move}]
+  (spec/assert ::board board)
+  (spec/assert ::full-move move)
+  (let [destination (:destination move)
+        next-turn (if (and (not= 0 roll) (rosettes destination))
+                    turn
+                    (opponent turn))]
+    (assoc (move-stone board move) :turn next-turn)))
 
 (defn child-board
   "It takes a move and a board (see specs), and returns
@@ -201,16 +215,19 @@
   (->> (valid-origins turn)
        (map (fn [origin] (full-move {:roll roll, :origin origin, :player turn})))))
 
-(defn valid-moves
+(defn valid-moves'
   "returns all valid moves with a given roll"
   [{:keys [turn] :as board} roll]
   (spec/assert ::board board)
   (spec/assert ::roll roll)
   (let [moves (->> (all-moves board roll)
                    (filter (partial valid-non-pass-move? board)))]
     (if-not (empty? moves)
-      (set moves)
-      #{(pass-move roll turn)})))
+      moves
+      (list (pass-move roll turn)))))
+
+(defn valid-moves [board roll]
+  (set (valid-moves' board roll)))
 
 (defn must-pass?
   "returns true if pass is a valid move"