From bf049a8d4a879140dedce01c6e137a5d6c3d2c83 Mon Sep 17 00:00:00 2001
From: Robby Zambito <contact@robbyzambito.me>
Date: Sun, 23 Jan 2022 20:14:17 -0500
Subject: Added strategy which will weigh possible moves based on conditions

---
 strategies/alpha.scm | 128 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 128 insertions(+)
 create mode 100644 strategies/alpha.scm

diff --git a/strategies/alpha.scm b/strategies/alpha.scm
new file mode 100644
index 0000000..73dfb2e
--- /dev/null
+++ b/strategies/alpha.scm
@@ -0,0 +1,128 @@
+(use-modules (srfi srfi-1))
+
+(define move cons)
+(define move->row car)
+(define move->col cdr)
+
+(define (move-eq? a b)
+  (and (eq? (move->row a)
+            (move->row b))
+       (eq? (move->col a)
+            (move->col b))))
+
+(define corner-moves
+  (list (move 0 0)   ; top left
+        (move 0 7)   ; top right
+        (move 7 0)   ; bottom left
+        (move 7 7))) ; bottom right
+
+(define (in-next-row? a b)
+  (eq? (+ 1 (move->row a))
+       (move->row b)))
+
+(define (in-previous-row? a b)
+  (eq? (- 1 (move->row a))
+       (move->row b)))
+
+(define (in-next-col? a b)
+  (eq? (+ 1 (move->col a))
+       (move->row b)))
+
+(define (in-previous-col? a b)
+  (eq? (- 1 (move->col a))
+       (move->row b)))
+
+(define (corner-move? m)
+  (member m corner-moves move-eq?))
+
+; We always want to get a corner move
+(define (corner-score m)
+  (if (corner-move? m)
+    1
+    0))
+
+(define (adjacent-to-corner? m)
+  (any (lambda (corner)
+         (or (and (eq? (move->col m)
+                       (move->col corner))
+                  (in-next-row? corner m))
+             (and (eq? (move->row m)
+                       (move->row corner))
+                  (in-next-col? corner m))
+             (and (eq? (move->col m)
+                       (move->col corner))
+                  (in-previous-row? corner m))
+             (and (eq? (move->row m)
+                       (move->row corner))
+                  (in-previous-col? corner m))
+             (and (in-next-row? corner m)
+                  (in-next-col? corner m))
+             (and (in-previous-row? corner m)
+                  (in-previous-col? corner m))
+             (and (in-previous-row? corner m)
+                  (in-next-col? corner m))
+             (and (in-next-row? corner m)
+                  (in-previous-col? corner m))))
+       corner-moves))
+
+; Discourage going near a corner, which could allow opponent to go there
+(define (near-corner-score m)
+  (if (adjacent-to-corner? m)
+    1
+    0))
+
+(define (is-edge? m)
+  (or (eq? 0 (move->row m))
+      (eq? 7 (move->row m))
+      (eq? 0 (move->col m))
+      (eq? 7 (move->col m))))
+
+(define (edge-score m)
+  (if (is-edge? m)
+    1
+    0))
+
+(define (adjacent-to-edge? m)
+  (or (eq? 1 (move->row m))
+      (eq? 6 (move->row m))
+      (eq? 1 (move->col m))
+      (eq? 6 (move->col m))))
+
+(define (near-edge-score m)
+  (if (adjacent-to-edge? m)
+    1
+    0))
+
+(define (first-or-else l d)
+  (if (null? l)
+    d
+    (first l)))
+
+(define (available-moves-for-opponent-after-move m)
+  (length (valid-moves (apply-move m) (other-player))))
+
+(define (maximum-flips-on-opponents-next-turn m)
+  (let ((board-after-move (apply-move m)))
+    (reduce
+      max
+      0
+      (map (lambda (n)
+             (flipped-by-move n board-after-move (other-player)))
+           (valid-moves board-after-move (other-player))))))
+
+; Score is the sum of some weighted conditions for a move
+(define (move->score m)
+  (+ (* (corner-score m)                             100)
+     (* (near-corner-score m)                         -5)
+     (* (edge-score m)                                4)
+     (* (near-edge-score m)                           -3)
+     (* (flipped-by-move m)                            3)
+     (* (available-moves-for-opponent-after-move m) -0.1)
+     (* (maximum-flips-on-opponents-next-turn m)      -1)))
+
+(define (score-sort a b)
+  (> (move->score a)
+     (move->score b)))
+
+(first (sort (valid-moves)
+             score-sort))
-- 
cgit v1.2.3