extracted higher-order function

yuanmai · Jul 29, 2012 · f382e03 · f382e03
1 parent ae39c6a
commit f382e03
Show file tree

Hide file tree

Showing 2 changed files with 35 additions and 26 deletions.
diff --git a/src/yuan/game/alpha_beta_pruning.clj b/src/yuan/game/alpha_beta_pruning.clj
@@ -8,49 +8,55 @@
 
 (declare ab-rate-position)
 
-(defn ab-get-rating-max [{:keys [moves board] :as tree} upper-limit lower-limit]
+(defn ab-get-rating-max [upper-limit lower-limit {:keys [moves board] :as tree}]
   (letfn [(f [[move & more] lower-limit]
             (if-let [x (and move
-                            (ab-rate-position move upper-limit lower-limit))]
+                            (ab-rate-position upper-limit lower-limit move))]
               (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]
+(defn ab-get-rating-min [upper-limit lower-limit {:keys [moves board] :as tree}]
   (letfn [(f [[move & more] upper-limit]
             (if-let [x (and move
-                            (ab-rate-position move upper-limit lower-limit))]
+                            (ab-rate-position upper-limit lower-limit move))]
               (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]
+(defn ab-rate-position [upper-limit lower-limit {:keys [moves board] :as tree}]
   (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)))
+      (apply max (ab-get-rating-max upper-limit
+                                    lower-limit
+                                    tree))
+      (apply min (ab-get-rating-min upper-limit
+                                    lower-limit
+                                    tree)))
     (*eval-fn* *current-player* board)))
 
+(defn opportunistic [f]
+  (fn g [tree]
+    (let [ratings (f tree)]
+      (if (and (> *ai-level* 1)
+               (apply = ratings))
+        (binding [*ai-level* (dec *ai-level*)]
+          (g tree))
+        ratings))))
+
 (defn make-agent
   [turn-fn eval-fn]
-  (fn best-move [{:keys [moves board] :as tree} & {:keys [depth] :or {depth *ai-level*}}]
+  (fn best-move [{: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 :depth depth)
-                                              1
-                                              -1))
+      (let [f (opportunistic (comp (partial ab-get-rating-max 1 -1)
+                                   limit-tree-depth))
+            ratings (trace :ratings (f tree))
             best (apply max ratings)]
-        (if (and (pos? depth) (= best -1))
-          (best-move tree :depth (trace "being opportunistic" (dec depth)))
-          (nth moves (.indexOf ratings best)))))))
+        (nth moves (.indexOf ratings best))))))
diff --git a/src/yuan/game/game_tree.clj b/src/yuan/game/game_tree.clj
@@ -1,4 +1,5 @@
-(ns yuan.game.game-tree)
+(ns yuan.game.game-tree
+  (:use [clojure.tools.trace]))
 
 (def ^:dynamic *ai-level* 5)
 
@@ -8,12 +9,14 @@
    :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 ()))))
+(defn limit-tree-depth [tree]
+  (letfn [(f [tree depth]
+            (update-in tree
+                       [:moves]
+                       (if (pos? depth)
+                         (partial map (fn [tree] (f tree (dec depth))))
+                         (constantly ()))))]
+    (f tree *ai-level*)))
 
 (defn random-agent [tree]
   (rand-nth (:moves tree)))