alpha beta pruning

.gitignore

@@ -0,0 +1,10 @@
+/target
+/lib
+/classes
+/checkouts
+pom.xml
+*.jar
+*.class
+.lein-deps-sum
+.lein-failures
+.lein-plugins

README.md

@@ -0,0 +1,15 @@
+# yuan.game
+
+I'm an app. Or maybe I'm a library? I haven't decided yet. 
+
+The choice is up to you!
+
+## Usage
+
+FIXME
+
+## License
+
+Copyright © 2012 FIXME
+
+Distributed under the Eclipse Public License, the same as Clojure.

project.clj

@@ -0,0 +1,6 @@
+(defproject yuan/game "0.1.0-SNAPSHOT"
+  :description "Alpha beta pruning"
+  :license {:name "Eclipse Public License"
+            :url "http://www.eclipse.org/legal/epl-v10.html"}
+  :dependencies [[org.clojure/clojure "1.3.0"]
+                 [org.clojure/tools.trace "0.7.3"]])

src/yuan/game/alpha_beta_pruning.clj

@@ -0,0 +1,54 @@
+(ns yuan.game.alpha-beta-pruning
+  (:use [clojure.tools.trace]
+        [yuan.game.game-tree]))
+
+(def ^:dynamic *current-player*)
+(def ^:dynamic *turn-fn*)
+(def ^:dynamic *eval-fn*)
+
+(declare ab-rate-position)
+
+(defn ab-get-rating-max [{:keys [moves board] :as tree} upper-limit lower-limit]
+  (letfn [(f [[move & more] lower-limit]
+            (if-let [x (and move
+                            (ab-rate-position move upper-limit lower-limit))]
+              (conj (if (>= x upper-limit)
+                      ()
+                      (f more (max x lower-limit)))
+                    x)))]
+    (f moves lower-limit)))
+
+(defn ab-get-rating-min [{:keys [moves board] :as tree} upper-limit lower-limit]
+  (letfn [(f [[move & more] upper-limit]
+            (if-let [x (and move
+                            (ab-rate-position move upper-limit lower-limit))]
+              (conj (if (<= x lower-limit)
+                      ()
+                      (f more (min x upper-limit)))
+                    x)))]
+    (f moves upper-limit)))
+
+(defn ab-rate-position [{:keys [moves board] :as tree} upper-limit lower-limit]
+  (if (seq moves)
+    (if (= (*turn-fn* board) *current-player*)
+      (apply max (ab-get-rating-max tree
+                                    upper-limit
+                                    lower-limit))
+      (apply min (ab-get-rating-min tree
+                                    upper-limit
+                                    lower-limit)))
+    (*eval-fn* *current-player* board)))
+
+(defn make-agent
+  [turn-fn eval-fn]
+  (fn [{:keys [moves board] :as tree}]
+    {:pre [(seq moves)]}
+    (binding [*turn-fn* turn-fn
+              *eval-fn* eval-fn
+              *current-player* (trace :turn (turn-fn board))]
+      (let [ratings (trace :ratings
+                           (ab-get-rating-max (limit-tree-depth tree)
+                                              1
+                                              -1))
+            best (apply max ratings)]
+        (:board (nth moves (.indexOf ratings best)))))))

src/yuan/game/game_tree.clj

@@ -0,0 +1,16 @@
+(ns yuan.game.game-tree)
+
+(def ^:dynamic *ai-level* 5)
+
+(defn game-tree
+  [make-move board]
+  {:board board
+   :moves (map (partial game-tree make-move)
+                  (make-move board))})
+
+(defn limit-tree-depth [tree & {:keys [depth] :or {depth *ai-level*}}]
+  (update-in tree
+             [:moves]
+             (if (pos? depth)
+               (partial map (fn [tree] (limit-tree-depth tree :depth (dec depth))))
+               (constantly ()))))

test/yuan.game/core_test.clj

@@ -0,0 +1,7 @@
+(ns yuan.game.core-test
+  (:use clojure.test
+        yuan.game.core))
+
+(deftest a-test
+  (testing "FIXME, I fail."
+    (is (= 0 1))))